(* Release 3.10 *) (*-------------------------------------------------------------------------* * * * COREMATH.A - trig functions and error handling * * * * COPYRIGHT (C) 1989..1992 Clarion Software Corporation. * * All Rights Reserved * * * *--------------------------------------------------------------------------*) include "corelib.inc" StdFloat = (_WINDOWS) | ~(_jpicall) module CoreMath (*%T RegParam *) PopParam = 1 (*%E RegParam *) (*************************************************************************) segment _BSS(BSS,28H) public _matherr : org CodePtrSize public __SH_sword : org 2 public __exc_addr : org 4 segment _BSS(BSS,28H) public __fac : org 10 (* return address & first error argument *) segment _DATA(DATA,28H) public _HUGE : db 098H,060H,0B9H,0D7H,0FFH,0FFH,0EFH,07FH segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) public @coremath_HUGE : db 098H,060H,0B9H,0D7H,0FFH,0FFH,0EFH,07FH segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) public @coremath_MIN : db 00H,00H,00H,00H,00H,00H,10H,00H segment _DATA(DATA,28H) public _LHUGE : db 0FFH,0FFH,0FFH,0FFH,0FFH,0FFH,0FFH,0FFH,0FEH,07FH segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) public @coremath_LHUGE : db 0FFH,0FFH,0FFH,0FFH,0FFH,0FFH,0FFH,0FFH,0FEH,07FH segment PROC_TEXT(CODE,28H) public @Save8087 : dw 0 (* 1 if floating point context save required *) segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) public @coremath_int_one : dw 1 segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) public @coremath_int_two : dw 2 segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) public @coremath_int_four : dw 4 segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) public @coremath_int_ten : dw 10 segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) public @coremath_tbyte_Pi_By_2 : dw 0C235H, 02168H, 0DAA2H, 0C90FH, 03FFFH segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) public @coremath_tbyte_Pi_By_4: dw 0C235H, 02168H, 0DAA2H, 0C90FH, 03FFEH segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) public @coremath_floor: dw 173FH (* affine,errors masked *) segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) public @coremath_ceil: dw 1B3FH (* affine errors masked *) segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) public @coremath_nearest: dw 133FH (* affine,errors masked *) segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) public @coremath_default: dw 1F22H (* affine,chop,64 bit precision,*) (* denorm & precision masked *) (*************************************************************************) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) public __fpreset : db Ret0@ (************************************************************************) (*%F StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,48H) extrn _matherr extrn __seterrno extrn @coremath_HUGE extrn @coremath_MIN (* __report_math_error is used for error reporting from math error functions. It is called from __lib_error where the table mechanism for error recovery is used, or may be called directly from a function detecting an error condition. On entry, st(0) == intended return value st(5) == arg1 st(6) == arg2 cs:bx points to function name, null terminated ax == exception type. If a user-defined matherr has been installed, it is called, otherwise errno is set and we return to the caller. struct exception { int type; char *name; double arg1; double arg2; double retval; } *) public __report_math_error: push bp mov bp,sp push di push si push cx (*%F SameDS *) push ds (*%E *) mov cx,ax (* cx == exception type *) (*%T _fcall *) (*%F SameDS *) mov ax, seg _matherr mov ds, ax (*%E *) les ax, [_matherr] mov si, es or si, ax (*%E *) (*%F _fcall *) cmp word [_matherr], 0 (*%E *) je doerrno (* A user-defined error handler has been installed. Call it *) (* First, copy the name into the stack segment *) push cs pop es mov di,bx sub al,al push cx mov cx,-1 repne; scasb not cx inc cx and cx,-2 mov si,cx pop cx sub sp,si mov si,sp (* si = ^name *) mov di,si lp: mov al,es:[bx] mov ss:[di],al inc bx inc di or al,al jnz lp (* Now create the structure on the stack *) sub sp,34 (* space for 3 doubles, one tbyte *) mov bx,sp fld st(0),st(0) fstp tbyte ss:[bx][24], st(0) call forcedouble fst qword ss:[bx][16], st(0) fld st(0),st(6) call forcedouble fstp qword ss:[bx][8], st(0) fld st(0),st(5) call forcedouble fstp qword ss:[bx][0], st(0) (*%T FarPtr *) push ss (*%E *) push si (* ^name *) push cx (* type *) mov ax,sp (* pointer to exception structure *) (*%T FarPtr *) mov bx,ss (* segment part of the above *) (*%E *) (*%T _fcall *) call dword [_matherr] (*%E *) (*%F _fcall *) call word [_matherr] (*%E *) test ax,ax mov bx,sp jnz newretval (* matherr supplied a new retval *) (* Reload the saved return value *) (*%T FarPtr *) fld tbyte st(0),ss:[bx][30] (*%E *) (*%F FarPtr *) fld tbyte st(0),ss:[bx][28] (*%E *) fstp st(1),st(0) (* retval in st(0) *) jmp doerrno newretval: (*%T FarPtr *) fld qword st(0),ss:[bx][22] (*%E *) (*%F FarPtr *) fld qword st(0),ss:[bx][20] (*%E *) fstp st(1),st(0) (* user's new retval in st(0) *) jmp done doerrno: mov ax, EDOM cmp cx,_DOMAIN (* type == _DOMAIN *) je wasdomain mov ax, ERANGE wasdomain: (*%T _fcall *) call far __seterrno (*%E *) (*%F _fcall *) call __seterrno (*%E *) done: (*%F SameDS *) lea sp,[bp][-8] pop ds (*%E *) (*%T SameDS *) lea sp,[bp][-6] (*%E *) pop cx pop si pop di mov sp,bp pop bp ret 0 forcedouble: (* force st(0) into the range that fits in a double *) push ax push bx mov bx,sp fcom qword st(0),cs:[@coremath_HUGE] push ax fstsw ss:[bx][-2] fwait pop ax sahf jb NotPosH fstp st(0),st(0) fld qword st(0),cs:[@coremath_HUGE] jmp fddone NotPosH: fcom qword st(0),cs:[@coremath_MIN] push ax fstsw ss:[bx][-2] fwait pop ax sahf ja fddone (* now st(0) must be < coremath_min *) fchs st(0) fcom qword st(0),cs:[@coremath_HUGE] push ax fstsw ss:[bx][-2] fwait pop ax sahf jb NotNegH fstp st(0),st(0) fld qword st(0),cs:[@coremath_HUGE] fchs st(0) jmp fddone NotNegH: fcom qword st(0),cs:[@coremath_MIN] push ax fstsw ss:[bx][-2] fchs st(0) pop ax sahf ja fddone fstp st(0),st(0) fldz st(0) fddone: pop bx pop ax ret 0 (*%E NOT StdFloat *) (*************************************************************************) (*%F StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn __report_math_error (* __lib_error is used by the math library functions to report range, domain and underflow errors etcetera. It may be called via two routes: 1. An exception occurring inside a math library function will cause __math_excep to call this function. __math_excep reads the address of a table from ss:InMathLib. This table contains a (short) resume address and then a table in the format below. The address of the table (excluding the resume address) is passed to __lib_error in si. 2. math library functions pre-emptively detecting an error case without causing an exception may call __lib_error directly. In this case, si must point to a table as described below. The table processed by __lib_error is in the following format: [si][0] short address of procedure to yield return value when arg1 is negative [si][2] ditto when arg1 is positive [si][4] flags byte. If [si][4] & f_st5 != 0, arg1 is in the st(5) register at the point of the exception or call to __lib_error. Otherwise, it is in st(0). If [si][4] & f_two != 0, there is a second argument in st(6). [si][6] null terminated string containing name of function with error. The procedures pointed to by [si][0] and [si][2] push the required return value into st(0), and return the error type in ax. *) public __lib_error: push bp mov bp, sp sub sp,2 push ax push bx push cx push dx test byte cs:[si][4], f_st5 (* is arg1 in st5? *) jz not_st5 fld st(0), st(5) fstp st(1), st(0) (* st(0) == st(5) == arg1 *) jmp st5_done not_st5: fst st(5), st(0) (* st(0) == st(5) == arg1 *) st5_done: ftst st(0) fstsw [bp][-2] fwait test byte [bp][-1], 1 (* Check if arg1 was +ve *) mov ax, cs:[si][2] (* negative entry from table *) jz me_positive mov ax, cs:[si][0] (* positive entry from table *) me_positive: call ax (* Call function to yield retval, pushed into st(0) *) fstp st(1), st(0) (* retval into st(0), arg1 in st(5) *) or ax, ax (* is it an error? *) jz me_ok test byte cs:[si][4], f_two (* Clear st(6) if there is only one argument *) jnz has_two fldz st(0) fstp st(7), st(0) has_two: lea bx, [si][5] (* st(0)==retval, st(5)==arg1, st(6)==arg2, bx=name *) call __report_math_error me_ok: pop dx pop cx pop bx pop ax mov sp, bp pop bp ret 0 (*%E NOT StdFloat *) (*************************************************************************) (*%F StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn @coremath_int_one extrn $err_domain public $check_abs_one: fld st(0), st(0) fabs st(0) ficomp word st(0), cs:[@coremath_int_one] fstsw [bp][-2] fwait test byte [bp][-1], 40H jz ab1_err ret 0 ab1_err: add sp,2 jmp near $err_domain (*%E NOT StdFloat *) (*************************************************************************) (*%F StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn $err_underflow extrn $err_plus_infinity extrn $err_minus_infinity public _ldexp: push bp mov bp,sp sub sp,10 mov word ss:[InMathLib], ldexptable mov word ss:[InMathLib][2], bp push ax fst st(5), st(0) fild word st(0), [bp][-12] fst st(7), st(0) fxch st(0),st(1) fscale st(0), st(1) fst qword [bp][-10],st(0) (* to provoke error if too big for double *) fstp st(1), st(0) ldexp_exit: mov sp,bp pop bp mov word ss:[InMathLib], 0 db Ret0@ ldexptable: dw ldexp_exit, ldexp_err_neg, ldexp_err_pos; db f_st5+f_two, "ldexp", 0 ldexp_err_pos: fld st(0),st(6) ftst st(0) fstsw [bp][-2] fstp st(0), st(0) test byte [bp][-1], 1 jnz $err_underflow jmp $err_plus_infinity ldexp_err_neg: fld st(0),st(6) ftst st(0) fstsw [bp][-2] fstp st(0), st(0) test byte [bp][-1], 1 jnz $err_underflow jmp $err_minus_infinity (*%E NOT StdFloat *) (*************************************************************************) (*%F StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn $err_underflow extrn $err_huge_plus_infinity extrn $err_huge_minus_infinity public _ldexpl : push bp mov bp,sp mov word ss:[InMathLib], ldexpltable mov word ss:[InMathLib][2], bp push ax fst st(5), st(0) fild word st(0), [bp][-2] fst st(7), st(0) fxch st(0),st(1) fscale st(0), st(1) fstp st(1), st(0) ldexpl_exit: mov sp,bp pop bp mov word ss:[InMathLib], 0 db Ret0@ ldexpltable: dw ldexpl_exit, ldexpl_err_neg, ldexpl_err_pos; db f_st5+f_two, "ldexpl", 0 ldexpl_err_pos: fld st(0),st(6) ftst st(0) fstsw [bp][-2] fstp st(0), st(0) test byte [bp][-1], 1 jnz $err_underflow jmp $err_huge_plus_infinity ldexpl_err_neg: fld st(0),st(6) ftst st(0) fstsw [bp][-2] fstp st(0), st(0) test byte [bp][-1], 1 jnz $err_underflow jmp $err_huge_minus_infinity (*%E NOT StdFloat *) (*************************************************************************) (*%F StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) public _hypot: public _hypotl: (*%T _DLLOVL *) push bp mov bp, sp (*%E *) hypotCommon: fmul st(0), st(0) fld st(0), st(6) fmul st(0), st(0) faddp st(1), st(0) fsqrt st(0) (*%T _DLLOVL *) pop bp (*%E *) db Ret0@ (*%E NOT StdFloat *) (*************************************************************************) (*%F StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) public __round: (*%T _DLLOVL *) push bp mov bp, sp (*%E *) frndint st(0) (*%T _DLLOVL *) pop bp (*%E *) (*%F NearCall *) ret far 0 (*%E *) (*%T NearCall *) ret 0 (*%E *) (*%E NOT StdFloat *) (*************************************************************************) (*%F StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn @coremath_tbyte_Pi_By_4 public _sin : public _sinl : push bp mov bp, sp sub sp, 2 push cx xor cl, cl jmp trig public _cos : public _cosl : push bp mov bp, sp sub sp, 2 push cx mov cl, 2 jmp trig public _tan : public _tanl : push bp mov bp, sp sub sp, 2 push cx mov cl, 4 trig: push ax trigCommon: fxam st(0) (* '87 works while we enter routine*) fstsw [bp][-2] fwait mov ah, [bp][-1] fabs st(0) fldpi st(0) fadd st(0),st(0) (* st(0) = 2*pi *) fxch st(0),st(1) Lp: fprem st(0) (* reduce abs(arg1) by 2*pi *) fwait fstsw [bp][-2] test byte [bp][-1],4 jnz Lp fstp st(1),st(0) fld tbyte st(0), cs:[@coremath_tbyte_Pi_By_4] fxch st(0),st(1) fprem st(0) mov ch, ah and ch, 2 shr ch, 1 (* ch := sign *) fstsw [bp][-2] fwait mov ax, [bp][-2] mov al, ah and al, 3 (* select the C3, C1, and C0 status bits*) shl ah, 1 shl ah, 1 rcl al, 1 (* arrange them in the ls 3 bits of BX*) add al, 0FCH rcl al, 1 (* al now contains the octant number*) cmp cl, 2 (* are we doing Cosine ?*) jne trig_notCosine add al, cl (* Cos (x) = Sin (x + 2 octants)*) mov ch, 0 (* Cosine has even symmetry around 0*) trig_notCosine: and al, 7 test al, 1 jz trig_evens fsubp st(1), st(0) (* overwrites pi/4 in st(1), pops.*) jmp trig_ptan trig_evens: fstp st(1), st(0) trig_ptan: fptan st(0) cmp cl, 4 je trig_tangent test al, 3 jpe trig_sineOctant trig_cosOctant: fxch st(0), st(1) trig_sineOctant: fmul st(0), st(0) fstp st(7), st(0) fld st(0), st(0) fmul st(0), st(0) fadd st(0), st(7) fsqrt st(0) shr al, 1 shr al, 1 xor al, ch jz trig_sineDiv fchs st(0) trig_sineDiv: fdivp st(1), st(0) jmp trig_end trig_tangent: mov ah, al shr ah, 1 and ah, 1 xor ah, ch jz trig_tanSigned fchs st(0) trig_tanSigned: test al, 3 jpe trig_ratio fdivrp st(1),st(0) jmp trig_end trig_ratio: fdivp st(1), st(0) trig_end: pop ax pop cx mov sp, bp pop bp db Ret0@ (*%E NOT StdFloat *) (*************************************************************************) (*%F StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn $err_domain extrn __lib_error extrn @coremath_tbyte_Pi_By_2 public _atan2: public _atan2l: push bp mov bp, sp sub sp, 4 atan2Common: call atan20 mov sp, bp pop bp db Ret0@ atan20: ftst st(0) fstsw [bp][-2] fwait test byte [bp][-1],1 je atan21 fchs st(0) call atan21 fchs st(0) ret 0 atan21: fld st(0), st(6) ftst st(0) fstsw [bp][-4] fwait test byte [bp][-3],1 je atan22 fchs st(0) call atan22 fldpi st(0) fsubrp st(1),st(0) ret 0 atan22: test byte [bp][-3],40H jnz maybe_zero_zero not_zero_zero: fcom st(0), st(1) fstsw [bp][-2] fwait test byte [bp][-1],1 jz atan23 fxch st(0), st(1) fpatan st(1), st(0) fld tbyte st(0), cs:[@coremath_tbyte_Pi_By_2] fsubrp st(1),st(0) ret 0 atan23: fpatan st(1),st(0) ret 0 maybe_zero_zero: test byte [bp][-1],40H jz not_zero_zero fstp st(0), st(0) push si mov si, atan2_err_data call __lib_error pop si ret 0 atan2_err_data: dw $err_domain, $err_domain; db f_two, "atan2", 0 (*%E NOT StdFloat *) (*************************************************************************) (*%F StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn $atan0 public _atan: public _atanl: push bp mov bp, sp sub sp, 2 atanCommon: call $atan0 mov sp, bp pop bp db Ret0@ (*%E StdFloat *) (*************************************************************************) (*%F StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn @coremath_tbyte_Pi_By_2 public $atan0: ftst st(0) fstsw [bp][-2] fwait test byte [bp][-1],1 je atan1 fchs st(0) call atan1 fchs st(0) ret 0 atan1: fld1 st(0) fcom st(0), st(1) fstsw [bp][-2] fwait test byte [bp][-1],1 jnz atan2 fpatan st(1), st(0) ret 0 atan2: fxch st(0), st(1) fpatan st(1),st(0) fld tbyte st(0),cs:[@coremath_tbyte_Pi_By_2] fsubrp st(1),st(0) ret 0 (*%E NOT StdFloat *) (*************************************************************************) (*%F StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn $err_domain extrn $err_minus_infinity extrn __lib_error public _log : push bp mov bp, sp sub sp, 2 logCommon: ftst st(0) fstsw [bp][-2] test byte [bp][-1], 41H jnz log_error fldln2 st(0) fxch st(0), st(1) fyl2x st(1), st(0) log_exit: mov sp, bp pop bp db Ret0@ log_error: push si mov si, log_err_data call __lib_error pop si jmp log_exit log_err_data: dw $err_domain, $err_minus_infinity; db 0, "log", 0 (*%E NOT StdFloat *) (*************************************************************************) (*%F StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn $err_domain extrn $err_huge_minus_infinity extrn __lib_error public _logl : push bp mov bp, sp sub sp, 2 logCommon: ftst st(0) fstsw [bp][-2] test byte [bp][-1], 41H jnz log_error fldln2 st(0) fxch st(0), st(1) fyl2x st(1), st(0) log_exit: mov sp, bp pop bp db Ret0@ log_error: push si mov si, log_err_data call __lib_error pop si jmp log_exit log_err_data: dw $err_domain, $err_huge_minus_infinity; db f_long, "logl", 0 (*%E NOT StdFloat *) (*************************************************************************) (*%F StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn $err_domain extrn $err_minus_infinity extrn __lib_error public _log10 : push bp mov bp, sp sub sp, 2 log10Common: ftst st(0) fstsw [bp][-2] fwait test byte [bp][-1], 41H jnz log10_error fldlg2 st(0) fxch st(0), st(1) fyl2x st(1), st(0) log10_exit: mov sp, bp pop bp db Ret0@ log10_error: push si mov si, log10_err_data call __lib_error pop si jmp log10_exit log10_err_data: dw $err_domain, $err_minus_infinity; db 0, "log10", 0 (*%E NOT StdFloat *) (*************************************************************************) (*%F StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn $err_domain extrn $err_huge_minus_infinity extrn __lib_error public _log10l : push bp mov bp, sp sub sp, 2 log10Common: ftst st(0) fstsw [bp][-2] fwait test byte [bp][-1], 41H jnz log10_error fldlg2 st(0) fxch st(0), st(1) fyl2x st(1), st(0) log10_exit: mov sp, bp pop bp db Ret0@ log10_error: push si mov si, log10_err_data call __lib_error pop si jmp log10_exit log10_err_data: dw $err_domain, $err_huge_minus_infinity; db f_long, "log10l", 0 (*%E NOT StdFloat *) (*************************************************************************) (*%F StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn $err_domain public _sqrt : public _sqrtl : push bp mov bp, sp mov word ss:[InMathLib], sqrttable mov word ss:[InMathLib][2], bp sqrtCommon: (* Return the square root of x, which must be greater than zero. *) fsqrt st(0) (*invalid op possible*) fwait sqrt_exit: mov word ss:[InMathLib], 0 mov sp,bp pop bp db Ret0@ sqrttable: dw sqrt_exit, $err_domain, $err_domain; db 0, "sqrt", 0 (*%E NOT StdFloat *) (*************************************************************************) (*%F StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) (* compute 2^st(0) , result is represented as st(0) * 2^st(4) *) extrn @coremath_int_four public $pow2 : fld1 st(0) fxch st(0), st(1) fst st(5), st(0) frndint st(0) fsub st(0), st(1) fxch st(0), st(5) fsub st(0), st(5) (* we now know that st(0) is in range [0..2) *) fidiv word st(0), cs:[@coremath_int_four] (* now in range [0..0.5] *) f2xm1 st(0) faddp st(1), st(0) fmul st(0), st(0) fmul st(0), st(0) ret 0 (*%E NOT StdFloat *) (*************************************************************************) (*%F StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn $err_underflow extrn $err_plus_infinity extrn $pow2 public _exp : push bp mov bp, sp mov word ss:[InMathLib], exptable mov word ss:[InMathLib][2], bp sub sp, 10 expCommon: fst st(5), st(0) (* save parameter for error processing *) fldl2e st(0) fmulp st(1), st(0) fist word [bp][-2], st(0) (* to check that it is not too large *) fwait call $pow2 fld st(0), st(4) (* retrieve integral part *) fxch st(1), st(0) fscale st(0), st(1) fst qword [bp][-10],st(0) (* to provoke error if too big for double *) fstp st(1),st(0) exp_exit: mov sp, bp pop bp mov word ss:[InMathLib], 0 db Ret0@ exptable: dw exp_exit, $err_underflow, $err_plus_infinity; db f_st5, "exp", 0 (*%E NOT StdFloat *) (*************************************************************************) (*%F StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn $err_underflow extrn $err_huge_plus_infinity extrn $pow2 public _expl : push bp mov bp, sp mov word ss:[InMathLib], expltable mov word ss:[InMathLib][2], bp sub sp, 2 expCommon: fst st(5), st(0) (* save parameter for error processing *) fldl2e st(0) fmulp st(1), st(0) fist word [bp][-2], st(0) (* to check that it is not too large *) fwait call $pow2 fld st(0), st(4) (* retrieve integral part *) fxch st(1), st(0) fscale st(0), st(1) fstp st(1),st(0) exp_exit: mov sp, bp pop bp mov word ss:[InMathLib], 0 db Ret0@ expltable: dw exp_exit, $err_underflow, $err_huge_plus_infinity; db f_st5+f_long, "expl", 0 (*%E NOT StdFloat *) (*************************************************************************) (*%F StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn $pow2 public _tanh : public _tanhl : push bp mov bp, sp mov word ss:[InMathLib], tanhtable mov word ss:[InMathLib][2], bp sub sp, 2 tanhCommon: fst st(5), st(0) (* save for error processing *) fldl2e st(0) fmulp st(1), st(0) fist word [bp][-2], st(0) (* to check that it is not too large *) fwait call $pow2 fld st(0), st(4) (* retrieve integral part *) fxch st(1), st(0) fscale st(0), st(1) fstp st(1), st(0) (* st(0) = e**arg1 *) fld1 st(0) fdiv st(0), st(1) (* Exp (-x) *) (* st(0) = e**arg1,st(1) = e**-arg1 *) fst st(7), st(0) (* st(7) = e**arg1 *) fadd st(0), st(1) (* st(0) = (e**arg1)+(e**-arg1) *) fxch st(0), st(1) (* st(0) = e**-arg1 *) fsub st(0), st(7) (* st(0) = (e**-arg1)-(e**arg1) *) fdivrp st(1), st(0) (* st(0) = (e**-arg1)-(e**arg1)/(e**arg1)+(e**-arg1) *) tanh_exit: mov sp, bp pop bp mov word ss:[InMathLib], 0 db Ret0@ tanhtable: dw tanh_exit, tanh_minus_one,tanh_one; db f_st5, "tanh", 0 tanh_one: sub ax, ax fld1 st(0) ret 0 tanh_minus_one: call tanh_one fchs st(0) ret 0 (*%E NOT StdFloat *) (*************************************************************************) (*%F StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn $pow2 extrn $err_minus_infinity extrn $err_plus_infinity extrn @coremath_int_two public _sinh : push bp mov bp, sp mov word ss:[InMathLib], sinhtable mov word ss:[InMathLib][2], bp sub sp, 10 sinhCommon: fst st(5), st(0) (* save for error processing *) fldl2e st(0) fmulp st(1), st(0) fist word [bp][-2], st(0) (* to check that it is not too large *) fwait call $pow2 fld st(0), st(4) (* retrieve integral part *) fxch st(1), st(0) fscale st(0), st(1) fstp st(1), st(0) fld1 st(0) fchs st(0) fdiv st(0), st(1) (* - Exp (-x) *) faddp st(1), st(0) fidiv word st(0), cs:[@coremath_int_two ] fst qword [bp][-10], st(0) (* To check not overflowed double *) fwait sinh_exit: mov sp, bp pop bp mov word ss:[InMathLib], 0 db Ret0@ sinhtable: dw sinh_exit, $err_minus_infinity, $err_plus_infinity; db f_st5, "sinh", 0 (*%E NOT StdFloat *) (*************************************************************************) (*%F StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn $pow2 extrn $err_huge_minus_infinity extrn $err_huge_plus_infinity extrn @coremath_int_two public _sinhl : push bp mov bp, sp mov word ss:[InMathLib], sinhltable mov word ss:[InMathLib][2], bp sub sp, 2 sinhCommon: fst st(5), st(0) (* save for error processing *) fldl2e st(0) fmulp st(1), st(0) fist word [bp][-2], st(0) (* to check that it is not too large *) fwait call $pow2 fld st(0), st(4) (* retrieve integral part *) fxch st(1), st(0) fscale st(0), st(1) fstp st(1), st(0) fld1 st(0) fchs st(0) fdiv st(0), st(1) (* - Exp (-x) *) faddp st(1), st(0) fidiv word st(0), cs:[@coremath_int_two ] sinh_exit: mov sp, bp pop bp mov word ss:[InMathLib], 0 db Ret0@ sinhltable: dw sinh_exit, $err_huge_minus_infinity, $err_huge_plus_infinity; db f_st5, "sinhl", 0 (*%E NOT StdFloat *) (*************************************************************************) (*%F StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn $err_plus_infinity extrn $pow2 extrn @coremath_int_two public _cosh : push bp mov bp, sp mov word ss:[InMathLib], coshtable mov word ss:[InMathLib][2], bp sub sp, 10 coshCommon: fst st(5), st(0) (* save for error processing *) fabs st(0) fldl2e st(0) fmulp st(1), st(0) fist word [bp][-2], st(0) (* to check that it is not too large *) fwait call $pow2 fld st(0), st(4) (* retrieve integral part *) fxch st(1), st(0) fscale st(0), st(1) fstp st(1), st(0) fld1 st(0) fdiv st(0), st(1) (* Exp (-x) *) faddp st(1), st(0) fidiv word st(0), cs:[@coremath_int_two ] fst qword [bp][-10], st(0) (* to check result is in double range *) fwait cosh_exit: mov sp, bp pop bp mov word ss:[InMathLib], 0 db Ret0@ coshtable: dw cosh_exit, $err_plus_infinity, $err_plus_infinity; db f_st5, "cosh", 0 (*%E NOT StdFloat *) (*************************************************************************) (*%F StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn $err_huge_plus_infinity extrn $pow2 extrn @coremath_int_two public _coshl : push bp mov bp, sp mov word ss:[InMathLib], coshltable mov word ss:[InMathLib][2], bp sub sp, 2 coshCommon: fst st(5), st(0) (* save for error processing *) fabs st(0) fldl2e st(0) fmulp st(1), st(0) fist word [bp][-2], st(0) (* to check that it is not too large *) fwait call $pow2 fld st(0), st(4) (* retrieve integral part *) fxch st(1), st(0) fscale st(0), st(1) fstp st(1), st(0) fld1 st(0) fdiv st(0), st(1) (* Exp (-x) *) faddp st(1), st(0) fidiv word st(0), cs:[@coremath_int_two ] cosh_exit: mov sp, bp pop bp mov word ss:[InMathLib], 0 db Ret0@ coshltable: dw cosh_exit, $err_huge_plus_infinity, $err_huge_plus_infinity; db f_st5, "coshl", 0 (*%E NOT StdFloat *) (*************************************************************************) (*%F StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn $atan0 extrn $check_abs_one extrn @coremath_tbyte_Pi_By_2 public _asin: public _asinl : push bp mov bp, sp mov word ss:[InMathLib], asintable mov word ss:[InMathLib][2], bp sub sp, 2 asinCommon: fst st(5), st(0) fmul st(0), st(0) (* arg1**2 *) fld1 st(0) fsubrp st(1),st(0) (* arg1**2-1 *) ftst st(0) fstsw [bp][-2] fsqrt st(0) (* sqrt (arg1**2-1) *) test byte [bp][-1],40H (* is result 0 *) jz Not0 (* no *) fcom st(0),st(5) (* was arg1 neg ? *) fstsw [bp][-2] fld tbyte st(0),cs:[@coremath_tbyte_Pi_By_2] (* $1 *) fstp st(1),st(0) (* $0 *) pop ax (* flags of cmp 0,arg1 *) sahf jb asin_exit (* arg1 was positive. return pi/2 *) fchs st(0) jmp asin_exit (* arg1 was negative. return -pi/2 *) Not0: fdivr st(0),st(5) (* arg1/(sqrt(arg1**2-1)) *) fwait call $atan0 asin_exit: mov sp,bp pop bp mov word ss:[InMathLib], 0 db Ret0@ asintable: dw asin_exit, err_asin_neg, err_asin_pos; db f_st5, "asin", 0 err_asin_pos: call $check_abs_one fld1 st(0) fstp st(1),st(0) fchs st(0) fldpi st(0) fscale st(0),st(1) sub ax, ax ret 0 err_asin_neg: call err_asin_pos fchs st(0) ret 0 (*%E NOT StdFloat *) (*************************************************************************) (*%F StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn $atan0 extrn $check_abs_one extrn @coremath_tbyte_Pi_By_2 public _acos : public _acosl : push bp mov bp, sp mov word ss:[InMathLib], acostable mov word ss:[InMathLib][2], bp sub sp, 2 acosCommon: ftst st(0) (* is arg1 0 or -0 ? *) fstsw [bp][-2] (* store SW *) fst st(5), st(0) test byte [bp][-1],40H (* test for zero flag *) jnz PiBy2 (* arg1 is 0,so return pi/2 *) fmul st(0), st(0) fld1 st(0) fsubrp st(1),st(0) fsqrt st(0) fdivr st(0),st(5) fwait call $atan0 PiBy2: fld tbyte st(0), cs:[@coremath_tbyte_Pi_By_2] fsubrp st(1), st(0) acos_exit: mov sp, bp pop bp mov word ss:[InMathLib], 0 db Ret0@ acostable: dw acos_exit, err_acos_neg, err_acos_pos; db f_st5, "acos", 0 err_acos_pos: call $check_abs_one fldz st(0) sub ax, ax ret 0 err_acos_neg: call $check_abs_one fldpi st(0) sub ax, ax ret 0 (*%E NOT StdFloat *) (*************************************************************************) (*%F StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) public __bcd_to_int : (* si = bcd, di = int mantissa *) ret 0 (*%E NOT StdFloat *) (*************************************************************************) (*%F StdFloat *) section segment _DATA(DATA,28H) segment SIG_TEXT(CODE,28H) segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn __SH_sword extrn __exc_addr extrn __lib_error public __math_excep: (* called from floating point exception handler *) (* 8087 status word on stack, behind FAR return address to signal handler. This function must reside in the same segment as the math library functions which use InMathLib [bp][0] == saved bp [bp][2] == return ip to signal handler [bp][4] == return cs to signal handler [bp][6] == 8087 status word [bp][8] == return ip to point of exception [bp][10] == return cs to point of exception [bp][12] == flags for iret *) push bp mov bp,sp sub sp,2 cmp word ss:[InMathLib], 0 je user_error (* An exception has occurred in a math library function *) jmp pop_8087 pop_8087_loop: fstp st(0), st(0) pop_8087: fstsw [bp][-2] fwait and word [bp][-2], 3800H cmp word [bp][-2], 0800H jnz pop_8087_loop (* The address of the handler table is in ss:[InMathLib] *) push si push ax push bx mov si,ss:[InMathLib] mov word ss:[InMathLib], 0 mov ax, cs:[si] (* resume address *) inc si inc si mov [bp][2],ax (* adjust local return address *) mov bx,ss:[InMathLib][2] (* get the BP at the point of error *) mov [bp],bx (* and make sure we restore to it *) call __lib_error pop bx pop ax pop si mov sp,bp pop bp ret 10 (* return NEAR to resume point (we know it's in same code segment) discard signal hadler cs, 8087 status word, and 6 byte iret info *) user_error: push ax push ds (*%T _WINDOWS *) mov ax, ss (*%E *) (*%F _WINDOWS *) mov ax, _DATA (*%E *) mov ds, ax mov ax, [bp][6] (* status word *) mov [__SH_sword], ax mov ax, [bp][8] (* error offset *) mov [__exc_addr], ax mov ax, [bp][10] (* error segment *) mov [__exc_addr][2], ax pop ds pop ax mov sp, bp pop bp ret far 2 (* return FAR to signal handler, discarding status word *) (*%E NOT StdFloat *) (*************************************************************************) (*%T StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,48H) extrn _matherr extrn __seterrno extrn @coremath_HUGE extrn @coremath_MIN (* __report_math_error is used for error reporting from math error functions. It is called from __lib_error where the table mechanism for error recovery is used, or may be called directly from a function detecting an error condition. On entry, st(0) == intended return value st(1) == arg1 st(2) == arg2 cs:bx points to function name, terminated by linefeed character ax == exception type. On exit, st(0) == return value If a user-defined matherr has been installed, it is called, otherwise errno is set and we return to the caller. struct exception { int type; char *name; double arg1; double arg2; double retval; } *) public __report_math_error: push bp mov bp,sp push di push si push cx (*%T SameDS *) push ds (*%E *) mov cx,ax (* cx == exception type *) (*%T _fcall *) (*%F SameDS *) mov ax, seg _matherr mov ds, ax (*%E *) les ax, [_matherr] mov si, es or si, ax (*%E *) (*%F _fcall *) cmp word [_matherr], 0 (*%E *) je nomatherr (* A user-defined error handler has been installed. Call it *) (* First, copy the name into the stack segment *) push cs pop es mov di,bx sub al,al push cx mov cx,-1 repne; scasb not cx inc cx and cx,-2 mov si,cx pop cx sub sp,si mov si,sp (* si = ^name *) mov di,si lp: mov al,es:[bx] mov ss:[di],al inc bx inc di or al,al jnz lp (* Now create the structure on the stack *) sub sp,34 (* space for 3 doubles, one tbyte *) mov bx,sp fld st(0),st(0) fstp tbyte ss:[bx][24], st(0) call forcedouble fstp qword ss:[bx][16], st(0) call forcedouble fstp qword ss:[bx][0], st(0) call forcedouble fstp qword ss:[bx][8], st(0) (*%T FarPtr *) push ss (*%E *) push si (* ^name *) push cx (* type *) mov ax,sp (* pointer to exception structure *) (*%F RegParam *) (*%T FarPtr *) mov bx,ss (* segment part of the above *) (*%E *) (*%E *) push cx (* save exception type *) (*%F RegParam *) (*%T FarPtr *) push ss (*%E *) push ax (*%E *) (*%T _fcall *) call dword [_matherr] (*%E *) (*%F _fcall *) call word [_matherr] (*%E *) (*%F RegParam *) (*%T FarPtr *) add sp,4 (*%E *) (*%F FarPtr *) add sp,2 (*%E*) (*%E *) pop cx (* recover the exception type *) test ax,ax mov bx,sp jnz newretval (* matherr supplied a new retval *) (* Reload the saved return value *) (*%T FarPtr *) fld tbyte st(0),ss:[bx][30] (*%E *) (*%F FarPtr *) fld tbyte st(0),ss:[bx][28] (*%E *) jmp doerrno newretval: (*%T FarPtr *) fld qword st(0),ss:[bx][22] (*%E *) (*%F FarPtr *) fld qword st(0),ss:[bx][20] (*%E *) jmp done nomatherr: fstp st(1), st(0) fstp st(1), st(0) (* discard arguments, keeping result *) doerrno: mov ax, EDOM cmp cx,_DOMAIN (* type == _DOMAIN *) je wasdomain mov ax, ERANGE wasdomain: (*%T _fcall *) call far __seterrno (*%E *) (*%F _fcall *) call __seterrno (*%E *) done: (*%F SameDS *) lea sp,[bp][-8] pop ds (*%E *) (*%T SameDS *) lea sp,[bp][-6] (*%E *) pop cx pop si pop di mov sp,bp pop bp ret 0 forcedouble: (* force st(0) into the range that fits in a double *) push ax push bx mov bx,sp fcom qword st(0),cs:[@coremath_HUGE] push ax fstsw ss:[bx][-2] fwait pop ax sahf jb NotPosH fstp st(0),st(0) fld qword st(0),cs:[@coremath_HUGE] jmp fddone NotPosH: fcom qword st(0),cs:[@coremath_MIN] push ax fstsw ss:[bx][-2] fwait pop ax sahf ja fddone (* now st(0) must be < coremath_min *) fchs st(0) fcom qword st(0),cs:[@coremath_HUGE] push ax fstsw ss:[bx][-2] fwait pop ax sahf jb NotNegH fstp st(0),st(0) fld qword st(0),cs:[@coremath_HUGE] fchs st(0) jmp fddone NotNegH: fcom qword st(0),cs:[@coremath_MIN] push ax fstsw ss:[bx][-2] fchs st(0) pop ax sahf ja fddone fstp st(0),st(0) fldz st(0) fddone: pop bx pop ax ret 0 (*%E StdFloat *) (*************************************************************************) (*%T StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn __report_math_error (* __lib_error is used by the math library functions to report range, domain and underflow errors etcetera. It may be called via two routes: 1. An exception occurring inside a math library function will cause __math_excep to call this function. __math_excep reads the address of a table from ss:InMathLib. This table contains a (short) resume address and then a table in the format below. The address of the table (excluding the resume address) is passed to __lib_error in si. 2. math library functions pre-emptively detecting an error case without causing an exception may call __lib_error directly. In this case, si must point to a table as described below, and bx must contain a pointer to the stack frame (i.e., a copy of bp). The table processed by __lib_error is in the following format: [si][0] short address of procedure to yield return value when arg1 is negative [si][2] ditto when arg1 is positive [si][4] flags byte. If [si][4] & f_two != 0, there is a second argument If [si][4] & f_long != 0, the arguments are long double [si][6] null terminated string containing name of function with error. The procedures pointed to by [si][0] and [si][2] push the required return value into st(0), and return the error type in ax. *) public __lib_error: push bp mov bp, sp sub sp,2 push ax push cx push dx test byte cs:[si][4], f_two (* find out arg count *) jnz has_two (* function has a single argument *) fldz st(0) (* arg2 == 0 *) test byte cs:[si][4], f_long (* long double args? *) jnz long_arg1 fld qword st(0), ss:[bx][2][CodePtrSize] jmp gotargs long_arg1: fld tbyte st(0), ss:[bx][2][CodePtrSize] jmp gotargs has_two: test byte cs:[si][4], f_long (* long double args? *) jnz long_arg2 (*%T RegParam *) fld qword st(0), ss:[bx][2][CodePtrSize] fld qword st(0), ss:[bx][2][CodePtrSize][8] (*%E *) (*%F RegParam *) fld qword st(0), ss:[bx][2][CodePtrSize][8] fld qword st(0), ss:[bx][2][CodePtrSize] (*%E *) jmp gotargs long_arg2: (*%T RegParam *) fld tbyte st(0), ss:[bx][2][CodePtrSize] fld tbyte st(0), ss:[bx][2][CodePtrSize][10] (*%E *) (*%F RegParam *) fld tbyte st(0), ss:[bx][2][CodePtrSize][10] fld tbyte st(0), ss:[bx][2][CodePtrSize] (*%E *) (* Now st(0)== arg1, st(1)==arg2 *) gotargs: ftst st(0) fstsw [bp][-2] fwait test byte [bp][-1], 1 (* Check if arg1 was +ve *) mov ax, cs:[si][2] (* negative entry from table *) jz me_positive mov ax, cs:[si][0] (* positive entry from table *) me_positive: call ax (* Call function to yield retval, pushed into st(0) *) or ax, ax (* is it an error? *) jz me_ok lea bx, [si][5] (* st(0)==retval, st(1)==arg1, st(2)==arg2, bx=name *) call __report_math_error jmp exit me_ok: (* Not an error - discard st(1) and st(2) *) fstp st(1), st(0) fstp st(1), st(0) exit: pop dx pop cx pop ax mov sp, bp pop bp ret 0 (*%E StdFloat *) (*************************************************************************) (*%T StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn @coremath_int_one extrn $err_domain public $check_abs_one: fld st(0),st(0) fabs st(0) ficomp word st(0), cs:[@coremath_int_one] fstsw [bp][-2] fwait test byte [bp][-1], 40H jz ab1_err ret 0 ab1_err: add sp, 2 jmp near $err_domain (*%E StdFloat *) (*************************************************************************) (*%T StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn __fac extrn @coremath_HUGE extrn @coremath_nearest extrn __report_math_error public _ldexp: push bp mov bp,sp sub sp,10 fld qword st(0), [bp][frame] (*%F RegParam *) mov ax, [bp][frame][8] fild word st(0), [bp][frame][8] (*%E *) (*%T RegParam *) or ax,ax jz ldexp_exit (* scale by 0 doesn't work in windows emulator *) mov [bp][-2],ax fild word st(0), [bp][-2] (*%E *) fstcw [bp][-2] (* save CW *) fldcw cs:[@coremath_nearest] (* mask exceptions *) fclex fxch st(0), st(1) fscale st(0), st(1) fst qword [bp][-10], st(0) (* ensure result fits in double variable *) fstsw [bp][-4] fclex fldcw [bp][-2] test byte [bp][-4], 1FH jnz ldexp_error fstp st(1),st(0) ldexp_exit: (*%F NearPtr *) mov dx, seg __fac mov es, dx fstp qword es:[__fac], st(0) (*%E *) (*%T NearPtr *) fstp qword [__fac], st(0) (*%E *) mov ax, __fac fwait mov sp,bp pop bp (*%T RegParam *) (*%T NearCall*) ret near PopParam*8 (*%E*) (*%F NearCall*) ret far PopParam*8 (*%E*) (*%E *) (*%F RegParam *) db Ret0@ (*%E*) ldexp_error: (* the scale has generated an exception of some sort *) (* ax == st(0) == arg2, arg1 on stack *) fld qword st(0), [bp][frame] fstp st(1),st(0) test ax,ax js underflow mov ax, _OVERFLOW ftst st(0) (* check sign of arg1 *) fstsw [bp][-2] fld qword st(0), cs:[@coremath_HUGE] test byte [bp][-1],1 jz report fchs st(0) jmp report underflow: fldz st(0) mov ax, _UNDERFLOW report: (* st(0) == retval, st(1) == arg1, st(2) == arg2, ax == error type *) mov bx, ldexp_name call __report_math_error jmp ldexp_exit ldexp_name: db "ldexp", 0 (*%E StdFloat *) (*************************************************************************) (*%T StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn __fac extrn @coremath_LHUGE extrn @coremath_nearest extrn __report_math_error public _ldexpl: push bp mov bp,sp sub sp,4 fld tbyte st(0), [bp][frame] (*%F RegParam *) mov ax, [bp][frame][10] fild word st(0), [bp][frame][10] (*%E *) (*%T RegParam *) or ax,ax jz ldexpl_exit (* scale by 0 doesn't work in windows emulator *) mov [bp][-2],ax fild word st(0), [bp][-2] (*%E *) fstcw [bp][-2] (* save CW in #1 *) fldcw cs:[@coremath_nearest] (* mask exceptions *) fclex fxch st(0), st(1) fscale st(0), st(1) fstsw [bp][-4] fclex fldcw [bp][-2] test byte [bp][-4], 1FH jnz ldexpl_error (*%T _WINDOWS *) fxam st(0) (* Windows emulator doesn't signal oflow properly *) fstsw [bp][-4] fwait test byte [bp][-3], 1 jnz ldexpl_error (*%E *) fstp st(1), st(0) ldexpl_exit: (*%F NearPtr *) mov dx, seg __fac mov es, dx fstp tbyte es:[__fac], st(0) (*%E *) (*%T NearPtr *) fstp tbyte [__fac], st(0) (*%E *) mov ax, __fac fwait mov sp,bp pop bp (*%T RegParam *) (*%T NearCall*) ret near PopParam*10 (*%E*) (*%F NearCall*) ret far PopParam*10 (*%E*) (*%E *) (*%F RegParam *) db Ret0@ (*%E*) ldexpl_error: (* the scale has generated an exception of some sort *) (* ax == st(0) == result of scale, st(1) == arg2, arg1 on stack *) fld tbyte st(0), [bp][frame] fstp st(1), st(0) test ax,ax js underflow mov ax, _OVERFLOW ftst st(0) (* check sign of arg1 *) fstsw [bp][-2] fld tbyte st(0), cs:[@coremath_LHUGE] test byte [bp][-1],1 jz report fchs st(0) jmp report underflow: fldz st(0) mov ax, _UNDERFLOW report: (* st(0) == retval, st(1) == arg1, st(2) == arg2, ax == error type *) mov bx, ldexpl_name call __report_math_error jmp ldexpl_exit ldexpl_name: db "ldexpl", 0 (*%E StdFloat *) (*************************************************************************) (*%T StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn __fac public _hypot: push bp mov bp, sp (*%T StkParam *) fld qword st(0), [bp][frame] fmul st(0), st(0) fld qword st(0), [bp][frame][8] (*%E StkParam *) (*%T RegParam *) fld qword st(0), [bp][frame][8] fmul st(0), st(0) fld qword st(0), [bp][frame] (*%E RegParam *) fmul st(0), st(0) faddp st(1), st(0) fsqrt st(0) (*%F NearPtr *) mov dx, seg __fac mov es, dx fstp qword es:[__fac], st(0) (*%E *) (*%T NearPtr *) fstp qword [__fac], st(0) (*%E *) mov ax, __fac fwait pop bp (*%T NearCall*) ret near PopParam*16 (*%E*) (*%F NearCall*) ret far PopParam*16 (*%E*) (*%E StdFloat *) (*************************************************************************) (*%T StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn __fac public _hypotl: push bp mov bp, sp (*%T StkParam *) fld tbyte st(0), [bp][frame] fmul st(0), st(0) fld tbyte st(0), [bp][frame][10] (*%E StkParam *) (*%T RegParam *) fld tbyte st(0), [bp][frame][10] fmul st(0), st(0) fld tbyte st(0), [bp][frame] (*%E RegParam *) fmul st(0), st(0) faddp st(1), st(0) fsqrt st(0) (*%F NearPtr *) mov dx, seg __fac mov es, dx fstp tbyte es:[__fac], st(0) (*%E *) (*%T NearPtr *) fstp tbyte [__fac], st(0) (*%E *) mov ax, __fac fwait pop bp (*%T NearCall*) ret near PopParam*20 (*%E*) (*%F NearCall*) ret far PopParam*20 (*%E*) (*%E StdFloat *) (*************************************************************************) (*%T StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn __fac public __round: push bp mov bp, sp fld tbyte st(0), [bp][frame] frndint st(0) (*%F NearPtr *) mov dx, seg __fac mov es, dx fstp tbyte es:[__fac], st(0) (*%E *) (*%T NearPtr *) fstp tbyte [__fac], st(0) (*%E *) mov ax, __fac fwait pop bp (*%F NearCall *) ret far 0 (*%E *) (*%T NearCall *) ret 0 (*%E *) (*%E StdFloat *) (*************************************************************************) (*%T StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) (* compute 2^st(0) , result is represented as st(0) * 2^st(4) *) extrn @coremath_int_four public $pow2 : fld1 st(0) fxch st(0), st(1) fst qword [bp][-12], st(0) frndint st(0) fsub st(0), st(1) fld qword st(0), [bp][-12] fxch st(0), st(1) fstp qword [bp][-12], st(0) fsub qword st(0), [bp][-12] (* we now know that st(0) is in range [0..2) *) fidiv word st(0), cs:[@coremath_int_four] (* now in range [0..0.5] *) f2xm1 st(0) faddp st(1), st(0) fmul st(0), st(0) fmul st(0), st(0) ret 0 (*%E StdFloat *) (*************************************************************************) (*%T StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn @coremath_tbyte_Pi_By_4 public __do_sct : fxam st(0) (* '87 works while we enter routine*) fstsw [bp][-2] fwait mov ah, [bp][-1] fabs st(0) fldpi st(0) fadd st(0),st(0) (* st(0) = 2*pi *) mov ch, ah and ch, 2 shr ch, 1 (* ch := sign *) fxch st(0),st(1) Lp: fprem st(0) (* reduce abs(arg1) by 2*pi *) fstsw [bp][-2] fwait test byte [bp][-1],4 jnz Lp (*%T _WINDOWS *) fst st(1),st(0) (* st(0)=st(1)=abs(arg1) reduced by 2*pi *) fld tbyte st(0), cs:[@coremath_tbyte_Pi_By_4] fxch st(0),st(1) (* st(0)=st(2) = arg1. st(1) = pi/4 *) fprem st(0) (* st(0)=abs(arg1) reduced by pi/4 *) fsub st(2),st(0) (* st(2)= octant*pi/4 *) fxch st(0),st(2) (* st(2)=abs(arg1) reduced by pi/4.st(0)=octant*pi/4 *) fdiv st(0),st(1) (* st(0)=octant *) fldlg2 st(0) (* st(0) = 0.3 --gives round to nearest *) faddp st(1),st(0) (* st(0) = octant+a smidgeon *) fistp word [bp][-2],st(0) (* store octant in [bp][-2] *) fxch st(0),st(1) (* st(0)=abs(arg1) reduced by pi/4.st(1)=pi/4 *) mov al,[bp][-2] (* al = octant *) (*%E _WINDOWS *) (*%F _WINDOWS *) fstp st(1),st(0) fld tbyte st(0), cs:[@coremath_tbyte_Pi_By_4] fxch st(0),st(1) fprem st(0) fstsw [bp][-2] fwait mov ax, [bp][-2] mov al, ah and al, 3 (* select the C3, C1, and C0 status bits*) shl ah, 1 shl ah, 1 rcl al, 1 (* arrange them in the ls 3 bits of AL as c1,c0,c3*) add al, 0FCH rcl al, 1 (* al now contains the octant number*) (*%E NOT _WINDOWS *) cmp cl, 2 (* are we doing Cosine ?*) jne trig_notCosine add al, cl (* Cos (x) = Sin (x + 2 octants)*) mov ch, 0 (* Cosine has even symmetry around 0*) trig_notCosine: and al, 7 test al, 1 jz trig_evens fsubp st(1), st(0) (* overwrites pi/4 in st(1), pops.*) jmp trig_ptan trig_evens: fstp st(1), st(0) trig_ptan: fptan st(0) (* st(1) / st(0) == tan(x) *) cmp cl, 4 je trig_tangent test al, 3 jpe trig_sineOctant trig_cosOctant: fxch st(0), st(1) trig_sineOctant: fmul st(0), st(0) fstp tbyte [bp][-12], st(0) fld st(0), st(0) fmul st(0), st(0) fld tbyte st(0), [bp][-12] faddp st(1), st(0) fsqrt st(0) shr al, 1 shr al, 1 xor al, ch jz trig_sineDiv fchs st(0) trig_sineDiv: fdivp st(1), st(0) jmp trig_end trig_tangent: mov ah, al shr ah, 1 and ah, 1 xor ah, ch jz trig_tanSigned fchs st(0) trig_tanSigned: test al, 3 jpe trig_ratio fdivrp st(1),st(0) jmp trig_end trig_ratio: fdivp st(1), st(0) trig_end: ret 0 (*%E StdFloat *) (*************************************************************************) (*%T StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn __fac extrn __do_sct public _sinl : push bp mov bp, sp (*%T RegParam *) push cx (*%E RegParam *) xor cl, cl jmp trigl public _cosl: push bp mov bp, sp (*%T RegParam *) push cx (*%E RegParam *) mov cl, 2 jmp trigl public _tanl : push bp mov bp, sp (*%T RegParam *) push cx (*%E RegParam *) mov cl, 4 trigl: (*%T RegParam *)(*%T NearPtr *) push dx (*%E NearPtr *)(*%E RegParam *) sub sp, 12 mov dx, cx fld tbyte st(0), [bp][frame] call __do_sct (*%F NearPtr *) mov dx, seg __fac mov es, dx fstp tbyte es:[__fac], st(0) (*%E *) (*%T NearPtr *) fstp tbyte [__fac], st(0) (*%E *) mov ax, __fac add sp,12 (*%T RegParam *)(*%T NearPtr *) pop dx (*%E NearPtr *)(*%E RegParam *) (*%T RegParam *) pop cx (*%E RegParam *) fwait pop bp (*%T NearCall*) ret near PopParam*10 (*%E*) (*%F NearCall*) ret far PopParam*10 (*%E*) (*%E StdFloat *) (*************************************************************************) (*%T StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn __fac extrn __do_sct public _sin : push bp mov bp, sp (*%T RegParam *) push cx (*%E RegParam *) xor cl, cl jmp trig public _cos: push bp mov bp, sp (*%T RegParam *) push cx (*%E RegParam *) mov cl, 2 jmp trig public _tan : push bp mov bp, sp (*%T RegParam *) push cx (*%E RegParam *) mov cl, 4 trig: (*%T RegParam *)(*%T NearPtr *) push dx (*%E NearPtr *)(*%E RegParam *) sub sp, 12 fld qword st(0), [bp][frame] call __do_sct (*%F NearPtr *) mov dx, seg __fac mov es, dx fstp qword es:[__fac], st(0) (*%E *) (*%T NearPtr *) fstp qword [__fac], st(0) (*%E *) mov ax, __fac add sp,12 (*%T RegParam *)(*%T NearPtr *) pop dx (*%E NearPtr *)(*%E RegParam *) (*%T RegParam *) pop cx (*%E RegParam *) fwait pop bp (*%T NearCall*) ret near PopParam*8 (*%E*) (*%F NearCall*) ret far PopParam*8 (*%E*) (*%E StdFloat *) (*************************************************************************) (*%T StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn @coremath_tbyte_Pi_By_2 extrn __fac extrn __lib_error extrn $err_domain public _atan2l: push bp mov bp, sp sub sp, 4 (*%T StkParam *) fld tbyte st(0), [bp][frame][10] fld tbyte st(0), [bp][frame] (*%E StkParam *) (*%T RegParam *) fld tbyte st(0), [bp][frame] fld tbyte st(0), [bp][frame][10] (*%E RegParam *) ftst st(0) fstsw [bp][-2] fwait test byte [bp][-1],1 je atan20 fchs st(0) call atan21 fchs st(0) jmp over atan20: call atan21 over: (*%F NearPtr *) mov dx, seg __fac mov es, dx fstp tbyte es:[__fac], st(0) (*%E *) (*%T NearPtr *) fstp tbyte [__fac], st(0) (*%E *) mov ax, __fac fwait mov sp, bp pop bp (*%T NearCall*) ret near PopParam*20 (*%E*) (*%F NearCall*) ret far PopParam*20 (*%E*) atan21: fxch st(0), st(1) ftst st(0) fstsw [bp][-4] fwait test byte [bp][-3],1 je atan22 fchs st(0) call atan22 fldpi st(0) fsubrp st(1),st(0) ret 0 atan22: test byte [bp][-3],40H jnz maybe_zero_zero not_zero_zero: fcom st(0), st(1) fstsw [bp][-2] fwait test byte [bp][-1],1 jz atan23 fxch st(0), st(1) fpatan st(1), st(0) fld tbyte st(0),cs:[@coremath_tbyte_Pi_By_2] fsubrp st(1),st(0) ret 0 atan23: fpatan st(1),st(0) ret 0 maybe_zero_zero: test byte [bp][-1],40H jz not_zero_zero fstp st(0), st(0) push si mov si, atan2_err_data mov bx, bp call __lib_error pop si ret 0 atan2_err_data: dw $err_domain, $err_domain; db f_two+f_long, "atan2l", 0 (*%E StdFloat *) (*************************************************************************) (*%T StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn @coremath_tbyte_Pi_By_2 extrn __fac extrn __lib_error extrn $err_domain public _atan2: push bp mov bp, sp sub sp, 4 (*%T StkParam *) fld qword st(0), [bp][frame][8]; fld qword st(0), [bp][frame]; (*%E StkParam *) (*%T RegParam *) fld qword st(0), [bp][frame] fld qword st(0), [bp][frame][8] (*%E RegParam *) ftst st(0) fstsw [bp][-2] fwait test byte [bp][-1],1 je atan20 fchs st(0) call atan21 fchs st(0) jmp over atan20: call atan21 over: (*%F NearPtr *) mov dx, seg __fac mov es, dx fstp qword es:[__fac], st(0) (*%E *) (*%T NearPtr *) fstp qword [__fac], st(0) (*%E *) mov ax, __fac fwait mov sp, bp pop bp (*%T NearCall*) ret near PopParam*16 (*%E*) (*%F NearCall*) ret far PopParam*16 (*%E*) atan21: fxch st(0), st(1) ftst st(0) fstsw [bp][-4] fwait test byte [bp][-3],1 je atan22 fchs st(0) call atan22 fldpi st(0) fsubrp st(1),st(0) ret 0 atan22: test byte [bp][-3],40H jnz maybe_zero_zero not_zero_zero: fcom st(0), st(1) fstsw [bp][-2] fwait test byte [bp][-1],1 jz atan23 fxch st(0), st(1) fpatan st(1), st(0) fld tbyte st(0),cs:[@coremath_tbyte_Pi_By_2] fsubrp st(1),st(0) ret 0 atan23: fpatan st(1),st(0) ret 0 maybe_zero_zero: test byte [bp][-1],40H jz not_zero_zero fstp st(0), st(0) push si mov si, atan2_err_data mov bx, bp call __lib_error pop si ret 0 atan2_err_data: dw $err_domain, $err_domain; db f_two, "atan2", 0 (*%E StdFloat *) (*************************************************************************) (*%T StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn __fac extrn $atan0 public _atanl: push bp mov bp, sp sub sp, 2 fld tbyte st(0), [bp][frame]; call $atan0 (*%F NearPtr *) mov dx, seg __fac mov es, dx fstp tbyte es:[__fac], st(0) (*%E *) (*%T NearPtr *) fstp tbyte [__fac], st(0) (*%E *) mov ax, __fac fwait mov sp, bp pop bp (*%T NearCall*) ret near PopParam*10 (*%E*) (*%F NearCall*) ret far PopParam*10 (*%E*) (*%E StdFloat *) (*************************************************************************) (*%T StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn __fac extrn $atan0 public _atan: push bp mov bp, sp sub sp, 2 fld qword st(0), [bp][frame]; call $atan0 (*%F NearPtr *) mov dx, seg __fac mov es, dx fstp qword es:[__fac], st(0) (*%E *) (*%T NearPtr *) fstp qword [__fac], st(0) (*%E *) mov ax, __fac fwait mov sp, bp pop bp (*%T NearCall*) ret near PopParam*8 (*%E*) (*%F NearCall*) ret far PopParam*8 (*%E*) (*%E StdFloat *) (*************************************************************************) (*%T StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn @coremath_tbyte_Pi_By_2 public $atan0: (* Note - this procedure must not have a stack frame *) ftst st(0) fstsw [bp][-2] fwait test byte [bp][-1],1 je atan1 fchs st(0) call atan1 fchs st(0) ret 0 atan1: fld1 st(0) fcom st(0), st(1) fstsw [bp][-2] fwait test byte [bp][-1],1 jnz atan2 fpatan st(1), st(0) ret 0 atan2: fxch st(0), st(1) fpatan st(1),st(0) fld tbyte st(0),cs:[@coremath_tbyte_Pi_By_2] fsubrp st(1),st(0) ret 0 (*%E StdFloat *) (*************************************************************************) (*%T StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn __lib_error extrn $err_domain extrn $err_huge_minus_infinity extrn __fac public _logl : push bp mov bp, sp sub sp, 2 fld tbyte st(0), [bp][frame] ftst st(0) fstsw [bp][-2] fwait test byte [bp][-1], 41H jnz logl_error fldln2 st(0) fxch st(0),st(1) fyl2x st(1),st(0) logl_exit: (*%F NearPtr *) mov dx, seg __fac mov es, dx fstp tbyte es:[__fac], st(0) (*%E *) (*%T NearPtr *) fstp tbyte [__fac], st(0) (*%E *) mov ax, __fac fwait mov sp, bp pop bp (*%T NearCall*) ret near PopParam*10 (*%E*) (*%F NearCall*) ret far PopParam*10 (*%E*) logl_error: fstp st(0), st(0) (* return fp stack to empty state *) push si mov si, logl_err_data mov bx, bp call __lib_error pop si jmp logl_exit logl_err_data: dw $err_domain, $err_huge_minus_infinity; db f_long, "logl", 0 (*%E StdFloat *) (*************************************************************************) (*%T StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn __fac extrn __lib_error extrn $err_domain extrn $err_minus_infinity public _log : push bp mov bp, sp sub sp, 2 fld qword st(0), [bp][frame] ftst st(0) fstsw [bp][-2] fwait test byte [bp][-1], 41H jnz log_error fldln2 st(0) fxch st(0),st(1) fyl2x st(1),st(0) log_exit: (*%F NearPtr *) mov dx, seg __fac mov es, dx fstp qword es:[__fac], st(0) (*%E *) (*%T NearPtr *) fstp qword [__fac], st(0) (*%E *) mov ax, __fac fwait mov sp, bp pop bp (*%T NearCall*) ret near PopParam*8 (*%E*) (*%F NearCall*) ret far PopParam*8 (*%E*) log_error: fstp st(0), st(0) (* return fp stack to empty state *) push si mov si, log_err_data mov bx, bp call __lib_error pop si jmp log_exit log_err_data: dw $err_domain, $err_minus_infinity; db 0, "log", 0 (*%E StdFloat *) (*************************************************************************) (*%T StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn __lib_error extrn $err_domain extrn $err_huge_minus_infinity extrn __fac public _log10l : push bp mov bp, sp sub sp, 2 fld tbyte st(0), [bp][frame] ftst st(0) fstsw [bp][-2] fwait test byte [bp][-1], 41H jnz log10l_error fldlg2 st(0) fxch st(0), st(1) fyl2x st(1), st(0) log10l_exit: (*%F NearPtr *) mov dx, seg __fac mov es, dx fstp tbyte es:[__fac], st(0) (*%E *) (*%T NearPtr *) fstp tbyte [__fac], st(0) (*%E *) mov ax, __fac fwait mov sp, bp pop bp (*%T NearCall*) ret near PopParam*10 (*%E*) (*%F NearCall*) ret far PopParam*10 (*%E*) log10l_error: fstp st(0), st(0) (* return fp stack to empty state *) push si mov si, log10l_err_data mov bx, bp call __lib_error pop si jmp log10l_exit log10l_err_data: dw $err_domain, $err_huge_minus_infinity; db f_long, "log10l", 0 (*%E StdFloat *) (*************************************************************************) (*%T StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn __fac extrn __lib_error extrn $err_domain extrn $err_minus_infinity public _log10 : push bp mov bp, sp sub sp, 2 fld qword st(0), [bp][frame] ftst st(0) fstsw [bp][-2] fwait test byte [bp][-1], 41H jnz log10_error fldlg2 st(0) fxch st(0), st(1) fyl2x st(1), st(0) log10_exit: (*%F NearPtr *) mov dx, seg __fac mov es, dx fstp qword es:[__fac], st(0) (*%E *) (*%T NearPtr *) fstp qword [__fac], st(0) (*%E *) mov ax, __fac fwait mov sp, bp pop bp (*%T NearCall*) ret near PopParam*8 (*%E*) (*%F NearCall*) ret far PopParam*8 (*%E*) log10_error: fstp st(0), st(0) (* return fp stack to empty state *) push si mov si, log10_err_data mov bx, bp call __lib_error pop si jmp log10_exit log10_err_data: dw $err_domain, $err_minus_infinity; db 0, "log10", 0 (*%E StdFloat *) (*************************************************************************) (*%T StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn __fac extrn $err_domain public _sqrtl : push bp mov bp, sp mov word ss:[InMathLib], sqrtltable mov word ss:[InMathLib][2], bp fld tbyte st(0), [bp][frame] (* Return the square root of x, which must be greater than zero. *) fsqrt st(0) (*invalid op possible*) fwait sqrtl_exit: mov word ss:[InMathLib], 0 (*%F NearPtr *) mov dx, seg __fac mov es, dx fstp tbyte es:[__fac], st(0) (*%E *) (*%T NearPtr *) fstp tbyte [__fac], st(0) (*%E *) mov ax, __fac fwait mov sp,bp pop bp (*%T NearCall*) ret near PopParam*10 (*%E*) (*%F NearCall*) ret far PopParam*10 (*%E*) sqrtltable: dw sqrtl_exit, $err_domain, $err_domain; db f_long, "sqrtl", 0 (*%E StdFloat *) (*************************************************************************) (*%T StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn __fac extrn $err_domain public _sqrt : push bp mov bp, sp mov word ss:[InMathLib], sqrttable mov word ss:[InMathLib][2], bp fld qword st(0), [bp][frame] (* Return the square root of x, which must be greater than zero. *) fsqrt st(0) (*invalid op possible*) fwait sqrt_exit: mov word ss:[InMathLib], 0 (*%F NearPtr *) mov dx, seg __fac mov es, dx fstp qword es:[__fac], st(0) (*%E *) (*%T NearPtr *) fstp qword [__fac], st(0) (*%E *) mov ax, __fac fwait mov sp,bp pop bp (*%T NearCall*) ret near PopParam*8 (*%E*) (*%F NearCall*) ret far PopParam*8 (*%E*) sqrttable: dw sqrt_exit, $err_domain, $err_domain; db 0, "sqrt", 0 (*%E StdFloat *) (*************************************************************************) (*%T StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn $pow2 extrn __fac extrn $err_underflow extrn $err_huge_plus_infinity public _expl : push bp mov bp, sp mov word ss:[InMathLib], expltable mov word ss:[InMathLib][2], bp sub sp, 12 fld tbyte st(0), [bp][frame] (*%F SameDS *) (* for error processing *) mov ax, seg __fac mov es, ax fst qword es:[__fac], st(0) (*%E *) (*%T SameDS *) fst qword [__fac], st(0) (*%E *) fwait fldl2e st(0) fmulp st(1), st(0) fist word [bp][-2], st(0) (* to check that it is not too large *) fwait call $pow2 fld qword st(0), [bp][-12] (* retrieve integral part *) (*%T _WINDOWS *) ftst st(0) (* work around windows emulator bug *) fstsw [bp][-2] (*%E *) fxch st(1), st(0) (*%T _WINDOWS *) test byte [bp][-1], 40H jnz skipscale (*%E *) fscale st(0), st(1) skipscale: fstp st(1),st(0) expl_exit: (*%F NearPtr *) mov dx, seg __fac mov es, dx fstp tbyte es:[__fac], st(0) (*%E *) (*%T NearPtr *) fstp tbyte [__fac], st(0) (*%E *) mov ax, __fac fwait mov sp, bp pop bp mov word ss:[InMathLib], 0 (*%T NearCall*) ret near PopParam*10 (*%E*) (*%F NearCall*) ret far PopParam*10 (*%E*) expltable: dw expl_exit, $err_underflow, $err_huge_plus_infinity; db f_st5+f_long, "expl", 0 (*%E StdFloat *) (*************************************************************************) (*%T StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn __fac extrn $pow2 extrn $err_underflow extrn $err_plus_infinity public _exp : push bp mov bp, sp mov word ss:[InMathLib], exptable mov word ss:[InMathLib][2], bp sub sp, 12 fld qword st(0), [bp][frame] (*%F SameDS *) (* for error processing *) mov ax, seg __fac mov es, ax fst qword es:[__fac], st(0) (*%E *) (*%T SameDS *) fst qword [__fac], st(0) (*%E *) fwait fldl2e st(0) fmulp st(1), st(0) fist word [bp][-2], st(0) (* to check that it is not too large *) fwait call $pow2 fld qword st(0), [bp][-12] (* retrieve integral part *) (*%T _WINDOWS *) ftst st(0) (* work around windows emulator bug *) fstsw [bp][-2] (*%E *) fxch st(1), st(0) (*%T _WINDOWS *) test byte [bp][-1], 40H jnz skipscale (*%E *) fscale st(0), st(1) skipscale: fstp st(1),st(0) exp_exit: (*%F NearPtr *) mov dx, seg __fac mov es, dx fstp qword es:[__fac], st(0) (*%E *) (*%T NearPtr *) fstp qword [__fac], st(0) (*%E *) mov ax, __fac fwait mov sp, bp pop bp mov word ss:[InMathLib], 0 (*%T NearCall*) ret near PopParam*8 (*%E*) (*%F NearCall*) ret far PopParam*8 (*%E*) exptable: dw exp_exit, $err_underflow, $err_plus_infinity; db f_st5, "exp", 0 (*%E StdFloat *) (****************************************************************************) (*%T StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn $pow2 extrn __fac public _tanhl : push bp mov bp, sp mov word ss:[InMathLib], tanhltable mov word ss:[InMathLib][2], bp sub sp, 12 fld tbyte st(0), [bp][frame] (*%F SameDS *) (* for error processing *) mov ax, seg __fac mov es, ax fst qword es:[__fac], st(0) (*%E *) (*%T SameDS *) fst qword [__fac], st(0) (*%E *) fwait fldl2e st(0) fmulp st(1), st(0) fist word [bp][-2], st(0) (* to check that it is not too large *) fwait call $pow2 fld qword st(0), [bp][-12] (* retrieve integral part *) (*%T _WINDOWS *) ftst st(0) (* work around windows emulator bug *) fstsw [bp][-2] (*%E *) fxch st(1), st(0) (*%T _WINDOWS *) test byte [bp][-1], 40H jnz skipscale (*%E *) fscale st(0), st(1) skipscale: fstp st(1), st(0) fld1 st(0) fdiv st(0), st(1) (* Exp (-x) *) fst qword [bp][-12], st(0) fadd st(0), st(1) fxch st(0), st(1) fsub qword st(0), [bp][-12] fdivrp st(1), st(0) tanhl_exit: (*%F NearPtr *) (* for error processing *) mov dx, seg __fac mov es, dx fstp tbyte es:[__fac], st(0) (*%E *) (*%T NearPtr *) fstp tbyte [__fac], st(0) (*%E *) mov ax, __fac fwait mov sp, bp pop bp mov word ss:[InMathLib], 0 (*%T NearCall*) ret near PopParam*10 (*%E*) (*%F NearCall*) ret far PopParam*10 (*%E*) tanhltable: dw tanhl_exit,tanhl_minus_one,tanhl_one ; db f_st5+f_long, "tanhl", 0 tanhl_one: sub ax, ax fld1 st(0) ret 0 tanhl_minus_one: call tanhl_one fchs st(0) ret 0 (*%E StdFloat *) (*************************************************************************) (*%T StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn $pow2 extrn __fac public _tanh : push bp mov bp, sp mov word ss:[InMathLib], tanhtable mov word ss:[InMathLib][2], bp sub sp, 12 fld qword st(0), [bp][frame] (*%F SameDS *) (* for error processing *) mov ax, seg __fac mov es, ax fst qword es:[__fac], st(0) (*%E *) (*%T SameDS *) fst qword [__fac], st(0) (*%E *) fwait fldl2e st(0) fmulp st(1), st(0) fist word [bp][-2], st(0) (* to check that it is not too large *) fwait call $pow2 fld qword st(0), [bp][-12] (* retrieve integral part *) (*%T _WINDOWS *) ftst st(0) (* work around windows emulator bug *) fstsw [bp][-2] (*%E *) fxch st(1), st(0) (*%T _WINDOWS *) test byte [bp][-1], 40H jnz skipscale (*%E *) fscale st(0), st(1) skipscale: fstp st(1), st(0) fld1 st(0) fdiv st(0), st(1) (* Exp (-x) *) fst qword [bp][-12], st(0) fadd st(0), st(1) fxch st(0), st(1) fsub qword st(0), [bp][-12] fdivrp st(1), st(0) tanh_exit: (*%F NearPtr *) (* for error processing *) mov dx, seg __fac mov es, dx fstp qword es:[__fac], st(0) (*%E *) (*%T NearPtr *) fstp qword [__fac], st(0) (*%E *) mov ax, __fac fwait mov sp, bp pop bp mov word ss:[InMathLib], 0 (*%T NearCall*) ret near PopParam*8 (*%E*) (*%F NearCall*) ret far PopParam*8 (*%E*) tanhtable: dw tanh_exit,tanh_minus_one,tanh_one; db f_st5, "tanh", 0 tanh_one: sub ax, ax fld1 st(0) ret 0 tanh_minus_one: call tanh_one fchs st(0) ret 0 (*%E StdFloat *) (*************************************************************************) (*%T StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn $pow2 extrn $err_huge_plus_infinity extrn $err_huge_minus_infinity extrn __fac extrn @coremath_int_two public _sinhl : push bp mov bp, sp mov word ss:[InMathLib], sinhltable mov word ss:[InMathLib][2], bp sub sp, 12 fld tbyte st(0), [bp][frame] (*%F SameDS *) (* for error processing *) mov ax, seg __fac mov es, ax fst qword es:[__fac], st(0) (*%E *) (*%T SameDS *) fst qword [__fac], st(0) (*%E *) fwait fldl2e st(0) fmulp st(1), st(0) fist word [bp][-2], st(0) (* to check that it is not too large *) fwait call $pow2 fld qword st(0), [bp][-12] (* retrieve integral part *) (*%T _WINDOWS *) ftst st(0) (* work around windows emulator bug *) fstsw [bp][-2] (*%E *) fxch st(1), st(0) (*%T _WINDOWS *) test byte [bp][-1], 40H jnz skipscale (*%E *) fscale st(0), st(1) skipscale: fstp st(1), st(0) fld1 st(0) fchs st(0) fdiv st(0), st(1) (* - Exp (-x) *) faddp st(1), st(0) fidiv word st(0), cs:[@coremath_int_two ] sinhl_exit: (*%F NearPtr *) mov dx, seg __fac mov es, dx fstp tbyte es:[__fac], st(0) (*%E *) (*%T NearPtr *) fstp tbyte [__fac], st(0) (*%E *) mov ax, __fac fwait mov sp, bp pop bp mov word ss:[InMathLib], 0 (*%T NearCall*) ret near PopParam*10 (*%E*) (*%F NearCall*) ret far PopParam*10 (*%E*) sinhltable: dw sinhl_exit, $err_huge_minus_infinity, $err_huge_plus_infinity; db f_st5+f_long, "sinhl", 0 (*%E StdFloat *) (*************************************************************************) (*%T StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn $pow2 extrn $err_plus_infinity extrn $err_minus_infinity extrn __fac extrn @coremath_int_two public _sinh : push bp mov bp, sp mov word ss:[InMathLib], sinhtable mov word ss:[InMathLib][2], bp sub sp, 12 fld qword st(0), [bp][frame] (*%F SameDS *) (* for error processing *) mov ax, seg __fac mov es, ax fst qword es:[__fac], st(0) (*%E *) (*%T SameDS *) fst qword [__fac], st(0) (*%E *) fwait fldl2e st(0) fmulp st(1), st(0) fist word [bp][-2], st(0) (* to check that it is not too large *) fwait call $pow2 fld qword st(0), [bp][-12] (* retrieve integral part *) (*%T _WINDOWS *) ftst st(0) (* work around windows emulator bug *) fstsw [bp][-2] (*%E *) fxch st(1), st(0) (*%T _WINDOWS *) test byte [bp][-1], 40H jnz skipscale (*%E *) fscale st(0), st(1) skipscale: fstp st(1), st(0) fld1 st(0) fchs st(0) fdiv st(0), st(1) (* - Exp (-x) *) faddp st(1), st(0) fidiv word st(0), cs:[@coremath_int_two ] sinh_exit: (*%F NearPtr *) mov dx, seg __fac mov es, dx fstp qword es:[__fac], st(0) (*%E *) (*%T NearPtr *) fstp qword [__fac], st(0) (*%E *) mov ax, __fac fwait mov sp, bp pop bp mov word ss:[InMathLib], 0 (*%T NearCall*) ret near PopParam*8 (*%E*) (*%F NearCall*) ret far PopParam*8 (*%E*) sinhtable: dw sinh_exit, $err_minus_infinity, $err_plus_infinity; db f_st5, "sinh", 0 (*%E StdFloat *) (*************************************************************************) (*%T StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn $err_huge_plus_infinity extrn __fac extrn @coremath_int_two extrn $pow2 public _coshl : push bp mov bp, sp mov word ss:[InMathLib], coshltable mov word ss:[InMathLib][2], bp sub sp, 12 fld tbyte st(0), [bp][frame]; (*%F SameDS *) (* for error processing *) mov ax, seg __fac mov es, ax fst qword es:[__fac], st(0) (*%E *) (*%T SameDS *) fst qword [__fac], st(0) (*%E *) fwait fabs st(0) fldl2e st(0) fmulp st(1), st(0) fist word [bp][-2], st(0) (* to check that it is not too large *) fwait call $pow2 fld qword st(0), [bp][-12] (* retrieve integral part *) (*%T _WINDOWS *) ftst st(0) (* work around windows emulator bug *) fstsw [bp][-2] (*%E *) fxch st(1), st(0) (*%T _WINDOWS *) test byte [bp][-1], 40H jnz skipscale (*%E *) fscale st(0), st(1) skipscale: fstp st(1), st(0) fld1 st(0) fdiv st(0), st(1) (* Exp (-x) *) faddp st(1), st(0) fidiv word st(0), cs:[@coremath_int_two ] coshl_exit: (*%F NearPtr *) mov dx, seg __fac mov es, dx fstp tbyte es:[__fac], st(0) (*%E *) (*%T NearPtr *) fstp tbyte [__fac], st(0) (*%E *) mov ax, __fac fwait mov sp, bp pop bp mov word ss:[InMathLib], 0 (*%T NearCall*) ret near PopParam*10 (*%E*) (*%F NearCall*) ret far PopParam*10 (*%E*) coshltable: dw coshl_exit, $err_huge_plus_infinity, $err_huge_plus_infinity; db f_st5+f_long, "coshl", 0 (*%E StdFloat *) (*************************************************************************) (*%T StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn $err_plus_infinity extrn __fac extrn @coremath_int_two extrn $pow2 public _cosh : push bp mov bp, sp mov word ss:[InMathLib], coshtable mov word ss:[InMathLib][2], bp sub sp, 12 fld qword st(0), [bp][frame]; (*%F SameDS *) (* for error processing *) mov ax, seg __fac mov es, ax fst qword es:[__fac], st(0) (*%E *) (*%T SameDS *) fst qword [__fac], st(0) (*%E *) fwait fabs st(0) fldl2e st(0) fmulp st(1), st(0) fist word [bp][-2], st(0) (* to check that it is not too large *) fwait call $pow2 fld qword st(0), [bp][-12] (* retrieve integral part *) (*%T _WINDOWS *) ftst st(0) (* work around windows emulator bug *) fstsw [bp][-2] (*%E *) fxch st(1), st(0) (*%T _WINDOWS *) test byte [bp][-1], 40H jnz skipscale (*%E *) fscale st(0), st(1) skipscale: fstp st(1), st(0) fld1 st(0) fdiv st(0), st(1) (* Exp (-x) *) faddp st(1), st(0) fidiv word st(0), cs:[@coremath_int_two ] cosh_exit: (*%F NearPtr *) mov dx, seg __fac mov es, dx fstp qword es:[__fac], st(0) (*%E *) (*%T NearPtr *) fstp qword [__fac], st(0) (*%E *) mov ax, __fac fwait mov sp, bp pop bp mov word ss:[InMathLib], 0 (*%T NearCall*) ret near PopParam*8 (*%E*) (*%F NearCall*) ret far PopParam*8 (*%E*) coshtable: dw cosh_exit, $err_plus_infinity, $err_plus_infinity; db f_st5, "cosh", 0 (*%E StdFloat *) (*************************************************************************) (*%T StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn $check_abs_one extrn __fac extrn $atan0 extrn @coremath_tbyte_Pi_By_2 public _asinl: push bp mov bp, sp mov word ss:[InMathLib], asinltable mov word ss:[InMathLib][2], bp sub sp, 12 fld tbyte st(0), [bp][frame] (*%F SameDS *) mov dx, seg __fac mov es, dx fst qword es:[__fac], st(0) (*%E *) (*%T SameDS *) fst qword [__fac], st(0) (*%E *) fst qword [bp][-12], st(0) fmul st(0), st(0) (* arg1**2 *) fld1 st(0) fsubrp st(1),st(0) (* arg1**2-1 *) ftst st(0) fstsw [bp][-2] fsqrt st(0) (* sqrt (arg1**2-1) *) test byte [bp][-1],40H (* is result 0 *) jz Not0 (* no *) fld tbyte st(0),cs:[@coremath_tbyte_Pi_By_2] (* $2 *) fstp st(1),st(0) (* $1 *) test byte [bp][frame][9],80H (* was arg1 neg ? *) jz asinl_exit (* arg1 was positive. return pi/2 *) fchs st(0) jmp asinl_exit (* arg1 was negative. return -pi/2 *) Not0: fdivr qword st(0), [bp][-12] fwait call $atan0 asinl_exit: (*%F NearPtr *) mov dx, seg __fac mov es, dx fstp tbyte es:[__fac], st(0) (*%E *) (*%T NearPtr *) fstp tbyte [__fac], st(0) (*%E *) mov ax, __fac fwait mov sp, bp pop bp mov word ss:[InMathLib], 0 (*%T NearCall*) ret near PopParam*10 (*%E*) (*%F NearCall*) ret far PopParam*10 (*%E*) asinltable: dw asinl_exit, err_asinl_neg, err_asinl_pos; db f_st5+f_long, "asinl", 0 err_asinl_pos: call $check_abs_one fld1 st(0) fstp st(1), st(0) fchs st(0) fldpi st(0) fscale st(0),st(1) sub ax, ax ret 0 err_asinl_neg: call err_asinl_pos fchs st(0) ret 0 (*%E StdFloat *) (*************************************************************************) (*%T StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn $check_abs_one extrn __fac extrn $atan0 extrn @coremath_tbyte_Pi_By_2 public _asin: push bp mov bp, sp mov word ss:[InMathLib], asintable mov word ss:[InMathLib][2], bp sub sp, 12 fld qword st(0),[bp][frame] (*%F SameDS *) mov dx, seg __fac mov es, dx fst qword es:[__fac], st(0) (*%E *) (*%T SameDS *) fst qword [__fac], st(0) (*%E *) fst qword [bp][-12], st(0) fmul st(0), st(0) (* arg1**2 *) fld1 st(0) fsubrp st(1),st(0) (* arg1**2-1 *) ftst st(0) fstsw [bp][-2] fsqrt st(0) (* sqrt (arg1**2-1) *) test byte [bp][-1],40H (* is result 0 *) jz Not0 (* no *) fld tbyte st(0),cs:[@coremath_tbyte_Pi_By_2] (* $2 *) fstp st(1),st(0) (* $1 *) test byte [bp][frame][7],80H (* was arg1 neg ? *) jz asin_exit (* arg1 was positive. return pi/2 *) fchs st(0) jmp asin_exit (* arg1 was negative. return -pi/2 *) Not0: fdivr qword st(0), [bp][-12] fwait call $atan0 asin_exit: (*%F NearPtr *) mov dx, seg __fac mov es, dx fstp qword es:[__fac], st(0) (*%E *) (*%T NearPtr *) fstp qword [__fac], st(0) (*%E *) mov ax, __fac fwait mov sp, bp pop bp mov word ss:[InMathLib], 0 (*%T NearCall*) ret near PopParam*8 (*%E*) (*%F NearCall*) ret far PopParam*8 (*%E*) asintable: dw asin_exit, err_asin_neg, err_asin_pos; db f_st5, "asin", 0 err_asin_pos: call $check_abs_one fld1 st(0) fstp st(1), st(0) fchs st(0) fldpi st(0) fscale st(0),st(1) sub ax, ax ret 0 err_asin_neg: call err_asin_pos fchs st(0) ret 0 (*%E StdFloat *) (*************************************************************************) (*%T StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn __fac extrn @coremath_tbyte_Pi_By_2 extrn $check_abs_one extrn $atan0 public _acosl : push bp mov bp, sp mov word ss:[InMathLib], acosltable mov word ss:[InMathLib][2], bp sub sp, 12 fld tbyte st(0), [bp][frame] (*%F SameDS *) (* for error processing *) mov ax, seg __fac mov es, ax fst qword es:[__fac], st(0) (*%E *) (*%T SameDS *) fst qword [__fac], st(0) (*%E *) ftst st(0) (* is st(0) 0 or -0 ? *) fstsw [bp][-2] fst qword [bp][-12], st(0) test byte [bp][-1],40H (* test for zero flag *) jnz DoPiBy2 (* if arg1 was 0,return pi/2 *) fmul st(0), st(0) fld1 st(0) fsubrp st(1),st(0) fsqrt st(0) fdivr qword st(0), [bp][-12] fwait call $atan0 DoPiBy2: fld tbyte st(0), cs:[@coremath_tbyte_Pi_By_2] fsubrp st(1), st(0) acosl_exit: (*%F NearPtr *) mov dx, seg __fac mov es, dx fstp tbyte es:[__fac], st(0) (*%E *) (*%T NearPtr *) fstp tbyte [__fac], st(0) (*%E *) mov ax, __fac mov sp, bp pop bp mov word ss:[InMathLib], 0 (*%T NearCall*) ret near PopParam*10 (*%E*) (*%F NearCall*) ret far PopParam*10 (*%E*) acosltable: dw acosl_exit, err_acosl_neg, err_acosl_pos; db f_long+f_st5, "acosl", 0 err_acosl_pos: call $check_abs_one fldz st(0) sub ax, ax ret 0 err_acosl_neg: call $check_abs_one fldpi st(0) sub ax, ax ret 0 (*%E StdFloat *) (*************************************************************************) (*%T StdFloat *) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn __fac extrn @coremath_tbyte_Pi_By_2 extrn $atan0 extrn $check_abs_one public _acos : push bp mov bp, sp mov word ss:[InMathLib], acostable mov word ss:[InMathLib][2], bp sub sp, 12 fld qword st(0), [bp][frame] (*%F SameDS *) (* for error processing *) mov ax, seg __fac mov es, ax fst qword es:[__fac], st(0) (*%E *) (*%T SameDS *) fst qword [__fac], st(0) (*%E *) ftst st(0) (* is st(0) 0 or -0 ? *) fstsw [bp][-2] fst qword [bp][-12], st(0) test byte [bp][-1],40H (* test for zero flag *) jnz DoPiBy2 (* if arg1 was 0,return pi/2 *) fmul st(0), st(0) fld1 st(0) fsubrp st(1),st(0) fsqrt st(0) fdivr qword st(0), [bp][-12] fwait call $atan0 DoPiBy2: fld tbyte st(0), cs:[@coremath_tbyte_Pi_By_2] fsubrp st(1), st(0) acos_exit: (*%F NearPtr *) mov dx, seg __fac mov es, dx fstp qword es:[__fac], st(0) (*%E *) (*%T NearPtr *) fstp qword [__fac], st(0) (*%E *) mov ax, __fac mov sp, bp pop bp mov word ss:[InMathLib], 0 (*%T NearCall*) ret near PopParam*8 (*%E*) (*%F NearCall*) ret far PopParam*8 (*%E*) acostable: dw acos_exit, err_acos_neg, err_acos_pos; db f_st5, "acos", 0 err_acos_pos: call $check_abs_one fldz st(0) sub ax, ax ret 0 err_acos_neg: call $check_abs_one fldpi st(0) sub ax, ax ret 0 (*%E StdFloat *) (*************************************************************************) (*%T StdFloat *) (*%F _WINDOWS *) section segment _DATA(DATA,28H) segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn __lib_error extrn __SH_sword extrn __exc_addr public __math_excep: (* called from floating point exception handler *) (* 8087 status word on stack, behind FAR return address to signal handler. This function must reside in the same segment as the math library functions which use InMathLib [bp][0] == saved bp [bp][2] == return ip to signal handler [bp][4] == return cs to signal handler [bp][6] == 8087 status word [bp][8] == return ip to point of exception [bp][10] == return cs to point of exception [bp][12] == flags for iret *) push bp mov bp,sp sub sp,2 cmp word ss:[InMathLib], 0 je user_error (* An error has occurred in a library function. Put the stack into a canonical state *) jmp pop_8087 pop_8087_loop: fstp st(0), st(0) pop_8087: fstsw [bp][-2] fwait test word [bp][-2], 3800H jnz pop_8087_loop (* The address of the handler table is in ss:[InMathLib] *) push si push ax push bx mov si,ss:[InMathLib] mov word ss:[InMathLib], 0 mov ax, cs:[si] (* resume address *) inc si inc si mov [bp][2],ax (* adjust local return address *) mov bx,ss:[InMathLib][2] (* get the BP at the point of error *) mov [bp],bx (* and make sure we restore to it *) call __lib_error pop bx pop ax pop si mov sp,bp pop bp ret 10 (* return NEAR to resume point (we know it's in same code segment) discard signal handler cs, 8087 status word, and 6 byte iret info *) user_error: push ax push ds mov ax, _DATA mov ds, ax mov ax, [bp][6] mov [__SH_sword], ax mov ax, [bp][8] mov [__exc_addr], ax mov ax, [bp][10] mov [__exc_addr][2], ax pop ds pop ax mov sp, bp pop bp ret far 2 (* return FAR to signal handler, discarding status word *) (*%E _WINDOWS *) (*%E StdFloat *) (**************************************************************************) (*%T StdFloat *) (*%T _WINDOWS *) section segment _DATA(DATA,28H) segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn __lib_error extrn __SH_sword extrn __exc_addr public __math_excep: (* called from floating point exception handler *) (* 8087 status word on stack, behind FAR return address to signal handler. This function must reside in the same segment as the math library functions which use InMathLib [bp][0] == saved bp [bp][2] == return ip to signal handler [bp][4] == return cs to signal handler [bp][6] == 8087 status word [bp][8] == return ip to windows emulator [bp][10] == return cs to windows emulator *) (* Windows version - emulator may or may not have placed junk on the stack, so use the saved info to work out where we are. *) push bp mov bp,sp sub sp,2 cmp word ss:[InMathLib], 0 je user_error (* An error has occurred in a library function. Put the stack into a canonical state *) jmp pop_8087 pop_8087_loop: fstp st(0), st(0) pop_8087: fxam st(0) fstsw [bp][-2] fwait and byte [bp][-1], 41H cmp byte [bp][-1], 41H jnz pop_8087_loop (* The address of the handler table is in ss:[InMathLib] *) push si push ax push bx mov si,ss:[InMathLib] mov word ss:[InMathLib], 0 mov ax, cs:[si] (* resume address *) inc si inc si mov [bp][2],ax (* adjust local return address *) mov bx,ss:[InMathLib][2] (* get the BP at the point of error *) mov [bp],bx (* and make sure we restore to it *) call __lib_error pop bx pop ax pop si mov sp,bp pop bp (* == BP at point of error *) ret 8 (* return NEAR to resume point (we know it's in same code segment) discard signal handler cs, 8087 status word, and return address to Windows. Anything else left on stack by Windows emulator is removed at the resume address by the mov sp,bp it will perform *) user_error: push ax push ds mov ax, ss mov ds, ax mov ax, [bp][6] mov [__SH_sword], ax sub ax, ax (* No hope of locating error source under windows *) mov [__exc_addr], ax mov [__exc_addr][2], ax pop ds pop ax mov sp, bp pop bp ret far 2 (* return FAR to signal handler, discarding status word *) (*%E _WINDOWS *) (*%E StdFloat *) section (*****************************************************************************) segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) public $err_domain: fldz st(0) mov ax, _DOMAIN ret 0 (************************************************************************) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) public $err_underflow: fldz st(0) mov ax, _UNDERFLOW ret 0 (************************************************************************) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) public $err_plus_infinity: (*%T SameDS *) extrn _HUGE fld qword st(0), [_HUGE] mov ax, _OVERFLOW ret 0 (*%E SameDS *) (*%F SameDS *) extrn @coremath_HUGE fld qword st(0), cs:[@coremath_HUGE] mov ax, _OVERFLOW ret 0 (*%E NOT SameDS *) (***********************************************************************) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn $err_plus_infinity public $err_minus_infinity: call $err_plus_infinity fchs st(0) ret 0 (************************************************************************) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) public $err_huge_plus_infinity: (*%T SameDS *) extrn _LHUGE fld tbyte st(0), [_LHUGE] mov ax, _OVERFLOW ret 0 (*%E SameDS *) (*%F SameDS *) extrn @coremath_LHUGE fld tbyte st(0),cs:[@coremath_LHUGE] mov ax, _OVERFLOW ret 0 (*%E NOT SameDS *) (***********************************************************************) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn $err_huge_plus_infinity public $err_huge_minus_infinity: call $err_huge_plus_infinity fchs st(0) ret 0 (***** Common Procedures *************************************************) (******************** __bcd ****************************************** void __bcd(LONGDOUBLE num,tbyte *return_area) COVENTIONS: all ROUNDING: to nearest OVERFLOW: returns signed Maximum UNDERFLOW: returns +0 converts the long double num to a standard packed tbyte bcd at address ss:return_area. ***********************************************************************) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) num = CodePtrSize+2 (*%F _WINDOWS *) extrn @coremath_nearest (*%E NOT _WINDOWS *) public __bcd: (*%T StkParam *)(*%F _WINDOWS *) push bp mov bp,sp push ax (* to store cw *) fstcw [bp][-2] (* store cw *) fld tbyte st(0),[bp][num] (* load num *) fldcw cs:[@coremath_nearest] (* set cw to "round to nearest" *) mov bx,[bp][12][CodePtrSize] (* ss:[bx] = return_area *) frndint st(0) (* 80287 does not use rounding controls on fbstp *) fbstp tbyte ss:[bx],st(0) (* store num as packed bcd in return_area *) fldcw [bp][-2] (* restore cw *) fwait mov sp,bp (* destroy stack frame *) pop bp db Ret0@ (*%E StkParam *)(*%E NOT _WINDOWS *) (*%F StdFloat *) push bp mov bp,sp push ax (* to store cw *) fstcw [bp][-2] (* store cw *) fldcw cs:[@coremath_nearest] (* set cw to "round to nearest" *) fld tbyte st(0),st(0) (* load num *) xchg bx,ax (* ss:[bx] = return_area *) frndint st(0) (* 80287 does not use rounding controls on fbstp *) fbstp tbyte ss:[bx],st(0) (* store num as packed bcd in return_area *) fldcw [bp][-2] (* restore cw *) xchg bx,ax (* restore bx *) fwait mov sp,bp (* destroy stack frame *) pop bp db Ret0@ (*%E StdFloat *) (*%T _WINDOWS *) extrn __FloatLoadCW extrn __FloatStoreCW (*%T RegParam *) push bp (* #1 save registers *) mov bp,sp push si (* #2 *) push di (* #3 *) push bx (* #4 *) push cx (* #5 *) push dx (* #6 *) mov di,ax (* ss:[di] = return area *) (*%E RegParam *) (*%T StkParam *) push bp (* #1 save registers *) mov bp,sp push si (* #2 *) push di (* #3 *) mov di,[bp][12][CodePtrSize](* ss:[di] = return area *) (*%E StkParam *) push ss pop es call far __FloatStoreCW (* store cur control word in ax *) push ax (* push cur control word *) and ax,~0C00H (* round to nearest or even *) call far __FloatLoadCW (* rounding control now set *) mov ax,[bp][8][num] (* load exponent & sign *) mov dl,80H (* sign mask *) and dl,ah (* sign in dl *) xor ah,dl (* remove from ax *) mov [bp][9][num],ah(* make long double positive *) mov es:[di][9],dl (* store sign in bcd *) cmp ax,3FFFH+60 (* overflow ? coarse test *) jae OverFlow (* dbl>2**60.definite overflow *) fld tbyte st(0),[bp][num](* load long double *) fistp qword [bp][num],st(0)(* return quad intiger *) fwait mov si,[bp][num] (* si =least sig word *) cmp ax,3FFFH (* if long double<1.... *) cmc sbb ax,ax (* clear ax *) or ax,si (* long double<1 & least sig=0 ? *) jz Zilch (* YES so return 0 *) (* ##1 divide quad int by 10000 *) mov dx,[bp][6][num] (* most sig word *) mov ax,[bp][4][num] (* 2'nd most sig word *) mov cx,10000 (* divisor *) div cx (* ##1.1 *) mov bx,ax (* bx = R1.1 *) mov ax,[bp][2][num] (* 3'rd most sig word *) div cx (* ##1.2 *) xchg ax,si (* si = R1.2 .ax = 4th sig *) div cx (* ##1.3 *) push dx (* push Rem.1 *) xchg ax,bx (* ax = R1.1 bx= R1.3 *) (* ##2 2'nd divide by 10000 *) cwd (* zero extend R1.1 *) div cx (* ##2.1 *) xchg ax,si (* ax = R1.2.si = R2.1 *) div cx (* ##2.2 *) xchg ax,bx (* ax = R1.3.bx = R2.2 *) div cx (* ##2.3 *) push dx (* push Rem.2 *) xchg ax,bx (* bx = R2.3. ax = R2.2 *) (* ## 3'rd divide by 10000 *) mov dx,si (* dx = R2.1,ax = R2.2 *) div cx (* ##3.1 *) xchg ax,bx (* ax = R2.3,bx = R3.1 *) div cx (* ##3.2 *) push dx (* push Rem.3 *) (* ## 4'th divide by 10000 *) mov dx,bx (* dx = R3.1,ax = R3.2 *) div cx (* ##4.1 *) mov cx,25604 (* ch =100,cl=4 *) cmp al,ch (* fine overflow test *) jb NotOver (* test passed *) add sp,6 (* destroy 3 pushes *) OverFlow: mov ax,9999H (* return signed max *) stosb (* 9 packed bytes set *) jmp Over2 (* don't set sign byte *) Zilch: stosw (* zilch clears all byte's including sign *) Over2: stosw stosw stosw stosw jmp Done NotOver: push dx (* push Rem.4 *) aam (* ah top digit,al = 2'nd *) shl ah,cl (* pack *) add al,ah add di,8 (* di -> top packed byte *) std (* packed words stored in reverse order *) stosb (* store top packed byte *) dec di (* di -> 4'th packed word *) mov si,4 (* 4 iterations of store loop *) StoreLp: pop ax (* pop next 4 digits *) div ch (* al = X34, ah =X12 *) mov dl,ah (* dl = X12 *) aam (* ah = X4,al = X3 *) xchg ax,dx (* al = X12,dh =X4,dl = X3 *) aam (* al = X1,ah = X2 *) xchg ah,dl (* al=X1,ah =X3,dl=X2,dh=X4 *) shl dx,cl (* dx<<4 *) add ax,dx (* ax = 4 packed bcd digits *) stosw (* store digits *) dec si jnz StoreLp (* next 4 digits *) cld (* reset direction flag *) Done: pop ax (* ax = original CW *) call far __FloatLoadCW (* restore CW *) (*%T StkParam *) pop di (* #3 restore registers *) pop si (* #2 *) pop bp (* #1 *) db Ret0@ (*%E StkParam *) (*%T RegParam *) pop dx (* #6 restore registers *) pop cx (* #5 *) pop bx (* #4 *) pop di (* #3 *) pop si (* #2 *) pop bp (* #1 *) db RetX@;dw 10 (*%E RegParam *) (*%E _WINDOWS *) (************************* _acvt() ************************************ LONGDOUBLE _acvt(int flag, char *mbuf, int exp, int len); converts the ascii string *mbuf of len digits to a long double, and multiplys it by 10**exp. the following asumptions are not checked: len is asumed to be 18 or less. all digits are asumed to be valid askii decimal with no '.' *************************************************************************) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn @coremath_int_ten extrn @coremath_int_one extrn __seterrno (*%T StdFloat *) extrn __fac (*%E StdFloat *) (*%T SameDS *) extrn _HUGE extrn _LHUGE (*%E SameDS *) (*%F SameDS *) extrn @coremath_HUGE extrn @coremath_LHUGE (*%E NOT SameDS *) (*%T _WINDOWS *) extrn __FloatLoadCW extrn __FloatStoreCW (*%E _WINDOWS *) (*%F _WINDOWS *) extrn @coremath_nearest (*%E NOT _WINDOWS *) _MNEG = 1 (* True -> result should be negative *) _STD = 8 (* True -> set errno if overflow *) _ACVTL = 16 (* False -> max return is HUGE, not LHUGE *) public __acvt: (*%F _WINDOWS *) push bp (* #0 *) mov bp,sp push ax (* #1 for CW *) fstcw [bp][-2] (* save old CW *) (*%T RegParam *)(*%T FarPtr *) mov es,cx (* es:[bx] = mbuff *) mov cx,[bp][2][CodePtrSize] (* cx = len. dx = exp *) (*%E RegParam *)(*%E FarPtr *) (*%T RegParam *)(*%T NearPtr *) xchg cx,dx (* cx = len. dx = exp *) (*%E RegParam *)(*%E NearPtr *) (*%T StkParam *)(*%T FarPtr *) mov ax,[bp][2][CodePtrSize] (* flags *) les bx,[bp][4][CodePtrSize] (* mbuff *) mov dx,[bp][8][CodePtrSize] (* exp *) mov cx,[bp][10][CodePtrSize] (* len *) (*%E StkParam *)(*%E FarPtr *) (*%T StkParam *)(*%T NearPtr *) mov ax,[bp][2][CodePtrSize] (* flags *) mov bx,[bp][4][CodePtrSize] (* mbuff *) mov dx,[bp][6][CodePtrSize] (* exp *) mov cx,[bp][8][CodePtrSize] (* len *) (*%E StkParam *)(*%E NearPtr *) xor bp,bp push bp (* #2 create cleared tbyte for packed bcd *) push bp (* #3 *) push bp (* #4 *) push bp (* #5 *) push bp (* #6 *) fldcw cs:[@coremath_nearest] (* round to nearest, mask exceptions *) mov bp,sp (* ss:[bp]->bcd_store *) push ax (* #7 save flags *) add bx,cx (* bx-> end of mbuf *) jmp PkEnt Pack: dec bx (* next 2 digits *) dec bx (*%T FarPtr *) db es@ (*%E es seg for mbuff *) mov ax,[bx] (* load digits from mbuff *) and ah,0FH (* convert lower digit to decimal from askii *) add al,al (* upper_digit<<4 . also converts to decimal *) add al,al add al,al add al,al add al,ah (* pack digits into al *) mov [bp],al (* store packed byte in bcd_store *) inc bp (* next byte of bcd_store *) PkEnt: sub cx,2 (* sub 2 from count *) jae Pack (* 2 or more characters remain *) jnp NoOdd (* cx= -2 so no odd character *) (*%T FarPtr *) db es@ (*%E es: for mbuff *) mov al,[bx][-1] (* pack last digit *) and al,0FH mov [bp],al NoOdd: mov bp,sp (* bp = stack frame *) add bp,14 (* compensate for 7 pushes *) fbld tbyte st(0),[bp][-12](* $1 load packed digits *) pop bx (* #7 flags *) or dx,dx (* test exponent *) (*%T RegParam *) fstp st(1),st(0) (*%E $0 *) jz Sign (* no power- return digits *) fild word st(0),cs:[@coremath_int_ten] (*$1or2 load 10 *) jns Ploop neg dx fidivr word st(0),cs:[@coremath_int_one] (* st(0) = 1/10 *) jmp Ploop Htest: fstsw [bp][-12] (* store SW *) fwait pop ax (* #6 ax = SW *) test al,8 (* has an overflow been recorded ? *) jz Sign (* No Error result0) or (X<0 && Y isn't an integer) pow calls matherr, with error = DOMAIN,& result = 0. ***************************************************************************) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) PowName: db "pow",0 (* name for exception handler *) extrn $err_plus_infinity extrn $err_huge_plus_infinity extrn $err_minus_infinity extrn $err_huge_minus_infinity extrn $err_domain extrn $err_underflow extrn __report_math_error extrn @coremath_int_one extrn @coremath_int_two (*%T StdFloat *) extrn __fac (*%E StdFloat *) (*%F _WINDOWS *) extrn @coremath_nearest (*%E NOT _WINDOWS *) (*%T _WINDOWS *) extrn __FloatStoreCW extrn __FloatStoreSW extrn __FloatLoadCW (*%E _WINDOWS *) (*%T RegParam *) (*%T NearPtr *) x=-6 (*%E NearPtr *) (*%T FarPtr *) x=-4 (*%E FarPtr *) Arg1Dbl = 2+CodePtrSize+8 Arg1Tbt = 2+CodePtrSize+10 Arg2Dbl = 2+CodePtrSize Arg2Tbt = 2+CodePtrSize (*%E RegParam *) (*%T StkParam *) x=0 Arg1Dbl = 2+CodePtrSize Arg1Tbt = 2+CodePtrSize Arg2Dbl = 2+CodePtrSize+8 Arg2Tbt = 2+CodePtrSize+10 (*%E StkParam *) (*%F StdFloat ********************************************) public _powl: push bp (* #0 save bp *) mov bp,sp push cx (* #1 save cx *) xor cx,cx (* powl flag: set cx = 0 *) jmp Ent public _pow: push bp (* #0 save bp *) mov bp,sp push cx (* #1 save cx *) mov ch,-1 (* pow flag: set cx =! 0 *) Ent: push ax (* #2 save ax *) ftst st(0) (* test X *) push ax (* #3 to store CW *) push ax (* #4 for test X *) fstsw word [bp][-8] (* store result of test *) fstcw [bp][-6] (* store control word *) fst st(5),st(0) (* save X in st(5) for error handler *) pop ax (* #4 ax = cmp X,0 *) sahf (* flags =cmp X,0 *) fld st(0),st(6) (* $1 Y = st(0) *) push bx (* #4 save bx *) mov ah,-1 (* set ZF flag in ax *) fldcw cs:[@coremath_nearest](* round to nearest,affine,excepts masked *) push ax (* #5 assume result is positive *) jz X0 (* X is Zero *) ja Xpos (* X is positive non-Zero *) Xneg: frndint st(0) (* X is neg. Y rounded to int *) fcom st(0),st(7) (* cmp Y,rounded Y *) fstsw [bp][-10] (* store result of test *) fidiv word st(0),cs:[@coremath_int_two] pop ax (* #5 ax = cmp Y,chopped Y *) sahf (* flags = cmp Y,chopped Y *) jne Domain (* Y isn't an integer *) frndint st(0) (* round 1/2Y - altered if Y was odd *) fadd st(0),st(0) fcomp st(0),st(7) (* $0 Y = st(0) if Y is even *) push ax (* #5 to store result sign *) fstsw [bp][-10] (* ZF = 1 if pos result *) fabs st(0) (* st(0) = abs(X) *) fld st(0),st(6) (* $1 st(0) = Y, st(1) = X *) Xpos: fxch st(0),st(1) (* st(0) = X,st(1) = Y *) fyl2x st(1),st(0) (* $0 st(0) = log2 result *) sub sp,10 (*#6-10 for tempory tbyte *) fld st(0),st(0) (* $1 *) fstp tbyte [bp][-20],st(0) (* $0 log2 result *) fld st(0),st(0) (* $1 st(1) = log2 result *) add sp,6 (* destroy 3 least sig words of tbyte *) frndint st(0) (* st(0) = integer part of log2 result *) pop bx (* #7 most sig mantisa word of log2 result*) fxch st(0),st(1) (* st(1) = integer part of log2 result *) pop ax (* #6 ax = biased exponent of log2 result *) fsub st(0),st(1) (* st(0) = fractional part of log2 result *) push ax (* #6 to test fractional exponent *) ftst st(0) (* is fractional part neg ? *) fstsw [bp][-12] (* store result of test *) fabs st(0) (* st(0) = abs(fraction) *) f2xm1 st(0) (* st(0) = (2 to power abs(fraction))-1 *) jcxz Lexp (* test for over/under tbyte result *) cmp ax,4009H (* 04009,8000 = max posible valid exponent *) jge Over (* tbyte>400H.overflow *) jb NoErr (* positive - no error *) cmp ax,0C008H (* 0C008,FFC0 = min posible valid exponent *) ja Under (* tbyte<-3FFH.underfow *) jb NoErr (* tbyte>-3FFH.in range *) cmp bx,0FFC0H (* 2'nd underflow test *) jb NoErr Under: pop ax (* #6 ax= sign of fractional exponent *) pop ax (* #5 destroy result's sign *) mov ax,$err_underflow jmp Error X0: fcomp st(0),st(1) (* $0 cmp Y,0. st(0)=0 *) fstsw [bp][-10] (* store result of test *) fwait pop ax (* #5 ax = cmp Y,0 *) sahf (* flags = cmp Y,0 *) ja Done (* Y>0.return 0 *) fld st(0),st(0) (* $1 *) Domain:mov ax,$err_domain (* else domain error *) Error: mov bx,PowName fstp st(1),st(0) (* $0 *) call ax (* st(0) = default return,ax =error num *) fstp st(1),st(0) (* $0 *) call __report_math_error (* call error handler *) jmp Done Over: pop ax (* #6 fractional exponent sign *) pop ax (* #5 result sign ? *) sahf (* sign *) jnz NegOv (* return -HUGE *) mov ax,$err_plus_infinity jmp Error NegOv: mov ax,$err_minus_infinity jmp Error LOver: pop ax (* #6 fractional exponent sign *) pop ax (* #5 result sign ? *) sahf jnz LNegOv (* return -LHUGE *) mov ax,$err_huge_plus_infinity jmp Error LNegOv:mov ax,$err_huge_minus_infinity jmp Error Lexp: cmp ax,400DH (* 0400D,8000 = max posible valid exponent *) jge LOver (* tbyte>4000H.overflow *) ja NoErr (* positive exp *) cmp ax,0C00CH (* 0C00C,FFFC = min posible valid exponent *) jb NoErr (* tbyte>-3FFFH.in range *) ja Under (* tbyte<-3FFFH.underfow *) cmp bx,0FFFCH (* 2'nd underflow test *) jae Under (* tbyte<-3FFFH.underfow *) NoErr: pop ax (* #6 ax= sign of fractional exponent *) fiadd word st(0),cs:[@coremath_int_one] sahf (* flags = sign of fractional exponent *) jae Pos (* st(0) = 2 to power fraction *) fidivr word st(0),cs:[@coremath_int_one] (* st(0) = 2 to power fraction *) Pos: fscale st(0),st(1) (* scale st(0) by integer power *) fstp st(1),st(0) (* $0 *) pop ax (* #5 sign of result ? *) sahf jz Done (* result is positive *) fchs st(0) (* negative result *) Done: fclex (* clear exceptions *) fldcw [bp][-6] (* load original cw *) pop bx (* #4 restore bx *) fwait (* when loaded.. *) pop ax (* #3 destroy original CW *) pop ax (* #2 restore registers *) pop cx (* #1 *) pop bp (* #0 *) db Ret0@ (*%E NOT StdFloat *********************************************) (*%T StdFloat *************************************************) public _powl: push bp mov bp,sp (*%T RegParam *) push bx push cx (*%T NearPtr *) push dx (*%E NearPtr *) (*%E RegParam *) xor cx,cx (* powl flag: set cx = 0 *) fld tbyte st(0),[bp][Arg1Tbt] (* $1 load X *) push ax (* #1 for test X *) ftst st(0) (* test X *) fstsw [bp][-2][x] fld tbyte st(0),[bp][Arg2Tbt] (* $2 load Y *) jmp Ent public _pow: push bp mov bp,sp (*%T RegParam *) push bx push cx (*%T NearPtr *) push dx (*%E NearPtr *) (*%E RegParam *) mov ch,-1 (* pow flag: cx != 0 *) fld qword st(0),[bp][Arg1Dbl] (* $1 load X *) push ax (* for test X *) ftst st(0) (* test X *) fstsw [bp][-2][x] fld qword st(0),[bp][Arg2Dbl] (* $2 load Y *) Ent: pop ax (* #1 ax = Test X *) (*%F _WINDOWS *) push ax (* #1 to save cw *) fstcw [bp][-2][x] (* save cw *) fldcw cs:[@coremath_nearest](* round to nearest,affine,excepts masked *) (*%E NOT _WINDOWS *) (*%T _WINDOWS *) mov bx,ax (* save test X *) call far __FloatStoreCW (* store control word *) push ax (* #1 original CW *) mov ax,133FH (* round to nearest,affine,excepts masked *) call far __FloatLoadCW mov ax,bx (* ax = Test X *) (*%E _WINDOWS *) sahf (* flags =cmp X,0 *) ja Xpos (* X is positive non-Zero *) push ax (* #2 to store cmp Y,rounded Y *) jz X0 (* X is Zero *) Xneg: fld st(0),st(0) (* $3 save Y in st(1) *) frndint st(0) (* X is neg. Y rounded to int *) fcom st(0),st(1) (* cmp Y,rounded Y *) fstsw [bp][-4][x] (* store result of test *) fidiv word st(0),cs:[@coremath_int_two] pop ax frndint st(0) fadd st(0),st(0) fcomp st(0),st(1) (* $2 Y = st(0) flags->ZF=0 if Y is even *) sahf (* flags = cmp Y,choped Y *) jnz Domain (* Y is not an integer *) push ax (* #2 to store result's sign *) fstsw [bp][-4][x] (* store result of test *) fxch st(0),st(1) (* st(1) = Y *) fabs st(0) (* st(0) = abs(X) *) not byte [bp][-3][x] (* #2 zf=1 if odd *) jmp Xneg2 Xpos: push ax (* #2 ZF in ax = 1 if neg result *) fxch st(0),st(1) (* st(0) = X,st(1) = Y *) Xneg2: fyl2x st(1),st(0) (* $1 st(0) = log2 result *) fld st(0),st(0) (* $2 st(1) = log2 result *) sub sp,10 (*#3-7 for tempory tbyte *) fld st(0),st(0) (* $3 *) fstp tbyte [bp][-14][x],st(0) (* $2 log2 result *) frndint st(0) (* st(0) = integer part of log2 result *) add sp,6 (* destoy 3 least sig words of tbyte *) fxch st(0),st(1) (* st(1) = integer part of log2 result *) pop bx (* #4 most sig word of mantisa *) fsub st(0),st(1) (* st(0) = factional part of log2 result *) pop dx (* #3 dx = biased exponent of log2 result *) ftst st(0) (* is fractional part neg ? *) push ax (* #3 to test sign of fraction *) fstsw [bp][-6][x] (* store result of test *) fabs st(0) (* st(0) = abs(fraction) *) pop ax (* #3 ax = result of test *) f2xm1 st(0) (* st(0) = (2 to power abs(fraction))-1 *) jcxz Lexp (* test for over/under tbyte result *) cmp dx,4009H (* 04009,8000 = max posible valid exponent *) jge Over (* tbyte>400H.overflow *) jb NoErr (* positive exponent *) cmp dx,0C008H (* 0C008,FFC0 = min posible valid exponent *) jb NoErr (* tbyte>-3FFH.in range *) ja Under (* tbyte<-3FFH.underfow *) cmp bx,0FFC0H (* 2'nd underflow test *) jb NoErr Under: pop ax (* #2 destroy result's sign *) mov ax,$err_underflow jmp Error X0: fcomp st(0),st(1) (* $1 cmp Y,0. st(0)=0 *) fstsw [bp][-4][x] (* store result of test *) fwait pop ax sahf ja Done1 (* Y>0.return 0 NOTE $1 *) fld st(0),st(0) (* $2 *) Domain:mov ax,$err_domain (* else domain error *) Error: mov bx,PowName (* ss:[bx]->"pow" *) fstp st(0),st(0) (* $1 *) fstp st(0),st(0) (* $0 *) jcxz Terr fld qword st(0),[bp][Arg2Dbl] fld qword st(0),[bp][Arg1Dbl] jmp Qerr Terr: fld tbyte st(0),[bp][Arg2Tbt] fld tbyte st(0),[bp][Arg1Tbt] Qerr: call ax (* st(0) =ret val,ax = exception type *) call __report_math_error Done1: jmp Done Over: pop ax (* #2 result sign ? *) sahf (* sign *) jz NegOv (* return -HUGE *) mov ax,$err_plus_infinity jmp Error NegOv: mov ax,$err_minus_infinity jmp Error LOver: pop ax (* #2 result sign ? *) sahf jz LNegOv (* return -LHUGE *) mov ax,$err_huge_plus_infinity jmp Error LNegOv:mov ax,$err_huge_minus_infinity jmp Error Lexp: cmp dx,400DH (* 0400D,8000 = max posible valid exponent *) jge LOver (* tbyte>4000H.overflow *) ja NoErr (* positive - no error *) cmp dx,0C00CH (* 0C00C,FFC0 = min posible valid exponent *) jb NoErr (* tbyte>-3FFFH.in range *) ja Under (* tbyte<-3FFFH.underfow *) cmp bx,0FFFCH (* 2'nd underflow test *) jae Under (* tbyte<-3FFFH.underfow *) NoErr: fiadd word st(0),cs:[@coremath_int_one] sahf (* flags = cmp st(0),0 *) jae Pos (* st(0) = 2 to power fraction *) fidivr word st(0),cs:[@coremath_int_one] (* st(0) = 2 to power fraction *) Pos: (*%T _WINDOWS *) fxch st(1), st(0) ftst st(0) (* work around windows emulator bug *) call far __FloatStoreSW fxch st(1), st(0) sahf jz skipscale (*%E *) fscale st(0),st(1) (* scale st(0) by integer power *) skipscale: fstp st(1),st(0) (* $1 *) pop ax (* #2 sign of result ? *) sahf jnz Done (* result is positive *) fchs st(0) (* negative result *) Done: fclex (* clear exceptions *) (*%T _WINDOWS *) pop ax (* #1 original CW *) call far __FloatLoadCW (* restore CW *) (*%E _WINDOWS *) (*%F _WINDOWS *) fldcw [bp][-2][x] (* restore original CW *) pop ax (* #1 original CW *) (*%E NOT _WINDOWS *) (*** TAIL for StdFloat pow **********************************) (*%T StkParam *)(*%T NearPtr *) jcxz Huge fstp qword [__fac], st(0) jmp Done2 Huge: fstp tbyte [__fac], st(0) Done2: pop bp (* restore bp *) mov ax, __fac fwait db Ret0@ (*%E StkParam *)(*%E NearPtr *) (*%T StkParam *)(*%T FarPtr *)(*%F _fdata *) jcxz Huge fstp qword [__fac], st(0) jmp Done2 Huge: fstp tbyte [__fac], st(0) Done2: pop bp (* restore bp *) mov ax, __fac mov dx,ds fwait db Ret0@ (*%E StkParam *)(*%E FarPtr *)(*%E NOT _fdata *) (*%T StkParam *)(*%T FarPtr *)(*%T _fdata *) mov dx,seg __fac mov es,dx jcxz Huge fstp qword es:[__fac], st(0) jmp Done2 Huge: fstp tbyte es:[__fac], st(0) Done2: pop bp (* restore bp *) mov ax, __fac fwait db Ret0@ (*%E StkParam *)(*%E FarPtr *)(*%E _fdata *) (*%T RegParam *)(*%T NearPtr *) mov ax, __fac jcxz Huge fstp qword [__fac],st(0) pop dx pop cx pop bx fwait pop bp db RetX@;dw 16 Huge: fstp tbyte [__fac],st(0) pop dx pop cx pop bx fwait pop bp db RetX@;dw 20 (*%E RegParam *)(*%E NearPtr *) (*%T RegParam *)(*%T FarPtr *) mov ax, __fac mov dx,ds jcxz Huge fstp qword [__fac], st(0) pop cx pop bx fwait pop bp db RetX@;dw 16 Huge: fstp tbyte [__fac], st(0) pop cx pop bx fwait pop bp db RetX@;dw 20 (*%E RegParam *)(*%E FarPtr *) (*%E StdFloat End of StdFloat pow *********************) (* __pow_int ************************************************************ internal function. LONGDOUBLE __pow_int(LONGDOUBLE X,int Y) conventions: all returns X to the power Y Error Handling: NONE *************************************************************************) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) extrn @coremath_int_one (*%T StdFloat *) extrn __fac (*%E StdFloat *) public __pow_int: push bp mov bp,sp (*%T StdFloat *) fld tbyte st(0),[bp][2][CodePtrSize] (*$1 num *) (*%E StdFloat *) (*%T StkParam *) mov ax,[bp][12][CodePtrSize] (* integral power *) (*%E StkParam *) or ax,ax (* power ? *) jg PosExp (* positive non-zero *) jz Pow0 (* power is 0,return 1 *) neg ax (* power was negative *) fidivr word st(0),cs:[@coremath_int_one] PosExp: dec ax jz Done fld st(0),st(0) jmp Ploop Pow0: fld1 st(0) (* store 1 in st(0) *) fstp st(1),st(0) jmp Done Ploop2: fmul st(1),st(0) (* mul st(1) by 10**2**N *) Ploop1: fmul st(0),st(0) (* N++ *) Ploop: shr ax,1 ja Ploop1 jnz Ploop2 fmulp st(1),st(0) (* last power,result in st(0) *) (*%T StdFloat *)(*%T _fdata *) Done: mov ax, __fac mov dx, seg __fac mov es, dx fstp tbyte es:[__fac], st(0) fwait (*%E StdFloat *)(*%E _fdata *) (*%T StdFloat *)(*%T FarPtr *)(*%T SameDS *) Done: mov ax, __fac mov dx,ds fstp tbyte [__fac], st(0) fwait (*%E StdFloat *)(*%E FarPtr *)(*%E SameDS *) (*%T StdFloat *)(*%T NearPtr *) Done: mov ax, __fac fstp tbyte [__fac], st(0) fwait (*%E StdFloat *)(*%E NearPtr *) (*%T StkParam *) pop bp db Ret0@ (*%E StkParam *) (*%T RegParam *)(*%T _WINDOWS *) pop bp db RetX@;dw 10 (*%E RegParam *)(*%E _WINDOWS *) (*%T RegParam *)(*%F _WINDOWS *) Done: pop bp db Ret0@ (*%E RegParam *)(*%E NOT _WINDOWS *) (*************************************************************************) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) public __clear87 : push bp mov bp, sp push ax fstsw [bp][-2] fclex pop ax pop bp db Ret0@ (*************************************************************************) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) (* returns status word in ax *) public __status87 : push bp mov bp, sp push ax fstsw [bp][-2] fwait pop ax pop bp db Ret0@ (*************************************************************************) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) (*%T _WINDOWS *) extrn __FloatStoreCW extrn __FloatLoadCW (*%E _WINDOWS *) public __control87 : (*%F _WINDOWS *) (*%T RegParam *) push bp (* save bp *) mov bp,sp (*%E RegParam *) (*%T StkParam *) push bp mov bp,sp mov ax,[bp][2][CodePtrSize] (* ax = new *) mov bx,[bp][4][CodePtrSize] (* bx = mask *) (*%E StkParam *) push ax (* for storeing CW *) fstcw [bp][-2] and ax,bx (* ax = new & mask *) not bx (* bx = ~mask *) fwait (* wait for old CW to be stored *) xchg ax,[bp][-2] (* ax = old CW, [bp][-2] = new & mask *) and bx,ax (* bx = old CW & ~mask *) or [bp][-2],bx (* [bp][-2] =(old CW & ~mask) | (new & mask) *) fldcw [bp][-2] (* load new CW *) fwait (* wait for CW to load *) pop bx (* destoy CW on stack *) pop bp (* restore bp *) db Ret0@ (* return old CW *) (*%E _WINDOWS *) (*%T _WINDOWS *) (*%T RegParam *) push cx mov cx,ax (* cx = new *) (*%E RegParam *) (*%T StkParam *) push bp mov bp,sp mov cx,[bp][2][CodePtrSize] (* cx = new *) mov bx,[bp][4][CodePtrSize] (* bx = mask *) (*%E StkParam *) and cx,bx (* cx = new & mask *) not bx (* bx = ~mask *) call far __FloatStoreCW (* ax = old CW *) and bx,ax (* bx = old CW & ~mask *) or bx,cx (* bx = (old CW & ~mask) | (new & mask) *) xchg ax,bx (* ax = new CW, bx = old CW *) call far __FloatLoadCW mov ax,bx (* return old CW *) (*%T RegParam *) pop cx (* restore cx *) db Ret0@ (* return old CW *) (*%E RegParam *) (*%T StkParam *) pop bp (* restore bp *) db Ret0@ (* return old CW *) (*%E StkParam *) (*%E _WINDOWS *) (*********************************************************************** double floor(double num) LONGEDOUBLE floorl(LONGDOUBLE num) returns num rounded down to the nearest intiger Error handling: NONE ************************************************************************) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) (*%F _WINDOWS *) extrn @coremath_floor (*%E NOT _WINDOWS *) (*%T StdFloat *) extrn __fac (*%E StdFloat *) (*%T _WINDOWS *) extrn __FloatStoreCW extrn __FloatLoadCW (*%E _WINDOWS *) (*%F StdFloat *) public _floor: public _floorl: push bp mov bp,sp push ax (* space for old CW *) fstcw [bp][-2] (* save old CW *) fldcw cs:[@coremath_floor] (* round down,affine,exceptions masked *) frndint st(0) (* round down to intiger *) fldcw [bp][-2] (* restore old CW *) fwait mov sp,bp (* destroy old CW on stack *) pop bp db Ret0@ (*%E NOT StdFloat *) (*%T StdFloat *) public _floor: push bp mov bp,sp fld qword st(0),[bp][2][CodePtrSize] (* load double *) (*%F _WINDOWS *) push ax (* space for old CW *) fstcw [bp][-2] (* save old CW *) fldcw cs:[@coremath_floor] (* round down,affine,exceptions masked *) frndint st(0) (* round down to intiger *) fldcw [bp][-2] (* restore old CW *) (*%E NOT _WINDOWS *) (*%T _WINDOWS *) call far __FloatStoreCW push ax (* save old cw *) mov ax,173FH (* round down,affine,exceptions masked *) call far __FloatLoadCW (* load ax into cw *) frndint st(0) (* round down to intiger *) pop ax (* old cw *) call far __FloatLoadCW (* restore old cw *) (*%E _WINDOWS *) mov ax,__fac (* return result in __fac *) (*%T FarPtr *)(*%T SameDS *) mov dx,ds fstp qword [__fac],st(0) (*%E FarPtr *)(*%E SameDS *) (*%T NearPtr *) fstp qword [__fac],st(0) (*%E NearPtr *) (*%F SameDS *) mov dx,seg __fac mov es,dx fstp qword es:[__fac],st(0) (*%E NOT SameDS *) (*%F _WINDOWS *) mov sp,bp (* desroy CW on stack *) (*%E NOT _WINDOWS *) fwait (* wait for return to be stored *) pop bp (*%T RegParam *) db RetX@;dw 8 (*%E RegParam *) (*%T StkParam *) db Ret0@ (*%E StkParam *) (*%E StdFloat *) segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) (****** LONGDOUBLE version. StdFloat only *) (*%T StdFloat *) public _floorl: push bp mov bp,sp fld tbyte st(0),[bp][2][CodePtrSize] (* load double *) (*%F _WINDOWS *) push ax (* space for old CW *) fstcw [bp][-2] (* save old CW *) fldcw cs:[@coremath_floor] (* round down,affine,exceptions masked *) frndint st(0) (* round down to intiger *) fldcw [bp][-2] (* restore old CW *) (*%E _WINDOWS *) (*%T _WINDOWS *) call far __FloatStoreCW push ax (* save old cw *) mov ax,173FH (* round down,affine,exceptions masked *) call far __FloatLoadCW (* load ax into cw *) frndint st(0) (* round down to intiger *) pop ax (* old cw *) call far __FloatLoadCW (* restore old cw *) (*%E _WINDOWS *) mov ax,__fac (* return result in __fac *) (*%T FarPtr *)(*%T SameDS *) mov dx,ds fstp tbyte [__fac],st(0) (*%E FarPtr *)(*%E SameDS *) (*%T NearPtr *) fstp tbyte [__fac],st(0) (*%E NearPtr *) (*%F SameDS *) mov dx,seg __fac mov es,dx fstp tbyte es:[__fac],st(0) (*%E NOT SameDS *) (*%F _WINDOWS *) mov sp,bp (* destroy CW on stack *) (*%E NOT _WINDOWS *) fwait (* wait for return to be stored *) pop bp (*%T RegParam *) db RetX@;dw 10 (*%E RegParam *) (*%T StkParam *) db Ret0@ (*%E StkParam *) (*%E StdFloat *) (*********************************************************************** double ceil( double num ) LONGEDOUBLE ceill( LONGDOUBLE num) returns num rounded up to the nearest intiger Error handling: NONE ************************************************************************) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) (*%T StdFloat *) extrn __fac (*%E StdFloat *) (*%F _WINDOWS *) extrn @coremath_ceil (*%E NOT _WINDOWS *) (*%T _WINDOWS *) extrn __FloatStoreCW extrn __FloatLoadCW (*%E _WINDOWS *) (*%F StdFloat *) public _ceil: public _ceill: push bp mov bp,sp push ax (* space for old CW *) fstcw [bp][-2] (* save old CW *) fldcw cs:[@coremath_ceil] (* round up,affine,exceptions masked *) frndint st(0) (* round up to intiger *) fldcw [bp][-2] (* restore old CW *) fwait mov sp,bp (* destroy old CW on stack *) pop bp db Ret0@ (*%E NOT StdFloat *) (*%T StdFloat *) public _ceil: push bp mov bp,sp fld qword st(0),[bp][2][CodePtrSize] (* $1 load double *) (*%F _WINDOWS *) push ax (* space for old CW *) fstcw [bp][-2] (* save old CW *) fldcw cs:[@coremath_ceil] (* round up,affine,exceptions masked *) frndint st(0) (* round up to intiger *) fldcw [bp][-2] (* restore old CW *) (*%E _WINDOWS *) (*%T _WINDOWS *) call far __FloatStoreCW push ax (* save old cw *) mov ax,1B3FH (* round up,affine,exceptions masked *) call far __FloatLoadCW (* load ax into cw *) frndint st(0) (* round up to intiger *) pop ax (* old cw *) call far __FloatLoadCW (* restore old cw *) (*%E _WINDOWS *) mov ax,__fac (* return result in __fac *) (*%T FarPtr *)(*%T SameDS *) mov dx,ds fstp qword [__fac],st(0) (*%E FarPtr *)(*%E SameDS *) (*%T NearPtr *) fstp qword [__fac],st(0) (*%E NearPtr *) (*%F SameDS *) mov dx,seg __fac mov es,dx fstp qword es:[__fac],st(0) (*%E NOT SameDS *) (*%F _WINDOWS *) mov sp,bp (* desroy CW on stack *) (*%E NOT _WINDOWS *) fwait (* wait for return to be stored *) pop bp (*%T RegParam *) db RetX@;dw 8 (*%E RegParam *) (*%T StkParam *) db Ret0@ (*%E StkParam *) (*%E StdFloat *) segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) (****** LONGDOUBLE version. StdFloat only *) (*%T StdFloat *) public _ceill: push bp mov bp,sp fld tbyte st(0),[bp][2][CodePtrSize] (* load double *) (*%F _WINDOWS *) push ax (* space for old CW *) fstcw [bp][-2] (* save old CW *) fldcw cs:[@coremath_ceil] (* round up,affine,exceptions masked *) frndint st(0) (* round up to intiger *) fldcw [bp][-2] (* restore old CW *) (*%E NOT _WINDOWS *) (*%T _WINDOWS *) call far __FloatStoreCW push ax (* save old cw *) mov ax,1B3FH (* round up,affine,exceptions masked *) call far __FloatLoadCW (* load ax into cw *) frndint st(0) (* round up to intiger *) pop ax (* old cw *) call far __FloatLoadCW (* restore old cw *) (*%E _WINDOWS *) mov ax,__fac (* return result in __fac *) (*%T FarPtr *)(*%T SameDS *) mov dx,ds fstp tbyte [__fac],st(0) (*%E FarPtr *)(*%E SameDS *) (*%T NearPtr *) fstp tbyte [__fac],st(0) (*%E NearPtr *) (*%F SameDS *) mov dx,seg __fac mov es,dx fstp tbyte es:[__fac],st(0) (*%E NOT SameDS *) (*%F _WINDOWS *) mov sp,bp (* destroy CW on stack *) (*%E NOT _WINDOWS *) fwait (* wait for return to be stored *) pop bp (*%T RegParam *) db RetX@;dw 10 (*%E RegParam *) (*%T StkParam *) db Ret0@ (*%E StkParam *) (*%E StdFloat *) (************************************************************************* double fabs(double num) LONGDOUBLE fabsl(LONGDOUBLE num) Return: the absolute value of num Error Handling: no error is possible **************************************************************************) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) (*%T StdFloat *) extrn __fac (*%E StdFloat *) (*%F StdFloat *)(*%T _DLLOVL *) public _fabsl: public _fabs: push bp mov bp,sp fabs st(0) pop bp db Ret0@ (*%E NOT StdFloat *)(*%E _DLLOVL *) (*%F StdFloat *)(*%F _DLLOVL *) public _fabsl: public _fabs: fabs st(0) db Ret0@ (*%E NOT StdFloat *)(*%E NOT _DLLOVL *) (*%T StdFloat *) public _fabsl: push bp mov bp,sp (*%T SameDS *) (*%T FarPtr *) mov dx,ds (* return seg __fac *) (*%E FarPtr *) mov ax,[bp][CodePtrSize][2] (* transfer tbyte to __fac *) mov [__fac],ax mov ax,[bp][CodePtrSize][4] mov [__fac][2],ax mov ax,[bp][CodePtrSize][6] mov [__fac][4],ax mov ax,[bp][CodePtrSize][8] mov [__fac][6],ax mov ax,[bp][CodePtrSize][10] and ax,7FFFH (* remove sign from exponent *) mov [__fac][8],ax (*%E SameDS *) (*%F SameDS *) mov dx,seg __fac (* return seg __fac *) mov es,dx mov ax,[bp][CodePtrSize][2] (* transfer tbyte to __fac *) mov es:[__fac],ax mov ax,[bp][CodePtrSize][4] mov es:[__fac][2],ax mov ax,[bp][CodePtrSize][6] mov es:[__fac][4],ax mov ax,[bp][CodePtrSize][8] mov es:[__fac][6],ax mov ax,[bp][CodePtrSize][10] and ax,7FFFH (* remove sign from exponent *) mov es:[__fac][8],ax (*%E SameDS *) mov ax,__fac (* return __fac *) pop bp (* restore bp *) (*%T RegParam *) db RetX@;dw 10 (*%E RegParam *) (*%T StkParam *) db Ret0@ (*%E StkParam *) (*%E StdFloat *) segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) (*%T StdFloat *) public _fabs: push bp mov bp,sp (*%T SameDS *) (*%T FarPtr *) mov dx,ds (* return seg __fac *) (*%E FarPtr *) mov ax,[bp][CodePtrSize][2] (* transfer qword to __fac *) mov [__fac],ax mov ax,[bp][CodePtrSize][4] mov [__fac][2],ax mov ax,[bp][CodePtrSize][6] mov [__fac][4],ax mov ax,[bp][CodePtrSize][8] and ax,7FFFH (* remove sign from exponent *) mov [__fac][6],ax (*%E SameDS *) (*%F SameDS *) mov dx,seg __fac (* return seg __fac *) mov es,dx mov ax,[bp][CodePtrSize][2] (* transfer qword to __fac *) mov es:[__fac],ax mov ax,[bp][CodePtrSize][4] mov es:[__fac][2],ax mov ax,[bp][CodePtrSize][6] mov es:[__fac][4],ax mov ax,[bp][CodePtrSize][8] and ax,7FFFH (* remove sign from exponent *) mov es:[__fac][6],ax (*%E SameDS *) mov ax,__fac (* return __fac *) pop bp (* restore bp *) (*%T RegParam *) db RetX@;dw 8 (*%E RegParam *) (*%T StkParam *) db Ret0@ (*%E StkParam *) (*%E StdFloat *) (************************************************************************* double _fmod(double X,double Y) LONGDOUBLE _fmodl(LONGDOUBLE X,LONGDOUBLE Y) Return: X % Y or 0 if Y is 0 Error: no error handling **************************************************************************) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) (*%T RegParam *) X = 2+CodePtrSize+8 Y = 2+CodePtrSize LX = 2+CodePtrSize+10 LY = 2+CodePtrSize (*%E RegParam *) (*%T StkParam *) X = 2+CodePtrSize Y = 2+CodePtrSize+8 LX = 2+CodePtrSize LY = 2+CodePtrSize+10 (*%E StkParam *) (*%T StdFloat *) extrn __fac (*%E StdFloat *) (*%F StdFloat *) public _fmod: public _fmodl: push bp mov bp, sp fld st(0), st(6) (* $1 st(0) = Y,st(1) = X *) push ax (* space for SW *) ftst st(0) (* Y=0 ? *) fstsw [bp][-2] fwait test byte [bp][-1], 40H jnz Done (* Y=0, so return 0 *) fxch st(0), st(1) (* st(1) = Y,st(0) = X *) More: fprem st(0) (* get partial remainder *) fstsw [bp][-2] fwait test byte [bp][-1], 4 (* C2 = 0 if reduction is complete *) jnz More (* reduction is incomplete *) Done: fstp st(1), st(0) (* $0 *) mov sp, bp (* destroy space for SW *) pop bp db Ret0@ (*%E NOT StdFloat *) (*%T StdFloat *) public _fmod: push bp mov bp,sp fld qword st(0),[bp][Y] (* $1 st(0) = Y *) push ax (* space for SW *) ftst st(0) fstsw [bp][-2] fwait test byte [bp][-1], 40H jnz Done (* Y=0, so return 0 *) fld qword st(0),[bp][X] (* st(0) = X,st(1) = Y *) More: fprem st(0) (* get partial remainder *) fstsw [bp][-2] fwait test byte [bp][-1], 4 (* C2 = 0 if reduction is complete *) jnz More (* reduction is incomplete *) fstp st(1),st(0) (* $1 *) Done: pop ax (* destroy space for CW *) (*%T NearPtr *) mov ax,__fac (* return in __fac *) fstp qword [__fac],st(0) (*%E NearPtr *) (*%T FarPtr *)(*%T SameDS *) mov ax,__fac (* return in __fac *) mov dx,ds fstp qword [__fac],st(0) (*%E FarPtr *)(*%E SameDS *) (*%T FarPtr *)(*%F SameDS *) mov ax,__fac (* return in __fac *) mov dx,seg __fac mov es,dx fstp qword es:[__fac],st(0) (*%E FarPtr *)(*%E NOT SameDS *) (*%T RegParam *) fwait (* wait for return to store *) pop bp (* restore bp *) db RetX@;dw 16 (* return,with cleanup *) (*%E RegParam *) (*%T StkParam *) fwait (* wait for return to store *) pop bp (* restore bp *) db Ret0@ (* return,without cleanup *) (*%E StkParam *) segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) public _fmodl: push bp mov bp,sp fld tbyte st(0),[bp][LY] (* $1 st(0) = Y *) push ax (* space for SW *) ftst st(0) fstsw [bp][-2] fwait test byte [bp][-1], 40H jnz LDone (* Y=0, so return 0 *) fld tbyte st(0),[bp][LX] (* st(0) = X,st(1) = Y *) LMore: fprem st(0) (* get partial remainder *) fstsw [bp][-2] fwait test byte [bp][-1], 4 (* C2 = 0 if reduction is complete *) jnz LMore (* reduction is incomplete *) fstp st(1),st(0) (* $1 *) LDone: pop ax (* destroy space for CW *) (*%T NearPtr *) mov ax,__fac (* return in __fac *) fstp tbyte [__fac],st(0) (*%E NearPtr *) (*%T FarPtr *)(*%T SameDS *) mov ax,__fac (* return in __fac *) mov dx,ds fstp tbyte [__fac],st(0) (*%E FarPtr *)(*%E SameDS *) (*%T FarPtr *)(*%F SameDS *) mov ax,__fac (* return in __fac *) mov dx,seg __fac mov es,dx fstp tbyte es:[__fac],st(0) (*%E FarPtr *)(*%E NOT SameDS *) (*%T RegParam *) fwait (* wait for return to store *) pop bp (* restore bp *) db RetX@;dw 20 (* return,with cleanup *) (*%E RegParam *) (*%T StkParam *) fwait (* wait for return to store *) pop bp (* restore bp *) db Ret0@ (* return,without cleanup *) (*%E StkParam *) (*%E StdFloat *) (************************************************************************ *************************************************************************) section segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) (*%T StdFloat *) extrn __fac (*%E StdFloat *) (*%F StdFloat *) extrn @coremath_int_two public _frexp : (*%E NOT StdFloat *) public _frexpl : push bp mov bp, sp (*%T StdFloat *) fld tbyte st(0),[bp][2][CodePtrSize] (* $1 val *) (*%E StdFloat *) (*%T FarPtr *)(*%T RegParam *) mov es, bx (* es:[bx] = *exp *) mov bx, ax (*%E FarPtr *)(*%E RegParam *) (*%T NearPtr *)(*%T RegParam *) xchg bx, ax (* ds:[bx] = *exp *) (*%E NearPtr*)(*%E RegParam *) (*%T FarPtr *)(*%T StkParam *) les bx,[bp][2][CodePtrSize][10] (* es:[bx] = *exp *) (*%E FarPtr *)(*%E StkParam *) (*%T FarPtr *)(*%T StkParam *) mov bx,[bp][2][CodePtrSize][10] (* ds:[bx] = *exp *) (*%E FarPtr *)(*%E StkParam *) ftst st(0) (* cmp val,0 *) push ax (* make room for CW *) fstsw [bp][-2] (* store CW *) (*%T FarPtr *) mov word es:[bx],0 (*%E assume 0 *) (*%T NearPtr *) mov word [bx],0 (*%E assume 0 *) fwait pop ax sahf (* is val 0 ? *) jz Done (* yes *) fxtract st(0) (* st(1) = val's exponent,st(0) = mantissa *) (*%T FarPtr *)(*%F StdFloat *) fxch st(0), st(1) fistp word es:[bx], st(0) (* store val's exponent *) fidiv word st(0), cs:[@coremath_int_two ] (* divide mantisa by 2 *) inc word es:[bx] (* exponent plus 1 *) Done: pop bp (* restore bp *) db Ret0@ (*%E FarPtr *)(*%E NOT StdFloat *) (*%T NearPtr *)(*%F StdFloat *) fxch st(0), st(1) fistp word [bx], st(0) (* store val's exponent *) fidiv word st(0), cs:[@coremath_int_two ] (* divide mantisa by 2 *) inc word [bx] (* exponent plus 1 *) Done: xchg bx,ax (* restore bx *) pop bp (* restore bp *) db Ret0@ (*%E NearPtr *)(*%E NOT StdFloat *) (*%T NearPtr *)(*%T StdFloat *) Done: fstp tbyte [__fac],st(0) (* store mantisa in __fac *) jz Done2 (* result was 0 *) dec word [__fac][8] (* dec exponent of mantissa *) fistp word es:[bx], st(0) (* store val's exponent *) fwait inc word es:[bx] (* exponent plus 1 *) Done2: pop bp (* restore bp *) (*%T RegParam *) xchg bx,ax (*%E restore bx *) mov ax,__fac (* return offset __fac *) (*%T RegParam *) db RetX@; dw 10 (*%E clean up stack & return *) (*%T StkParam *) db Ret0@ (*%E Return *) (*%E NearPtr *)(*%E StdFloat *) (*%T FarPtr *)(*%T SameDS *)(*%T StdFloat *) Done: mov ax,__fac (* return offset __fac *) mov dx,ds (* return seg __fac *) fstp tbyte [__fac],st(0) (* store mantisa in __fac *) jz Done2 (* result was 0 *) dec word [__fac][8] (* dec exponent of mantissa *) fistp word es:[bx], st(0) (* store val's exponent *) fwait inc word es:[bx] (* exponent plus 1 *) Done2: pop bp (* restore bp *) (*%T RegParam *) db RetX@; dw 10 (*%E clean up stack & return *) (*%T StkParam *) db Ret0@ (*%E Return *) (*%E FarPtr *)(*%E SameDS *)(*%E StdFloat *) (*%T FarPtr *)(*%F SameDS *)(*%T StdFloat *) Done: push ds (* save ds *) mov ax,__fac (* return offset __fac *) mov dx,seg __fac (* return seg __fac *) mov ds,dx fstp tbyte [__fac],st(0) (* store mantisa in __fac *) jz Done2 (* result was 0 *) dec word [__fac][8] (* dec exponent of mantissa *) fistp word es:[bx], st(0) (* store val's exponent *) fwait inc word es:[bx] (* exponent plus 1 *) Done2: pop ds (* restore ds *) pop bp (* restore bp *) (*%T RegParam *) db RetX@; dw 10 (*%E clean up stack & return *) (*%T StkParam *) db Ret0@ (*%E Return *) (*%E FarPtr *)(*%E NOT SameDS *)(*%E StdFloat *) segment (*%F SameDS*)MATH_TEXT(*%E*)(*%T SameDS*)_TEXT(*%E*)(CODE,28H) (*%T StdFloat *) public _frexp : push bp mov bp, sp fld qword st(0),[bp][2][CodePtrSize] (* $1 val *) (*%T FarPtr *)(*%T RegParam *) mov es, bx (* es:[bx] = *exp *) mov bx, ax (*%E FarPtr *)(*%E RegParam *) (*%T NearPtr *)(*%T RegParam *) xchg bx, ax (* ds:[bx] = *exp *) (*%E NearPtr*)(*%E RegParam *) (*%T FarPtr *)(*%T StkParam *) les bx,[bp][2][CodePtrSize][8] (* es:[bx] = *exp *) (*%E FarPtr *)(*%E StkParam *) (*%T NearPtr *)(*%T StkParam *) mov bx,[bp][2][CodePtrSize][8] (* ds:[bx] = *exp *) (*%E NearPtr *)(*%E StkParam *) ftst st(0) (* cmp val,0 *) push ax (* make room for CW *) fstsw [bp][-2] (* store CW *) (*%T FarPtr *) mov word es:[bx],0 (*%E assume 0 *) (*%T NearPtr *) mov word [bx],0 (*%E assume 0 *) fwait pop ax sahf (* is val 0 ? *) jz DoneL (* yes *) fxtract st(0) (* st(1) = val's exponent,st(0) = mantissa *) (*%T NearPtr *) DoneL: fstp qword [__fac],st(0) (* store mantisa in __fac *) jz Done2L (* result was 0 *) sub word [__fac][6],10H (* dec exponent of mantissa *) fistp word es:[bx], st(0) (* store val's exponent *) fwait inc word es:[bx] (* exponent plus 1 *) Done2L: pop bp (* restore bp *) (*%T RegParam *) xchg bx,ax (*%E restore bx *) mov ax,__fac (* return offset __fac *) (*%T RegParam *) db RetX@;dw 8 (*%E clean up stack & return *) (*%T StkParam *) db Ret0@ (*%E Return *) (*%E NearPtr *) (*%T FarPtr *)(*%T SameDS *) DoneL: mov ax,__fac (* return offset __fac *) mov dx,ds (* return seg __fac *) fstp qword [__fac],st(0) (* store mantisa in __fac *) jz Done2L (* result was 0 *) sub word [__fac][6],10H (* dec exponent of mantissa *) fistp word es:[bx], st(0) (* store val's exponent *) fwait inc word es:[bx] (* exponent plus 1 *) Done2L: pop bp (* restore bp *) (*%T RegParam *) db RetX@; dw 8 (*%E clean up stack & return *) (*%T StkParam *) db Ret0@ (*%E Return *) (*%E FarPtr *)(*%E SameDS *) (*%T FarPtr *)(*%F SameDS *) DoneL: push ds (* save ds *) mov ax,__fac (* return offset __fac *) mov dx,seg __fac (* return seg __fac *) mov ds,dx fstp qword [__fac],st(0) (* store mantisa in __fac *) jz Done2L (* result was 0 *) sub word [__fac][6],10H (* dec exponent of mantissa *) fistp word es:[bx], st(0) (* store val's exponent *) fwait inc word es:[bx] (* exponent plus 1 *) Done2L: pop ds (* restore ds *) pop bp (* restore bp *) (*%T RegParam *) db RetX@; dw 8 (*%E clean up stack & return *) (*%T StkParam *) db Ret0@ (*%E Return *) (*%E FarPtr *)(*%E NOT SameDS *) (*%E StdFloat *) end