~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ MOTOROLA MICROPROCESSOR & MEMORY TECHNOLOGY GROUP M68000 Hi-Performance Microprocessor Division M68060 Software Package Production Release P1.00 -- October 10, 1994 M68060 Software Package Copyright © 1993, 1994 Motorola Inc. All rights reserved. THE SOFTWARE is provided on an "AS IS" basis and without warranty. To the maximum extent permitted by applicable law, MOTOROLA DISCLAIMS ALL WARRANTIES WHETHER EXPRESS OR IMPLIED, INCLUDING IMPLIED WARRANTIES OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE and any warranty against infringement with regard to the SOFTWARE (INCLUDING ANY MODIFIED VERSIONS THEREOF) and any accompanying written materials. To the maximum extent permitted by applicable law, IN NO EVENT SHALL MOTOROLA BE LIABLE FOR ANY DAMAGES WHATSOEVER (INCLUDING WITHOUT LIMITATION, DAMAGES FOR LOSS OF BUSINESS PROFITS, BUSINESS INTERRUPTION, LOSS OF BUSINESS INFORMATION, OR OTHER PECUNIARY LOSS) ARISING OF THE USE OR INABILITY TO USE THE SOFTWARE. Motorola assumes no responsibility for the maintenance and support of the SOFTWARE. You are hereby granted a copyright license to use, modify, and distribute the SOFTWARE so long as this entire notice is retained without alteration in any modified and/or redistributed versions, and that such modified versions are clearly identified as such. No licenses are granted by implication, estoppel or otherwise under any patents or trademarks of Motorola, Inc. ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # # lfptop.s: # This file is appended to the top of the 060ILSP package # and contains the entry points into the package. The user, in # effect, branches to one of the branch table entries located here. # bra.l _facoss_ short 0x0000 bra.l _facosd_ short 0x0000 bra.l _facosx_ short 0x0000 bra.l _fasins_ short 0x0000 bra.l _fasind_ short 0x0000 bra.l _fasinx_ short 0x0000 bra.l _fatans_ short 0x0000 bra.l _fatand_ short 0x0000 bra.l _fatanx_ short 0x0000 bra.l _fatanhs_ short 0x0000 bra.l _fatanhd_ short 0x0000 bra.l _fatanhx_ short 0x0000 bra.l _fcoss_ short 0x0000 bra.l _fcosd_ short 0x0000 bra.l _fcosx_ short 0x0000 bra.l _fcoshs_ short 0x0000 bra.l _fcoshd_ short 0x0000 bra.l _fcoshx_ short 0x0000 bra.l _fetoxs_ short 0x0000 bra.l _fetoxd_ short 0x0000 bra.l _fetoxx_ short 0x0000 bra.l _fetoxm1s_ short 0x0000 bra.l _fetoxm1d_ short 0x0000 bra.l _fetoxm1x_ short 0x0000 bra.l _fgetexps_ short 0x0000 bra.l _fgetexpd_ short 0x0000 bra.l _fgetexpx_ short 0x0000 bra.l _fgetmans_ short 0x0000 bra.l _fgetmand_ short 0x0000 bra.l _fgetmanx_ short 0x0000 bra.l _flog10s_ short 0x0000 bra.l _flog10d_ short 0x0000 bra.l _flog10x_ short 0x0000 bra.l _flog2s_ short 0x0000 bra.l _flog2d_ short 0x0000 bra.l _flog2x_ short 0x0000 bra.l _flogns_ short 0x0000 bra.l _flognd_ short 0x0000 bra.l _flognx_ short 0x0000 bra.l _flognp1s_ short 0x0000 bra.l _flognp1d_ short 0x0000 bra.l _flognp1x_ short 0x0000 bra.l _fmods_ short 0x0000 bra.l _fmodd_ short 0x0000 bra.l _fmodx_ short 0x0000 bra.l _frems_ short 0x0000 bra.l _fremd_ short 0x0000 bra.l _fremx_ short 0x0000 bra.l _fscales_ short 0x0000 bra.l _fscaled_ short 0x0000 bra.l _fscalex_ short 0x0000 bra.l _fsins_ short 0x0000 bra.l _fsind_ short 0x0000 bra.l _fsinx_ short 0x0000 bra.l _fsincoss_ short 0x0000 bra.l _fsincosd_ short 0x0000 bra.l _fsincosx_ short 0x0000 bra.l _fsinhs_ short 0x0000 bra.l _fsinhd_ short 0x0000 bra.l _fsinhx_ short 0x0000 bra.l _ftans_ short 0x0000 bra.l _ftand_ short 0x0000 bra.l _ftanx_ short 0x0000 bra.l _ftanhs_ short 0x0000 bra.l _ftanhd_ short 0x0000 bra.l _ftanhx_ short 0x0000 bra.l _ftentoxs_ short 0x0000 bra.l _ftentoxd_ short 0x0000 bra.l _ftentoxx_ short 0x0000 bra.l _ftwotoxs_ short 0x0000 bra.l _ftwotoxd_ short 0x0000 bra.l _ftwotoxx_ short 0x0000 bra.l _fabss_ short 0x0000 bra.l _fabsd_ short 0x0000 bra.l _fabsx_ short 0x0000 bra.l _fadds_ short 0x0000 bra.l _faddd_ short 0x0000 bra.l _faddx_ short 0x0000 bra.l _fdivs_ short 0x0000 bra.l _fdivd_ short 0x0000 bra.l _fdivx_ short 0x0000 bra.l _fints_ short 0x0000 bra.l _fintd_ short 0x0000 bra.l _fintx_ short 0x0000 bra.l _fintrzs_ short 0x0000 bra.l _fintrzd_ short 0x0000 bra.l _fintrzx_ short 0x0000 bra.l _fmuls_ short 0x0000 bra.l _fmuld_ short 0x0000 bra.l _fmulx_ short 0x0000 bra.l _fnegs_ short 0x0000 bra.l _fnegd_ short 0x0000 bra.l _fnegx_ short 0x0000 bra.l _fsqrts_ short 0x0000 bra.l _fsqrtd_ short 0x0000 bra.l _fsqrtx_ short 0x0000 bra.l _fsubs_ short 0x0000 bra.l _fsubd_ short 0x0000 bra.l _fsubx_ short 0x0000 # leave room for future possible additions align 0x400 # # This file contains a set of define statements for constants # in order to promote readability within the corecode itself. # set LOCAL_SIZE, 192 # stack frame size(bytes) set LV, -LOCAL_SIZE # stack offset set EXC_SR, 0x4 # stack status register set EXC_PC, 0x6 # stack pc set EXC_VOFF, 0xa # stacked vector offset set EXC_EA, 0xc # stacked set EXC_FP, 0x0 # frame pointer set EXC_AREGS, -68 # offset of all address regs set EXC_DREGS, -100 # offset of all data regs set EXC_FPREGS, -36 # offset of all fp regs set EXC_A7, EXC_AREGS+(7*4) # offset of saved a7 set OLD_A7, EXC_AREGS+(6*4) # extra copy of saved a7 set EXC_A6, EXC_AREGS+(6*4) # offset of saved a6 set EXC_A5, EXC_AREGS+(5*4) set EXC_A4, EXC_AREGS+(4*4) set EXC_A3, EXC_AREGS+(3*4) set EXC_A2, EXC_AREGS+(2*4) set EXC_A1, EXC_AREGS+(1*4) set EXC_A0, EXC_AREGS+(0*4) set EXC_D7, EXC_DREGS+(7*4) set EXC_D6, EXC_DREGS+(6*4) set EXC_D5, EXC_DREGS+(5*4) set EXC_D4, EXC_DREGS+(4*4) set EXC_D3, EXC_DREGS+(3*4) set EXC_D2, EXC_DREGS+(2*4) set EXC_D1, EXC_DREGS+(1*4) set EXC_D0, EXC_DREGS+(0*4) set EXC_FP0, EXC_FPREGS+(0*12) # offset of saved fp0 set EXC_FP1, EXC_FPREGS+(1*12) # offset of saved fp1 set EXC_FP2, EXC_FPREGS+(2*12) # offset of saved fp2 (not used) set FP_SCR1, LV+80 # fp scratch 1 set FP_SCR1_EX, FP_SCR1+0 set FP_SCR1_SGN, FP_SCR1+2 set FP_SCR1_HI, FP_SCR1+4 set FP_SCR1_LO, FP_SCR1+8 set FP_SCR0, LV+68 # fp scratch 0 set FP_SCR0_EX, FP_SCR0+0 set FP_SCR0_SGN, FP_SCR0+2 set FP_SCR0_HI, FP_SCR0+4 set FP_SCR0_LO, FP_SCR0+8 set FP_DST, LV+56 # fp destination operand set FP_DST_EX, FP_DST+0 set FP_DST_SGN, FP_DST+2 set FP_DST_HI, FP_DST+4 set FP_DST_LO, FP_DST+8 set FP_SRC, LV+44 # fp source operand set FP_SRC_EX, FP_SRC+0 set FP_SRC_SGN, FP_SRC+2 set FP_SRC_HI, FP_SRC+4 set FP_SRC_LO, FP_SRC+8 set USER_FPIAR, LV+40 # FP instr address register set USER_FPSR, LV+36 # FP status register set FPSR_CC, USER_FPSR+0 # FPSR condition codes set FPSR_QBYTE, USER_FPSR+1 # FPSR qoutient byte set FPSR_EXCEPT, USER_FPSR+2 # FPSR exception status byte set FPSR_AEXCEPT, USER_FPSR+3 # FPSR accrued exception byte set USER_FPCR, LV+32 # FP control register set FPCR_ENABLE, USER_FPCR+2 # FPCR exception enable set FPCR_MODE, USER_FPCR+3 # FPCR rounding mode control set L_SCR3, LV+28 # integer scratch 3 set L_SCR2, LV+24 # integer scratch 2 set L_SCR1, LV+20 # integer scratch 1 set STORE_FLG, LV+19 # flag: operand store (ie. not fcmp/ftst) set EXC_TEMP2, LV+24 # temporary space set EXC_TEMP, LV+16 # temporary space set DTAG, LV+15 # destination operand type set STAG, LV+14 # source operand type set SPCOND_FLG, LV+10 # flag: special case (see below) set EXC_CC, LV+8 # saved condition codes set EXC_EXTWPTR, LV+4 # saved current PC (active) set EXC_EXTWORD, LV+2 # saved extension word set EXC_CMDREG, LV+2 # saved extension word set EXC_OPWORD, LV+0 # saved operation word ################################ # Helpful macros set FTEMP, 0 # offsets within an set FTEMP_EX, 0 # extended precision set FTEMP_SGN, 2 # value saved in memory. set FTEMP_HI, 4 set FTEMP_LO, 8 set FTEMP_GRS, 12 set LOCAL, 0 # offsets within an set LOCAL_EX, 0 # extended precision set LOCAL_SGN, 2 # value saved in memory. set LOCAL_HI, 4 set LOCAL_LO, 8 set LOCAL_GRS, 12 set DST, 0 # offsets within an set DST_EX, 0 # extended precision set DST_HI, 4 # value saved in memory. set DST_LO, 8 set SRC, 0 # offsets within an set SRC_EX, 0 # extended precision set SRC_HI, 4 # value saved in memory. set SRC_LO, 8 set SGL_LO, 0x3f81 # min sgl prec exponent set SGL_HI, 0x407e # max sgl prec exponent set DBL_LO, 0x3c01 # min dbl prec exponent set DBL_HI, 0x43fe # max dbl prec exponent set EXT_LO, 0x0 # min ext prec exponent set EXT_HI, 0x7ffe # max ext prec exponent set EXT_BIAS, 0x3fff # extended precision bias set SGL_BIAS, 0x007f # single precision bias set DBL_BIAS, 0x03ff # double precision bias set NORM, 0x00 # operand type for STAG/DTAG set ZERO, 0x01 # operand type for STAG/DTAG set INF, 0x02 # operand type for STAG/DTAG set QNAN, 0x03 # operand type for STAG/DTAG set DENORM, 0x04 # operand type for STAG/DTAG set SNAN, 0x05 # operand type for STAG/DTAG set UNNORM, 0x06 # operand type for STAG/DTAG ################## # FPSR/FPCR bits # ################## set neg_bit, 0x3 # negative result set z_bit, 0x2 # zero result set inf_bit, 0x1 # infinite result set nan_bit, 0x0 # NAN result set q_sn_bit, 0x7 # sign bit of quotient byte set bsun_bit, 7 # branch on unordered set snan_bit, 6 # signalling NAN set operr_bit, 5 # operand error set ovfl_bit, 4 # overflow set unfl_bit, 3 # underflow set dz_bit, 2 # divide by zero set inex2_bit, 1 # inexact result 2 set inex1_bit, 0 # inexact result 1 set aiop_bit, 7 # accrued inexact operation bit set aovfl_bit, 6 # accrued overflow bit set aunfl_bit, 5 # accrued underflow bit set adz_bit, 4 # accrued dz bit set ainex_bit, 3 # accrued inexact bit ############################# # FPSR individual bit masks # ############################# set neg_mask, 0x08000000 # negative bit mask (lw) set inf_mask, 0x02000000 # infinity bit mask (lw) set z_mask, 0x04000000 # zero bit mask (lw) set nan_mask, 0x01000000 # nan bit mask (lw) set neg_bmask, 0x08 # negative bit mask (byte) set inf_bmask, 0x02 # infinity bit mask (byte) set z_bmask, 0x04 # zero bit mask (byte) set nan_bmask, 0x01 # nan bit mask (byte) set bsun_mask, 0x00008000 # bsun exception mask set snan_mask, 0x00004000 # snan exception mask set operr_mask, 0x00002000 # operr exception mask set ovfl_mask, 0x00001000 # overflow exception mask set unfl_mask, 0x00000800 # underflow exception mask set dz_mask, 0x00000400 # dz exception mask set inex2_mask, 0x00000200 # inex2 exception mask set inex1_mask, 0x00000100 # inex1 exception mask set aiop_mask, 0x00000080 # accrued illegal operation set aovfl_mask, 0x00000040 # accrued overflow set aunfl_mask, 0x00000020 # accrued underflow set adz_mask, 0x00000010 # accrued divide by zero set ainex_mask, 0x00000008 # accrued inexact ###################################### # FPSR combinations used in the FPSP # ###################################### set dzinf_mask, inf_mask+dz_mask+adz_mask set opnan_mask, nan_mask+operr_mask+aiop_mask set nzi_mask, 0x01ffffff #clears N, Z, and I set unfinx_mask, unfl_mask+inex2_mask+aunfl_mask+ainex_mask set unf2inx_mask, unfl_mask+inex2_mask+ainex_mask set ovfinx_mask, ovfl_mask+inex2_mask+aovfl_mask+ainex_mask set inx1a_mask, inex1_mask+ainex_mask set inx2a_mask, inex2_mask+ainex_mask set snaniop_mask, nan_mask+snan_mask+aiop_mask set snaniop2_mask, snan_mask+aiop_mask set naniop_mask, nan_mask+aiop_mask set neginf_mask, neg_mask+inf_mask set infaiop_mask, inf_mask+aiop_mask set negz_mask, neg_mask+z_mask set opaop_mask, operr_mask+aiop_mask set unfl_inx_mask, unfl_mask+aunfl_mask+ainex_mask set ovfl_inx_mask, ovfl_mask+aovfl_mask+ainex_mask ######### # misc. # ######### set rnd_stky_bit, 29 # stky bit pos in longword set sign_bit, 0x7 # sign bit set signan_bit, 0x6 # signalling nan bit set sgl_thresh, 0x3f81 # minimum sgl exponent set dbl_thresh, 0x3c01 # minimum dbl exponent set x_mode, 0x0 # extended precision set s_mode, 0x4 # single precision set d_mode, 0x8 # double precision set rn_mode, 0x0 # round-to-nearest set rz_mode, 0x1 # round-to-zero set rm_mode, 0x2 # round-tp-minus-infinity set rp_mode, 0x3 # round-to-plus-infinity set mantissalen, 64 # length of mantissa in bits set BYTE, 1 # len(byte) == 1 byte set WORD, 2 # len(word) == 2 bytes set LONG, 4 # len(longword) == 2 bytes set BSUN_VEC, 0xc0 # bsun vector offset set INEX_VEC, 0xc4 # inexact vector offset set DZ_VEC, 0xc8 # dz vector offset set UNFL_VEC, 0xcc # unfl vector offset set OPERR_VEC, 0xd0 # operr vector offset set OVFL_VEC, 0xd4 # ovfl vector offset set SNAN_VEC, 0xd8 # snan vector offset ########################### # SPecial CONDition FLaGs # ########################### set ftrapcc_flg, 0x01 # flag bit: ftrapcc exception set fbsun_flg, 0x02 # flag bit: bsun exception set mia7_flg, 0x04 # flag bit: (a7)+ set mda7_flg, 0x08 # flag bit: -(a7) set fmovm_flg, 0x40 # flag bit: fmovm instruction set immed_flg, 0x80 # flag bit: & set ftrapcc_bit, 0x0 set fbsun_bit, 0x1 set mia7_bit, 0x2 set mda7_bit, 0x3 set immed_bit, 0x7 ################################## # TRANSCENDENTAL "LAST-OP" FLAGS # ################################## set FMUL_OP, 0x0 # fmul instr performed last set FDIV_OP, 0x1 # fdiv performed last set FADD_OP, 0x2 # fadd performed last set FMOV_OP, 0x3 # fmov performed last ############# # CONSTANTS # ############# T1: long 0x40C62D38,0xD3D64634 # 16381 LOG2 LEAD T2: long 0x3D6F90AE,0xB1E75CC7 # 16381 LOG2 TRAIL PI: long 0x40000000,0xC90FDAA2,0x2168C235,0x00000000 PIBY2: long 0x3FFF0000,0xC90FDAA2,0x2168C235,0x00000000 TWOBYPI: long 0x3FE45F30,0x6DC9C883 ######################################################################### # MONADIC TEMPLATE # ######################################################################### global _fsins_ _fsins_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # fmov.s 0x8(%a6),%fp0 # load sgl input fmov.x %fp0,FP_SRC(%a6) lea FP_SRC(%a6),%a0 bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec tst.b %d1 bne.b _L0_2s bsr.l ssin # operand is a NORM bra.b _L0_6s _L0_2s: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L0_3s # no bsr.l src_zero # yes bra.b _L0_6s _L0_3s: cmpi.b %d1,&INF # is operand an INF? bne.b _L0_4s # no bsr.l t_operr # yes bra.b _L0_6s _L0_4s: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L0_5s # no bsr.l src_qnan # yes bra.b _L0_6s _L0_5s: bsr.l ssind # operand is a DENORM _L0_6s: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts global _fsind_ _fsind_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # fmov.d 0x8(%a6),%fp0 # load dbl input fmov.x %fp0,FP_SRC(%a6) lea FP_SRC(%a6),%a0 bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec mov.b %d1,STAG(%a6) tst.b %d1 bne.b _L0_2d bsr.l ssin # operand is a NORM bra.b _L0_6d _L0_2d: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L0_3d # no bsr.l src_zero # yes bra.b _L0_6d _L0_3d: cmpi.b %d1,&INF # is operand an INF? bne.b _L0_4d # no bsr.l t_operr # yes bra.b _L0_6d _L0_4d: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L0_5d # no bsr.l src_qnan # yes bra.b _L0_6d _L0_5d: bsr.l ssind # operand is a DENORM _L0_6d: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts global _fsinx_ _fsinx_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # lea FP_SRC(%a6),%a0 mov.l 0x8+0x0(%a6),0x0(%a0) # load ext input mov.l 0x8+0x4(%a6),0x4(%a0) mov.l 0x8+0x8(%a6),0x8(%a0) bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec tst.b %d1 bne.b _L0_2x bsr.l ssin # operand is a NORM bra.b _L0_6x _L0_2x: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L0_3x # no bsr.l src_zero # yes bra.b _L0_6x _L0_3x: cmpi.b %d1,&INF # is operand an INF? bne.b _L0_4x # no bsr.l t_operr # yes bra.b _L0_6x _L0_4x: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L0_5x # no bsr.l src_qnan # yes bra.b _L0_6x _L0_5x: bsr.l ssind # operand is a DENORM _L0_6x: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts ######################################################################### # MONADIC TEMPLATE # ######################################################################### global _fcoss_ _fcoss_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # fmov.s 0x8(%a6),%fp0 # load sgl input fmov.x %fp0,FP_SRC(%a6) lea FP_SRC(%a6),%a0 bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec tst.b %d1 bne.b _L1_2s bsr.l scos # operand is a NORM bra.b _L1_6s _L1_2s: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L1_3s # no bsr.l ld_pone # yes bra.b _L1_6s _L1_3s: cmpi.b %d1,&INF # is operand an INF? bne.b _L1_4s # no bsr.l t_operr # yes bra.b _L1_6s _L1_4s: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L1_5s # no bsr.l src_qnan # yes bra.b _L1_6s _L1_5s: bsr.l scosd # operand is a DENORM _L1_6s: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts global _fcosd_ _fcosd_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # fmov.d 0x8(%a6),%fp0 # load dbl input fmov.x %fp0,FP_SRC(%a6) lea FP_SRC(%a6),%a0 bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec mov.b %d1,STAG(%a6) tst.b %d1 bne.b _L1_2d bsr.l scos # operand is a NORM bra.b _L1_6d _L1_2d: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L1_3d # no bsr.l ld_pone # yes bra.b _L1_6d _L1_3d: cmpi.b %d1,&INF # is operand an INF? bne.b _L1_4d # no bsr.l t_operr # yes bra.b _L1_6d _L1_4d: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L1_5d # no bsr.l src_qnan # yes bra.b _L1_6d _L1_5d: bsr.l scosd # operand is a DENORM _L1_6d: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts global _fcosx_ _fcosx_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # lea FP_SRC(%a6),%a0 mov.l 0x8+0x0(%a6),0x0(%a0) # load ext input mov.l 0x8+0x4(%a6),0x4(%a0) mov.l 0x8+0x8(%a6),0x8(%a0) bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec tst.b %d1 bne.b _L1_2x bsr.l scos # operand is a NORM bra.b _L1_6x _L1_2x: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L1_3x # no bsr.l ld_pone # yes bra.b _L1_6x _L1_3x: cmpi.b %d1,&INF # is operand an INF? bne.b _L1_4x # no bsr.l t_operr # yes bra.b _L1_6x _L1_4x: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L1_5x # no bsr.l src_qnan # yes bra.b _L1_6x _L1_5x: bsr.l scosd # operand is a DENORM _L1_6x: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts ######################################################################### # MONADIC TEMPLATE # ######################################################################### global _fsinhs_ _fsinhs_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # fmov.s 0x8(%a6),%fp0 # load sgl input fmov.x %fp0,FP_SRC(%a6) lea FP_SRC(%a6),%a0 bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec tst.b %d1 bne.b _L2_2s bsr.l ssinh # operand is a NORM bra.b _L2_6s _L2_2s: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L2_3s # no bsr.l src_zero # yes bra.b _L2_6s _L2_3s: cmpi.b %d1,&INF # is operand an INF? bne.b _L2_4s # no bsr.l src_inf # yes bra.b _L2_6s _L2_4s: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L2_5s # no bsr.l src_qnan # yes bra.b _L2_6s _L2_5s: bsr.l ssinhd # operand is a DENORM _L2_6s: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts global _fsinhd_ _fsinhd_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # fmov.d 0x8(%a6),%fp0 # load dbl input fmov.x %fp0,FP_SRC(%a6) lea FP_SRC(%a6),%a0 bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec mov.b %d1,STAG(%a6) tst.b %d1 bne.b _L2_2d bsr.l ssinh # operand is a NORM bra.b _L2_6d _L2_2d: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L2_3d # no bsr.l src_zero # yes bra.b _L2_6d _L2_3d: cmpi.b %d1,&INF # is operand an INF? bne.b _L2_4d # no bsr.l src_inf # yes bra.b _L2_6d _L2_4d: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L2_5d # no bsr.l src_qnan # yes bra.b _L2_6d _L2_5d: bsr.l ssinhd # operand is a DENORM _L2_6d: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts global _fsinhx_ _fsinhx_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # lea FP_SRC(%a6),%a0 mov.l 0x8+0x0(%a6),0x0(%a0) # load ext input mov.l 0x8+0x4(%a6),0x4(%a0) mov.l 0x8+0x8(%a6),0x8(%a0) bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec tst.b %d1 bne.b _L2_2x bsr.l ssinh # operand is a NORM bra.b _L2_6x _L2_2x: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L2_3x # no bsr.l src_zero # yes bra.b _L2_6x _L2_3x: cmpi.b %d1,&INF # is operand an INF? bne.b _L2_4x # no bsr.l src_inf # yes bra.b _L2_6x _L2_4x: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L2_5x # no bsr.l src_qnan # yes bra.b _L2_6x _L2_5x: bsr.l ssinhd # operand is a DENORM _L2_6x: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts ######################################################################### # MONADIC TEMPLATE # ######################################################################### global _flognp1s_ _flognp1s_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # fmov.s 0x8(%a6),%fp0 # load sgl input fmov.x %fp0,FP_SRC(%a6) lea FP_SRC(%a6),%a0 bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec tst.b %d1 bne.b _L3_2s bsr.l slognp1 # operand is a NORM bra.b _L3_6s _L3_2s: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L3_3s # no bsr.l src_zero # yes bra.b _L3_6s _L3_3s: cmpi.b %d1,&INF # is operand an INF? bne.b _L3_4s # no bsr.l sopr_inf # yes bra.b _L3_6s _L3_4s: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L3_5s # no bsr.l src_qnan # yes bra.b _L3_6s _L3_5s: bsr.l slognp1d # operand is a DENORM _L3_6s: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts global _flognp1d_ _flognp1d_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # fmov.d 0x8(%a6),%fp0 # load dbl input fmov.x %fp0,FP_SRC(%a6) lea FP_SRC(%a6),%a0 bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec mov.b %d1,STAG(%a6) tst.b %d1 bne.b _L3_2d bsr.l slognp1 # operand is a NORM bra.b _L3_6d _L3_2d: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L3_3d # no bsr.l src_zero # yes bra.b _L3_6d _L3_3d: cmpi.b %d1,&INF # is operand an INF? bne.b _L3_4d # no bsr.l sopr_inf # yes bra.b _L3_6d _L3_4d: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L3_5d # no bsr.l src_qnan # yes bra.b _L3_6d _L3_5d: bsr.l slognp1d # operand is a DENORM _L3_6d: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts global _flognp1x_ _flognp1x_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # lea FP_SRC(%a6),%a0 mov.l 0x8+0x0(%a6),0x0(%a0) # load ext input mov.l 0x8+0x4(%a6),0x4(%a0) mov.l 0x8+0x8(%a6),0x8(%a0) bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec tst.b %d1 bne.b _L3_2x bsr.l slognp1 # operand is a NORM bra.b _L3_6x _L3_2x: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L3_3x # no bsr.l src_zero # yes bra.b _L3_6x _L3_3x: cmpi.b %d1,&INF # is operand an INF? bne.b _L3_4x # no bsr.l sopr_inf # yes bra.b _L3_6x _L3_4x: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L3_5x # no bsr.l src_qnan # yes bra.b _L3_6x _L3_5x: bsr.l slognp1d # operand is a DENORM _L3_6x: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts ######################################################################### # MONADIC TEMPLATE # ######################################################################### global _fetoxm1s_ _fetoxm1s_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # fmov.s 0x8(%a6),%fp0 # load sgl input fmov.x %fp0,FP_SRC(%a6) lea FP_SRC(%a6),%a0 bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec tst.b %d1 bne.b _L4_2s bsr.l setoxm1 # operand is a NORM bra.b _L4_6s _L4_2s: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L4_3s # no bsr.l src_zero # yes bra.b _L4_6s _L4_3s: cmpi.b %d1,&INF # is operand an INF? bne.b _L4_4s # no bsr.l setoxm1i # yes bra.b _L4_6s _L4_4s: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L4_5s # no bsr.l src_qnan # yes bra.b _L4_6s _L4_5s: bsr.l setoxm1d # operand is a DENORM _L4_6s: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts global _fetoxm1d_ _fetoxm1d_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # fmov.d 0x8(%a6),%fp0 # load dbl input fmov.x %fp0,FP_SRC(%a6) lea FP_SRC(%a6),%a0 bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec mov.b %d1,STAG(%a6) tst.b %d1 bne.b _L4_2d bsr.l setoxm1 # operand is a NORM bra.b _L4_6d _L4_2d: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L4_3d # no bsr.l src_zero # yes bra.b _L4_6d _L4_3d: cmpi.b %d1,&INF # is operand an INF? bne.b _L4_4d # no bsr.l setoxm1i # yes bra.b _L4_6d _L4_4d: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L4_5d # no bsr.l src_qnan # yes bra.b _L4_6d _L4_5d: bsr.l setoxm1d # operand is a DENORM _L4_6d: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts global _fetoxm1x_ _fetoxm1x_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # lea FP_SRC(%a6),%a0 mov.l 0x8+0x0(%a6),0x0(%a0) # load ext input mov.l 0x8+0x4(%a6),0x4(%a0) mov.l 0x8+0x8(%a6),0x8(%a0) bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec tst.b %d1 bne.b _L4_2x bsr.l setoxm1 # operand is a NORM bra.b _L4_6x _L4_2x: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L4_3x # no bsr.l src_zero # yes bra.b _L4_6x _L4_3x: cmpi.b %d1,&INF # is operand an INF? bne.b _L4_4x # no bsr.l setoxm1i # yes bra.b _L4_6x _L4_4x: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L4_5x # no bsr.l src_qnan # yes bra.b _L4_6x _L4_5x: bsr.l setoxm1d # operand is a DENORM _L4_6x: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts ######################################################################### # MONADIC TEMPLATE # ######################################################################### global _ftanhs_ _ftanhs_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # fmov.s 0x8(%a6),%fp0 # load sgl input fmov.x %fp0,FP_SRC(%a6) lea FP_SRC(%a6),%a0 bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec tst.b %d1 bne.b _L5_2s bsr.l stanh # operand is a NORM bra.b _L5_6s _L5_2s: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L5_3s # no bsr.l src_zero # yes bra.b _L5_6s _L5_3s: cmpi.b %d1,&INF # is operand an INF? bne.b _L5_4s # no bsr.l src_one # yes bra.b _L5_6s _L5_4s: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L5_5s # no bsr.l src_qnan # yes bra.b _L5_6s _L5_5s: bsr.l stanhd # operand is a DENORM _L5_6s: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts global _ftanhd_ _ftanhd_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # fmov.d 0x8(%a6),%fp0 # load dbl input fmov.x %fp0,FP_SRC(%a6) lea FP_SRC(%a6),%a0 bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec mov.b %d1,STAG(%a6) tst.b %d1 bne.b _L5_2d bsr.l stanh # operand is a NORM bra.b _L5_6d _L5_2d: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L5_3d # no bsr.l src_zero # yes bra.b _L5_6d _L5_3d: cmpi.b %d1,&INF # is operand an INF? bne.b _L5_4d # no bsr.l src_one # yes bra.b _L5_6d _L5_4d: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L5_5d # no bsr.l src_qnan # yes bra.b _L5_6d _L5_5d: bsr.l stanhd # operand is a DENORM _L5_6d: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts global _ftanhx_ _ftanhx_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # lea FP_SRC(%a6),%a0 mov.l 0x8+0x0(%a6),0x0(%a0) # load ext input mov.l 0x8+0x4(%a6),0x4(%a0) mov.l 0x8+0x8(%a6),0x8(%a0) bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec tst.b %d1 bne.b _L5_2x bsr.l stanh # operand is a NORM bra.b _L5_6x _L5_2x: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L5_3x # no bsr.l src_zero # yes bra.b _L5_6x _L5_3x: cmpi.b %d1,&INF # is operand an INF? bne.b _L5_4x # no bsr.l src_one # yes bra.b _L5_6x _L5_4x: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L5_5x # no bsr.l src_qnan # yes bra.b _L5_6x _L5_5x: bsr.l stanhd # operand is a DENORM _L5_6x: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts ######################################################################### # MONADIC TEMPLATE # ######################################################################### global _fatans_ _fatans_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # fmov.s 0x8(%a6),%fp0 # load sgl input fmov.x %fp0,FP_SRC(%a6) lea FP_SRC(%a6),%a0 bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec tst.b %d1 bne.b _L6_2s bsr.l satan # operand is a NORM bra.b _L6_6s _L6_2s: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L6_3s # no bsr.l src_zero # yes bra.b _L6_6s _L6_3s: cmpi.b %d1,&INF # is operand an INF? bne.b _L6_4s # no bsr.l spi_2 # yes bra.b _L6_6s _L6_4s: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L6_5s # no bsr.l src_qnan # yes bra.b _L6_6s _L6_5s: bsr.l satand # operand is a DENORM _L6_6s: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts global _fatand_ _fatand_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # fmov.d 0x8(%a6),%fp0 # load dbl input fmov.x %fp0,FP_SRC(%a6) lea FP_SRC(%a6),%a0 bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec mov.b %d1,STAG(%a6) tst.b %d1 bne.b _L6_2d bsr.l satan # operand is a NORM bra.b _L6_6d _L6_2d: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L6_3d # no bsr.l src_zero # yes bra.b _L6_6d _L6_3d: cmpi.b %d1,&INF # is operand an INF? bne.b _L6_4d # no bsr.l spi_2 # yes bra.b _L6_6d _L6_4d: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L6_5d # no bsr.l src_qnan # yes bra.b _L6_6d _L6_5d: bsr.l satand # operand is a DENORM _L6_6d: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts global _fatanx_ _fatanx_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # lea FP_SRC(%a6),%a0 mov.l 0x8+0x0(%a6),0x0(%a0) # load ext input mov.l 0x8+0x4(%a6),0x4(%a0) mov.l 0x8+0x8(%a6),0x8(%a0) bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec tst.b %d1 bne.b _L6_2x bsr.l satan # operand is a NORM bra.b _L6_6x _L6_2x: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L6_3x # no bsr.l src_zero # yes bra.b _L6_6x _L6_3x: cmpi.b %d1,&INF # is operand an INF? bne.b _L6_4x # no bsr.l spi_2 # yes bra.b _L6_6x _L6_4x: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L6_5x # no bsr.l src_qnan # yes bra.b _L6_6x _L6_5x: bsr.l satand # operand is a DENORM _L6_6x: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts ######################################################################### # MONADIC TEMPLATE # ######################################################################### global _fasins_ _fasins_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # fmov.s 0x8(%a6),%fp0 # load sgl input fmov.x %fp0,FP_SRC(%a6) lea FP_SRC(%a6),%a0 bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec tst.b %d1 bne.b _L7_2s bsr.l sasin # operand is a NORM bra.b _L7_6s _L7_2s: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L7_3s # no bsr.l src_zero # yes bra.b _L7_6s _L7_3s: cmpi.b %d1,&INF # is operand an INF? bne.b _L7_4s # no bsr.l t_operr # yes bra.b _L7_6s _L7_4s: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L7_5s # no bsr.l src_qnan # yes bra.b _L7_6s _L7_5s: bsr.l sasind # operand is a DENORM _L7_6s: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts global _fasind_ _fasind_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # fmov.d 0x8(%a6),%fp0 # load dbl input fmov.x %fp0,FP_SRC(%a6) lea FP_SRC(%a6),%a0 bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec mov.b %d1,STAG(%a6) tst.b %d1 bne.b _L7_2d bsr.l sasin # operand is a NORM bra.b _L7_6d _L7_2d: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L7_3d # no bsr.l src_zero # yes bra.b _L7_6d _L7_3d: cmpi.b %d1,&INF # is operand an INF? bne.b _L7_4d # no bsr.l t_operr # yes bra.b _L7_6d _L7_4d: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L7_5d # no bsr.l src_qnan # yes bra.b _L7_6d _L7_5d: bsr.l sasind # operand is a DENORM _L7_6d: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts global _fasinx_ _fasinx_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # lea FP_SRC(%a6),%a0 mov.l 0x8+0x0(%a6),0x0(%a0) # load ext input mov.l 0x8+0x4(%a6),0x4(%a0) mov.l 0x8+0x8(%a6),0x8(%a0) bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec tst.b %d1 bne.b _L7_2x bsr.l sasin # operand is a NORM bra.b _L7_6x _L7_2x: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L7_3x # no bsr.l src_zero # yes bra.b _L7_6x _L7_3x: cmpi.b %d1,&INF # is operand an INF? bne.b _L7_4x # no bsr.l t_operr # yes bra.b _L7_6x _L7_4x: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L7_5x # no bsr.l src_qnan # yes bra.b _L7_6x _L7_5x: bsr.l sasind # operand is a DENORM _L7_6x: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts ######################################################################### # MONADIC TEMPLATE # ######################################################################### global _fatanhs_ _fatanhs_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # fmov.s 0x8(%a6),%fp0 # load sgl input fmov.x %fp0,FP_SRC(%a6) lea FP_SRC(%a6),%a0 bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec tst.b %d1 bne.b _L8_2s bsr.l satanh # operand is a NORM bra.b _L8_6s _L8_2s: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L8_3s # no bsr.l src_zero # yes bra.b _L8_6s _L8_3s: cmpi.b %d1,&INF # is operand an INF? bne.b _L8_4s # no bsr.l t_operr # yes bra.b _L8_6s _L8_4s: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L8_5s # no bsr.l src_qnan # yes bra.b _L8_6s _L8_5s: bsr.l satanhd # operand is a DENORM _L8_6s: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts global _fatanhd_ _fatanhd_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # fmov.d 0x8(%a6),%fp0 # load dbl input fmov.x %fp0,FP_SRC(%a6) lea FP_SRC(%a6),%a0 bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec mov.b %d1,STAG(%a6) tst.b %d1 bne.b _L8_2d bsr.l satanh # operand is a NORM bra.b _L8_6d _L8_2d: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L8_3d # no bsr.l src_zero # yes bra.b _L8_6d _L8_3d: cmpi.b %d1,&INF # is operand an INF? bne.b _L8_4d # no bsr.l t_operr # yes bra.b _L8_6d _L8_4d: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L8_5d # no bsr.l src_qnan # yes bra.b _L8_6d _L8_5d: bsr.l satanhd # operand is a DENORM _L8_6d: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts global _fatanhx_ _fatanhx_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # lea FP_SRC(%a6),%a0 mov.l 0x8+0x0(%a6),0x0(%a0) # load ext input mov.l 0x8+0x4(%a6),0x4(%a0) mov.l 0x8+0x8(%a6),0x8(%a0) bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec tst.b %d1 bne.b _L8_2x bsr.l satanh # operand is a NORM bra.b _L8_6x _L8_2x: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L8_3x # no bsr.l src_zero # yes bra.b _L8_6x _L8_3x: cmpi.b %d1,&INF # is operand an INF? bne.b _L8_4x # no bsr.l t_operr # yes bra.b _L8_6x _L8_4x: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L8_5x # no bsr.l src_qnan # yes bra.b _L8_6x _L8_5x: bsr.l satanhd # operand is a DENORM _L8_6x: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts ######################################################################### # MONADIC TEMPLATE # ######################################################################### global _ftans_ _ftans_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # fmov.s 0x8(%a6),%fp0 # load sgl input fmov.x %fp0,FP_SRC(%a6) lea FP_SRC(%a6),%a0 bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec tst.b %d1 bne.b _L9_2s bsr.l stan # operand is a NORM bra.b _L9_6s _L9_2s: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L9_3s # no bsr.l src_zero # yes bra.b _L9_6s _L9_3s: cmpi.b %d1,&INF # is operand an INF? bne.b _L9_4s # no bsr.l t_operr # yes bra.b _L9_6s _L9_4s: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L9_5s # no bsr.l src_qnan # yes bra.b _L9_6s _L9_5s: bsr.l stand # operand is a DENORM _L9_6s: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts global _ftand_ _ftand_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # fmov.d 0x8(%a6),%fp0 # load dbl input fmov.x %fp0,FP_SRC(%a6) lea FP_SRC(%a6),%a0 bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec mov.b %d1,STAG(%a6) tst.b %d1 bne.b _L9_2d bsr.l stan # operand is a NORM bra.b _L9_6d _L9_2d: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L9_3d # no bsr.l src_zero # yes bra.b _L9_6d _L9_3d: cmpi.b %d1,&INF # is operand an INF? bne.b _L9_4d # no bsr.l t_operr # yes bra.b _L9_6d _L9_4d: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L9_5d # no bsr.l src_qnan # yes bra.b _L9_6d _L9_5d: bsr.l stand # operand is a DENORM _L9_6d: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts global _ftanx_ _ftanx_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # lea FP_SRC(%a6),%a0 mov.l 0x8+0x0(%a6),0x0(%a0) # load ext input mov.l 0x8+0x4(%a6),0x4(%a0) mov.l 0x8+0x8(%a6),0x8(%a0) bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec tst.b %d1 bne.b _L9_2x bsr.l stan # operand is a NORM bra.b _L9_6x _L9_2x: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L9_3x # no bsr.l src_zero # yes bra.b _L9_6x _L9_3x: cmpi.b %d1,&INF # is operand an INF? bne.b _L9_4x # no bsr.l t_operr # yes bra.b _L9_6x _L9_4x: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L9_5x # no bsr.l src_qnan # yes bra.b _L9_6x _L9_5x: bsr.l stand # operand is a DENORM _L9_6x: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts ######################################################################### # MONADIC TEMPLATE # ######################################################################### global _fetoxs_ _fetoxs_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # fmov.s 0x8(%a6),%fp0 # load sgl input fmov.x %fp0,FP_SRC(%a6) lea FP_SRC(%a6),%a0 bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec tst.b %d1 bne.b _L10_2s bsr.l setox # operand is a NORM bra.b _L10_6s _L10_2s: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L10_3s # no bsr.l ld_pone # yes bra.b _L10_6s _L10_3s: cmpi.b %d1,&INF # is operand an INF? bne.b _L10_4s # no bsr.l szr_inf # yes bra.b _L10_6s _L10_4s: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L10_5s # no bsr.l src_qnan # yes bra.b _L10_6s _L10_5s: bsr.l setoxd # operand is a DENORM _L10_6s: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts global _fetoxd_ _fetoxd_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # fmov.d 0x8(%a6),%fp0 # load dbl input fmov.x %fp0,FP_SRC(%a6) lea FP_SRC(%a6),%a0 bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec mov.b %d1,STAG(%a6) tst.b %d1 bne.b _L10_2d bsr.l setox # operand is a NORM bra.b _L10_6d _L10_2d: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L10_3d # no bsr.l ld_pone # yes bra.b _L10_6d _L10_3d: cmpi.b %d1,&INF # is operand an INF? bne.b _L10_4d # no bsr.l szr_inf # yes bra.b _L10_6d _L10_4d: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L10_5d # no bsr.l src_qnan # yes bra.b _L10_6d _L10_5d: bsr.l setoxd # operand is a DENORM _L10_6d: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts global _fetoxx_ _fetoxx_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # lea FP_SRC(%a6),%a0 mov.l 0x8+0x0(%a6),0x0(%a0) # load ext input mov.l 0x8+0x4(%a6),0x4(%a0) mov.l 0x8+0x8(%a6),0x8(%a0) bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec tst.b %d1 bne.b _L10_2x bsr.l setox # operand is a NORM bra.b _L10_6x _L10_2x: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L10_3x # no bsr.l ld_pone # yes bra.b _L10_6x _L10_3x: cmpi.b %d1,&INF # is operand an INF? bne.b _L10_4x # no bsr.l szr_inf # yes bra.b _L10_6x _L10_4x: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L10_5x # no bsr.l src_qnan # yes bra.b _L10_6x _L10_5x: bsr.l setoxd # operand is a DENORM _L10_6x: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts ######################################################################### # MONADIC TEMPLATE # ######################################################################### global _ftwotoxs_ _ftwotoxs_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # fmov.s 0x8(%a6),%fp0 # load sgl input fmov.x %fp0,FP_SRC(%a6) lea FP_SRC(%a6),%a0 bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec tst.b %d1 bne.b _L11_2s bsr.l stwotox # operand is a NORM bra.b _L11_6s _L11_2s: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L11_3s # no bsr.l ld_pone # yes bra.b _L11_6s _L11_3s: cmpi.b %d1,&INF # is operand an INF? bne.b _L11_4s # no bsr.l szr_inf # yes bra.b _L11_6s _L11_4s: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L11_5s # no bsr.l src_qnan # yes bra.b _L11_6s _L11_5s: bsr.l stwotoxd # operand is a DENORM _L11_6s: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts global _ftwotoxd_ _ftwotoxd_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # fmov.d 0x8(%a6),%fp0 # load dbl input fmov.x %fp0,FP_SRC(%a6) lea FP_SRC(%a6),%a0 bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec mov.b %d1,STAG(%a6) tst.b %d1 bne.b _L11_2d bsr.l stwotox # operand is a NORM bra.b _L11_6d _L11_2d: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L11_3d # no bsr.l ld_pone # yes bra.b _L11_6d _L11_3d: cmpi.b %d1,&INF # is operand an INF? bne.b _L11_4d # no bsr.l szr_inf # yes bra.b _L11_6d _L11_4d: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L11_5d # no bsr.l src_qnan # yes bra.b _L11_6d _L11_5d: bsr.l stwotoxd # operand is a DENORM _L11_6d: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts global _ftwotoxx_ _ftwotoxx_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # lea FP_SRC(%a6),%a0 mov.l 0x8+0x0(%a6),0x0(%a0) # load ext input mov.l 0x8+0x4(%a6),0x4(%a0) mov.l 0x8+0x8(%a6),0x8(%a0) bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec tst.b %d1 bne.b _L11_2x bsr.l stwotox # operand is a NORM bra.b _L11_6x _L11_2x: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L11_3x # no bsr.l ld_pone # yes bra.b _L11_6x _L11_3x: cmpi.b %d1,&INF # is operand an INF? bne.b _L11_4x # no bsr.l szr_inf # yes bra.b _L11_6x _L11_4x: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L11_5x # no bsr.l src_qnan # yes bra.b _L11_6x _L11_5x: bsr.l stwotoxd # operand is a DENORM _L11_6x: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts ######################################################################### # MONADIC TEMPLATE # ######################################################################### global _ftentoxs_ _ftentoxs_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # fmov.s 0x8(%a6),%fp0 # load sgl input fmov.x %fp0,FP_SRC(%a6) lea FP_SRC(%a6),%a0 bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec tst.b %d1 bne.b _L12_2s bsr.l stentox # operand is a NORM bra.b _L12_6s _L12_2s: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L12_3s # no bsr.l ld_pone # yes bra.b _L12_6s _L12_3s: cmpi.b %d1,&INF # is operand an INF? bne.b _L12_4s # no bsr.l szr_inf # yes bra.b _L12_6s _L12_4s: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L12_5s # no bsr.l src_qnan # yes bra.b _L12_6s _L12_5s: bsr.l stentoxd # operand is a DENORM _L12_6s: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts global _ftentoxd_ _ftentoxd_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # fmov.d 0x8(%a6),%fp0 # load dbl input fmov.x %fp0,FP_SRC(%a6) lea FP_SRC(%a6),%a0 bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec mov.b %d1,STAG(%a6) tst.b %d1 bne.b _L12_2d bsr.l stentox # operand is a NORM bra.b _L12_6d _L12_2d: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L12_3d # no bsr.l ld_pone # yes bra.b _L12_6d _L12_3d: cmpi.b %d1,&INF # is operand an INF? bne.b _L12_4d # no bsr.l szr_inf # yes bra.b _L12_6d _L12_4d: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L12_5d # no bsr.l src_qnan # yes bra.b _L12_6d _L12_5d: bsr.l stentoxd # operand is a DENORM _L12_6d: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts global _ftentoxx_ _ftentoxx_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # lea FP_SRC(%a6),%a0 mov.l 0x8+0x0(%a6),0x0(%a0) # load ext input mov.l 0x8+0x4(%a6),0x4(%a0) mov.l 0x8+0x8(%a6),0x8(%a0) bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec tst.b %d1 bne.b _L12_2x bsr.l stentox # operand is a NORM bra.b _L12_6x _L12_2x: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L12_3x # no bsr.l ld_pone # yes bra.b _L12_6x _L12_3x: cmpi.b %d1,&INF # is operand an INF? bne.b _L12_4x # no bsr.l szr_inf # yes bra.b _L12_6x _L12_4x: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L12_5x # no bsr.l src_qnan # yes bra.b _L12_6x _L12_5x: bsr.l stentoxd # operand is a DENORM _L12_6x: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts ######################################################################### # MONADIC TEMPLATE # ######################################################################### global _flogns_ _flogns_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # fmov.s 0x8(%a6),%fp0 # load sgl input fmov.x %fp0,FP_SRC(%a6) lea FP_SRC(%a6),%a0 bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec tst.b %d1 bne.b _L13_2s bsr.l slogn # operand is a NORM bra.b _L13_6s _L13_2s: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L13_3s # no bsr.l t_dz2 # yes bra.b _L13_6s _L13_3s: cmpi.b %d1,&INF # is operand an INF? bne.b _L13_4s # no bsr.l sopr_inf # yes bra.b _L13_6s _L13_4s: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L13_5s # no bsr.l src_qnan # yes bra.b _L13_6s _L13_5s: bsr.l slognd # operand is a DENORM _L13_6s: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts global _flognd_ _flognd_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # fmov.d 0x8(%a6),%fp0 # load dbl input fmov.x %fp0,FP_SRC(%a6) lea FP_SRC(%a6),%a0 bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec mov.b %d1,STAG(%a6) tst.b %d1 bne.b _L13_2d bsr.l slogn # operand is a NORM bra.b _L13_6d _L13_2d: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L13_3d # no bsr.l t_dz2 # yes bra.b _L13_6d _L13_3d: cmpi.b %d1,&INF # is operand an INF? bne.b _L13_4d # no bsr.l sopr_inf # yes bra.b _L13_6d _L13_4d: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L13_5d # no bsr.l src_qnan # yes bra.b _L13_6d _L13_5d: bsr.l slognd # operand is a DENORM _L13_6d: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts global _flognx_ _flognx_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # lea FP_SRC(%a6),%a0 mov.l 0x8+0x0(%a6),0x0(%a0) # load ext input mov.l 0x8+0x4(%a6),0x4(%a0) mov.l 0x8+0x8(%a6),0x8(%a0) bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec tst.b %d1 bne.b _L13_2x bsr.l slogn # operand is a NORM bra.b _L13_6x _L13_2x: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L13_3x # no bsr.l t_dz2 # yes bra.b _L13_6x _L13_3x: cmpi.b %d1,&INF # is operand an INF? bne.b _L13_4x # no bsr.l sopr_inf # yes bra.b _L13_6x _L13_4x: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L13_5x # no bsr.l src_qnan # yes bra.b _L13_6x _L13_5x: bsr.l slognd # operand is a DENORM _L13_6x: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts ######################################################################### # MONADIC TEMPLATE # ######################################################################### global _flog10s_ _flog10s_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # fmov.s 0x8(%a6),%fp0 # load sgl input fmov.x %fp0,FP_SRC(%a6) lea FP_SRC(%a6),%a0 bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec tst.b %d1 bne.b _L14_2s bsr.l slog10 # operand is a NORM bra.b _L14_6s _L14_2s: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L14_3s # no bsr.l t_dz2 # yes bra.b _L14_6s _L14_3s: cmpi.b %d1,&INF # is operand an INF? bne.b _L14_4s # no bsr.l sopr_inf # yes bra.b _L14_6s _L14_4s: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L14_5s # no bsr.l src_qnan # yes bra.b _L14_6s _L14_5s: bsr.l slog10d # operand is a DENORM _L14_6s: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts global _flog10d_ _flog10d_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # fmov.d 0x8(%a6),%fp0 # load dbl input fmov.x %fp0,FP_SRC(%a6) lea FP_SRC(%a6),%a0 bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec mov.b %d1,STAG(%a6) tst.b %d1 bne.b _L14_2d bsr.l slog10 # operand is a NORM bra.b _L14_6d _L14_2d: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L14_3d # no bsr.l t_dz2 # yes bra.b _L14_6d _L14_3d: cmpi.b %d1,&INF # is operand an INF? bne.b _L14_4d # no bsr.l sopr_inf # yes bra.b _L14_6d _L14_4d: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L14_5d # no bsr.l src_qnan # yes bra.b _L14_6d _L14_5d: bsr.l slog10d # operand is a DENORM _L14_6d: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts global _flog10x_ _flog10x_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # lea FP_SRC(%a6),%a0 mov.l 0x8+0x0(%a6),0x0(%a0) # load ext input mov.l 0x8+0x4(%a6),0x4(%a0) mov.l 0x8+0x8(%a6),0x8(%a0) bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec tst.b %d1 bne.b _L14_2x bsr.l slog10 # operand is a NORM bra.b _L14_6x _L14_2x: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L14_3x # no bsr.l t_dz2 # yes bra.b _L14_6x _L14_3x: cmpi.b %d1,&INF # is operand an INF? bne.b _L14_4x # no bsr.l sopr_inf # yes bra.b _L14_6x _L14_4x: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L14_5x # no bsr.l src_qnan # yes bra.b _L14_6x _L14_5x: bsr.l slog10d # operand is a DENORM _L14_6x: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts ######################################################################### # MONADIC TEMPLATE # ######################################################################### global _flog2s_ _flog2s_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # fmov.s 0x8(%a6),%fp0 # load sgl input fmov.x %fp0,FP_SRC(%a6) lea FP_SRC(%a6),%a0 bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec tst.b %d1 bne.b _L15_2s bsr.l slog2 # operand is a NORM bra.b _L15_6s _L15_2s: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L15_3s # no bsr.l t_dz2 # yes bra.b _L15_6s _L15_3s: cmpi.b %d1,&INF # is operand an INF? bne.b _L15_4s # no bsr.l sopr_inf # yes bra.b _L15_6s _L15_4s: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L15_5s # no bsr.l src_qnan # yes bra.b _L15_6s _L15_5s: bsr.l slog2d # operand is a DENORM _L15_6s: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts global _flog2d_ _flog2d_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # fmov.d 0x8(%a6),%fp0 # load dbl input fmov.x %fp0,FP_SRC(%a6) lea FP_SRC(%a6),%a0 bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec mov.b %d1,STAG(%a6) tst.b %d1 bne.b _L15_2d bsr.l slog2 # operand is a NORM bra.b _L15_6d _L15_2d: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L15_3d # no bsr.l t_dz2 # yes bra.b _L15_6d _L15_3d: cmpi.b %d1,&INF # is operand an INF? bne.b _L15_4d # no bsr.l sopr_inf # yes bra.b _L15_6d _L15_4d: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L15_5d # no bsr.l src_qnan # yes bra.b _L15_6d _L15_5d: bsr.l slog2d # operand is a DENORM _L15_6d: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts global _flog2x_ _flog2x_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # lea FP_SRC(%a6),%a0 mov.l 0x8+0x0(%a6),0x0(%a0) # load ext input mov.l 0x8+0x4(%a6),0x4(%a0) mov.l 0x8+0x8(%a6),0x8(%a0) bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec tst.b %d1 bne.b _L15_2x bsr.l slog2 # operand is a NORM bra.b _L15_6x _L15_2x: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L15_3x # no bsr.l t_dz2 # yes bra.b _L15_6x _L15_3x: cmpi.b %d1,&INF # is operand an INF? bne.b _L15_4x # no bsr.l sopr_inf # yes bra.b _L15_6x _L15_4x: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L15_5x # no bsr.l src_qnan # yes bra.b _L15_6x _L15_5x: bsr.l slog2d # operand is a DENORM _L15_6x: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts ######################################################################### # MONADIC TEMPLATE # ######################################################################### global _fcoshs_ _fcoshs_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # fmov.s 0x8(%a6),%fp0 # load sgl input fmov.x %fp0,FP_SRC(%a6) lea FP_SRC(%a6),%a0 bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec tst.b %d1 bne.b _L16_2s bsr.l scosh # operand is a NORM bra.b _L16_6s _L16_2s: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L16_3s # no bsr.l ld_pone # yes bra.b _L16_6s _L16_3s: cmpi.b %d1,&INF # is operand an INF? bne.b _L16_4s # no bsr.l ld_pinf # yes bra.b _L16_6s _L16_4s: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L16_5s # no bsr.l src_qnan # yes bra.b _L16_6s _L16_5s: bsr.l scoshd # operand is a DENORM _L16_6s: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts global _fcoshd_ _fcoshd_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # fmov.d 0x8(%a6),%fp0 # load dbl input fmov.x %fp0,FP_SRC(%a6) lea FP_SRC(%a6),%a0 bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec mov.b %d1,STAG(%a6) tst.b %d1 bne.b _L16_2d bsr.l scosh # operand is a NORM bra.b _L16_6d _L16_2d: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L16_3d # no bsr.l ld_pone # yes bra.b _L16_6d _L16_3d: cmpi.b %d1,&INF # is operand an INF? bne.b _L16_4d # no bsr.l ld_pinf # yes bra.b _L16_6d _L16_4d: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L16_5d # no bsr.l src_qnan # yes bra.b _L16_6d _L16_5d: bsr.l scoshd # operand is a DENORM _L16_6d: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts global _fcoshx_ _fcoshx_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # lea FP_SRC(%a6),%a0 mov.l 0x8+0x0(%a6),0x0(%a0) # load ext input mov.l 0x8+0x4(%a6),0x4(%a0) mov.l 0x8+0x8(%a6),0x8(%a0) bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec tst.b %d1 bne.b _L16_2x bsr.l scosh # operand is a NORM bra.b _L16_6x _L16_2x: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L16_3x # no bsr.l ld_pone # yes bra.b _L16_6x _L16_3x: cmpi.b %d1,&INF # is operand an INF? bne.b _L16_4x # no bsr.l ld_pinf # yes bra.b _L16_6x _L16_4x: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L16_5x # no bsr.l src_qnan # yes bra.b _L16_6x _L16_5x: bsr.l scoshd # operand is a DENORM _L16_6x: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts ######################################################################### # MONADIC TEMPLATE # ######################################################################### global _facoss_ _facoss_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # fmov.s 0x8(%a6),%fp0 # load sgl input fmov.x %fp0,FP_SRC(%a6) lea FP_SRC(%a6),%a0 bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec tst.b %d1 bne.b _L17_2s bsr.l sacos # operand is a NORM bra.b _L17_6s _L17_2s: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L17_3s # no bsr.l ld_ppi2 # yes bra.b _L17_6s _L17_3s: cmpi.b %d1,&INF # is operand an INF? bne.b _L17_4s # no bsr.l t_operr # yes bra.b _L17_6s _L17_4s: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L17_5s # no bsr.l src_qnan # yes bra.b _L17_6s _L17_5s: bsr.l sacosd # operand is a DENORM _L17_6s: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts global _facosd_ _facosd_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # fmov.d 0x8(%a6),%fp0 # load dbl input fmov.x %fp0,FP_SRC(%a6) lea FP_SRC(%a6),%a0 bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec mov.b %d1,STAG(%a6) tst.b %d1 bne.b _L17_2d bsr.l sacos # operand is a NORM bra.b _L17_6d _L17_2d: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L17_3d # no bsr.l ld_ppi2 # yes bra.b _L17_6d _L17_3d: cmpi.b %d1,&INF # is operand an INF? bne.b _L17_4d # no bsr.l t_operr # yes bra.b _L17_6d _L17_4d: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L17_5d # no bsr.l src_qnan # yes bra.b _L17_6d _L17_5d: bsr.l sacosd # operand is a DENORM _L17_6d: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts global _facosx_ _facosx_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # lea FP_SRC(%a6),%a0 mov.l 0x8+0x0(%a6),0x0(%a0) # load ext input mov.l 0x8+0x4(%a6),0x4(%a0) mov.l 0x8+0x8(%a6),0x8(%a0) bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec tst.b %d1 bne.b _L17_2x bsr.l sacos # operand is a NORM bra.b _L17_6x _L17_2x: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L17_3x # no bsr.l ld_ppi2 # yes bra.b _L17_6x _L17_3x: cmpi.b %d1,&INF # is operand an INF? bne.b _L17_4x # no bsr.l t_operr # yes bra.b _L17_6x _L17_4x: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L17_5x # no bsr.l src_qnan # yes bra.b _L17_6x _L17_5x: bsr.l sacosd # operand is a DENORM _L17_6x: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts ######################################################################### # MONADIC TEMPLATE # ######################################################################### global _fgetexps_ _fgetexps_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # fmov.s 0x8(%a6),%fp0 # load sgl input fmov.x %fp0,FP_SRC(%a6) lea FP_SRC(%a6),%a0 bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec tst.b %d1 bne.b _L18_2s bsr.l sgetexp # operand is a NORM bra.b _L18_6s _L18_2s: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L18_3s # no bsr.l src_zero # yes bra.b _L18_6s _L18_3s: cmpi.b %d1,&INF # is operand an INF? bne.b _L18_4s # no bsr.l t_operr # yes bra.b _L18_6s _L18_4s: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L18_5s # no bsr.l src_qnan # yes bra.b _L18_6s _L18_5s: bsr.l sgetexpd # operand is a DENORM _L18_6s: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts global _fgetexpd_ _fgetexpd_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # fmov.d 0x8(%a6),%fp0 # load dbl input fmov.x %fp0,FP_SRC(%a6) lea FP_SRC(%a6),%a0 bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec mov.b %d1,STAG(%a6) tst.b %d1 bne.b _L18_2d bsr.l sgetexp # operand is a NORM bra.b _L18_6d _L18_2d: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L18_3d # no bsr.l src_zero # yes bra.b _L18_6d _L18_3d: cmpi.b %d1,&INF # is operand an INF? bne.b _L18_4d # no bsr.l t_operr # yes bra.b _L18_6d _L18_4d: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L18_5d # no bsr.l src_qnan # yes bra.b _L18_6d _L18_5d: bsr.l sgetexpd # operand is a DENORM _L18_6d: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts global _fgetexpx_ _fgetexpx_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # lea FP_SRC(%a6),%a0 mov.l 0x8+0x0(%a6),0x0(%a0) # load ext input mov.l 0x8+0x4(%a6),0x4(%a0) mov.l 0x8+0x8(%a6),0x8(%a0) bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec tst.b %d1 bne.b _L18_2x bsr.l sgetexp # operand is a NORM bra.b _L18_6x _L18_2x: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L18_3x # no bsr.l src_zero # yes bra.b _L18_6x _L18_3x: cmpi.b %d1,&INF # is operand an INF? bne.b _L18_4x # no bsr.l t_operr # yes bra.b _L18_6x _L18_4x: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L18_5x # no bsr.l src_qnan # yes bra.b _L18_6x _L18_5x: bsr.l sgetexpd # operand is a DENORM _L18_6x: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts ######################################################################### # MONADIC TEMPLATE # ######################################################################### global _fgetmans_ _fgetmans_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # fmov.s 0x8(%a6),%fp0 # load sgl input fmov.x %fp0,FP_SRC(%a6) lea FP_SRC(%a6),%a0 bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec tst.b %d1 bne.b _L19_2s bsr.l sgetman # operand is a NORM bra.b _L19_6s _L19_2s: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L19_3s # no bsr.l src_zero # yes bra.b _L19_6s _L19_3s: cmpi.b %d1,&INF # is operand an INF? bne.b _L19_4s # no bsr.l t_operr # yes bra.b _L19_6s _L19_4s: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L19_5s # no bsr.l src_qnan # yes bra.b _L19_6s _L19_5s: bsr.l sgetmand # operand is a DENORM _L19_6s: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts global _fgetmand_ _fgetmand_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # fmov.d 0x8(%a6),%fp0 # load dbl input fmov.x %fp0,FP_SRC(%a6) lea FP_SRC(%a6),%a0 bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec mov.b %d1,STAG(%a6) tst.b %d1 bne.b _L19_2d bsr.l sgetman # operand is a NORM bra.b _L19_6d _L19_2d: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L19_3d # no bsr.l src_zero # yes bra.b _L19_6d _L19_3d: cmpi.b %d1,&INF # is operand an INF? bne.b _L19_4d # no bsr.l t_operr # yes bra.b _L19_6d _L19_4d: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L19_5d # no bsr.l src_qnan # yes bra.b _L19_6d _L19_5d: bsr.l sgetmand # operand is a DENORM _L19_6d: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts global _fgetmanx_ _fgetmanx_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # lea FP_SRC(%a6),%a0 mov.l 0x8+0x0(%a6),0x0(%a0) # load ext input mov.l 0x8+0x4(%a6),0x4(%a0) mov.l 0x8+0x8(%a6),0x8(%a0) bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec tst.b %d1 bne.b _L19_2x bsr.l sgetman # operand is a NORM bra.b _L19_6x _L19_2x: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L19_3x # no bsr.l src_zero # yes bra.b _L19_6x _L19_3x: cmpi.b %d1,&INF # is operand an INF? bne.b _L19_4x # no bsr.l t_operr # yes bra.b _L19_6x _L19_4x: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L19_5x # no bsr.l src_qnan # yes bra.b _L19_6x _L19_5x: bsr.l sgetmand # operand is a DENORM _L19_6x: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts ######################################################################### # MONADIC TEMPLATE # ######################################################################### global _fsincoss_ _fsincoss_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # fmov.s 0x8(%a6),%fp0 # load sgl input fmov.x %fp0,FP_SRC(%a6) lea FP_SRC(%a6),%a0 bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec tst.b %d1 bne.b _L20_2s bsr.l ssincos # operand is a NORM bra.b _L20_6s _L20_2s: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L20_3s # no bsr.l ssincosz # yes bra.b _L20_6s _L20_3s: cmpi.b %d1,&INF # is operand an INF? bne.b _L20_4s # no bsr.l ssincosi # yes bra.b _L20_6s _L20_4s: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L20_5s # no bsr.l ssincosqnan # yes bra.b _L20_6s _L20_5s: bsr.l ssincosd # operand is a DENORM _L20_6s: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x &0x03,-(%sp) # store off fp0/fp1 fmovm.x (%sp)+,&0x40 # fp0 now in fp1 fmovm.x (%sp)+,&0x80 # fp1 now in fp0 unlk %a6 rts global _fsincosd_ _fsincosd_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # fmov.d 0x8(%a6),%fp0 # load dbl input fmov.x %fp0,FP_SRC(%a6) lea FP_SRC(%a6),%a0 bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec mov.b %d1,STAG(%a6) tst.b %d1 bne.b _L20_2d bsr.l ssincos # operand is a NORM bra.b _L20_6d _L20_2d: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L20_3d # no bsr.l ssincosz # yes bra.b _L20_6d _L20_3d: cmpi.b %d1,&INF # is operand an INF? bne.b _L20_4d # no bsr.l ssincosi # yes bra.b _L20_6d _L20_4d: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L20_5d # no bsr.l ssincosqnan # yes bra.b _L20_6d _L20_5d: bsr.l ssincosd # operand is a DENORM _L20_6d: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x &0x03,-(%sp) # store off fp0/fp1 fmovm.x (%sp)+,&0x40 # fp0 now in fp1 fmovm.x (%sp)+,&0x80 # fp1 now in fp0 unlk %a6 rts global _fsincosx_ _fsincosx_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # lea FP_SRC(%a6),%a0 mov.l 0x8+0x0(%a6),0x0(%a0) # load ext input mov.l 0x8+0x4(%a6),0x4(%a0) mov.l 0x8+0x8(%a6),0x8(%a0) bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.b %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec tst.b %d1 bne.b _L20_2x bsr.l ssincos # operand is a NORM bra.b _L20_6x _L20_2x: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L20_3x # no bsr.l ssincosz # yes bra.b _L20_6x _L20_3x: cmpi.b %d1,&INF # is operand an INF? bne.b _L20_4x # no bsr.l ssincosi # yes bra.b _L20_6x _L20_4x: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L20_5x # no bsr.l ssincosqnan # yes bra.b _L20_6x _L20_5x: bsr.l ssincosd # operand is a DENORM _L20_6x: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x &0x03,-(%sp) # store off fp0/fp1 fmovm.x (%sp)+,&0x40 # fp0 now in fp1 fmovm.x (%sp)+,&0x80 # fp1 now in fp0 unlk %a6 rts ######################################################################### # DYADIC TEMPLATE # ######################################################################### global _frems_ _frems_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # fmov.s 0x8(%a6),%fp0 # load sgl dst fmov.x %fp0,FP_DST(%a6) lea FP_DST(%a6),%a0 bsr.l tag # fetch operand type mov.b %d0,DTAG(%a6) fmov.s 0xc(%a6),%fp0 # load sgl src fmov.x %fp0,FP_SRC(%a6) lea FP_SRC(%a6),%a0 bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.l %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec lea FP_SRC(%a6),%a0 # pass ptr to src lea FP_DST(%a6),%a1 # pass ptr to dst tst.b %d1 bne.b _L21_2s bsr.l srem_snorm # operand is a NORM bra.b _L21_6s _L21_2s: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L21_3s # no bsr.l srem_szero # yes bra.b _L21_6s _L21_3s: cmpi.b %d1,&INF # is operand an INF? bne.b _L21_4s # no bsr.l srem_sinf # yes bra.b _L21_6s _L21_4s: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L21_5s # no bsr.l sop_sqnan # yes bra.b _L21_6s _L21_5s: bsr.l srem_sdnrm # operand is a DENORM _L21_6s: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts global _fremd_ _fremd_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # fmov.d 0x8(%a6),%fp0 # load dbl dst fmov.x %fp0,FP_DST(%a6) lea FP_DST(%a6),%a0 bsr.l tag # fetch operand type mov.b %d0,DTAG(%a6) fmov.d 0x10(%a6),%fp0 # load dbl src fmov.x %fp0,FP_SRC(%a6) lea FP_SRC(%a6),%a0 bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.l %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec lea FP_SRC(%a6),%a0 # pass ptr to src lea FP_DST(%a6),%a1 # pass ptr to dst tst.b %d1 bne.b _L21_2d bsr.l srem_snorm # operand is a NORM bra.b _L21_6d _L21_2d: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L21_3d # no bsr.l srem_szero # yes bra.b _L21_6d _L21_3d: cmpi.b %d1,&INF # is operand an INF? bne.b _L21_4d # no bsr.l srem_sinf # yes bra.b _L21_6d _L21_4d: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L21_5d # no bsr.l sop_sqnan # yes bra.b _L21_6d _L21_5d: bsr.l srem_sdnrm # operand is a DENORM _L21_6d: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts global _fremx_ _fremx_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # lea FP_DST(%a6),%a0 mov.l 0x8+0x0(%a6),0x0(%a0) # load ext dst mov.l 0x8+0x4(%a6),0x4(%a0) mov.l 0x8+0x8(%a6),0x8(%a0) bsr.l tag # fetch operand type mov.b %d0,DTAG(%a6) lea FP_SRC(%a6),%a0 mov.l 0x14+0x0(%a6),0x0(%a0) # load ext src mov.l 0x14+0x4(%a6),0x4(%a0) mov.l 0x14+0x8(%a6),0x8(%a0) bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.l %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec lea FP_SRC(%a6),%a0 # pass ptr to src lea FP_DST(%a6),%a1 # pass ptr to dst tst.b %d1 bne.b _L21_2x bsr.l srem_snorm # operand is a NORM bra.b _L21_6x _L21_2x: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L21_3x # no bsr.l srem_szero # yes bra.b _L21_6x _L21_3x: cmpi.b %d1,&INF # is operand an INF? bne.b _L21_4x # no bsr.l srem_sinf # yes bra.b _L21_6x _L21_4x: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L21_5x # no bsr.l sop_sqnan # yes bra.b _L21_6x _L21_5x: bsr.l srem_sdnrm # operand is a DENORM _L21_6x: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts ######################################################################### # DYADIC TEMPLATE # ######################################################################### global _fmods_ _fmods_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # fmov.s 0x8(%a6),%fp0 # load sgl dst fmov.x %fp0,FP_DST(%a6) lea FP_DST(%a6),%a0 bsr.l tag # fetch operand type mov.b %d0,DTAG(%a6) fmov.s 0xc(%a6),%fp0 # load sgl src fmov.x %fp0,FP_SRC(%a6) lea FP_SRC(%a6),%a0 bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.l %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec lea FP_SRC(%a6),%a0 # pass ptr to src lea FP_DST(%a6),%a1 # pass ptr to dst tst.b %d1 bne.b _L22_2s bsr.l smod_snorm # operand is a NORM bra.b _L22_6s _L22_2s: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L22_3s # no bsr.l smod_szero # yes bra.b _L22_6s _L22_3s: cmpi.b %d1,&INF # is operand an INF? bne.b _L22_4s # no bsr.l smod_sinf # yes bra.b _L22_6s _L22_4s: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L22_5s # no bsr.l sop_sqnan # yes bra.b _L22_6s _L22_5s: bsr.l smod_sdnrm # operand is a DENORM _L22_6s: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts global _fmodd_ _fmodd_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # fmov.d 0x8(%a6),%fp0 # load dbl dst fmov.x %fp0,FP_DST(%a6) lea FP_DST(%a6),%a0 bsr.l tag # fetch operand type mov.b %d0,DTAG(%a6) fmov.d 0x10(%a6),%fp0 # load dbl src fmov.x %fp0,FP_SRC(%a6) lea FP_SRC(%a6),%a0 bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.l %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec lea FP_SRC(%a6),%a0 # pass ptr to src lea FP_DST(%a6),%a1 # pass ptr to dst tst.b %d1 bne.b _L22_2d bsr.l smod_snorm # operand is a NORM bra.b _L22_6d _L22_2d: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L22_3d # no bsr.l smod_szero # yes bra.b _L22_6d _L22_3d: cmpi.b %d1,&INF # is operand an INF? bne.b _L22_4d # no bsr.l smod_sinf # yes bra.b _L22_6d _L22_4d: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L22_5d # no bsr.l sop_sqnan # yes bra.b _L22_6d _L22_5d: bsr.l smod_sdnrm # operand is a DENORM _L22_6d: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts global _fmodx_ _fmodx_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # lea FP_DST(%a6),%a0 mov.l 0x8+0x0(%a6),0x0(%a0) # load ext dst mov.l 0x8+0x4(%a6),0x4(%a0) mov.l 0x8+0x8(%a6),0x8(%a0) bsr.l tag # fetch operand type mov.b %d0,DTAG(%a6) lea FP_SRC(%a6),%a0 mov.l 0x14+0x0(%a6),0x0(%a0) # load ext src mov.l 0x14+0x4(%a6),0x4(%a0) mov.l 0x14+0x8(%a6),0x8(%a0) bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.l %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec lea FP_SRC(%a6),%a0 # pass ptr to src lea FP_DST(%a6),%a1 # pass ptr to dst tst.b %d1 bne.b _L22_2x bsr.l smod_snorm # operand is a NORM bra.b _L22_6x _L22_2x: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L22_3x # no bsr.l smod_szero # yes bra.b _L22_6x _L22_3x: cmpi.b %d1,&INF # is operand an INF? bne.b _L22_4x # no bsr.l smod_sinf # yes bra.b _L22_6x _L22_4x: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L22_5x # no bsr.l sop_sqnan # yes bra.b _L22_6x _L22_5x: bsr.l smod_sdnrm # operand is a DENORM _L22_6x: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts ######################################################################### # DYADIC TEMPLATE # ######################################################################### global _fscales_ _fscales_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # fmov.s 0x8(%a6),%fp0 # load sgl dst fmov.x %fp0,FP_DST(%a6) lea FP_DST(%a6),%a0 bsr.l tag # fetch operand type mov.b %d0,DTAG(%a6) fmov.s 0xc(%a6),%fp0 # load sgl src fmov.x %fp0,FP_SRC(%a6) lea FP_SRC(%a6),%a0 bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.l %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec lea FP_SRC(%a6),%a0 # pass ptr to src lea FP_DST(%a6),%a1 # pass ptr to dst tst.b %d1 bne.b _L23_2s bsr.l sscale_snorm # operand is a NORM bra.b _L23_6s _L23_2s: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L23_3s # no bsr.l sscale_szero # yes bra.b _L23_6s _L23_3s: cmpi.b %d1,&INF # is operand an INF? bne.b _L23_4s # no bsr.l sscale_sinf # yes bra.b _L23_6s _L23_4s: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L23_5s # no bsr.l sop_sqnan # yes bra.b _L23_6s _L23_5s: bsr.l sscale_sdnrm # operand is a DENORM _L23_6s: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts global _fscaled_ _fscaled_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # fmov.d 0x8(%a6),%fp0 # load dbl dst fmov.x %fp0,FP_DST(%a6) lea FP_DST(%a6),%a0 bsr.l tag # fetch operand type mov.b %d0,DTAG(%a6) fmov.d 0x10(%a6),%fp0 # load dbl src fmov.x %fp0,FP_SRC(%a6) lea FP_SRC(%a6),%a0 bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.l %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec lea FP_SRC(%a6),%a0 # pass ptr to src lea FP_DST(%a6),%a1 # pass ptr to dst tst.b %d1 bne.b _L23_2d bsr.l sscale_snorm # operand is a NORM bra.b _L23_6d _L23_2d: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L23_3d # no bsr.l sscale_szero # yes bra.b _L23_6d _L23_3d: cmpi.b %d1,&INF # is operand an INF? bne.b _L23_4d # no bsr.l sscale_sinf # yes bra.b _L23_6d _L23_4d: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L23_5d # no bsr.l sop_sqnan # yes bra.b _L23_6d _L23_5d: bsr.l sscale_sdnrm # operand is a DENORM _L23_6d: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts global _fscalex_ _fscalex_: link %a6,&-LOCAL_SIZE movm.l &0x0303,EXC_DREGS(%a6) # save d0-d1/a0-a1 fmovm.l %fpcr,%fpsr,USER_FPCR(%a6) # save ctrl regs fmovm.x &0xc0,EXC_FP0(%a6) # save fp0/fp1 fmov.l &0x0,%fpcr # zero FPCR # # copy, convert, and tag input argument # lea FP_DST(%a6),%a0 mov.l 0x8+0x0(%a6),0x0(%a0) # load ext dst mov.l 0x8+0x4(%a6),0x4(%a0) mov.l 0x8+0x8(%a6),0x8(%a0) bsr.l tag # fetch operand type mov.b %d0,DTAG(%a6) lea FP_SRC(%a6),%a0 mov.l 0x14+0x0(%a6),0x0(%a0) # load ext src mov.l 0x14+0x4(%a6),0x4(%a0) mov.l 0x14+0x8(%a6),0x8(%a0) bsr.l tag # fetch operand type mov.b %d0,STAG(%a6) mov.l %d0,%d1 andi.l &0x00ff00ff,USER_FPSR(%a6) clr.l %d0 mov.b FPCR_MODE(%a6),%d0 # pass rnd mode,prec lea FP_SRC(%a6),%a0 # pass ptr to src lea FP_DST(%a6),%a1 # pass ptr to dst tst.b %d1 bne.b _L23_2x bsr.l sscale_snorm # operand is a NORM bra.b _L23_6x _L23_2x: cmpi.b %d1,&ZERO # is operand a ZERO? bne.b _L23_3x # no bsr.l sscale_szero # yes bra.b _L23_6x _L23_3x: cmpi.b %d1,&INF # is operand an INF? bne.b _L23_4x # no bsr.l sscale_sinf # yes bra.b _L23_6x _L23_4x: cmpi.b %d1,&QNAN # is operand a QNAN? bne.b _L23_5x # no bsr.l sop_sqnan # yes bra.b _L23_6x _L23_5x: bsr.l sscale_sdnrm # operand is a DENORM _L23_6x: # # Result is now in FP0 # movm.l EXC_DREGS(%a6),&0x0303 # restore d0-d1/a0-a1 fmovm.l USER_FPCR(%a6),%fpcr,%fpsr # restore ctrl regs fmovm.x EXC_FP1(%a6),&0x40 # restore fp1 unlk %a6 rts ######################################################################### # ssin(): computes the sine of a normalized input # # ssind(): computes the sine of a denormalized input # # scos(): computes the cosine of a normalized input # # scosd(): computes the cosine of a denormalized input # # ssincos(): computes the sine and cosine of a normalized input # # ssincosd(): computes the sine and cosine of a denormalized input # # # # INPUT *************************************************************** # # a0 = pointer to extended precision input # # d0 = round precision,mode # # # # OUTPUT ************************************************************** # # fp0 = sin(X) or cos(X) # # # # For ssincos(X): # # fp0 = sin(X) # # fp1 = cos(X) # # # # ACCURACY and MONOTONICITY ******************************************* # # The returned result is within 1 ulp in 64 significant bit, i.e. # # within 0.5001 ulp to 53 bits if the result is subsequently # # rounded to double precision. The result is provably monotonic # # in double precision. # # # # ALGORITHM *********************************************************** # # # # SIN and COS: # # 1. If SIN is invoked, set AdjN := 0; otherwise, set AdjN := 1. # # # # 2. If |X| >= 15Pi or |X| < 2**(-40), go to 7. # # # # 3. Decompose X as X = N(Pi/2) + r where |r| <= Pi/4. Let # # k = N mod 4, so in particular, k = 0,1,2,or 3. # # Overwrite k by k := k + AdjN. # # # # 4. If k is even, go to 6. # # # # 5. (k is odd) Set j := (k-1)/2, sgn := (-1)**j. # # Return sgn*cos(r) where cos(r) is approximated by an # # even polynomial in r, 1 + r*r*(B1+s*(B2+ ... + s*B8)), # # s = r*r. # # Exit. # # # # 6. (k is even) Set j := k/2, sgn := (-1)**j. Return sgn*sin(r) # # where sin(r) is approximated by an odd polynomial in r # # r + r*s*(A1+s*(A2+ ... + s*A7)), s = r*r. # # Exit. # # # # 7. If |X| > 1, go to 9. # # # # 8. (|X|<2**(-40)) If SIN is invoked, return X; # # otherwise return 1. # # # # 9. Overwrite X by X := X rem 2Pi. Now that |X| <= Pi, # # go back to 3. # # # # SINCOS: # # 1. If |X| >= 15Pi or |X| < 2**(-40), go to 6. # # # # 2. Decompose X as X = N(Pi/2) + r where |r| <= Pi/4. Let # # k = N mod 4, so in particular, k = 0,1,2,or 3. # # # # 3. If k is even, go to 5. # # # # 4. (k is odd) Set j1 := (k-1)/2, j2 := j1 (EOR) (k mod 2), ie. # # j1 exclusive or with the l.s.b. of k. # # sgn1 := (-1)**j1, sgn2 := (-1)**j2. # # SIN(X) = sgn1 * cos(r) and COS(X) = sgn2*sin(r) where # # sin(r) and cos(r) are computed as odd and even # # polynomials in r, respectively. Exit # # # # 5. (k is even) Set j1 := k/2, sgn1 := (-1)**j1. # # SIN(X) = sgn1 * sin(r) and COS(X) = sgn1*cos(r) where # # sin(r) and cos(r) are computed as odd and even # # polynomials in r, respectively. Exit # # # # 6. If |X| > 1, go to 8. # # # # 7. (|X|<2**(-40)) SIN(X) = X and COS(X) = 1. Exit. # # # # 8. Overwrite X by X := X rem 2Pi. Now that |X| <= Pi, # # go back to 2. # # # ######################################################################### SINA7: long 0xBD6AAA77,0xCCC994F5 SINA6: long 0x3DE61209,0x7AAE8DA1 SINA5: long 0xBE5AE645,0x2A118AE4 SINA4: long 0x3EC71DE3,0xA5341531 SINA3: long 0xBF2A01A0,0x1A018B59,0x00000000,0x00000000 SINA2: long 0x3FF80000,0x88888888,0x888859AF,0x00000000 SINA1: long 0xBFFC0000,0xAAAAAAAA,0xAAAAAA99,0x00000000 COSB8: long 0x3D2AC4D0,0xD6011EE3 COSB7: long 0xBDA9396F,0x9F45AC19 COSB6: long 0x3E21EED9,0x0612C972 COSB5: long 0xBE927E4F,0xB79D9FCF COSB4: long 0x3EFA01A0,0x1A01D423,0x00000000,0x00000000 COSB3: long 0xBFF50000,0xB60B60B6,0x0B61D438,0x00000000 COSB2: long 0x3FFA0000,0xAAAAAAAA,0xAAAAAB5E COSB1: long 0xBF000000 set INARG,FP_SCR0 set X,FP_SCR0 # set XDCARE,X+2 set XFRAC,X+4 set RPRIME,FP_SCR0 set SPRIME,FP_SCR1 set POSNEG1,L_SCR1 set TWOTO63,L_SCR1 set ENDFLAG,L_SCR2 set INT,L_SCR2 set ADJN,L_SCR3 ############################################ global ssin ssin: mov.l &0,ADJN(%a6) # yes; SET ADJN TO 0 bra.b SINBGN ############################################ global scos scos: mov.l &1,ADJN(%a6) # yes; SET ADJN TO 1 ############################################ SINBGN: #--SAVE FPCR, FP1. CHECK IF |X| IS TOO SMALL OR LARGE fmov.x (%a0),%fp0 # LOAD INPUT fmov.x %fp0,X(%a6) # save input at X # "COMPACTIFY" X mov.l (%a0),%d1 # put exp in hi word mov.w 4(%a0),%d1 # fetch hi(man) and.l &0x7FFFFFFF,%d1 # strip sign cmpi.l %d1,&0x3FD78000 # is |X| >= 2**(-40)? bge.b SOK1 # no bra.w SINSM # yes; input is very small SOK1: cmp.l %d1,&0x4004BC7E # is |X| < 15 PI? blt.b SINMAIN # no bra.w SREDUCEX # yes; input is very large #--THIS IS THE USUAL CASE, |X| <= 15 PI. #--THE ARGUMENT REDUCTION IS DONE BY TABLE LOOK UP. SINMAIN: fmov.x %fp0,%fp1 fmul.d TWOBYPI(%pc),%fp1 # X*2/PI lea PITBL+0x200(%pc),%a1 # TABLE OF N*PI/2, N = -32,...,32 fmov.l %fp1,INT(%a6) # CONVERT TO INTEGER mov.l INT(%a6),%d1 # make a copy of N asl.l &4,%d1 # N *= 16 add.l %d1,%a1 # tbl_addr = a1 + (N*16) # A1 IS THE ADDRESS OF N*PIBY2 # ...WHICH IS IN TWO PIECES Y1 & Y2 fsub.x (%a1)+,%fp0 # X-Y1 fsub.s (%a1),%fp0 # fp0 = R = (X-Y1)-Y2 SINCONT: #--continuation from REDUCEX #--GET N+ADJN AND SEE IF SIN(R) OR COS(R) IS NEEDED mov.l INT(%a6),%d1 add.l ADJN(%a6),%d1 # SEE IF D0 IS ODD OR EVEN ror.l &1,%d1 # D0 WAS ODD IFF D0 IS NEGATIVE cmp.l %d1,&0 blt.w COSPOLY #--LET J BE THE LEAST SIG. BIT OF D0, LET SGN := (-1)**J. #--THEN WE RETURN SGN*SIN(R). SGN*SIN(R) IS COMPUTED BY #--R' + R'*S*(A1 + S(A2 + S(A3 + S(A4 + ... + SA7)))), WHERE #--R' = SGN*R, S=R*R. THIS CAN BE REWRITTEN AS #--R' + R'*S*( [A1+T(A3+T(A5+TA7))] + [S(A2+T(A4+TA6))]) #--WHERE T=S*S. #--NOTE THAT A3 THROUGH A7 ARE STORED IN DOUBLE PRECISION #--WHILE A1 AND A2 ARE IN DOUBLE-EXTENDED FORMAT. SINPOLY: fmovm.x &0x0c,-(%sp) # save fp2/fp3 fmov.x %fp0,X(%a6) # X IS R fmul.x %fp0,%fp0 # FP0 IS S fmov.d SINA7(%pc),%fp3 fmov.d SINA6(%pc),%fp2 fmov.x %fp0,%fp1 fmul.x %fp1,%fp1 # FP1 IS T ror.l &1,%d1 and.l &0x80000000,%d1 # ...LEAST SIG. BIT OF D0 IN SIGN POSITION eor.l %d1,X(%a6) # X IS NOW R'= SGN*R fmul.x %fp1,%fp3 # TA7 fmul.x %fp1,%fp2 # TA6 fadd.d SINA5(%pc),%fp3 # A5+TA7 fadd.d SINA4(%pc),%fp2 # A4+TA6 fmul.x %fp1,%fp3 # T(A5+TA7) fmul.x %fp1,%fp2 # T(A4+TA6) fadd.d SINA3(%pc),%fp3 # A3+T(A5+TA7) fadd.x SINA2(%pc),%fp2 # A2+T(A4+TA6) fmul.x %fp3,%fp1 # T(A3+T(A5+TA7)) fmul.x %fp0,%fp2 # S(A2+T(A4+TA6)) fadd.x SINA1(%pc),%fp1 # A1+T(A3+T(A5+TA7)) fmul.x X(%a6),%fp0 # R'*S fadd.x %fp2,%fp1 # [A1+T(A3+T(A5+TA7))]+[S(A2+T(A4+TA6))] fmul.x %fp1,%fp0 # SIN(R')-R' fmovm.x (%sp)+,&0x30 # restore fp2/fp3 fmov.l %d0,%fpcr # restore users round mode,prec fadd.x X(%a6),%fp0 # last inst - possible exception set bra t_inx2 #--LET J BE THE LEAST SIG. BIT OF D0, LET SGN := (-1)**J. #--THEN WE RETURN SGN*COS(R). SGN*COS(R) IS COMPUTED BY #--SGN + S'*(B1 + S(B2 + S(B3 + S(B4 + ... + SB8)))), WHERE #--S=R*R AND S'=SGN*S. THIS CAN BE REWRITTEN AS #--SGN + S'*([B1+T(B3+T(B5+TB7))] + [S(B2+T(B4+T(B6+TB8)))]) #--WHERE T=S*S. #--NOTE THAT B4 THROUGH B8 ARE STORED IN DOUBLE PRECISION #--WHILE B2 AND B3 ARE IN DOUBLE-EXTENDED FORMAT, B1 IS -1/2 #--AND IS THEREFORE STORED AS SINGLE PRECISION. COSPOLY: fmovm.x &0x0c,-(%sp) # save fp2/fp3 fmul.x %fp0,%fp0 # FP0 IS S fmov.d COSB8(%pc),%fp2 fmov.d COSB7(%pc),%fp3 fmov.x %fp0,%fp1 fmul.x %fp1,%fp1 # FP1 IS T fmov.x %fp0,X(%a6) # X IS S ror.l &1,%d1 and.l &0x80000000,%d1 # ...LEAST SIG. BIT OF D0 IN SIGN POSITION fmul.x %fp1,%fp2 # TB8 eor.l %d1,X(%a6) # X IS NOW S'= SGN*S and.l &0x80000000,%d1 fmul.x %fp1,%fp3 # TB7 or.l &0x3F800000,%d1 # D0 IS SGN IN SINGLE mov.l %d1,POSNEG1(%a6) fadd.d COSB6(%pc),%fp2 # B6+TB8 fadd.d COSB5(%pc),%fp3 # B5+TB7 fmul.x %fp1,%fp2 # T(B6+TB8) fmul.x %fp1,%fp3 # T(B5+TB7) fadd.d COSB4(%pc),%fp2 # B4+T(B6+TB8) fadd.x COSB3(%pc),%fp3 # B3+T(B5+TB7) fmul.x %fp1,%fp2 # T(B4+T(B6+TB8)) fmul.x %fp3,%fp1 # T(B3+T(B5+TB7)) fadd.x COSB2(%pc),%fp2 # B2+T(B4+T(B6+TB8)) fadd.s COSB1(%pc),%fp1 # B1+T(B3+T(B5+TB7)) fmul.x %fp2,%fp0 # S(B2+T(B4+T(B6+TB8))) fadd.x %fp1,%fp0 fmul.x X(%a6),%fp0 fmovm.x (%sp)+,&0x30 # restore fp2/fp3 fmov.l %d0,%fpcr # restore users round mode,prec fadd.s POSNEG1(%a6),%fp0 # last inst - possible exception set bra t_inx2 ############################################## # SINe: Big OR Small? #--IF |X| > 15PI, WE USE THE GENERAL ARGUMENT REDUCTION. #--IF |X| < 2**(-40), RETURN X OR 1. SINBORS: cmp.l %d1,&0x3FFF8000 bgt.l SREDUCEX SINSM: mov.l ADJN(%a6),%d1 cmp.l %d1,&0 bgt.b COSTINY # here, the operation may underflow iff the precision is sgl or dbl. # extended denorms are handled through another entry point. SINTINY: # mov.w &0x0000,XDCARE(%a6) # JUST IN CASE fmov.l %d0,%fpcr # restore users round mode,prec mov.b &FMOV_OP,%d1 # last inst is MOVE fmov.x X(%a6),%fp0 # last inst - possible exception set bra t_catch COSTINY: fmov.s &0x3F800000,%fp0 # fp0 = 1.0 fmov.l %d0,%fpcr # restore users round mode,prec fadd.s &0x80800000,%fp0 # last inst - possible exception set bra t_pinx2 ################################################ global ssind #--SIN(X) = X FOR DENORMALIZED X ssind: bra t_extdnrm ############################################ global scosd #--COS(X) = 1 FOR DENORMALIZED X scosd: fmov.s &0x3F800000,%fp0 # fp0 = 1.0 bra t_pinx2 ################################################## global ssincos ssincos: #--SET ADJN TO 4 mov.l &4,ADJN(%a6) fmov.x (%a0),%fp0 # LOAD INPUT fmov.x %fp0,X(%a6) mov.l (%a0),%d1 mov.w 4(%a0),%d1 and.l &0x7FFFFFFF,%d1 # COMPACTIFY X cmp.l %d1,&0x3FD78000 # |X| >= 2**(-40)? bge.b SCOK1 bra.w SCSM SCOK1: cmp.l %d1,&0x4004BC7E # |X| < 15 PI? blt.b SCMAIN bra.w SREDUCEX #--THIS IS THE USUAL CASE, |X| <= 15 PI. #--THE ARGUMENT REDUCTION IS DONE BY TABLE LOOK UP. SCMAIN: fmov.x %fp0,%fp1 fmul.d TWOBYPI(%pc),%fp1 # X*2/PI lea PITBL+0x200(%pc),%a1 # TABLE OF N*PI/2, N = -32,...,32 fmov.l %fp1,INT(%a6) # CONVERT TO INTEGER mov.l INT(%a6),%d1 asl.l &4,%d1 add.l %d1,%a1 # ADDRESS OF N*PIBY2, IN Y1, Y2 fsub.x (%a1)+,%fp0 # X-Y1 fsub.s (%a1),%fp0 # FP0 IS R = (X-Y1)-Y2 SCCONT: #--continuation point from REDUCEX mov.l INT(%a6),%d1 ror.l &1,%d1 cmp.l %d1,&0 # D0 < 0 IFF N IS ODD bge.w NEVEN SNODD: #--REGISTERS SAVED SO FAR: D0, A0, FP2. fmovm.x &0x04,-(%sp) # save fp2 fmov.x %fp0,RPRIME(%a6) fmul.x %fp0,%fp0 # FP0 IS S = R*R fmov.d SINA7(%pc),%fp1 # A7 fmov.d COSB8(%pc),%fp2 # B8 fmul.x %fp0,%fp1 # SA7 fmul.x %fp0,%fp2 # SB8 mov.l %d2,-(%sp) mov.l %d1,%d2 ror.l &1,%d2 and.l &0x80000000,%d2 eor.l %d1,%d2 and.l &0x80000000,%d2 fadd.d SINA6(%pc),%fp1 # A6+SA7 fadd.d COSB7(%pc),%fp2 # B7+SB8 fmul.x %fp0,%fp1 # S(A6+SA7) eor.l %d2,RPRIME(%a6) mov.l (%sp)+,%d2 fmul.x %fp0,%fp2 # S(B7+SB8) ror.l &1,%d1 and.l &0x80000000,%d1 mov.l &0x3F800000,POSNEG1(%a6) eor.l %d1,POSNEG1(%a6) fadd.d SINA5(%pc),%fp1 # A5+S(A6+SA7) fadd.d COSB6(%pc),%fp2 # B6+S(B7+SB8) fmul.x %fp0,%fp1 # S(A5+S(A6+SA7)) fmul.x %fp0,%fp2 # S(B6+S(B7+SB8)) fmov.x %fp0,SPRIME(%a6) fadd.d SINA4(%pc),%fp1 # A4+S(A5+S(A6+SA7)) eor.l %d1,SPRIME(%a6) fadd.d COSB5(%pc),%fp2 # B5+S(B6+S(B7+SB8)) fmul.x %fp0,%fp1 # S(A4+...) fmul.x %fp0,%fp2 # S(B5+...) fadd.d SINA3(%pc),%fp1 # A3+S(A4+...) fadd.d COSB4(%pc),%fp2 # B4+S(B5+...) fmul.x %fp0,%fp1 # S(A3+...) fmul.x %fp0,%fp2 # S(B4+...) fadd.x SINA2(%pc),%fp1 # A2+S(A3+...) fadd.x COSB3(%pc),%fp2 # B3+S(B4+...) fmul.x %fp0,%fp1 # S(A2+...) fmul.x %fp0,%fp2 # S(B3+...) fadd.x SINA1(%pc),%fp1 # A1+S(A2+...) fadd.x COSB2(%pc),%fp2 # B2+S(B3+...) fmul.x %fp0,%fp1 # S(A1+...) fmul.x %fp2,%fp0 # S(B2+...) fmul.x RPRIME(%a6),%fp1 # R'S(A1+...) fadd.s COSB1(%pc),%fp0 # B1+S(B2...) fmul.x SPRIME(%a6),%fp0 # S'(B1+S(B2+...)) fmovm.x (%sp)+,&0x20 # restore fp2 fmov.l %d0,%fpcr fadd.x RPRIME(%a6),%fp1 # COS(X) bsr sto_cos # store cosine result fadd.s POSNEG1(%a6),%fp0 # SIN(X) bra t_inx2 NEVEN: #--REGISTERS SAVED SO FAR: FP2. fmovm.x &0x04,-(%sp) # save fp2 fmov.x %fp0,RPRIME(%a6) fmul.x %fp0,%fp0 # FP0 IS S = R*R fmov.d COSB8(%pc),%fp1 # B8 fmov.d SINA7(%pc),%fp2 # A7 fmul.x %fp0,%fp1 # SB8 fmov.x %fp0,SPRIME(%a6) fmul.x %fp0,%fp2 # SA7 ror.l &1,%d1 and.l &0x80000000,%d1 fadd.d COSB7(%pc),%fp1 # B7+SB8 fadd.d SINA6(%pc),%fp2 # A6+SA7 eor.l %d1,RPRIME(%a6) eor.l %d1,SPRIME(%a6) fmul.x %fp0,%fp1 # S(B7+SB8) or.l &0x3F800000,%d1 mov.l %d1,POSNEG1(%a6) fmul.x %fp0,%fp2 # S(A6+SA7) fadd.d COSB6(%pc),%fp1 # B6+S(B7+SB8) fadd.d SINA5(%pc),%fp2 # A5+S(A6+SA7) fmul.x %fp0,%fp1 # S(B6+S(B7+SB8)) fmul.x %fp0,%fp2 # S(A5+S(A6+SA7)) fadd.d COSB5(%pc),%fp1 # B5+S(B6+S(B7+SB8)) fadd.d SINA4(%pc),%fp2 # A4+S(A5+S(A6+SA7)) fmul.x %fp0,%fp1 # S(B5+...) fmul.x %fp0,%fp2 # S(A4+...) fadd.d COSB4(%pc),%fp1 # B4+S(B5+...) fadd.d SINA3(%pc),%fp2 # A3+S(A4+...) fmul.x %fp0,%fp1 # S(B4+...) fmul.x %fp0,%fp2 # S(A3+...) fadd.x COSB3(%pc),%fp1 # B3+S(B4+...) fadd.x SINA2(%pc),%fp2 # A2+S(A3+...) fmul.x %fp0,%fp1 # S(B3+...) fmul.x %fp0,%fp2 # S(A2+...) fadd.x COSB2(%pc),%fp1 # B2+S(B3+...) fadd.x SINA1(%pc),%fp2 # A1+S(A2+...) fmul.x %fp0,%fp1 # S(B2+...) fmul.x %fp2,%fp0 # s(a1+...) fadd.s COSB1(%pc),%fp1 # B1+S(B2...) fmul.x RPRIME(%a6),%fp0 # R'S(A1+...) fmul.x SPRIME(%a6),%fp1 # S'(B1+S(B2+...)) fmovm.x (%sp)+,&0x20 # restore fp2 fmov.l %d0,%fpcr fadd.s POSNEG1(%a6),%fp1 # COS(X) bsr sto_cos # store cosine result fadd.x RPRIME(%a6),%fp0 # SIN(X) bra t_inx2 ################################################ SCBORS: cmp.l %d1,&0x3FFF8000 bgt.w SREDUCEX ################################################ SCSM: # mov.w &0x0000,XDCARE(%a6) fmov.s &0x3F800000,%fp1 fmov.l %d0,%fpcr fsub.s &0x00800000,%fp1 bsr sto_cos # store cosine result fmov.l %fpcr,%d0 # d0 must have fpcr,too mov.b &FMOV_OP,%d1 # last inst is MOVE fmov.x X(%a6),%fp0 bra t_catch ############################################## global ssincosd #--SIN AND COS OF X FOR DENORMALIZED X ssincosd: mov.l %d0,-(%sp) # save d0 fmov.s &0x3F800000,%fp1 bsr sto_cos # store cosine result mov.l (%sp)+,%d0 # restore d0 bra t_extdnrm ############################################ #--WHEN REDUCEX IS USED, THE CODE WILL INEVITABLY BE SLOW. #--THIS REDUCTION METHOD, HOWEVER, IS MUCH FASTER THAN USING #--THE REMAINDER INSTRUCTION WHICH IS NOW IN SOFTWARE. SREDUCEX: fmovm.x &0x3c,-(%sp) # save {fp2-fp5} mov.l %d2,-(%sp) # save d2 fmov.s &0x00000000,%fp1 # fp1 = 0 #--If compact form of abs(arg) in d0=$7ffeffff, argument is so large that #--there is a danger of unwanted overflow in first LOOP iteration. In this #--case, reduce argument by one remainder step to make subsequent reduction #--safe. cmp.l %d1,&0x7ffeffff # is arg dangerously large? bne.b SLOOP # no # yes; create 2**16383*PI/2 mov.w &0x7ffe,FP_SCR0_EX(%a6) mov.l &0xc90fdaa2,FP_SCR0_HI(%a6) clr.l FP_SCR0_LO(%a6) # create low half of 2**16383*PI/2 at FP_SCR1 mov.w &0x7fdc,FP_SCR1_EX(%a6) mov.l &0x85a308d3,FP_SCR1_HI(%a6) clr.l FP_SCR1_LO(%a6) ftest.x %fp0 # test sign of argument fblt.w sred_neg or.b &0x80,FP_SCR0_EX(%a6) # positive arg or.b &0x80,FP_SCR1_EX(%a6) sred_neg: fadd.x FP_SCR0(%a6),%fp0 # high part of reduction is exact fmov.x %fp0,%fp1 # save high result in fp1 fadd.x FP_SCR1(%a6),%fp0 # low part of reduction fsub.x %fp0,%fp1 # determine low component of result fadd.x FP_SCR1(%a6),%fp1 # fp0/fp1 are reduced argument. #--ON ENTRY, FP0 IS X, ON RETURN, FP0 IS X REM PI/2, |X| <= PI/4. #--integer quotient will be stored in N #--Intermeditate remainder is 66-bit long; (R,r) in (FP0,FP1) SLOOP: fmov.x %fp0,INARG(%a6) # +-2**K * F, 1 <= F < 2 mov.w INARG(%a6),%d1 mov.l %d1,%a1 # save a copy of D0 and.l &0x00007FFF,%d1 sub.l &0x00003FFF,%d1 # d0 = K cmp.l %d1,&28 ble.b SLASTLOOP SCONTLOOP: sub.l &27,%d1 # d0 = L := K-27 mov.b &0,ENDFLAG(%a6) bra.b SWORK SLASTLOOP: clr.l %d1 # d0 = L := 0 mov.b &1,ENDFLAG(%a6) SWORK: #--FIND THE REMAINDER OF (R,r) W.R.T. 2**L * (PI/2). L IS SO CHOSEN #--THAT INT( X * (2/PI) / 2**(L) ) < 2**29. #--CREATE 2**(-L) * (2/PI), SIGN(INARG)*2**(63), #--2**L * (PIby2_1), 2**L * (PIby2_2) mov.l &0x00003FFE,%d2 # BIASED EXP OF 2/PI sub.l %d1,%d2 # BIASED EXP OF 2**(-L)*(2/PI) mov.l &0xA2F9836E,FP_SCR0_HI(%a6) mov.l &0x4E44152A,FP_SCR0_LO(%a6) mov.w %d2,FP_SCR0_EX(%a6) # FP_SCR0 = 2**(-L)*(2/PI) fmov.x %fp0,%fp2 fmul.x FP_SCR0(%a6),%fp2 # fp2 = X * 2**(-L)*(2/PI) #--WE MUST NOW FIND INT(FP2). SINCE WE NEED THIS VALUE IN #--FLOATING POINT FORMAT, THE TWO FMOVE'S FMOVE.L FP <--> N #--WILL BE TOO INEFFICIENT. THE WAY AROUND IT IS THAT #--(SIGN(INARG)*2**63 + FP2) - SIGN(INARG)*2**63 WILL GIVE #--US THE DESIRED VALUE IN FLOATING POINT. mov.l %a1,%d2 swap %d2 and.l &0x80000000,%d2 or.l &0x5F000000,%d2 # d2 = SIGN(INARG)*2**63 IN SGL mov.l %d2,TWOTO63(%a6) fadd.s TWOTO63(%a6),%fp2 # THE FRACTIONAL PART OF FP1 IS ROUNDED fsub.s TWOTO63(%a6),%fp2 # fp2 = N # fint.x %fp2 #--CREATING 2**(L)*Piby2_1 and 2**(L)*Piby2_2 mov.l %d1,%d2 # d2 = L add.l &0x00003FFF,%d2 # BIASED EXP OF 2**L * (PI/2) mov.w %d2,FP_SCR0_EX(%a6) mov.l &0xC90FDAA2,FP_SCR0_HI(%a6) clr.l FP_SCR0_LO(%a6) # FP_SCR0 = 2**(L) * Piby2_1 add.l &0x00003FDD,%d1 mov.w %d1,FP_SCR1_EX(%a6) mov.l &0x85A308D3,FP_SCR1_HI(%a6) clr.l FP_SCR1_LO(%a6) # FP_SCR1 = 2**(L) * Piby2_2 mov.b ENDFLAG(%a6),%d1 #--We are now ready to perform (R+r) - N*P1 - N*P2, P1 = 2**(L) * Piby2_1 and #--P2 = 2**(L) * Piby2_2 fmov.x %fp2,%fp4 # fp4 = N fmul.x FP_SCR0(%a6),%fp4 # fp4 = W = N*P1 fmov.x %fp2,%fp5 # fp5 = N fmul.x FP_SCR1(%a6),%fp5 # fp5 = w = N*P2 fmov.x %fp4,%fp3 # fp3 = W = N*P1 #--we want P+p = W+w but |p| <= half ulp of P #--Then, we need to compute A := R-P and a := r-p fadd.x %fp5,%fp3 # fp3 = P fsub.x %fp3,%fp4 # fp4 = W-P fsub.x %fp3,%fp0 # fp0 = A := R - P fadd.x %fp5,%fp4 # fp4 = p = (W-P)+w fmov.x %fp0,%fp3 # fp3 = A fsub.x %fp4,%fp1 # fp1 = a := r - p #--Now we need to normalize (A,a) to "new (R,r)" where R+r = A+a but #--|r| <= half ulp of R. fadd.x %fp1,%fp0 # fp0 = R := A+a #--No need to calculate r if this is the last loop cmp.b %d1,&0 bgt.w SRESTORE #--Need to calculate r fsub.x %fp0,%fp3 # fp3 = A-R fadd.x %fp3,%fp1 # fp1 = r := (A-R)+a bra.w SLOOP SRESTORE: fmov.l %fp2,INT(%a6) mov.l (%sp)+,%d2 # restore d2 fmovm.x (%sp)+,&0x3c # restore {fp2-fp5} mov.l ADJN(%a6),%d1 cmp.l %d1,&4 blt.w SINCONT bra.w SCCONT ######################################################################### # stan(): computes the tangent of a normalized input # # stand(): computes the tangent of a denormalized input # # # # INPUT *************************************************************** # # a0 = pointer to extended precision input # # d0 = round precision,mode # # # # OUTPUT ************************************************************** # # fp0 = tan(X) # # # # ACCURACY and MONOTONICITY ******************************************* # # The returned result is within 3 ulp in 64 significant bit, i.e. # # within 0.5001 ulp to 53 bits if the result is subsequently # # rounded to double precision. The result is provably monotonic # # in double precision. # # # # ALGORITHM *********************************************************** # # # # 1. If |X| >= 15Pi or |X| < 2**(-40), go to 6. # # # # 2. Decompose X as X = N(Pi/2) + r where |r| <= Pi/4. Let # # k = N mod 2, so in particular, k = 0 or 1. # # # # 3. If k is odd, go to 5. # # # # 4. (k is even) Tan(X) = tan(r) and tan(r) is approximated by a # # rational function U/V where # # U = r + r*s*(P1 + s*(P2 + s*P3)), and # # V = 1 + s*(Q1 + s*(Q2 + s*(Q3 + s*Q4))), s = r*r. # # Exit. # # # # 4. (k is odd) Tan(X) = -cot(r). Since tan(r) is approximated by # # a rational function U/V where # # U = r + r*s*(P1 + s*(P2 + s*P3)), and # # V = 1 + s*(Q1 + s*(Q2 + s*(Q3 + s*Q4))), s = r*r, # # -Cot(r) = -V/U. Exit. # # # # 6. If |X| > 1, go to 8. # # # # 7. (|X|<2**(-40)) Tan(X) = X. Exit. # # # # 8. Overwrite X by X := X rem 2Pi. Now that |X| <= Pi, go back # # to 2. # # # ######################################################################### TANQ4: long 0x3EA0B759,0xF50F8688 TANP3: long 0xBEF2BAA5,0xA8924F04 TANQ3: long 0xBF346F59,0xB39BA65F,0x00000000,0x00000000 TANP2: long 0x3FF60000,0xE073D3FC,0x199C4A00,0x00000000 TANQ2: long 0x3FF90000,0xD23CD684,0x15D95FA1,0x00000000 TANP1: long 0xBFFC0000,0x8895A6C5,0xFB423BCA,0x00000000 TANQ1: long 0xBFFD0000,0xEEF57E0D,0xA84BC8CE,0x00000000 INVTWOPI: long 0x3FFC0000,0xA2F9836E,0x4E44152A,0x00000000 TWOPI1: long 0x40010000,0xC90FDAA2,0x00000000,0x00000000 TWOPI2: long 0x3FDF0000,0x85A308D4,0x00000000,0x00000000 #--N*PI/2, -32 <= N <= 32, IN A LEADING TERM IN EXT. AND TRAILING #--TERM IN SGL. NOTE THAT PI IS 64-BIT LONG, THUS N*PI/2 IS AT #--MOST 69 BITS LONG. # global PITBL PITBL: long 0xC0040000,0xC90FDAA2,0x2168C235,0x21800000 long 0xC0040000,0xC2C75BCD,0x105D7C23,0xA0D00000 long 0xC0040000,0xBC7EDCF7,0xFF523611,0xA1E80000 long 0xC0040000,0xB6365E22,0xEE46F000,0x21480000 long 0xC0040000,0xAFEDDF4D,0xDD3BA9EE,0xA1200000 long 0xC0040000,0xA9A56078,0xCC3063DD,0x21FC0000 long 0xC0040000,0xA35CE1A3,0xBB251DCB,0x21100000 long 0xC0040000,0x9D1462CE,0xAA19D7B9,0xA1580000 long 0xC0040000,0x96CBE3F9,0x990E91A8,0x21E00000 long 0xC0040000,0x90836524,0x88034B96,0x20B00000 long 0xC0040000,0x8A3AE64F,0x76F80584,0xA1880000 long 0xC0040000,0x83F2677A,0x65ECBF73,0x21C40000 long 0xC0030000,0xFB53D14A,0xA9C2F2C2,0x20000000 long 0xC0030000,0xEEC2D3A0,0x87AC669F,0x21380000 long 0xC0030000,0xE231D5F6,0x6595DA7B,0xA1300000 long 0xC0030000,0xD5A0D84C,0x437F4E58,0x9FC00000 long 0xC0030000,0xC90FDAA2,0x2168C235,0x21000000 long 0xC0030000,0xBC7EDCF7,0xFF523611,0xA1680000 long 0xC0030000,0xAFEDDF4D,0xDD3BA9EE,0xA0A00000 long 0xC0030000,0xA35CE1A3,0xBB251DCB,0x20900000 long 0xC0030000,0x96CBE3F9,0x990E91A8,0x21600000 long 0xC0030000,0x8A3AE64F,0x76F80584,0xA1080000 long 0xC0020000,0xFB53D14A,0xA9C2F2C2,0x1F800000 long 0xC0020000,0xE231D5F6,0x6595DA7B,0xA0B00000 long 0xC0020000,0xC90FDAA2,0x2168C235,0x20800000 long 0xC0020000,0xAFEDDF4D,0xDD3BA9EE,0xA0200000 long 0xC0020000,0x96CBE3F9,0x990E91A8,0x20E00000 long 0xC0010000,0xFB53D14A,0xA9C2F2C2,0x1F000000 long 0xC0010000,0xC90FDAA2,0x2168C235,0x20000000 long 0xC0010000,0x96CBE3F9,0x990E91A8,0x20600000 long 0xC0000000,0xC90FDAA2,0x2168C235,0x1F800000 long 0xBFFF0000,0xC90FDAA2,0x2168C235,0x1F000000 long 0x00000000,0x00000000,0x00000000,0x00000000 long 0x3FFF0000,0xC90FDAA2,0x2168C235,0x9F000000 long 0x40000000,0xC90FDAA2,0x2168C235,0x9F800000 long 0x40010000,0x96CBE3F9,0x990E91A8,0xA0600000 long 0x40010000,0xC90FDAA2,0x2168C235,0xA0000000 long 0x40010000,0xFB53D14A,0xA9C2F2C2,0x9F000000 long 0x40020000,0x96CBE3F9,0x990E91A8,0xA0E00000 long 0x40020000,0xAFEDDF4D,0xDD3BA9EE,0x20200000 long 0x40020000,0xC90FDAA2,0x2168C235,0xA0800000 long 0x40020000,0xE231D5F6,0x6595DA7B,0x20B00000 long 0x40020000,0xFB53D14A,0xA9C2F2C2,0x9F800000 long 0x40030000,0x8A3AE64F,0x76F80584,0x21080000 long 0x40030000,0x96CBE3F9,0x990E91A8,0xA1600000 long 0x40030000,0xA35CE1A3,0xBB251DCB,0xA0900000 long 0x40030000,0xAFEDDF4D,0xDD3BA9EE,0x20A00000 long 0x40030000,0xBC7EDCF7,0xFF523611,0x21680000 long 0x40030000,0xC90FDAA2,0x2168C235,0xA1000000 long 0x40030000,0xD5A0D84C,0x437F4E58,0x1FC00000 long 0x40030000,0xE231D5F6,0x6595DA7B,0x21300000 long 0x40030000,0xEEC2D3A0,0x87AC669F,0xA1380000 long 0x40030000,0xFB53D14A,0xA9C2F2C2,0xA0000000 long 0x40040000,0x83F2677A,0x65ECBF73,0xA1C40000 long 0x40040000,0x8A3AE64F,0x76F80584,0x21880000 long 0x40040000,0x90836524,0x88034B96,0xA0B00000 long 0x40040000,0x96CBE3F9,0x990E91A8,0xA1E00000 long 0x40040000,0x9D1462CE,0xAA19D7B9,0x21580000 long 0x40040000,0xA35CE1A3,0xBB251DCB,0xA1100000 long 0x40040000,0xA9A56078,0xCC3063DD,0xA1FC0000 long 0x40040000,0xAFEDDF4D,0xDD3BA9EE,0x21200000 long 0x40040000,0xB6365E22,0xEE46F000,0xA1480000 long 0x40040000,0xBC7EDCF7,0xFF523611,0x21E80000 long 0x40040000,0xC2C75BCD,0x105D7C23,0x20D00000 long 0x40040000,0xC90FDAA2,0x2168C235,0xA1800000 set INARG,FP_SCR0 set TWOTO63,L_SCR1 set INT,L_SCR1 set ENDFLAG,L_SCR2 global stan stan: fmov.x (%a0),%fp0 # LOAD INPUT mov.l (%a0),%d1 mov.w 4(%a0),%d1 and.l &0x7FFFFFFF,%d1 cmp.l %d1,&0x3FD78000 # |X| >= 2**(-40)? bge.b TANOK1 bra.w TANSM TANOK1: cmp.l %d1,&0x4004BC7E # |X| < 15 PI? blt.b TANMAIN bra.w REDUCEX TANMAIN: #--THIS IS THE USUAL CASE, |X| <= 15 PI. #--THE ARGUMENT REDUCTION IS DONE BY TABLE LOOK UP. fmov.x %fp0,%fp1 fmul.d TWOBYPI(%pc),%fp1 # X*2/PI lea.l PITBL+0x200(%pc),%a1 # TABLE OF N*PI/2, N = -32,...,32 fmov.l %fp1,%d1 # CONVERT TO INTEGER asl.l &4,%d1 add.l %d1,%a1 # ADDRESS N*PIBY2 IN Y1, Y2 fsub.x (%a1)+,%fp0 # X-Y1 fsub.s (%a1),%fp0 # FP0 IS R = (X-Y1)-Y2 ror.l &5,%d1 and.l &0x80000000,%d1 # D0 WAS ODD IFF D0 < 0 TANCONT: fmovm.x &0x0c,-(%sp) # save fp2,fp3 cmp.l %d1,&0 blt.w NODD fmov.x %fp0,%fp1 fmul.x %fp1,%fp1 # S = R*R fmov.d TANQ4(%pc),%fp3 fmov.d TANP3(%pc),%fp2 fmul.x %fp1,%fp3 # SQ4 fmul.x %fp1,%fp2 # SP3 fadd.d TANQ3(%pc),%fp3 # Q3+SQ4 fadd.x TANP2(%pc),%fp2 # P2+SP3 fmul.x %fp1,%fp3 # S(Q3+SQ4) fmul.x %fp1,%fp2 # S(P2+SP3) fadd.x TANQ2(%pc),%fp3 # Q2+S(Q3+SQ4) fadd.x TANP1(%pc),%fp2 # P1+S(P2+SP3) fmul.x %fp1,%fp3 # S(Q2+S(Q3+SQ4)) fmul.x %fp1,%fp2 # S(P1+S(P2+SP3)) fadd.x TANQ1(%pc),%fp3 # Q1+S(Q2+S(Q3+SQ4)) fmul.x %fp0,%fp2 # RS(P1+S(P2+SP3)) fmul.x %fp3,%fp1 # S(Q1+S(Q2+S(Q3+SQ4))) fadd.x %fp2,%fp0 # R+RS(P1+S(P2+SP3)) fadd.s &0x3F800000,%fp1 # 1+S(Q1+...) fmovm.x (%sp)+,&0x30 # restore fp2,fp3 fmov.l %d0,%fpcr # restore users round mode,prec fdiv.x %fp1,%fp0 # last inst - possible exception set bra t_inx2 NODD: fmov.x %fp0,%fp1 fmul.x %fp0,%fp0 # S = R*R fmov.d TANQ4(%pc),%fp3 fmov.d TANP3(%pc),%fp2 fmul.x %fp0,%fp3 # SQ4 fmul.x %fp0,%fp2 # SP3 fadd.d TANQ3(%pc),%fp3 # Q3+SQ4 fadd.x TANP2(%pc),%fp2 # P2+SP3 fmul.x %fp0,%fp3 # S(Q3+SQ4) fmul.x %fp0,%fp2 # S(P2+SP3) fadd.x TANQ2(%pc),%fp3 # Q2+S(Q3+SQ4) fadd.x TANP1(%pc),%fp2 # P1+S(P2+SP3) fmul.x %fp0,%fp3 # S(Q2+S(Q3+SQ4)) fmul.x %fp0,%fp2 # S(P1+S(P2+SP3)) fadd.x TANQ1(%pc),%fp3 # Q1+S(Q2+S(Q3+SQ4)) fmul.x %fp1,%fp2 # RS(P1+S(P2+SP3)) fmul.x %fp3,%fp0 # S(Q1+S(Q2+S(Q3+SQ4))) fadd.x %fp2,%fp1 # R+RS(P1+S(P2+SP3)) fadd.s &0x3F800000,%fp0 # 1+S(Q1+...) fmovm.x (%sp)+,&0x30 # restore fp2,fp3 fmov.x %fp1,-(%sp) eor.l &0x80000000,(%sp) fmov.l %d0,%fpcr # restore users round mode,prec fdiv.x (%sp)+,%fp0 # last inst - possible exception set bra t_inx2 TANBORS: #--IF |X| > 15PI, WE USE THE GENERAL ARGUMENT REDUCTION. #--IF |X| < 2**(-40), RETURN X OR 1. cmp.l %d1,&0x3FFF8000 bgt.b REDUCEX TANSM: fmov.x %fp0,-(%sp) fmov.l %d0,%fpcr # restore users round mode,prec mov.b &FMOV_OP,%d1 # last inst is MOVE fmov.x (%sp)+,%fp0 # last inst - posibble exception set bra t_catch global stand #--TAN(X) = X FOR DENORMALIZED X stand: bra t_extdnrm #--WHEN REDUCEX IS USED, THE CODE WILL INEVITABLY BE SLOW. #--THIS REDUCTION METHOD, HOWEVER, IS MUCH FASTER THAN USING #--THE REMAINDER INSTRUCTION WHICH IS NOW IN SOFTWARE. REDUCEX: fmovm.x &0x3c,-(%sp) # save {fp2-fp5} mov.l %d2,-(%sp) # save d2 fmov.s &0x00000000,%fp1 # fp1 = 0 #--If compact form of abs(arg) in d0=$7ffeffff, argument is so large that #--there is a danger of unwanted overflow in first LOOP iteration. In this #--case, reduce argument by one remainder step to make subsequent reduction #--safe. cmp.l %d1,&0x7ffeffff # is arg dangerously large? bne.b LOOP # no # yes; create 2**16383*PI/2 mov.w &0x7ffe,FP_SCR0_EX(%a6) mov.l &0xc90fdaa2,FP_SCR0_HI(%a6) clr.l FP_SCR0_LO(%a6) # create low half of 2**16383*PI/2 at FP_SCR1 mov.w &0x7fdc,FP_SCR1_EX(%a6) mov.l &0x85a308d3,FP_SCR1_HI(%a6) clr.l FP_SCR1_LO(%a6) ftest.x %fp0 # test sign of argument fblt.w red_neg or.b &0x80,FP_SCR0_EX(%a6) # positive arg or.b &0x80,FP_SCR1_EX(%a6) red_neg: fadd.x FP_SCR0(%a6),%fp0 # high part of reduction is exact fmov.x %fp0,%fp1 # save high result in fp1 fadd.x FP_SCR1(%a6),%fp0 # low part of reduction fsub.x %fp0,%fp1 # determine low component of result fadd.x FP_SCR1(%a6),%fp1 # fp0/fp1 are reduced argument. #--ON ENTRY, FP0 IS X, ON RETURN, FP0 IS X REM PI/2, |X| <= PI/4. #--integer quotient will be stored in N #--Intermeditate remainder is 66-bit long; (R,r) in (FP0,FP1) LOOP: fmov.x %fp0,INARG(%a6) # +-2**K * F, 1 <= F < 2 mov.w INARG(%a6),%d1 mov.l %d1,%a1 # save a copy of D0 and.l &0x00007FFF,%d1 sub.l &0x00003FFF,%d1 # d0 = K cmp.l %d1,&28 ble.b LASTLOOP CONTLOOP: sub.l &27,%d1 # d0 = L := K-27 mov.b &0,ENDFLAG(%a6) bra.b WORK LASTLOOP: clr.l %d1 # d0 = L := 0 mov.b &1,ENDFLAG(%a6) WORK: #--FIND THE REMAINDER OF (R,r) W.R.T. 2**L * (PI/2). L IS SO CHOSEN #--THAT INT( X * (2/PI) / 2**(L) ) < 2**29. #--CREATE 2**(-L) * (2/PI), SIGN(INARG)*2**(63), #--2**L * (PIby2_1), 2**L * (PIby2_2) mov.l &0x00003FFE,%d2 # BIASED EXP OF 2/PI sub.l %d1,%d2 # BIASED EXP OF 2**(-L)*(2/PI) mov.l &0xA2F9836E,FP_SCR0_HI(%a6) mov.l &0x4E44152A,FP_SCR0_LO(%a6) mov.w %d2,FP_SCR0_EX(%a6) # FP_SCR0 = 2**(-L)*(2/PI) fmov.x %fp0,%fp2 fmul.x FP_SCR0(%a6),%fp2 # fp2 = X * 2**(-L)*(2/PI) #--WE MUST NOW FIND INT(FP2). SINCE WE NEED THIS VALUE IN #--FLOATING POINT FORMAT, THE TWO FMOVE'S FMOVE.L FP <--> N #--WILL BE TOO INEFFICIENT. THE WAY AROUND IT IS THAT #--(SIGN(INARG)*2**63 + FP2) - SIGN(INARG)*2**63 WILL GIVE #--US THE DESIRED VALUE IN FLOATING POINT. mov.l %a1,%d2 swap %d2 and.l &0x80000000,%d2 or.l &0x5F000000,%d2 # d2 = SIGN(INARG)*2**63 IN SGL mov.l %d2,TWOTO63(%a6) fadd.s TWOTO63(%a6),%fp2 # THE FRACTIONAL PART OF FP1 IS ROUNDED fsub.s TWOTO63(%a6),%fp2 # fp2 = N # fintrz.x %fp2,%fp2 #--CREATING 2**(L)*Piby2_1 and 2**(L)*Piby2_2 mov.l %d1,%d2 # d2 = L add.l &0x00003FFF,%d2 # BIASED EXP OF 2**L * (PI/2) mov.w %d2,FP_SCR0_EX(%a6) mov.l &0xC90FDAA2,FP_SCR0_HI(%a6) clr.l FP_SCR0_LO(%a6) # FP_SCR0 = 2**(L) * Piby2_1 add.l &0x00003FDD,%d1 mov.w %d1,FP_SCR1_EX(%a6) mov.l &0x85A308D3,FP_SCR1_HI(%a6) clr.l FP_SCR1_LO(%a6) # FP_SCR1 = 2**(L) * Piby2_2 mov.b ENDFLAG(%a6),%d1 #--We are now ready to perform (R+r) - N*P1 - N*P2, P1 = 2**(L) * Piby2_1 and #--P2 = 2**(L) * Piby2_2 fmov.x %fp2,%fp4 # fp4 = N fmul.x FP_SCR0(%a6),%fp4 # fp4 = W = N*P1 fmov.x %fp2,%fp5 # fp5 = N fmul.x FP_SCR1(%a6),%fp5 # fp5 = w = N*P2 fmov.x %fp4,%fp3 # fp3 = W = N*P1 #--we want P+p = W+w but |p| <= half ulp of P #--Then, we need to compute A := R-P and a := r-p fadd.x %fp5,%fp3 # fp3 = P fsub.x %fp3,%fp4 # fp4 = W-P fsub.x %fp3,%fp0 # fp0 = A := R - P fadd.x %fp5,%fp4 # fp4 = p = (W-P)+w fmov.x %fp0,%fp3 # fp3 = A fsub.x %fp4,%fp1 # fp1 = a := r - p #--Now we need to normalize (A,a) to "new (R,r)" where R+r = A+a but #--|r| <= half ulp of R. fadd.x %fp1,%fp0 # fp0 = R := A+a #--No need to calculate r if this is the last loop cmp.b %d1,&0 bgt.w RESTORE #--Need to calculate r fsub.x %fp0,%fp3 # fp3 = A-R fadd.x %fp3,%fp1 # fp1 = r := (A-R)+a bra.w LOOP RESTORE: fmov.l %fp2,INT(%a6) mov.l (%sp)+,%d2 # restore d2 fmovm.x (%sp)+,&0x3c # restore {fp2-fp5} mov.l INT(%a6),%d1 ror.l &1,%d1 bra.w TANCONT ######################################################################### # satan(): computes the arctangent of a normalized number # # satand(): computes the arctangent of a denormalized number # # # # INPUT *************************************************************** # # a0 = pointer to extended precision input # # d0 = round precision,mode # # # # OUTPUT ************************************************************** # # fp0 = arctan(X) # # # # ACCURACY and MONOTONICITY ******************************************* # # The returned result is within 2 ulps in 64 significant bit, # # i.e. within 0.5001 ulp to 53 bits if the result is subsequently # # rounded to double precision. The result is provably monotonic # # in double precision. # # # # ALGORITHM *********************************************************** # # Step 1. If |X| >= 16 or |X| < 1/16, go to Step 5. # # # # Step 2. Let X = sgn * 2**k * 1.xxxxxxxx...x. # # Note that k = -4, -3,..., or 3. # # Define F = sgn * 2**k * 1.xxxx1, i.e. the first 5 # # significant bits of X with a bit-1 attached at the 6-th # # bit position. Define u to be u = (X-F) / (1 + X*F). # # # # Step 3. Approximate arctan(u) by a polynomial poly. # # # # Step 4. Return arctan(F) + poly, arctan(F) is fetched from a # # table of values calculated beforehand. Exit. # # # # Step 5. If |X| >= 16, go to Step 7. # # # # Step 6. Approximate arctan(X) by an odd polynomial in X. Exit. # # # # Step 7. Define X' = -1/X. Approximate arctan(X') by an odd # # polynomial in X'. # # Arctan(X) = sign(X)*Pi/2 + arctan(X'). Exit. # # # ######################################################################### ATANA3: long 0xBFF6687E,0x314987D8 ATANA2: long 0x4002AC69,0x34A26DB3 ATANA1: long 0xBFC2476F,0x4E1DA28E ATANB6: long 0x3FB34444,0x7F876989 ATANB5: long 0xBFB744EE,0x7FAF45DB ATANB4: long 0x3FBC71C6,0x46940220 ATANB3: long 0xBFC24924,0x921872F9 ATANB2: long 0x3FC99999,0x99998FA9 ATANB1: long 0xBFD55555,0x55555555 ATANC5: long 0xBFB70BF3,0x98539E6A ATANC4: long 0x3FBC7187,0x962D1D7D ATANC3: long 0xBFC24924,0x827107B8 ATANC2: long 0x3FC99999,0x9996263E ATANC1: long 0xBFD55555,0x55555536 PPIBY2: long 0x3FFF0000,0xC90FDAA2,0x2168C235,0x00000000 NPIBY2: long 0xBFFF0000,0xC90FDAA2,0x2168C235,0x00000000 PTINY: long 0x00010000,0x80000000,0x00000000,0x00000000 NTINY: long 0x80010000,0x80000000,0x00000000,0x00000000 ATANTBL: long 0x3FFB0000,0x83D152C5,0x060B7A51,0x00000000 long 0x3FFB0000,0x8BC85445,0x65498B8B,0x00000000 long 0x3FFB0000,0x93BE4060,0x17626B0D,0x00000000 long 0x3FFB0000,0x9BB3078D,0x35AEC202,0x00000000 long 0x3FFB0000,0xA3A69A52,0x5DDCE7DE,0x00000000 long 0x3FFB0000,0xAB98E943,0x62765619,0x00000000 long 0x3FFB0000,0xB389E502,0xF9C59862,0x00000000 long 0x3FFB0000,0xBB797E43,0x6B09E6FB,0x00000000 long 0x3FFB0000,0xC367A5C7,0x39E5F446,0x00000000 long 0x3FFB0000,0xCB544C61,0xCFF7D5C6,0x00000000 long 0x3FFB0000,0xD33F62F8,0x2488533E,0x00000000 long 0x3FFB0000,0xDB28DA81,0x62404C77,0x00000000 long 0x3FFB0000,0xE310A407,0x8AD34F18,0x00000000 long 0x3FFB0000,0xEAF6B0A8,0x188EE1EB,0x00000000 long 0x3FFB0000,0xF2DAF194,0x9DBE79D5,0x00000000 long 0x3FFB0000,0xFABD5813,0x61D47E3E,0x00000000 long 0x3FFC0000,0x8346AC21,0x0959ECC4,0x00000000 long 0x3FFC0000,0x8B232A08,0x304282D8,0x00000000 long 0x3FFC0000,0x92FB70B8,0xD29AE2F9,0x00000000 long 0x3FFC0000,0x9ACF476F,0x5CCD1CB4,0x00000000 long 0x3FFC0000,0xA29E7630,0x4954F23F,0x00000000 long 0x3FFC0000,0xAA68C5D0,0x8AB85230,0x00000000 long 0x3FFC0000,0xB22DFFFD,0x9D539F83,0x00000000 long 0x3FFC0000,0xB9EDEF45,0x3E900EA5,0x00000000 long 0x3FFC0000,0xC1A85F1C,0xC75E3EA5,0x00000000 long 0x3FFC0000,0xC95D1BE8,0x28138DE6,0x00000000 long 0x3FFC0000,0xD10BF300,0x840D2DE4,0x00000000 long 0x3FFC0000,0xD8B4B2BA,0x6BC05E7A,0x00000000 long 0x3FFC0000,0xE0572A6B,0xB42335F6,0x00000000 long 0x3FFC0000,0xE7F32A70,0xEA9CAA8F,0x00000000 long 0x3FFC0000,0xEF888432,0x64ECEFAA,0x00000000 long 0x3FFC0000,0xF7170A28,0xECC06666,0x00000000 long 0x3FFD0000,0x812FD288,0x332DAD32,0x00000000 long 0x3FFD0000,0x88A8D1B1,0x218E4D64,0x00000000 long 0x3FFD0000,0x9012AB3F,0x23E4AEE8,0x00000000 long 0x3FFD0000,0x976CC3D4,0x11E7F1B9,0x00000000 long 0x3FFD0000,0x9EB68949,0x3889A227,0x00000000 long 0x3FFD0000,0xA5EF72C3,0x4487361B,0x00000000 long 0x3FFD0000,0xAD1700BA,0xF07A7227,0x00000000 long 0x3FFD0000,0xB42CBCFA,0xFD37EFB7,0x00000000 long 0x3FFD0000,0xBB303A94,0x0BA80F89,0x00000000 long 0x3FFD0000,0xC22115C6,0xFCAEBBAF,0x00000000 long 0x3FFD0000,0xC8FEF3E6,0x86331221,0x00000000 long 0x3FFD0000,0xCFC98330,0xB4000C70,0x00000000 long 0x3FFD0000,0xD6807AA1,0x102C5BF9,0x00000000 long 0x3FFD0000,0xDD2399BC,0x31252AA3,0x00000000 long 0x3FFD0000,0xE3B2A855,0x6B8FC517,0x00000000 long 0x3FFD0000,0xEA2D764F,0x64315989,0x00000000 long 0x3FFD0000,0xF3BF5BF8,0xBAD1A21D,0x00000000 long 0x3FFE0000,0x801CE39E,0x0D205C9A,0x00000000 long 0x3FFE0000,0x8630A2DA,0xDA1ED066,0x00000000 long 0x3FFE0000,0x8C1AD445,0xF3E09B8C,0x00000000 long 0x3FFE0000,0x91DB8F16,0x64F350E2,0x00000000 long 0x3FFE0000,0x97731420,0x365E538C,0x00000000 long 0x3FFE0000,0x9CE1C8E6,0xA0B8CDBA,0x00000000 long 0x3FFE0000,0xA22832DB,0xCADAAE09,0x00000000 long 0x3FFE0000,0xA746F2DD,0xB7602294,0x00000000 long 0x3FFE0000,0xAC3EC0FB,0x997DD6A2,0x00000000 long 0x3FFE0000,0xB110688A,0xEBDC6F6A,0x00000000 long 0x3FFE0000,0xB5BCC490,0x59ECC4B0,0x00000000 long 0x3FFE0000,0xBA44BC7D,0xD470782F,0x00000000 long 0x3FFE0000,0xBEA94144,0xFD049AAC,0x00000000 long 0x3FFE0000,0xC2EB4ABB,0x661628B6,0x00000000 long 0x3FFE0000,0xC70BD54C,0xE602EE14,0x00000000 long 0x3FFE0000,0xCD000549,0xADEC7159,0x00000000 long 0x3FFE0000,0xD48457D2,0xD8EA4EA3,0x00000000 long 0x3FFE0000,0xDB948DA7,0x12DECE3B,0x00000000 long 0x3FFE0000,0xE23855F9,0x69E8096A,0x00000000 long 0x3FFE0000,0xE8771129,0xC4353259,0x00000000 long 0x3FFE0000,0xEE57C16E,0x0D379C0D,0x00000000 long 0x3FFE0000,0xF3E10211,0xA87C3779,0x00000000 long 0x3FFE0000,0xF919039D,0x758B8D41,0x00000000 long 0x3FFE0000,0xFE058B8F,0x64935FB3,0x00000000 long 0x3FFF0000,0x8155FB49,0x7B685D04,0x00000000 long 0x3FFF0000,0x83889E35,0x49D108E1,0x00000000 long 0x3FFF0000,0x859CFA76,0x511D724B,0x00000000 long 0x3FFF0000,0x87952ECF,0xFF8131E7,0x00000000 long 0x3FFF0000,0x89732FD1,0x9557641B,0x00000000 long 0x3FFF0000,0x8B38CAD1,0x01932A35,0x00000000 long 0x3FFF0000,0x8CE7A8D8,0x301EE6B5,0x00000000 long 0x3FFF0000,0x8F46A39E,0x2EAE5281,0x00000000 long 0x3FFF0000,0x922DA7D7,0x91888487,0x00000000 long 0x3FFF0000,0x94D19FCB,0xDEDF5241,0x00000000 long 0x3FFF0000,0x973AB944,0x19D2A08B,0x00000000 long 0x3FFF0000,0x996FF00E,0x08E10B96,0x00000000 long 0x3FFF0000,0x9B773F95,0x12321DA7,0x00000000 long 0x3FFF0000,0x9D55CC32,0x0F935624,0x00000000 long 0x3FFF0000,0x9F100575,0x006CC571,0x00000000 long 0x3FFF0000,0xA0A9C290,0xD97CC06C,0x00000000 long 0x3FFF0000,0xA22659EB,0xEBC0630A,0x00000000 long 0x3FFF0000,0xA388B4AF,0xF6EF0EC9,0x00000000 long 0x3FFF0000,0xA4D35F10,0x61D292C4,0x00000000 long 0x3FFF0000,0xA60895DC,0xFBE3187E,0x00000000 long 0x3FFF0000,0xA72A51DC,0x7367BEAC,0x00000000 long 0x3FFF0000,0xA83A5153,0x0956168F,0x00000000 long 0x3FFF0000,0xA93A2007,0x7539546E,0x00000000 long 0x3FFF0000,0xAA9E7245,0x023B2605,0x00000000 long 0x3FFF0000,0xAC4C84BA,0x6FE4D58F,0x00000000 long 0x3FFF0000,0xADCE4A4A,0x606B9712,0x00000000 long 0x3FFF0000,0xAF2A2DCD,0x8D263C9C,0x00000000 long 0x3FFF0000,0xB0656F81,0xF22265C7,0x00000000 long 0x3FFF0000,0xB1846515,0x0F71496A,0x00000000 long 0x3FFF0000,0xB28AAA15,0x6F9ADA35,0x00000000 long 0x3FFF0000,0xB37B44FF,0x3766B895,0x00000000 long 0x3FFF0000,0xB458C3DC,0xE9630433,0x00000000 long 0x3FFF0000,0xB525529D,0x562246BD,0x00000000 long 0x3FFF0000,0xB5E2CCA9,0x5F9D88CC,0x00000000 long 0x3FFF0000,0xB692CADA,0x7ACA1ADA,0x00000000 long 0x3FFF0000,0xB736AEA7,0xA6925838,0x00000000 long 0x3FFF0000,0xB7CFAB28,0x7E9F7B36,0x00000000 long 0x3FFF0000,0xB85ECC66,0xCB219835,0x00000000 long 0x3FFF0000,0xB8E4FD5A,0x20A593DA,0x00000000 long 0x3FFF0000,0xB99F41F6,0x4AFF9BB5,0x00000000 long 0x3FFF0000,0xBA7F1E17,0x842BBE7B,0x00000000 long 0x3FFF0000,0xBB471285,0x7637E17D,0x00000000 long 0x3FFF0000,0xBBFABE8A,0x4788DF6F,0x00000000 long 0x3FFF0000,0xBC9D0FAD,0x2B689D79,0x00000000 long 0x3FFF0000,0xBD306A39,0x471ECD86,0x00000000 long 0x3FFF0000,0xBDB6C731,0x856AF18A,0x00000000 long 0x3FFF0000,0xBE31CAC5,0x02E80D70,0x00000000 long 0x3FFF0000,0xBEA2D55C,0xE33194E2,0x00000000 long 0x3FFF0000,0xBF0B10B7,0xC03128F0,0x00000000 long 0x3FFF0000,0xBF6B7A18,0xDACB778D,0x00000000 long 0x3FFF0000,0xBFC4EA46,0x63FA18F6,0x00000000 long 0x3FFF0000,0xC0181BDE,0x8B89A454,0x00000000 long 0x3FFF0000,0xC065B066,0xCFBF6439,0x00000000 long 0x3FFF0000,0xC0AE345F,0x56340AE6,0x00000000 long 0x3FFF0000,0xC0F22291,0x9CB9E6A7,0x00000000 set X,FP_SCR0 set XDCARE,X+2 set XFRAC,X+4 set XFRACLO,X+8 set ATANF,FP_SCR1 set ATANFHI,ATANF+4 set ATANFLO,ATANF+8 global satan #--ENTRY POINT FOR ATAN(X), HERE X IS FINITE, NON-ZERO, AND NOT NAN'S satan: fmov.x (%a0),%fp0 # LOAD INPUT mov.l (%a0),%d1 mov.w 4(%a0),%d1 fmov.x %fp0,X(%a6) and.l &0x7FFFFFFF,%d1 cmp.l %d1,&0x3FFB8000 # |X| >= 1/16? bge.b ATANOK1 bra.w ATANSM ATANOK1: cmp.l %d1,&0x4002FFFF # |X| < 16 ? ble.b ATANMAIN bra.w ATANBIG #--THE MOST LIKELY CASE, |X| IN [1/16, 16). WE USE TABLE TECHNIQUE #--THE IDEA IS ATAN(X) = ATAN(F) + ATAN( [X-F] / [1+XF] ). #--SO IF F IS CHOSEN TO BE CLOSE TO X AND ATAN(F) IS STORED IN #--A TABLE, ALL WE NEED IS TO APPROXIMATE ATAN(U) WHERE #--U = (X-F)/(1+XF) IS SMALL (REMEMBER F IS CLOSE TO X). IT IS #--TRUE THAT A DIVIDE IS NOW NEEDED, BUT THE APPROXIMATION FOR #--ATAN(U) IS A VERY SHORT POLYNOMIAL AND THE INDEXING TO #--FETCH F AND SAVING OF REGISTERS CAN BE ALL HIDED UNDER THE #--DIVIDE. IN THE END THIS METHOD IS MUCH FASTER THAN A TRADITIONAL #--ONE. NOTE ALSO THAT THE TRADITIONAL SCHEME THAT APPROXIMATE #--ATAN(X) DIRECTLY WILL NEED TO USE A RATIONAL APPROXIMATION #--(DIVISION NEEDED) ANYWAY BECAUSE A POLYNOMIAL APPROXIMATION #--WILL INVOLVE A VERY LONG POLYNOMIAL. #--NOW WE SEE X AS +-2^K * 1.BBBBBBB....B <- 1. + 63 BITS #--WE CHOSE F TO BE +-2^K * 1.BBBB1 #--THAT IS IT MATCHES THE EXPONENT AND FIRST 5 BITS OF X, THE #--SIXTH BITS IS SET TO BE 1. SINCE K = -4, -3, ..., 3, THERE #--ARE ONLY 8 TIMES 16 = 2^7 = 128 |F|'S. SINCE ATAN(-|F|) IS #-- -ATAN(|F|), WE NEED TO STORE ONLY ATAN(|F|). ATANMAIN: and.l &0xF8000000,XFRAC(%a6) # FIRST 5 BITS or.l &0x04000000,XFRAC(%a6) # SET 6-TH BIT TO 1 mov.l &0x00000000,XFRACLO(%a6) # LOCATION OF X IS NOW F fmov.x %fp0,%fp1 # FP1 IS X fmul.x X(%a6),%fp1 # FP1 IS X*F, NOTE THAT X*F > 0 fsub.x X(%a6),%fp0 # FP0 IS X-F fadd.s &0x3F800000,%fp1 # FP1 IS 1 + X*F fdiv.x %fp1,%fp0 # FP0 IS U = (X-F)/(1+X*F) #--WHILE THE DIVISION IS TAKING ITS TIME, WE FETCH ATAN(|F|) #--CREATE ATAN(F) AND STORE IT IN ATANF, AND #--SAVE REGISTERS FP2. mov.l %d2,-(%sp) # SAVE d2 TEMPORARILY mov.l %d1,%d2 # THE EXP AND 16 BITS OF X and.l &0x00007800,%d1 # 4 VARYING BITS OF F'S FRACTION and.l &0x7FFF0000,%d2 # EXPONENT OF F sub.l &0x3FFB0000,%d2 # K+4 asr.l &1,%d2 add.l %d2,%d1 # THE 7 BITS IDENTIFYING F asr.l &7,%d1 # INDEX INTO TBL OF ATAN(|F|) lea ATANTBL(%pc),%a1 add.l %d1,%a1 # ADDRESS OF ATAN(|F|) mov.l (%a1)+,ATANF(%a6) mov.l (%a1)+,ATANFHI(%a6) mov.l (%a1)+,ATANFLO(%a6) # ATANF IS NOW ATAN(|F|) mov.l X(%a6),%d1 # LOAD SIGN AND EXPO. AGAIN and.l &0x80000000,%d1 # SIGN(F) or.l %d1,ATANF(%a6) # ATANF IS NOW SIGN(F)*ATAN(|F|) mov.l (%sp)+,%d2 # RESTORE d2 #--THAT'S ALL I HAVE TO DO FOR NOW, #--BUT ALAS, THE DIVIDE IS STILL CRANKING! #--U IN FP0, WE ARE NOW READY TO COMPUTE ATAN(U) AS #--U + A1*U*V*(A2 + V*(A3 + V)), V = U*U #--THE POLYNOMIAL MAY LOOK STRANGE, BUT IS NEVERTHELESS CORRECT. #--THE NATURAL FORM IS U + U*V*(A1 + V*(A2 + V*A3)) #--WHAT WE HAVE HERE IS MERELY A1 = A3, A2 = A1/A3, A3 = A2/A3. #--THE REASON FOR THIS REARRANGEMENT IS TO MAKE THE INDEPENDENT #--PARTS A1*U*V AND (A2 + ... STUFF) MORE LOAD-BALANCED fmovm.x &0x04,-(%sp) # save fp2 fmov.x %fp0,%fp1 fmul.x %fp1,%fp1 fmov.d ATANA3(%pc),%fp2 fadd.x %fp1,%fp2 # A3+V fmul.x %fp1,%fp2 # V*(A3+V) fmul.x %fp0,%fp1 # U*V fadd.d ATANA2(%pc),%fp2 # A2+V*(A3+V) fmul.d ATANA1(%pc),%fp1 # A1*U*V fmul.x %fp2,%fp1 # A1*U*V*(A2+V*(A3+V)) fadd.x %fp1,%fp0 # ATAN(U), FP1 RELEASED fmovm.x (%sp)+,&0x20 # restore fp2 fmov.l %d0,%fpcr # restore users rnd mode,prec fadd.x ATANF(%a6),%fp0 # ATAN(X) bra t_inx2 ATANBORS: #--|X| IS IN d0 IN COMPACT FORM. FP1, d0 SAVED. #--FP0 IS X AND |X| <= 1/16 OR |X| >= 16. cmp.l %d1,&0x3FFF8000 bgt.w ATANBIG # I.E. |X| >= 16 ATANSM: #--|X| <= 1/16 #--IF |X| < 2^(-40), RETURN X AS ANSWER. OTHERWISE, APPROXIMATE #--ATAN(X) BY X + X*Y*(B1+Y*(B2+Y*(B3+Y*(B4+Y*(B5+Y*B6))))) #--WHICH IS X + X*Y*( [B1+Z*(B3+Z*B5)] + [Y*(B2+Z*(B4+Z*B6)] ) #--WHERE Y = X*X, AND Z = Y*Y. cmp.l %d1,&0x3FD78000 blt.w ATANTINY #--COMPUTE POLYNOMIAL fmovm.x &0x0c,-(%sp) # save fp2/fp3 fmul.x %fp0,%fp0 # FPO IS Y = X*X fmov.x %fp0,%fp1 fmul.x %fp1,%fp1 # FP1 IS Z = Y*Y fmov.d ATANB6(%pc),%fp2 fmov.d ATANB5(%pc),%fp3 fmul.x %fp1,%fp2 # Z*B6 fmul.x %fp1,%fp3 # Z*B5 fadd.d ATANB4(%pc),%fp2 # B4+Z*B6 fadd.d ATANB3(%pc),%fp3 # B3+Z*B5 fmul.x %fp1,%fp2 # Z*(B4+Z*B6) fmul.x %fp3,%fp1 # Z*(B3+Z*B5) fadd.d ATANB2(%pc),%fp2 # B2+Z*(B4+Z*B6) fadd.d ATANB1(%pc),%fp1 # B1+Z*(B3+Z*B5) fmul.x %fp0,%fp2 # Y*(B2+Z*(B4+Z*B6)) fmul.x X(%a6),%fp0 # X*Y fadd.x %fp2,%fp1 # [B1+Z*(B3+Z*B5)]+[Y*(B2+Z*(B4+Z*B6))] fmul.x %fp1,%fp0 # X*Y*([B1+Z*(B3+Z*B5)]+[Y*(B2+Z*(B4+Z*B6))]) fmovm.x (%sp)+,&0x30 # restore fp2/fp3 fmov.l %d0,%fpcr # restore users rnd mode,prec fadd.x X(%a6),%fp0 bra t_inx2 ATANTINY: #--|X| < 2^(-40), ATAN(X) = X fmov.l %d0,%fpcr # restore users rnd mode,prec mov.b &FMOV_OP,%d1 # last inst is MOVE fmov.x X(%a6),%fp0 # last inst - possible exception set bra t_catch ATANBIG: #--IF |X| > 2^(100), RETURN SIGN(X)*(PI/2 - TINY). OTHERWISE, #--RETURN SIGN(X)*PI/2 + ATAN(-1/X). cmp.l %d1,&0x40638000 bgt.w ATANHUGE #--APPROXIMATE ATAN(-1/X) BY #--X'+X'*Y*(C1+Y*(C2+Y*(C3+Y*(C4+Y*C5)))), X' = -1/X, Y = X'*X' #--THIS CAN BE RE-WRITTEN AS #--X'+X'*Y*( [C1+Z*(C3+Z*C5)] + [Y*(C2+Z*C4)] ), Z = Y*Y. fmovm.x &0x0c,-(%sp) # save fp2/fp3 fmov.s &0xBF800000,%fp1 # LOAD -1 fdiv.x %fp0,%fp1 # FP1 IS -1/X #--DIVIDE IS STILL CRANKING fmov.x %fp1,%fp0 # FP0 IS X' fmul.x %fp0,%fp0 # FP0 IS Y = X'*X' fmov.x %fp1,X(%a6) # X IS REALLY X' fmov.x %fp0,%fp1 fmul.x %fp1,%fp1 # FP1 IS Z = Y*Y fmov.d ATANC5(%pc),%fp3 fmov.d ATANC4(%pc),%fp2 fmul.x %fp1,%fp3 # Z*C5 fmul.x %fp1,%fp2 # Z*B4 fadd.d ATANC3(%pc),%fp3 # C3+Z*C5 fadd.d ATANC2(%pc),%fp2 # C2+Z*C4 fmul.x %fp3,%fp1 # Z*(C3+Z*C5), FP3 RELEASED fmul.x %fp0,%fp2 # Y*(C2+Z*C4) fadd.d ATANC1(%pc),%fp1 # C1+Z*(C3+Z*C5) fmul.x X(%a6),%fp0 # X'*Y fadd.x %fp2,%fp1 # [Y*(C2+Z*C4)]+[C1+Z*(C3+Z*C5)] fmul.x %fp1,%fp0 # X'*Y*([B1+Z*(B3+Z*B5)] # ... +[Y*(B2+Z*(B4+Z*B6))]) fadd.x X(%a6),%fp0 fmovm.x (%sp)+,&0x30 # restore fp2/fp3 fmov.l %d0,%fpcr # restore users rnd mode,prec tst.b (%a0) bpl.b pos_big neg_big: fadd.x NPIBY2(%pc),%fp0 bra t_minx2 pos_big: fadd.x PPIBY2(%pc),%fp0 bra t_pinx2 ATANHUGE: #--RETURN SIGN(X)*(PIBY2 - TINY) = SIGN(X)*PIBY2 - SIGN(X)*TINY tst.b (%a0) bpl.b pos_huge neg_huge: fmov.x NPIBY2(%pc),%fp0 fmov.l %d0,%fpcr fadd.x PTINY(%pc),%fp0 bra t_minx2 pos_huge: fmov.x PPIBY2(%pc),%fp0 fmov.l %d0,%fpcr fadd.x NTINY(%pc),%fp0 bra t_pinx2 global satand #--ENTRY POINT FOR ATAN(X) FOR DENORMALIZED ARGUMENT satand: bra t_extdnrm ######################################################################### # sasin(): computes the inverse sine of a normalized input # # sasind(): computes the inverse sine of a denormalized input # # # # INPUT *************************************************************** # # a0 = pointer to extended precision input # # d0 = round precision,mode # # # # OUTPUT ************************************************************** # # fp0 = arcsin(X) # # # # ACCURACY and MONOTONICITY ******************************************* # # The returned result is within 3 ulps in 64 significant bit, # # i.e. within 0.5001 ulp to 53 bits if the result is subsequently # # rounded to double precision. The result is provably monotonic # # in double precision. # # # # ALGORITHM *********************************************************** # # # # ASIN # # 1. If |X| >= 1, go to 3. # # # # 2. (|X| < 1) Calculate asin(X) by # # z := sqrt( [1-X][1+X] ) # # asin(X) = atan( x / z ). # # Exit. # # # # 3. If |X| > 1, go to 5. # # # # 4. (|X| = 1) sgn := sign(X), return asin(X) := sgn * Pi/2. Exit.# # # # 5. (|X| > 1) Generate an invalid operation by 0 * infinity. # # Exit. # # # ######################################################################### global sasin sasin: fmov.x (%a0),%fp0 # LOAD INPUT mov.l (%a0),%d1 mov.w 4(%a0),%d1 and.l &0x7FFFFFFF,%d1 cmp.l %d1,&0x3FFF8000 bge.b ASINBIG # This catch is added here for the '060 QSP. Originally, the call to # satan() would handle this case by causing the exception which would # not be caught until gen_except(). Now, with the exceptions being # detected inside of satan(), the exception would have been handled there # instead of inside sasin() as expected. cmp.l %d1,&0x3FD78000 blt.w ASINTINY #--THIS IS THE USUAL CASE, |X| < 1 #--ASIN(X) = ATAN( X / SQRT( (1-X)(1+X) ) ) ASINMAIN: fmov.s &0x3F800000,%fp1 fsub.x %fp0,%fp1 # 1-X fmovm.x &0x4,-(%sp) # {fp2} fmov.s &0x3F800000,%fp2 fadd.x %fp0,%fp2 # 1+X fmul.x %fp2,%fp1 # (1+X)(1-X) fmovm.x (%sp)+,&0x20 # {fp2} fsqrt.x %fp1 # SQRT([1-X][1+X]) fdiv.x %fp1,%fp0 # X/SQRT([1-X][1+X]) fmovm.x &0x01,-(%sp) # save X/SQRT(...) lea (%sp),%a0 # pass ptr to X/SQRT(...) bsr satan add.l &0xc,%sp # clear X/SQRT(...) from stack bra t_inx2 ASINBIG: fabs.x %fp0 # |X| fcmp.s %fp0,&0x3F800000 fbgt t_operr # cause an operr exception #--|X| = 1, ASIN(X) = +- PI/2. ASINONE: fmov.x PIBY2(%pc),%fp0 mov.l (%a0),%d1 and.l &0x80000000,%d1 # SIGN BIT OF X or.l &0x3F800000,%d1 # +-1 IN SGL FORMAT mov.l %d1,-(%sp) # push SIGN(X) IN SGL-FMT fmov.l %d0,%fpcr fmul.s (%sp)+,%fp0 bra t_inx2 #--|X| < 2^(-40), ATAN(X) = X ASINTINY: fmov.l %d0,%fpcr # restore users rnd mode,prec mov.b &FMOV_OP,%d1 # last inst is MOVE fmov.x (%a0),%fp0 # last inst - possible exception bra t_catch global sasind #--ASIN(X) = X FOR DENORMALIZED X sasind: bra t_extdnrm ######################################################################### # sacos(): computes the inverse cosine of a normalized input # # sacosd(): computes the inverse cosine of a denormalized input # # # # INPUT *************************************************************** # # a0 = pointer to extended precision input # # d0 = round precision,mode # # # # OUTPUT ************************************************************** # # fp0 = arccos(X) # # # # ACCURACY and MONOTONICITY ******************************************* # # The returned result is within 3 ulps in 64 significant bit, # # i.e. within 0.5001 ulp to 53 bits if the result is subsequently # # rounded to double precision. The result is provably monotonic # # in double precision. # # # # ALGORITHM *********************************************************** # # # # ACOS # # 1. If |X| >= 1, go to 3. # # # # 2. (|X| < 1) Calculate acos(X) by # # z := (1-X) / (1+X) # # acos(X) = 2 * atan( sqrt(z) ). # # Exit. # # # # 3. If |X| > 1, go to 5. # # # # 4. (|X| = 1) If X > 0, return 0. Otherwise, return Pi. Exit. # # # # 5. (|X| > 1) Generate an invalid operation by 0 * infinity. # # Exit. # # # ######################################################################### global sacos sacos: fmov.x (%a0),%fp0 # LOAD INPUT mov.l (%a0),%d1 # pack exp w/ upper 16 fraction mov.w 4(%a0),%d1 and.l &0x7FFFFFFF,%d1 cmp.l %d1,&0x3FFF8000 bge.b ACOSBIG #--THIS IS THE USUAL CASE, |X| < 1 #--ACOS(X) = 2 * ATAN( SQRT( (1-X)/(1+X) ) ) ACOSMAIN: fmov.s &0x3F800000,%fp1 fadd.x %fp0,%fp1 # 1+X fneg.x %fp0 # -X fadd.s &0x3F800000,%fp0 # 1-X fdiv.x %fp1,%fp0 # (1-X)/(1+X) fsqrt.x %fp0 # SQRT((1-X)/(1+X)) mov.l %d0,-(%sp) # save original users fpcr clr.l %d0 fmovm.x &0x01,-(%sp) # save SQRT(...) to stack lea (%sp),%a0 # pass ptr to sqrt bsr satan # ATAN(SQRT([1-X]/[1+X])) add.l &0xc,%sp # clear SQRT(...) from stack fmov.l (%sp)+,%fpcr # restore users round prec,mode fadd.x %fp0,%fp0 # 2 * ATAN( STUFF ) bra t_pinx2 ACOSBIG: fabs.x %fp0 fcmp.s %fp0,&0x3F800000 fbgt t_operr # cause an operr exception #--|X| = 1, ACOS(X) = 0 OR PI tst.b (%a0) # is X positive or negative? bpl.b ACOSP1 #--X = -1 #Returns PI and inexact exception ACOSM1: fmov.x PI(%pc),%fp0 # load PI fmov.l %d0,%fpcr # load round mode,prec fadd.s &0x00800000,%fp0 # add a small value bra t_pinx2 ACOSP1: bra ld_pzero # answer is positive zero global sacosd #--ACOS(X) = PI/2 FOR DENORMALIZED X sacosd: fmov.l %d0,%fpcr # load user's rnd mode/prec fmov.x PIBY2(%pc),%fp0 bra t_pinx2 ######################################################################### # setox(): computes the exponential for a normalized input # # setoxd(): computes the exponential for a denormalized input # # setoxm1(): computes the exponential minus 1 for a normalized input # # setoxm1d(): computes the exponential minus 1 for a denormalized input # # # # INPUT *************************************************************** # # a0 = pointer to extended precision input # # d0 = round precision,mode # # # # OUTPUT ************************************************************** # # fp0 = exp(X) or exp(X)-1 # # # # ACCURACY and MONOTONICITY ******************************************* # # The returned result is within 0.85 ulps in 64 significant bit, # # i.e. within 0.5001 ulp to 53 bits if the result is subsequently # # rounded to double precision. The result is provably monotonic # # in double precision. # # # # ALGORITHM and IMPLEMENTATION **************************************** # # # # setoxd # # ------ # # Step 1. Set ans := 1.0 # # # # Step 2. Return ans := ans + sign(X)*2^(-126). Exit. # # Notes: This will always generate one exception -- inexact. # # # # # # setox # # ----- # # # # Step 1. Filter out extreme cases of input argument. # # 1.1 If |X| >= 2^(-65), go to Step 1.3. # # 1.2 Go to Step 7. # # 1.3 If |X| < 16380 log(2), go to Step 2. # # 1.4 Go to Step 8. # # Notes: The usual case should take the branches 1.1 -> 1.3 -> 2.# # To avoid the use of floating-point comparisons, a # # compact representation of |X| is used. This format is a # # 32-bit integer, the upper (more significant) 16 bits # # are the sign and biased exponent field of |X|; the # # lower 16 bits are the 16 most significant fraction # # (including the explicit bit) bits of |X|. Consequently, # # the comparisons in Steps 1.1 and 1.3 can be performed # # by integer comparison. Note also that the constant # # 16380 log(2) used in Step 1.3 is also in the compact # # form. Thus taking the branch to Step 2 guarantees # # |X| < 16380 log(2). There is no harm to have a small # # number of cases where |X| is less than, but close to, # # 16380 log(2) and the branch to Step 9 is taken. # # # # Step 2. Calculate N = round-to-nearest-int( X * 64/log2 ). # # 2.1 Set AdjFlag := 0 (indicates the branch 1.3 -> 2 # # was taken) # # 2.2 N := round-to-nearest-integer( X * 64/log2 ). # # 2.3 Calculate J = N mod 64; so J = 0,1,2,..., # # or 63. # # 2.4 Calculate M = (N - J)/64; so N = 64M + J. # # 2.5 Calculate the address of the stored value of # # 2^(J/64). # # 2.6 Create the value Scale = 2^M. # # Notes: The calculation in 2.2 is really performed by # # Z := X * constant # # N := round-to-nearest-integer(Z) # # where # # constant := single-precision( 64/log 2 ). # # # # Using a single-precision constant avoids memory # # access. Another effect of using a single-precision # # "constant" is that the calculated value Z is # # # # Z = X*(64/log2)*(1+eps), |eps| <= 2^(-24). # # # # This error has to be considered later in Steps 3 and 4. # # # # Step 3. Calculate X - N*log2/64. # # 3.1 R := X + N*L1, # # where L1 := single-precision(-log2/64). # # 3.2 R := R + N*L2, # # L2 := extended-precision(-log2/64 - L1).# # Notes: a) The way L1 and L2 are chosen ensures L1+L2 # # approximate the value -log2/64 to 88 bits of accuracy. # # b) N*L1 is exact because N is no longer than 22 bits # # and L1 is no longer than 24 bits. # # c) The calculation X+N*L1 is also exact due to # # cancellation. Thus, R is practically X+N(L1+L2) to full # # 64 bits. # # d) It is important to estimate how large can |R| be # # after Step 3.2. # # # # N = rnd-to-int( X*64/log2 (1+eps) ), |eps|<=2^(-24) # # X*64/log2 (1+eps) = N + f, |f| <= 0.5 # # X*64/log2 - N = f - eps*X 64/log2 # # X - N*log2/64 = f*log2/64 - eps*X # # # # # # Now |X| <= 16446 log2, thus # # # # |X - N*log2/64| <= (0.5 + 16446/2^(18))*log2/64 # # <= 0.57 log2/64. # # This bound will be used in Step 4. # # # # Step 4. Approximate exp(R)-1 by a polynomial # # p = R + R*R*(A1 + R*(A2 + R*(A3 + R*(A4 + R*A5)))) # # Notes: a) In order to reduce memory access, the coefficients # # are made as "short" as possible: A1 (which is 1/2), A4 # # and A5 are single precision; A2 and A3 are double # # precision. # # b) Even with the restrictions above, # # |p - (exp(R)-1)| < 2^(-68.8) for all |R| <= 0.0062. # # Note that 0.0062 is slightly bigger than 0.57 log2/64. # # c) To fully utilize the pipeline, p is separated into # # two independent pieces of roughly equal complexities # # p = [ R + R*S*(A2 + S*A4) ] + # # [ S*(A1 + S*(A3 + S*A5)) ] # # where S = R*R. # # # # Step 5. Compute 2^(J/64)*exp(R) = 2^(J/64)*(1+p) by # # ans := T + ( T*p + t) # # where T and t are the stored values for 2^(J/64). # # Notes: 2^(J/64) is stored as T and t where T+t approximates # # 2^(J/64) to roughly 85 bits; T is in extended precision # # and t is in single precision. Note also that T is # # rounded to 62 bits so that the last two bits of T are # # zero. The reason for such a special form is that T-1, # # T-2, and T-8 will all be exact --- a property that will # # give much more accurate computation of the function # # EXPM1. # # # # Step 6. Reconstruction of exp(X) # # exp(X) = 2^M * 2^(J/64) * exp(R). # # 6.1 If AdjFlag = 0, go to 6.3 # # 6.2 ans := ans * AdjScale # # 6.3 Restore the user FPCR # # 6.4 Return ans := ans * Scale. Exit. # # Notes: If AdjFlag = 0, we have X = Mlog2 + Jlog2/64 + R, # # |M| <= 16380, and Scale = 2^M. Moreover, exp(X) will # # neither overflow nor underflow. If AdjFlag = 1, that # # means that # # X = (M1+M)log2 + Jlog2/64 + R, |M1+M| >= 16380. # # Hence, exp(X) may overflow or underflow or neither. # # When that is the case, AdjScale = 2^(M1) where M1 is # # approximately M. Thus 6.2 will never cause # # over/underflow. Possible exception in 6.4 is overflow # # or underflow. The inexact exception is not generated in # # 6.4. Although one can argue that the inexact flag # # should always be raised, to simulate that exception # # cost to much than the flag is worth in practical uses. # # # # Step 7. Return 1 + X. # # 7.1 ans := X # # 7.2 Restore user FPCR. # # 7.3 Return ans := 1 + ans. Exit # # Notes: For non-zero X, the inexact exception will always be # # raised by 7.3. That is the only exception raised by 7.3.# # Note also that we use the FMOVEM instruction to move X # # in Step 7.1 to avoid unnecessary trapping. (Although # # the FMOVEM may not seem relevant since X is normalized, # # the precaution will be useful in the library version of # # this code where the separate entry for denormalized # # inputs will be done away with.) # # # # Step 8. Handle exp(X) where |X| >= 16380log2. # # 8.1 If |X| > 16480 log2, go to Step 9. # # (mimic 2.2 - 2.6) # # 8.2 N := round-to-integer( X * 64/log2 ) # # 8.3 Calculate J = N mod 64, J = 0,1,...,63 # # 8.4 K := (N-J)/64, M1 := truncate(K/2), M = K-M1, # # AdjFlag := 1. # # 8.5 Calculate the address of the stored value # # 2^(J/64). # # 8.6 Create the values Scale = 2^M, AdjScale = 2^M1. # # 8.7 Go to Step 3. # # Notes: Refer to notes for 2.2 - 2.6. # # # # Step 9. Handle exp(X), |X| > 16480 log2. # # 9.1 If X < 0, go to 9.3 # # 9.2 ans := Huge, go to 9.4 # # 9.3 ans := Tiny. # # 9.4 Restore user FPCR. # # 9.5 Return ans := ans * ans. Exit. # # Notes: Exp(X) will surely overflow or underflow, depending on # # X's sign. "Huge" and "Tiny" are respectively large/tiny # # extended-precision numbers whose square over/underflow # # with an inexact result. Thus, 9.5 always raises the # # inexact together with either overflow or underflow. # # # # setoxm1d # # -------- # # # # Step 1. Set ans := 0 # # # # Step 2. Return ans := X + ans. Exit. # # Notes: This will return X with the appropriate rounding # # precision prescribed by the user FPCR. # # # # setoxm1 # # ------- # # # # Step 1. Check |X| # # 1.1 If |X| >= 1/4, go to Step 1.3. # # 1.2 Go to Step 7. # # 1.3 If |X| < 70 log(2), go to Step 2. # # 1.4 Go to Step 10. # # Notes: The usual case should take the branches 1.1 -> 1.3 -> 2.# # However, it is conceivable |X| can be small very often # # because EXPM1 is intended to evaluate exp(X)-1 # # accurately when |X| is small. For further details on # # the comparisons, see the notes on Step 1 of setox. # # # # Step 2. Calculate N = round-to-nearest-int( X * 64/log2 ). # # 2.1 N := round-to-nearest-integer( X * 64/log2 ). # # 2.2 Calculate J = N mod 64; so J = 0,1,2,..., # # or 63. # # 2.3 Calculate M = (N - J)/64; so N = 64M + J. # # 2.4 Calculate the address of the stored value of # # 2^(J/64). # # 2.5 Create the values Sc = 2^M and # # OnebySc := -2^(-M). # # Notes: See the notes on Step 2 of setox. # # # # Step 3. Calculate X - N*log2/64. # # 3.1 R := X + N*L1, # # where L1 := single-precision(-log2/64). # # 3.2 R := R + N*L2, # # L2 := extended-precision(-log2/64 - L1).# # Notes: Applying the analysis of Step 3 of setox in this case # # shows that |R| <= 0.0055 (note that |X| <= 70 log2 in # # this case). # # # # Step 4. Approximate exp(R)-1 by a polynomial # # p = R+R*R*(A1+R*(A2+R*(A3+R*(A4+R*(A5+R*A6))))) # # Notes: a) In order to reduce memory access, the coefficients # # are made as "short" as possible: A1 (which is 1/2), A5 # # and A6 are single precision; A2, A3 and A4 are double # # precision. # # b) Even with the restriction above, # # |p - (exp(R)-1)| < |R| * 2^(-72.7) # # for all |R| <= 0.0055. # # c) To fully utilize the pipeline, p is separated into # # two independent pieces of roughly equal complexity # # p = [ R*S*(A2 + S*(A4 + S*A6)) ] + # # [ R + S*(A1 + S*(A3 + S*A5)) ] # # where S = R*R. # # # # Step 5. Compute 2^(J/64)*p by # # p := T*p # # where T and t are the stored values for 2^(J/64). # # Notes: 2^(J/64) is stored as T and t where T+t approximates # # 2^(J/64) to roughly 85 bits; T is in extended precision # # and t is in single precision. Note also that T is # # rounded to 62 bits so that the last two bits of T are # # zero. The reason for such a special form is that T-1, # # T-2, and T-8 will all be exact --- a property that will # # be exploited in Step 6 below. The total relative error # # in p is no bigger than 2^(-67.7) compared to the final # # result. # # # # Step 6. Reconstruction of exp(X)-1 # # exp(X)-1 = 2^M * ( 2^(J/64) + p - 2^(-M) ). # # 6.1 If M <= 63, go to Step 6.3. # # 6.2 ans := T + (p + (t + OnebySc)). Go to 6.6 # # 6.3 If M >= -3, go to 6.5. # # 6.4 ans := (T + (p + t)) + OnebySc. Go to 6.6 # # 6.5 ans := (T + OnebySc) + (p + t). # # 6.6 Restore user FPCR. # # 6.7 Return ans := Sc * ans. Exit. # # Notes: The various arrangements of the expressions give # # accurate evaluations. # # # # Step 7. exp(X)-1 for |X| < 1/4. # # 7.1 If |X| >= 2^(-65), go to Step 9. # # 7.2 Go to Step 8. # # # # Step 8. Calculate exp(X)-1, |X| < 2^(-65). # # 8.1 If |X| < 2^(-16312), goto 8.3 # # 8.2 Restore FPCR; return ans := X - 2^(-16382). # # Exit. # # 8.3 X := X * 2^(140). # # 8.4 Restore FPCR; ans := ans - 2^(-16382). # # Return ans := ans*2^(140). Exit # # Notes: The idea is to return "X - tiny" under the user # # precision and rounding modes. To avoid unnecessary # # inefficiency, we stay away from denormalized numbers # # the best we can. For |X| >= 2^(-16312), the # # straightforward 8.2 generates the inexact exception as # # the case warrants. # # # # Step 9. Calculate exp(X)-1, |X| < 1/4, by a polynomial # # p = X + X*X*(B1 + X*(B2 + ... + X*B12)) # # Notes: a) In order to reduce memory access, the coefficients # # are made as "short" as possible: B1 (which is 1/2), B9 # # to B12 are single precision; B3 to B8 are double # # precision; and B2 is double extended. # # b) Even with the restriction above, # # |p - (exp(X)-1)| < |X| 2^(-70.6) # # for all |X| <= 0.251. # # Note that 0.251 is slightly bigger than 1/4. # # c) To fully preserve accuracy, the polynomial is # # computed as # # X + ( S*B1 + Q ) where S = X*X and # # Q = X*S*(B2 + X*(B3 + ... + X*B12)) # # d) To fully utilize the pipeline, Q is separated into # # two independent pieces of roughly equal complexity # # Q = [ X*S*(B2 + S*(B4 + ... + S*B12)) ] + # # [ S*S*(B3 + S*(B5 + ... + S*B11)) ] # # # # Step 10. Calculate exp(X)-1 for |X| >= 70 log 2. # # 10.1 If X >= 70log2 , exp(X) - 1 = exp(X) for all # # practical purposes. Therefore, go to Step 1 of setox. # # 10.2 If X <= -70log2, exp(X) - 1 = -1 for all practical # # purposes. # # ans := -1 # # Restore user FPCR # # Return ans := ans + 2^(-126). Exit. # # Notes: 10.2 will always create an inexact and return -1 + tiny # # in the user rounding precision and mode. # # # ######################################################################### L2: long 0x3FDC0000,0x82E30865,0x4361C4C6,0x00000000 EEXPA3: long 0x3FA55555,0x55554CC1 EEXPA2: long 0x3FC55555,0x55554A54 EM1A4: long 0x3F811111,0x11174385 EM1A3: long 0x3FA55555,0x55554F5A EM1A2: long 0x3FC55555,0x55555555,0x00000000,0x00000000 EM1B8: long 0x3EC71DE3,0xA5774682 EM1B7: long 0x3EFA01A0,0x19D7CB68 EM1B6: long 0x3F2A01A0,0x1A019DF3 EM1B5: long 0x3F56C16C,0x16C170E2 EM1B4: long 0x3F811111,0x11111111 EM1B3: long 0x3FA55555,0x55555555 EM1B2: long 0x3FFC0000,0xAAAAAAAA,0xAAAAAAAB long 0x00000000 TWO140: long 0x48B00000,0x00000000 TWON140: long 0x37300000,0x00000000 EEXPTBL: long 0x3FFF0000,0x80000000,0x00000000,0x00000000 long 0x3FFF0000,0x8164D1F3,0xBC030774,0x9F841A9B long 0x3FFF0000,0x82CD8698,0xAC2BA1D8,0x9FC1D5B9 long 0x3FFF0000,0x843A28C3,0xACDE4048,0xA0728369 long 0x3FFF0000,0x85AAC367,0xCC487B14,0x1FC5C95C long 0x3FFF0000,0x871F6196,0x9E8D1010,0x1EE85C9F long 0x3FFF0000,0x88980E80,0x92DA8528,0x9FA20729 long 0x3FFF0000,0x8A14D575,0x496EFD9C,0xA07BF9AF long 0x3FFF0000,0x8B95C1E3,0xEA8BD6E8,0xA0020DCF long 0x3FFF0000,0x8D1ADF5B,0x7E5BA9E4,0x205A63DA long 0x3FFF0000,0x8EA4398B,0x45CD53C0,0x1EB70051 long 0x3FFF0000,0x9031DC43,0x1466B1DC,0x1F6EB029 long 0x3FFF0000,0x91C3D373,0xAB11C338,0xA0781494 long 0x3FFF0000,0x935A2B2F,0x13E6E92C,0x9EB319B0 long 0x3FFF0000,0x94F4EFA8,0xFEF70960,0x2017457D long 0x3FFF0000,0x96942D37,0x20185A00,0x1F11D537 long 0x3FFF0000,0x9837F051,0x8DB8A970,0x9FB952DD long 0x3FFF0000,0x99E04593,0x20B7FA64,0x1FE43087 long 0x3FFF0000,0x9B8D39B9,0xD54E5538,0x1FA2A818 long 0x3FFF0000,0x9D3ED9A7,0x2CFFB750,0x1FDE494D long 0x3FFF0000,0x9EF53260,0x91A111AC,0x20504890 long 0x3FFF0000,0xA0B0510F,0xB9714FC4,0xA073691C long 0x3FFF0000,0xA2704303,0x0C496818,0x1F9B7A05 long 0x3FFF0000,0xA43515AE,0x09E680A0,0xA0797126 long 0x3FFF0000,0xA5FED6A9,0xB15138EC,0xA071A140 long 0x3FFF0000,0xA7CD93B4,0xE9653568,0x204F62DA long 0x3FFF0000,0xA9A15AB4,0xEA7C0EF8,0x1F283C4A long 0x3FFF0000,0xAB7A39B5,0xA93ED338,0x9F9A7FDC long 0x3FFF0000,0xAD583EEA,0x42A14AC8,0xA05B3FAC long 0x3FFF0000,0xAF3B78AD,0x690A4374,0x1FDF2610 long 0x3FFF0000,0xB123F581,0xD2AC2590,0x9F705F90 long 0x3FFF0000,0xB311C412,0xA9112488,0x201F678A long 0x3FFF0000,0xB504F333,0xF9DE6484,0x1F32FB13 long 0x3FFF0000,0xB6FD91E3,0x28D17790,0x20038B30 long 0x3FFF0000,0xB8FBAF47,0x62FB9EE8,0x200DC3CC long 0x3FFF0000,0xBAFF5AB2,0x133E45FC,0x9F8B2AE6 long 0x3FFF0000,0xBD08A39F,0x580C36C0,0xA02BBF70 long 0x3FFF0000,0xBF1799B6,0x7A731084,0xA00BF518 long 0x3FFF0000,0xC12C4CCA,0x66709458,0xA041DD41 long 0x3FFF0000,0xC346CCDA,0x24976408,0x9FDF137B long 0x3FFF0000,0xC5672A11,0x5506DADC,0x201F1568 long 0x3FFF0000,0xC78D74C8,0xABB9B15C,0x1FC13A2E long 0x3FFF0000,0xC9B9BD86,0x6E2F27A4,0xA03F8F03 long 0x3FFF0000,0xCBEC14FE,0xF2727C5C,0x1FF4907D long 0x3FFF0000,0xCE248C15,0x1F8480E4,0x9E6E53E4 long 0x3FFF0000,0xD06333DA,0xEF2B2594,0x1FD6D45C long 0x3FFF0000,0xD2A81D91,0xF12AE45C,0xA076EDB9 long 0x3FFF0000,0xD4F35AAB,0xCFEDFA20,0x9FA6DE21 long 0x3FFF0000,0xD744FCCA,0xD69D6AF4,0x1EE69A2F long 0x3FFF0000,0xD99D15C2,0x78AFD7B4,0x207F439F long 0x3FFF0000,0xDBFBB797,0xDAF23754,0x201EC207 long 0x3FFF0000,0xDE60F482,0x5E0E9124,0x9E8BE175 long 0x3FFF0000,0xE0CCDEEC,0x2A94E110,0x20032C4B long 0x3FFF0000,0xE33F8972,0xBE8A5A50,0x2004DFF5 long 0x3FFF0000,0xE5B906E7,0x7C8348A8,0x1E72F47A long 0x3FFF0000,0xE8396A50,0x3C4BDC68,0x1F722F22 long 0x3FFF0000,0xEAC0C6E7,0xDD243930,0xA017E945 long 0x3FFF0000,0xED4F301E,0xD9942B84,0x1F401A5B long 0x3FFF0000,0xEFE4B99B,0xDCDAF5CC,0x9FB9A9E3 long 0x3FFF0000,0xF281773C,0x59FFB138,0x20744C05 long 0x3FFF0000,0xF5257D15,0x2486CC2C,0x1F773A19 long 0x3FFF0000,0xF7D0DF73,0x0AD13BB8,0x1FFE90D5 long 0x3FFF0000,0xFA83B2DB,0x722A033C,0xA041ED22 long 0x3FFF0000,0xFD3E0C0C,0xF486C174,0x1F853F3A set ADJFLAG,L_SCR2 set SCALE,FP_SCR0 set ADJSCALE,FP_SCR1 set SC,FP_SCR0 set ONEBYSC,FP_SCR1 global setox setox: #--entry point for EXP(X), here X is finite, non-zero, and not NaN's #--Step 1. mov.l (%a0),%d1 # load part of input X and.l &0x7FFF0000,%d1 # biased expo. of X cmp.l %d1,&0x3FBE0000 # 2^(-65) bge.b EXPC1 # normal case bra EXPSM EXPC1: #--The case |X| >= 2^(-65) mov.w 4(%a0),%d1 # expo. and partial sig. of |X| cmp.l %d1,&0x400CB167 # 16380 log2 trunc. 16 bits blt.b EXPMAIN # normal case bra EEXPBIG EXPMAIN: #--Step 2. #--This is the normal branch: 2^(-65) <= |X| < 16380 log2. fmov.x (%a0),%fp0 # load input from (a0) fmov.x %fp0,%fp1 fmul.s &0x42B8AA3B,%fp0 # 64/log2 * X fmovm.x &0xc,-(%sp) # save fp2 {%fp2/%fp3} mov.l &0,ADJFLAG(%a6) fmov.l %fp0,%d1 # N = int( X * 64/log2 ) lea EEXPTBL(%pc),%a1 fmov.l %d1,%fp0 # convert to floating-format mov.l %d1,L_SCR1(%a6) # save N temporarily and.l &0x3F,%d1 # D0 is J = N mod 64 lsl.l &4,%d1 add.l %d1,%a1 # address of 2^(J/64) mov.l L_SCR1(%a6),%d1 asr.l &6,%d1 # D0 is M add.w &0x3FFF,%d1 # biased expo. of 2^(M) mov.w L2(%pc),L_SCR1(%a6) # prefetch L2, no need in CB EXPCONT1: #--Step 3. #--fp1,fp2 saved on the stack. fp0 is N, fp1 is X, #--a0 points to 2^(J/64), D0 is biased expo. of 2^(M) fmov.x %fp0,%fp2 fmul.s &0xBC317218,%fp0 # N * L1, L1 = lead(-log2/64) fmul.x L2(%pc),%fp2 # N * L2, L1+L2 = -log2/64 fadd.x %fp1,%fp0 # X + N*L1 fadd.x %fp2,%fp0 # fp0 is R, reduced arg. #--Step 4. #--WE NOW COMPUTE EXP(R)-1 BY A POLYNOMIAL #-- R + R*R*(A1 + R*(A2 + R*(A3 + R*(A4 + R*A5)))) #--TO FULLY UTILIZE THE PIPELINE, WE COMPUTE S = R*R #--[R+R*S*(A2+S*A4)] + [S*(A1+S*(A3+S*A5))] fmov.x %fp0,%fp1 fmul.x %fp1,%fp1 # fp1 IS S = R*R fmov.s &0x3AB60B70,%fp2 # fp2 IS A5 fmul.x %fp1,%fp2 # fp2 IS S*A5 fmov.x %fp1,%fp3 fmul.s &0x3C088895,%fp3 # fp3 IS S*A4 fadd.d EEXPA3(%pc),%fp2 # fp2 IS A3+S*A5 fadd.d EEXPA2(%pc),%fp3 # fp3 IS A2+S*A4 fmul.x %fp1,%fp2 # fp2 IS S*(A3+S*A5) mov.w %d1,SCALE(%a6) # SCALE is 2^(M) in extended mov.l &0x80000000,SCALE+4(%a6) clr.l SCALE+8(%a6) fmul.x %fp1,%fp3 # fp3 IS S*(A2+S*A4) fadd.s &0x3F000000,%fp2 # fp2 IS A1+S*(A3+S*A5) fmul.x %fp0,%fp3 # fp3 IS R*S*(A2+S*A4) fmul.x %fp1,%fp2 # fp2 IS S*(A1+S*(A3+S*A5)) fadd.x %fp3,%fp0 # fp0 IS R+R*S*(A2+S*A4), fmov.x (%a1)+,%fp1 # fp1 is lead. pt. of 2^(J/64) fadd.x %fp2,%fp0 # fp0 is EXP(R) - 1 #--Step 5 #--final reconstruction process #--EXP(X) = 2^M * ( 2^(J/64) + 2^(J/64)*(EXP(R)-1) ) fmul.x %fp1,%fp0 # 2^(J/64)*(Exp(R)-1) fmovm.x (%sp)+,&0x30 # fp2 restored {%fp2/%fp3} fadd.s (%a1),%fp0 # accurate 2^(J/64) fadd.x %fp1,%fp0 # 2^(J/64) + 2^(J/64)*... mov.l ADJFLAG(%a6),%d1 #--Step 6 tst.l %d1 beq.b NORMAL ADJUST: fmul.x ADJSCALE(%a6),%fp0 NORMAL: fmov.l %d0,%fpcr # restore user FPCR mov.b &FMUL_OP,%d1 # last inst is MUL fmul.x SCALE(%a6),%fp0 # multiply 2^(M) bra t_catch EXPSM: #--Step 7 fmovm.x (%a0),&0x80 # load X fmov.l %d0,%fpcr fadd.s &0x3F800000,%fp0 # 1+X in user mode bra t_pinx2 EEXPBIG: #--Step 8 cmp.l %d1,&0x400CB27C # 16480 log2 bgt.b EXP2BIG #--Steps 8.2 -- 8.6 fmov.x (%a0),%fp0 # load input from (a0) fmov.x %fp0,%fp1 fmul.s &0x42B8AA3B,%fp0 # 64/log2 * X fmovm.x &0xc,-(%sp) # save fp2 {%fp2/%fp3} mov.l &1,ADJFLAG(%a6) fmov.l %fp0,%d1 # N = int( X * 64/log2 ) lea EEXPTBL(%pc),%a1 fmov.l %d1,%fp0 # convert to floating-format mov.l %d1,L_SCR1(%a6) # save N temporarily and.l &0x3F,%d1 # D0 is J = N mod 64 lsl.l &4,%d1 add.l %d1,%a1 # address of 2^(J/64) mov.l L_SCR1(%a6),%d1 asr.l &6,%d1 # D0 is K mov.l %d1,L_SCR1(%a6) # save K temporarily asr.l &1,%d1 # D0 is M1 sub.l %d1,L_SCR1(%a6) # a1 is M add.w &0x3FFF,%d1 # biased expo. of 2^(M1) mov.w %d1,ADJSCALE(%a6) # ADJSCALE := 2^(M1) mov.l &0x80000000,ADJSCALE+4(%a6) clr.l ADJSCALE+8(%a6) mov.l L_SCR1(%a6),%d1 # D0 is M add.w &0x3FFF,%d1 # biased expo. of 2^(M) bra.w EXPCONT1 # go back to Step 3 EXP2BIG: #--Step 9 tst.b (%a0) # is X positive or negative? bmi t_unfl2 bra t_ovfl2 global setoxd setoxd: #--entry point for EXP(X), X is denormalized mov.l (%a0),-(%sp) andi.l &0x80000000,(%sp) ori.l &0x00800000,(%sp) # sign(X)*2^(-126) fmov.s &0x3F800000,%fp0 fmov.l %d0,%fpcr fadd.s (%sp)+,%fp0 bra t_pinx2 global setoxm1 setoxm1: #--entry point for EXPM1(X), here X is finite, non-zero, non-NaN #--Step 1. #--Step 1.1 mov.l (%a0),%d1 # load part of input X and.l &0x7FFF0000,%d1 # biased expo. of X cmp.l %d1,&0x3FFD0000 # 1/4 bge.b EM1CON1 # |X| >= 1/4 bra EM1SM EM1CON1: #--Step 1.3 #--The case |X| >= 1/4 mov.w 4(%a0),%d1 # expo. and partial sig. of |X| cmp.l %d1,&0x4004C215 # 70log2 rounded up to 16 bits ble.b EM1MAIN # 1/4 <= |X| <= 70log2 bra EM1BIG EM1MAIN: #--Step 2. #--This is the case: 1/4 <= |X| <= 70 log2. fmov.x (%a0),%fp0 # load input from (a0) fmov.x %fp0,%fp1 fmul.s &0x42B8AA3B,%fp0 # 64/log2 * X fmovm.x &0xc,-(%sp) # save fp2 {%fp2/%fp3} fmov.l %fp0,%d1 # N = int( X * 64/log2 ) lea EEXPTBL(%pc),%a1 fmov.l %d1,%fp0 # convert to floating-format mov.l %d1,L_SCR1(%a6) # save N temporarily and.l &0x3F,%d1 # D0 is J = N mod 64 lsl.l &4,%d1 add.l %d1,%a1 # address of 2^(J/64) mov.l L_SCR1(%a6),%d1 asr.l &6,%d1 # D0 is M mov.l %d1,L_SCR1(%a6) # save a copy of M #--Step 3. #--fp1,fp2 saved on the stack. fp0 is N, fp1 is X, #--a0 points to 2^(J/64), D0 and a1 both contain M fmov.x %fp0,%fp2 fmul.s &0xBC317218,%fp0 # N * L1, L1 = lead(-log2/64) fmul.x L2(%pc),%fp2 # N * L2, L1+L2 = -log2/64 fadd.x %fp1,%fp0 # X + N*L1 fadd.x %fp2,%fp0 # fp0 is R, reduced arg. add.w &0x3FFF,%d1 # D0 is biased expo. of 2^M #--Step 4. #--WE NOW COMPUTE EXP(R)-1 BY A POLYNOMIAL #-- R + R*R*(A1 + R*(A2 + R*(A3 + R*(A4 + R*(A5 + R*A6))))) #--TO FULLY UTILIZE THE PIPELINE, WE COMPUTE S = R*R #--[R*S*(A2+S*(A4+S*A6))] + [R+S*(A1+S*(A3+S*A5))] fmov.x %fp0,%fp1 fmul.x %fp1,%fp1 # fp1 IS S = R*R fmov.s &0x3950097B,%fp2 # fp2 IS a6 fmul.x %fp1,%fp2 # fp2 IS S*A6 fmov.x %fp1,%fp3 fmul.s &0x3AB60B6A,%fp3 # fp3 IS S*A5 fadd.d EM1A4(%pc),%fp2 # fp2 IS A4+S*A6 fadd.d EM1A3(%pc),%fp3 # fp3 IS A3+S*A5 mov.w %d1,SC(%a6) # SC is 2^(M) in extended mov.l &0x80000000,SC+4(%a6) clr.l SC+8(%a6) fmul.x %fp1,%fp2 # fp2 IS S*(A4+S*A6) mov.l L_SCR1(%a6),%d1 # D0 is M neg.w %d1 # D0 is -M fmul.x %fp1,%fp3 # fp3 IS S*(A3+S*A5) add.w &0x3FFF,%d1 # biased expo. of 2^(-M) fadd.d EM1A2(%pc),%fp2 # fp2 IS A2+S*(A4+S*A6) fadd.s &0x3F000000,%fp3 # fp3 IS A1+S*(A3+S*A5) fmul.x %fp1,%fp2 # fp2 IS S*(A2+S*(A4+S*A6)) or.w &0x8000,%d1 # signed/expo. of -2^(-M) mov.w %d1,ONEBYSC(%a6) # OnebySc is -2^(-M) mov.l &0x80000000,ONEBYSC+4(%a6) clr.l ONEBYSC+8(%a6) fmul.x %fp3,%fp1 # fp1 IS S*(A1+S*(A3+S*A5)) fmul.x %fp0,%fp2 # fp2 IS R*S*(A2+S*(A4+S*A6)) fadd.x %fp1,%fp0 # fp0 IS R+S*(A1+S*(A3+S*A5)) fadd.x %fp2,%fp0 # fp0 IS EXP(R)-1 fmovm.x (%sp)+,&0x30 # fp2 restored {%fp2/%fp3} #--Step 5 #--Compute 2^(J/64)*p fmul.x (%a1),%fp0 # 2^(J/64)*(Exp(R)-1) #--Step 6 #--Step 6.1 mov.l L_SCR1(%a6),%d1 # retrieve M cmp.l %d1,&63 ble.b MLE63 #--Step 6.2 M >= 64 fmov.s 12(%a1),%fp1 # fp1 is t fadd.x ONEBYSC(%a6),%fp1 # fp1 is t+OnebySc fadd.x %fp1,%fp0 # p+(t+OnebySc), fp1 released fadd.x (%a1),%fp0 # T+(p+(t+OnebySc)) bra EM1SCALE MLE63: #--Step 6.3 M <= 63 cmp.l %d1,&-3 bge.b MGEN3 MLTN3: #--Step 6.4 M <= -4 fadd.s 12(%a1),%fp0 # p+t fadd.x (%a1),%fp0 # T+(p+t) fadd.x ONEBYSC(%a6),%fp0 # OnebySc + (T+(p+t)) bra EM1SCALE MGEN3: #--Step 6.5 -3 <= M <= 63 fmov.x (%a1)+,%fp1 # fp1 is T fadd.s (%a1),%fp0 # fp0 is p+t fadd.x ONEBYSC(%a6),%fp1 # fp1 is T+OnebySc fadd.x %fp1,%fp0 # (T+OnebySc)+(p+t) EM1SCALE: #--Step 6.6 fmov.l %d0,%fpcr fmul.x SC(%a6),%fp0 bra t_inx2 EM1SM: #--Step 7 |X| < 1/4. cmp.l %d1,&0x3FBE0000 # 2^(-65) bge.b EM1POLY EM1TINY: #--Step 8 |X| < 2^(-65) cmp.l %d1,&0x00330000 # 2^(-16312) blt.b EM12TINY #--Step 8.2 mov.l &0x80010000,SC(%a6) # SC is -2^(-16382) mov.l &0x80000000,SC+4(%a6) clr.l SC+8(%a6) fmov.x (%a0),%fp0 fmov.l %d0,%fpcr mov.b &FADD_OP,%d1 # last inst is ADD fadd.x SC(%a6),%fp0 bra t_catch EM12TINY: #--Step 8.3 fmov.x (%a0),%fp0 fmul.d TWO140(%pc),%fp0 mov.l &0x80010000,SC(%a6) mov.l &0x80000000,SC+4(%a6) clr.l SC+8(%a6) fadd.x SC(%a6),%fp0 fmov.l %d0,%fpcr mov.b &FMUL_OP,%d1 # last inst is MUL fmul.d TWON140(%pc),%fp0 bra t_catch EM1POLY: #--Step 9 exp(X)-1 by a simple polynomial fmov.x (%a0),%fp0 # fp0 is X fmul.x %fp0,%fp0 # fp0 is S := X*X fmovm.x &0xc,-(%sp) # save fp2 {%fp2/%fp3} fmov.s &0x2F30CAA8,%fp1 # fp1 is B12 fmul.x %fp0,%fp1 # fp1 is S*B12 fmov.s &0x310F8290,%fp2 # fp2 is B11 fadd.s &0x32D73220,%fp1 # fp1 is B10+S*B12 fmul.x %fp0,%fp2 # fp2 is S*B11 fmul.x %fp0,%fp1 # fp1 is S*(B10 + ... fadd.s &0x3493F281,%fp2 # fp2 is B9+S*... fadd.d EM1B8(%pc),%fp1 # fp1 is B8+S*... fmul.x %fp0,%fp2 # fp2 is S*(B9+... fmul.x %fp0,%fp1 # fp1 is S*(B8+... fadd.d EM1B7(%pc),%fp2 # fp2 is B7+S*... fadd.d EM1B6(%pc),%fp1 # fp1 is B6+S*... fmul.x %fp0,%fp2 # fp2 is S*(B7+... fmul.x %fp0,%fp1 # fp1 is S*(B6+... fadd.d EM1B5(%pc),%fp2 # fp2 is B5+S*... fadd.d EM1B4(%pc),%fp1 # fp1 is B4+S*... fmul.x %fp0,%fp2 # fp2 is S*(B5+... fmul.x %fp0,%fp1 # fp1 is S*(B4+... fadd.d EM1B3(%pc),%fp2 # fp2 is B3+S*... fadd.x EM1B2(%pc),%fp1 # fp1 is B2+S*... fmul.x %fp0,%fp2 # fp2 is S*(B3+... fmul.x %fp0,%fp1 # fp1 is S*(B2+... fmul.x %fp0,%fp2 # fp2 is S*S*(B3+...) fmul.x (%a0),%fp1 # fp1 is X*S*(B2... fmul.s &0x3F000000,%fp0 # fp0 is S*B1 fadd.x %fp2,%fp1 # fp1 is Q fmovm.x (%sp)+,&0x30 # fp2 restored {%fp2/%fp3} fadd.x %fp1,%fp0 # fp0 is S*B1+Q fmov.l %d0,%fpcr fadd.x (%a0),%fp0 bra t_inx2 EM1BIG: #--Step 10 |X| > 70 log2 mov.l (%a0),%d1 cmp.l %d1,&0 bgt.w EXPC1 #--Step 10.2 fmov.s &0xBF800000,%fp0 # fp0 is -1 fmov.l %d0,%fpcr fadd.s &0x00800000,%fp0 # -1 + 2^(-126) bra t_minx2 global setoxm1d setoxm1d: #--entry point for EXPM1(X), here X is denormalized #--Step 0. bra t_extdnrm ######################################################################### # sgetexp(): returns the exponent portion of the input argument. # # The exponent bias is removed and the exponent value is # # returned as an extended precision number in fp0. # # sgetexpd(): handles denormalized numbers. # # # # sgetman(): extracts the mantissa of the input argument. The # # mantissa is converted to an extended precision number w/ # # an exponent of $3fff and is returned in fp0. The range of # # the result is [1.0 - 2.0). # # sgetmand(): handles denormalized numbers. # # # # INPUT *************************************************************** # # a0 = pointer to extended precision input # # # # OUTPUT ************************************************************** # # fp0 = exponent(X) or mantissa(X) # # # ######################################################################### global sgetexp sgetexp: mov.w SRC_EX(%a0),%d0 # get the exponent bclr &0xf,%d0 # clear the sign bit subi.w &0x3fff,%d0 # subtract off the bias fmov.w %d0,%fp0 # return exp in fp0 blt.b sgetexpn # it's negative rts sgetexpn: mov.b &neg_bmask,FPSR_CC(%a6) # set 'N' ccode bit rts global sgetexpd sgetexpd: bsr.l norm # normalize neg.w %d0 # new exp = -(shft amt) subi.w &0x3fff,%d0 # subtract off the bias fmov.w %d0,%fp0 # return exp in fp0 mov.b &neg_bmask,FPSR_CC(%a6) # set 'N' ccode bit rts global sgetman sgetman: mov.w SRC_EX(%a0),%d0 # get the exp ori.w &0x7fff,%d0 # clear old exp bclr &0xe,%d0 # make it the new exp +-3fff # here, we build the result in a tmp location so as not to disturb the input mov.l SRC_HI(%a0),FP_SCR0_HI(%a6) # copy to tmp loc mov.l SRC_LO(%a0),FP_SCR0_LO(%a6) # copy to tmp loc mov.w %d0,FP_SCR0_EX(%a6) # insert new exponent fmov.x FP_SCR0(%a6),%fp0 # put new value back in fp0 bmi.b sgetmann # it's negative rts sgetmann: mov.b &neg_bmask,FPSR_CC(%a6) # set 'N' ccode bit rts # # For denormalized numbers, shift the mantissa until the j-bit = 1, # then load the exponent with +/1 $3fff. # global sgetmand sgetmand: bsr.l norm # normalize exponent bra.b sgetman ######################################################################### # scosh(): computes the hyperbolic cosine of a normalized input # # scoshd(): computes the hyperbolic cosine of a denormalized input # # # # INPUT *************************************************************** # # a0 = pointer to extended precision input # # d0 = round precision,mode # # # # OUTPUT ************************************************************** # # fp0 = cosh(X) # # # # ACCURACY and MONOTONICITY ******************************************* # # The returned result is within 3 ulps in 64 significant bit, # # i.e. within 0.5001 ulp to 53 bits if the result is subsequently # # rounded to double precision. The result is provably monotonic # # in double precision. # # # # ALGORITHM *********************************************************** # # # # COSH # # 1. If |X| > 16380 log2, go to 3. # # # # 2. (|X| <= 16380 log2) Cosh(X) is obtained by the formulae # # y = |X|, z = exp(Y), and # # cosh(X) = (1/2)*( z + 1/z ). # # Exit. # # # # 3. (|X| > 16380 log2). If |X| > 16480 log2, go to 5. # # # # 4. (16380 log2 < |X| <= 16480 log2) # # cosh(X) = sign(X) * exp(|X|)/2. # # However, invoking exp(|X|) may cause premature # # overflow. Thus, we calculate sinh(X) as follows: # # Y := |X| # # Fact := 2**(16380) # # Y' := Y - 16381 log2 # # cosh(X) := Fact * exp(Y'). # # Exit. # # # # 5. (|X| > 16480 log2) sinh(X) must overflow. Return # # Huge*Huge to generate overflow and an infinity with # # the appropriate sign. Huge is the largest finite number # # in extended format. Exit. # # # ######################################################################### TWO16380: long 0x7FFB0000,0x80000000,0x00000000,0x00000000 global scosh scosh: fmov.x (%a0),%fp0 # LOAD INPUT mov.l (%a0),%d1 mov.w 4(%a0),%d1 and.l &0x7FFFFFFF,%d1 cmp.l %d1,&0x400CB167 bgt.b COSHBIG #--THIS IS THE USUAL CASE, |X| < 16380 LOG2 #--COSH(X) = (1/2) * ( EXP(X) + 1/EXP(X) ) fabs.x %fp0 # |X| mov.l %d0,-(%sp) clr.l %d0 fmovm.x &0x01,-(%sp) # save |X| to stack lea (%sp),%a0 # pass ptr to |X| bsr setox # FP0 IS EXP(|X|) add.l &0xc,%sp # erase |X| from stack fmul.s &0x3F000000,%fp0 # (1/2)EXP(|X|) mov.l (%sp)+,%d0 fmov.s &0x3E800000,%fp1 # (1/4) fdiv.x %fp0,%fp1 # 1/(2 EXP(|X|)) fmov.l %d0,%fpcr mov.b &FADD_OP,%d1 # last inst is ADD fadd.x %fp1,%fp0 bra t_catch COSHBIG: cmp.l %d1,&0x400CB2B3 bgt.b COSHHUGE fabs.x %fp0 fsub.d T1(%pc),%fp0 # (|X|-16381LOG2_LEAD) fsub.d T2(%pc),%fp0 # |X| - 16381 LOG2, ACCURATE mov.l %d0,-(%sp) clr.l %d0 fmovm.x &0x01,-(%sp) # save fp0 to stack lea (%sp),%a0 # pass ptr to fp0 bsr setox add.l &0xc,%sp # clear fp0 from stack mov.l (%sp)+,%d0 fmov.l %d0,%fpcr mov.b &FMUL_OP,%d1 # last inst is MUL fmul.x TWO16380(%pc),%fp0 bra t_catch COSHHUGE: bra t_ovfl2 global scoshd #--COSH(X) = 1 FOR DENORMALIZED X scoshd: fmov.s &0x3F800000,%fp0 fmov.l %d0,%fpcr fadd.s &0x00800000,%fp0 bra t_pinx2 ######################################################################### # ssinh(): computes the hyperbolic sine of a normalized input # # ssinhd(): computes the hyperbolic sine of a denormalized input # # # # INPUT *************************************************************** # # a0 = pointer to extended precision input # # d0 = round precision,mode # # # # OUTPUT ************************************************************** # # fp0 = sinh(X) # # # # ACCURACY and MONOTONICITY ******************************************* # # The returned result is within 3 ulps in 64 significant bit, # # i.e. within 0.5001 ulp to 53 bits if the result is subsequently # # rounded to double precision. The result is provably monotonic # # in double precision. # # # # ALGORITHM *********************************************************** # # # # SINH # # 1. If |X| > 16380 log2, go to 3. # # # # 2. (|X| <= 16380 log2) Sinh(X) is obtained by the formula # # y = |X|, sgn = sign(X), and z = expm1(Y), # # sinh(X) = sgn*(1/2)*( z + z/(1+z) ). # # Exit. # # # # 3. If |X| > 16480 log2, go to 5. # # # # 4. (16380 log2 < |X| <= 16480 log2) # # sinh(X) = sign(X) * exp(|X|)/2. # # However, invoking exp(|X|) may cause premature overflow. # # Thus, we calculate sinh(X) as follows: # # Y := |X| # # sgn := sign(X) # # sgnFact := sgn * 2**(16380) # # Y' := Y - 16381 log2 # # sinh(X) := sgnFact * exp(Y'). # # Exit. # # # # 5. (|X| > 16480 log2) sinh(X) must overflow. Return # # sign(X)*Huge*Huge to generate overflow and an infinity with # # the appropriate sign. Huge is the largest finite number in # # extended format. Exit. # # # ######################################################################### global ssinh ssinh: fmov.x (%a0),%fp0 # LOAD INPUT mov.l (%a0),%d1 mov.w 4(%a0),%d1 mov.l %d1,%a1 # save (compacted) operand and.l &0x7FFFFFFF,%d1 cmp.l %d1,&0x400CB167 bgt.b SINHBIG #--THIS IS THE USUAL CASE, |X| < 16380 LOG2 #--Y = |X|, Z = EXPM1(Y), SINH(X) = SIGN(X)*(1/2)*( Z + Z/(1+Z) ) fabs.x %fp0 # Y = |X| movm.l &0x8040,-(%sp) # {a1/d0} fmovm.x &0x01,-(%sp) # save Y on stack lea (%sp),%a0 # pass ptr to Y clr.l %d0 bsr setoxm1 # FP0 IS Z = EXPM1(Y) add.l &0xc,%sp # clear Y from stack fmov.l &0,%fpcr movm.l (%sp)+,&0x0201 # {a1/d0} fmov.x %fp0,%fp1 fadd.s &0x3F800000,%fp1 # 1+Z fmov.x %fp0,-(%sp) fdiv.x %fp1,%fp0 # Z/(1+Z) mov.l %a1,%d1 and.l &0x80000000,%d1 or.l &0x3F000000,%d1 fadd.x (%sp)+,%fp0 mov.l %d1,-(%sp) fmov.l %d0,%fpcr mov.b &FMUL_OP,%d1 # last inst is MUL fmul.s (%sp)+,%fp0 # last fp inst - possible exceptions set bra t_catch SINHBIG: cmp.l %d1,&0x400CB2B3 bgt t_ovfl fabs.x %fp0 fsub.d T1(%pc),%fp0 # (|X|-16381LOG2_LEAD) mov.l &0,-(%sp) mov.l &0x80000000,-(%sp) mov.l %a1,%d1 and.l &0x80000000,%d1 or.l &0x7FFB0000,%d1 mov.l %d1,-(%sp) # EXTENDED FMT fsub.d T2(%pc),%fp0 # |X| - 16381 LOG2, ACCURATE mov.l %d0,-(%sp) clr.l %d0 fmovm.x &0x01,-(%sp) # save fp0 on stack lea (%sp),%a0 # pass ptr to fp0 bsr setox add.l &0xc,%sp # clear fp0 from stack mov.l (%sp)+,%d0 fmov.l %d0,%fpcr mov.b &FMUL_OP,%d1 # last inst is MUL fmul.x (%sp)+,%fp0 # possible exception bra t_catch global ssinhd #--SINH(X) = X FOR DENORMALIZED X ssinhd: bra t_extdnrm ######################################################################### # stanh(): computes the hyperbolic tangent of a normalized input # # stanhd(): computes the hyperbolic tangent of a denormalized input # # # # INPUT *************************************************************** # # a0 = pointer to extended precision input # # d0 = round precision,mode # # # # OUTPUT ************************************************************** # # fp0 = tanh(X) # # # # ACCURACY and MONOTONICITY ******************************************* # # The returned result is within 3 ulps in 64 significant bit, # # i.e. within 0.5001 ulp to 53 bits if the result is subsequently # # rounded to double precision. The result is provably monotonic # # in double precision. # # # # ALGORITHM *********************************************************** # # # # TANH # # 1. If |X| >= (5/2) log2 or |X| <= 2**(-40), go to 3. # # # # 2. (2**(-40) < |X| < (5/2) log2) Calculate tanh(X) by # # sgn := sign(X), y := 2|X|, z := expm1(Y), and # # tanh(X) = sgn*( z/(2+z) ). # # Exit. # # # # 3. (|X| <= 2**(-40) or |X| >= (5/2) log2). If |X| < 1, # # go to 7. # # # # 4. (|X| >= (5/2) log2) If |X| >= 50 log2, go to 6. # # # # 5. ((5/2) log2 <= |X| < 50 log2) Calculate tanh(X) by # # sgn := sign(X), y := 2|X|, z := exp(Y), # # tanh(X) = sgn - [ sgn*2/(1+z) ]. # # Exit. # # # # 6. (|X| >= 50 log2) Tanh(X) = +-1 (round to nearest). Thus, we # # calculate Tanh(X) by # # sgn := sign(X), Tiny := 2**(-126), # # tanh(X) := sgn - sgn*Tiny. # # Exit. # # # # 7. (|X| < 2**(-40)). Tanh(X) = X. Exit. # # # ######################################################################### set X,FP_SCR0 set XFRAC,X+4 set SGN,L_SCR3 set V,FP_SCR0 global stanh stanh: fmov.x (%a0),%fp0 # LOAD INPUT fmov.x %fp0,X(%a6) mov.l (%a0),%d1 mov.w 4(%a0),%d1 mov.l %d1,X(%a6) and.l &0x7FFFFFFF,%d1 cmp.l %d1, &0x3fd78000 # is |X| < 2^(-40)? blt.w TANHBORS # yes cmp.l %d1, &0x3fffddce # is |X| > (5/2)LOG2? bgt.w TANHBORS # yes #--THIS IS THE USUAL CASE #--Y = 2|X|, Z = EXPM1(Y), TANH(X) = SIGN(X) * Z / (Z+2). mov.l X(%a6),%d1 mov.l %d1,SGN(%a6) and.l &0x7FFF0000,%d1 add.l &0x00010000,%d1 # EXPONENT OF 2|X| mov.l %d1,X(%a6) and.l &0x80000000,SGN(%a6) fmov.x X(%a6),%fp0 # FP0 IS Y = 2|X| mov.l %d0,-(%sp) clr.l %d0 fmovm.x &0x1,-(%sp) # save Y on stack lea (%sp),%a0 # pass ptr to Y bsr setoxm1 # FP0 IS Z = EXPM1(Y) add.l &0xc,%sp # clear Y from stack mov.l (%sp)+,%d0 fmov.x %fp0,%fp1 fadd.s &0x40000000,%fp1 # Z+2 mov.l SGN(%a6),%d1 fmov.x %fp1,V(%a6) eor.l %d1,V(%a6) fmov.l %d0,%fpcr # restore users round prec,mode fdiv.x V(%a6),%fp0 bra t_inx2 TANHBORS: cmp.l %d1,&0x3FFF8000 blt.w TANHSM cmp.l %d1,&0x40048AA1 bgt.w TANHHUGE #-- (5/2) LOG2 < |X| < 50 LOG2, #--TANH(X) = 1 - (2/[EXP(2X)+1]). LET Y = 2|X|, SGN = SIGN(X), #--TANH(X) = SGN - SGN*2/[EXP(Y)+1]. mov.l X(%a6),%d1 mov.l %d1,SGN(%a6) and.l &0x7FFF0000,%d1 add.l &0x00010000,%d1 # EXPO OF 2|X| mov.l %d1,X(%a6) # Y = 2|X| and.l &0x80000000,SGN(%a6) mov.l SGN(%a6),%d1 fmov.x X(%a6),%fp0 # Y = 2|X| mov.l %d0,-(%sp) clr.l %d0 fmovm.x &0x01,-(%sp) # save Y on stack lea (%sp),%a0 # pass ptr to Y bsr setox # FP0 IS EXP(Y) add.l &0xc,%sp # clear Y from stack mov.l (%sp)+,%d0 mov.l SGN(%a6),%d1 fadd.s &0x3F800000,%fp0 # EXP(Y)+1 eor.l &0xC0000000,%d1 # -SIGN(X)*2 fmov.s %d1,%fp1 # -SIGN(X)*2 IN SGL FMT fdiv.x %fp0,%fp1 # -SIGN(X)2 / [EXP(Y)+1 ] mov.l SGN(%a6),%d1 or.l &0x3F800000,%d1 # SGN fmov.s %d1,%fp0 # SGN IN SGL FMT fmov.l %d0,%fpcr # restore users round prec,mode mov.b &FADD_OP,%d1 # last inst is ADD fadd.x %fp1,%fp0 bra t_inx2 TANHSM: fmov.l %d0,%fpcr # restore users round prec,mode mov.b &FMOV_OP,%d1 # last inst is MOVE fmov.x X(%a6),%fp0 # last inst - possible exception set bra t_catch #---RETURN SGN(X) - SGN(X)EPS TANHHUGE: mov.l X(%a6),%d1 and.l &0x80000000,%d1 or.l &0x3F800000,%d1 fmov.s %d1,%fp0 and.l &0x80000000,%d1 eor.l &0x80800000,%d1 # -SIGN(X)*EPS fmov.l %d0,%fpcr # restore users round prec,mode fadd.s %d1,%fp0 bra t_inx2 global stanhd #--TANH(X) = X FOR DENORMALIZED X stanhd: bra t_extdnrm ######################################################################### # slogn(): computes the natural logarithm of a normalized input # # slognd(): computes the natural logarithm of a denormalized input # # slognp1(): computes the log(1+X) of a normalized input # # slognp1d(): computes the log(1+X) of a denormalized input # # # # INPUT *************************************************************** # # a0 = pointer to extended precision input # # d0 = round precision,mode # # # # OUTPUT ************************************************************** # # fp0 = log(X) or log(1+X) # # # # ACCURACY and MONOTONICITY ******************************************* # # The returned result is within 2 ulps in 64 significant bit, # # i.e. within 0.5001 ulp to 53 bits if the result is subsequently # # rounded to double precision. The result is provably monotonic # # in double precision. # # # # ALGORITHM *********************************************************** # # LOGN: # # Step 1. If |X-1| < 1/16, approximate log(X) by an odd # # polynomial in u, where u = 2(X-1)/(X+1). Otherwise, # # move on to Step 2. # # # # Step 2. X = 2**k * Y where 1 <= Y < 2. Define F to be the first # # seven significant bits of Y plus 2**(-7), i.e. # # F = 1.xxxxxx1 in base 2 where the six "x" match those # # of Y. Note that |Y-F| <= 2**(-7). # # # # Step 3. Define u = (Y-F)/F. Approximate log(1+u) by a # # polynomial in u, log(1+u) = poly. # # # # Step 4. Reconstruct # # log(X) = log( 2**k * Y ) = k*log(2) + log(F) + log(1+u) # # by k*log(2) + (log(F) + poly). The values of log(F) are # # calculated beforehand and stored in the program. # # # # lognp1: # # Step 1: If |X| < 1/16, approximate log(1+X) by an odd # # polynomial in u where u = 2X/(2+X). Otherwise, move on # # to Step 2. # # # # Step 2: Let 1+X = 2**k * Y, where 1 <= Y < 2. Define F as done # # in Step 2 of the algorithm for LOGN and compute # # log(1+X) as k*log(2) + log(F) + poly where poly # # approximates log(1+u), u = (Y-F)/F. # # # # Implementation Notes: # # Note 1. There are 64 different possible values for F, thus 64 # # log(F)'s need to be tabulated. Moreover, the values of # # 1/F are also tabulated so that the division in (Y-F)/F # # can be performed by a multiplication. # # # # Note 2. In Step 2 of lognp1, in order to preserved accuracy, # # the value Y-F has to be calculated carefully when # # 1/2 <= X < 3/2. # # # # Note 3. To fully exploit the pipeline, polynomials are usually # # separated into two parts evaluated independently before # # being added up. # # # ######################################################################### LOGOF2: long 0x3FFE0000,0xB17217F7,0xD1CF79AC,0x00000000 one: long 0x3F800000 zero: long 0x00000000 infty: long 0x7F800000 negone: long 0xBF800000 LOGA6: long 0x3FC2499A,0xB5E4040B LOGA5: long 0xBFC555B5,0x848CB7DB LOGA4: long 0x3FC99999,0x987D8730 LOGA3: long 0xBFCFFFFF,0xFF6F7E97 LOGA2: long 0x3FD55555,0x555555A4 LOGA1: long 0xBFE00000,0x00000008 LOGB5: long 0x3F175496,0xADD7DAD6 LOGB4: long 0x3F3C71C2,0xFE80C7E0 LOGB3: long 0x3F624924,0x928BCCFF LOGB2: long 0x3F899999,0x999995EC LOGB1: long 0x3FB55555,0x55555555 TWO: long 0x40000000,0x00000000 LTHOLD: long 0x3f990000,0x80000000,0x00000000,0x00000000 LOGTBL: long 0x3FFE0000,0xFE03F80F,0xE03F80FE,0x00000000 long 0x3FF70000,0xFF015358,0x833C47E2,0x00000000 long 0x3FFE0000,0xFA232CF2,0x52138AC0,0x00000000 long 0x3FF90000,0xBDC8D83E,0xAD88D549,0x00000000 long 0x3FFE0000,0xF6603D98,0x0F6603DA,0x00000000 long 0x3FFA0000,0x9CF43DCF,0xF5EAFD48,0x00000000 long 0x3FFE0000,0xF2B9D648,0x0F2B9D65,0x00000000 long 0x3FFA0000,0xDA16EB88,0xCB8DF614,0x00000000 long 0x3FFE0000,0xEF2EB71F,0xC4345238,0x00000000 long 0x3FFB0000,0x8B29B775,0x1BD70743,0x00000000 long 0x3FFE0000,0xEBBDB2A5,0xC1619C8C,0x00000000 long 0x3FFB0000,0xA8D839F8,0x30C1FB49,0x00000000 long 0x3FFE0000,0xE865AC7B,0x7603A197,0x00000000 long 0x3FFB0000,0xC61A2EB1,0x8CD907AD,0x00000000 long 0x3FFE0000,0xE525982A,0xF70C880E,0x00000000 long 0x3FFB0000,0xE2F2A47A,0xDE3A18AF,0x00000000 long 0x3FFE0000,0xE1FC780E,0x1FC780E2,0x00000000 long 0x3FFB0000,0xFF64898E,0xDF55D551,0x00000000 long 0x3FFE0000,0xDEE95C4C,0xA037BA57,0x00000000 long 0x3FFC0000,0x8DB956A9,0x7B3D0148,0x00000000 long 0x3FFE0000,0xDBEB61EE,0xD19C5958,0x00000000 long 0x3FFC0000,0x9B8FE100,0xF47BA1DE,0x00000000 long 0x3FFE0000,0xD901B203,0x6406C80E,0x00000000 long 0x3FFC0000,0xA9372F1D,0x0DA1BD17,0x00000000 long 0x3FFE0000,0xD62B80D6,0x2B80D62C,0x00000000 long 0x3FFC0000,0xB6B07F38,0xCE90E46B,0x00000000 long 0x3FFE0000,0xD3680D36,0x80D3680D,0x00000000 long 0x3FFC0000,0xC3FD0329,0x06488481,0x00000000 long 0x3FFE0000,0xD0B69FCB,0xD2580D0B,0x00000000 long 0x3FFC0000,0xD11DE0FF,0x15AB18CA,0x00000000 long 0x3FFE0000,0xCE168A77,0x25080CE1,0x00000000 long 0x3FFC0000,0xDE1433A1,0x6C66B150,0x00000000 long 0x3FFE0000,0xCB8727C0,0x65C393E0,0x00000000 long 0x3FFC0000,0xEAE10B5A,0x7DDC8ADD,0x00000000 long 0x3FFE0000,0xC907DA4E,0x871146AD,0x00000000 long 0x3FFC0000,0xF7856E5E,0xE2C9B291,0x00000000 long 0x3FFE0000,0xC6980C69,0x80C6980C,0x00000000 long 0x3FFD0000,0x82012CA5,0xA68206D7,0x00000000 long 0x3FFE0000,0xC4372F85,0x5D824CA6,0x00000000 long 0x3FFD0000,0x882C5FCD,0x7256A8C5,0x00000000 long 0x3FFE0000,0xC1E4BBD5,0x95F6E947,0x00000000 long 0x3FFD0000,0x8E44C60B,0x4CCFD7DE,0x00000000 long 0x3FFE0000,0xBFA02FE8,0x0BFA02FF,0x00000000 long 0x3FFD0000,0x944AD09E,0xF4351AF6,0x00000000 long 0x3FFE0000,0xBD691047,0x07661AA3,0x00000000 long 0x3FFD0000,0x9A3EECD4,0xC3EAA6B2,0x00000000 long 0x3FFE0000,0xBB3EE721,0xA54D880C,0x00000000 long 0x3FFD0000,0xA0218434,0x353F1DE8,0x00000000 long 0x3FFE0000,0xB92143FA,0x36F5E02E,0x00000000 long 0x3FFD0000,0xA5F2FCAB,0xBBC506DA,0x00000000 long 0x3FFE0000,0xB70FBB5A,0x19BE3659,0x00000000 long 0x3FFD0000,0xABB3B8BA,0x2AD362A5,0x00000000 long 0x3FFE0000,0xB509E68A,0x9B94821F,0x00000000 long 0x3FFD0000,0xB1641795,0xCE3CA97B,0x00000000 long 0x3FFE0000,0xB30F6352,0x8917C80B,0x00000000 long 0x3FFD0000,0xB7047551,0x5D0F1C61,0x00000000 long 0x3FFE0000,0xB11FD3B8,0x0B11FD3C,0x00000000 long 0x3FFD0000,0xBC952AFE,0xEA3D13E1,0x00000000 long 0x3FFE0000,0xAF3ADDC6,0x80AF3ADE,0x00000000 long 0x3FFD0000,0xC2168ED0,0xF458BA4A,0x00000000 long 0x3FFE0000,0xAD602B58,0x0AD602B6,0x00000000 long 0x3FFD0000,0xC788F439,0xB3163BF1,0x00000000 long 0x3FFE0000,0xAB8F69E2,0x8359CD11,0x00000000 long 0x3FFD0000,0xCCECAC08,0xBF04565D,0x00000000 long 0x3FFE0000,0xA9C84A47,0xA07F5638,0x00000000 long 0x3FFD0000,0xD2420487,0x2DD85160,0x00000000 long 0x3FFE0000,0xA80A80A8,0x0A80A80B,0x00000000 long 0x3FFD0000,0xD7894992,0x3BC3588A,0x00000000 long 0x3FFE0000,0xA655C439,0x2D7B73A8,0x00000000 long 0x3FFD0000,0xDCC2C4B4,0x9887DACC,0x00000000 long 0x3FFE0000,0xA4A9CF1D,0x96833751,0x00000000 long 0x3FFD0000,0xE1EEBD3E,0x6D6A6B9E,0x00000000 long 0x3FFE0000,0xA3065E3F,0xAE7CD0E0,0x00000000 long 0x3FFD0000,0xE70D785C,0x2F9F5BDC,0x00000000 long 0x3FFE0000,0xA16B312E,0xA8FC377D,0x00000000 long 0x3FFD0000,0xEC1F392C,0x5179F283,0x00000000 long 0x3FFE0000,0x9FD809FD,0x809FD80A,0x00000000 long 0x3FFD0000,0xF12440D3,0xE36130E6,0x00000000 long 0x3FFE0000,0x9E4CAD23,0xDD5F3A20,0x00000000 long 0x3FFD0000,0xF61CCE92,0x346600BB,0x00000000 long 0x3FFE0000,0x9CC8E160,0xC3FB19B9,0x00000000 long 0x3FFD0000,0xFB091FD3,0x8145630A,0x00000000 long 0x3FFE0000,0x9B4C6F9E,0xF03A3CAA,0x00000000 long 0x3FFD0000,0xFFE97042,0xBFA4C2AD,0x00000000 long 0x3FFE0000,0x99D722DA,0xBDE58F06,0x00000000 long 0x3FFE0000,0x825EFCED,0x49369330,0x00000000 long 0x3FFE0000,0x9868C809,0x868C8098,0x00000000 long 0x3FFE0000,0x84C37A7A,0xB9A905C9,0x00000000 long 0x3FFE0000,0x97012E02,0x5C04B809,0x00000000 long 0x3FFE0000,0x87224C2E,0x8E645FB7,0x00000000 long 0x3FFE0000,0x95A02568,0x095A0257,0x00000000 long 0x3FFE0000,0x897B8CAC,0x9F7DE298,0x00000000 long 0x3FFE0000,0x94458094,0x45809446,0x00000000 long 0x3FFE0000,0x8BCF55DE,0xC4CD05FE,0x00000000 long 0x3FFE0000,0x92F11384,0x0497889C,0x00000000 long 0x3FFE0000,0x8E1DC0FB,0x89E125E5,0x00000000 long 0x3FFE0000,0x91A2B3C4,0xD5E6F809,0x00000000 long 0x3FFE0000,0x9066E68C,0x955B6C9B,0x00000000 long 0x3FFE0000,0x905A3863,0x3E06C43B,0x00000000 long 0x3FFE0000,0x92AADE74,0xC7BE59E0,0x00000000 long 0x3FFE0000,0x8F1779D9,0xFDC3A219,0x00000000 long 0x3FFE0000,0x94E9BFF6,0x15845643,0x00000000 long 0x3FFE0000,0x8DDA5202,0x37694809,0x00000000 long 0x3FFE0000,0x9723A1B7,0x20134203,0x00000000 long 0x3FFE0000,0x8CA29C04,0x6514E023,0x00000000 long 0x3FFE0000,0x995899C8,0x90EB8990,0x00000000 long 0x3FFE0000,0x8B70344A,0x139BC75A,0x00000000 long 0x3FFE0000,0x9B88BDAA,0x3A3DAE2F,0x00000000 long 0x3FFE0000,0x8A42F870,0x5669DB46,0x00000000 long 0x3FFE0000,0x9DB4224F,0xFFE1157C,0x00000000 long 0x3FFE0000,0x891AC73A,0xE9819B50,0x00000000 long 0x3FFE0000,0x9FDADC26,0x8B7A12DA,0x00000000 long 0x3FFE0000,0x87F78087,0xF78087F8,0x00000000 long 0x3FFE0000,0xA1FCFF17,0xCE733BD4,0x00000000 long 0x3FFE0000,0x86D90544,0x7A34ACC6,0x00000000 long 0x3FFE0000,0xA41A9E8F,0x5446FB9F,0x00000000 long 0x3FFE0000,0x85BF3761,0x2CEE3C9B,0x00000000 long 0x3FFE0000,0xA633CD7E,0x6771CD8B,0x00000000 long 0x3FFE0000,0x84A9F9C8,0x084A9F9D,0x00000000 long 0x3FFE0000,0xA8489E60,0x0B435A5E,0x00000000 long 0x3FFE0000,0x83993052,0x3FBE3368,0x00000000 long 0x3FFE0000,0xAA59233C,0xCCA4BD49,0x00000000 long 0x3FFE0000,0x828CBFBE,0xB9A020A3,0x00000000 long 0x3FFE0000,0xAC656DAE,0x6BCC4985,0x00000000 long 0x3FFE0000,0x81848DA8,0xFAF0D277,0x00000000 long 0x3FFE0000,0xAE6D8EE3,0x60BB2468,0x00000000 long 0x3FFE0000,0x80808080,0x80808081,0x00000000 long 0x3FFE0000,0xB07197A2,0x3C46C654,0x00000000 set ADJK,L_SCR1 set X,FP_SCR0 set XDCARE,X+2 set XFRAC,X+4 set F,FP_SCR1 set FFRAC,F+4 set KLOG2,FP_SCR0 set SAVEU,FP_SCR0 global slogn #--ENTRY POINT FOR LOG(X) FOR X FINITE, NON-ZERO, NOT NAN'S slogn: fmov.x (%a0),%fp0 # LOAD INPUT mov.l &0x00000000,ADJK(%a6) LOGBGN: #--FPCR SAVED AND CLEARED, INPUT IS 2^(ADJK)*FP0, FP0 CONTAINS #--A FINITE, NON-ZERO, NORMALIZED NUMBER. mov.l (%a0),%d1 mov.w 4(%a0),%d1 mov.l (%a0),X(%a6) mov.l 4(%a0),X+4(%a6) mov.l 8(%a0),X+8(%a6) cmp.l %d1,&0 # CHECK IF X IS NEGATIVE blt.w LOGNEG # LOG OF NEGATIVE ARGUMENT IS INVALID # X IS POSITIVE, CHECK IF X IS NEAR 1 cmp.l %d1,&0x3ffef07d # IS X < 15/16? blt.b LOGMAIN # YES cmp.l %d1,&0x3fff8841 # IS X > 17/16? ble.w LOGNEAR1 # NO LOGMAIN: #--THIS SHOULD BE THE USUAL CASE, X NOT VERY CLOSE TO 1 #--X = 2^(K) * Y, 1 <= Y < 2. THUS, Y = 1.XXXXXXXX....XX IN BINARY. #--WE DEFINE F = 1.XXXXXX1, I.E. FIRST 7 BITS OF Y AND ATTACH A 1. #--THE IDEA IS THAT LOG(X) = K*LOG2 + LOG(Y) #-- = K*LOG2 + LOG(F) + LOG(1 + (Y-F)/F). #--NOTE THAT U = (Y-F)/F IS VERY SMALL AND THUS APPROXIMATING #--LOG(1+U) CAN BE VERY EFFICIENT. #--ALSO NOTE THAT THE VALUE 1/F IS STORED IN A TABLE SO THAT NO #--DIVISION IS NEEDED TO CALCULATE (Y-F)/F. #--GET K, Y, F, AND ADDRESS OF 1/F. asr.l &8,%d1 asr.l &8,%d1 # SHIFTED 16 BITS, BIASED EXPO. OF X sub.l &0x3FFF,%d1 # THIS IS K add.l ADJK(%a6),%d1 # ADJUST K, ORIGINAL INPUT MAY BE DENORM. lea LOGTBL(%pc),%a0 # BASE ADDRESS OF 1/F AND LOG(F) fmov.l %d1,%fp1 # CONVERT K TO FLOATING-POINT FORMAT #--WHILE THE CONVERSION IS GOING ON, WE GET F AND ADDRESS OF 1/F mov.l &0x3FFF0000,X(%a6) # X IS NOW Y, I.E. 2^(-K)*X mov.l XFRAC(%a6),FFRAC(%a6) and.l &0xFE000000,FFRAC(%a6) # FIRST 7 BITS OF Y or.l &0x01000000,FFRAC(%a6) # GET F: ATTACH A 1 AT THE EIGHTH BIT mov.l FFRAC(%a6),%d1 # READY TO GET ADDRESS OF 1/F and.l &0x7E000000,%d1 asr.l &8,%d1 asr.l &8,%d1 asr.l &4,%d1 # SHIFTED 20, D0 IS THE DISPLACEMENT add.l %d1,%a0 # A0 IS THE ADDRESS FOR 1/F fmov.x X(%a6),%fp0 mov.l &0x3fff0000,F(%a6) clr.l F+8(%a6) fsub.x F(%a6),%fp0 # Y-F fmovm.x &0xc,-(%sp) # SAVE FP2-3 WHILE FP0 IS NOT READY #--SUMMARY: FP0 IS Y-F, A0 IS ADDRESS OF 1/F, FP1 IS K #--REGISTERS SAVED: FPCR, FP1, FP2 LP1CONT1: #--AN RE-ENTRY POINT FOR LOGNP1 fmul.x (%a0),%fp0 # FP0 IS U = (Y-F)/F fmul.x LOGOF2(%pc),%fp1 # GET K*LOG2 WHILE FP0 IS NOT READY fmov.x %fp0,%fp2 fmul.x %fp2,%fp2 # FP2 IS V=U*U fmov.x %fp1,KLOG2(%a6) # PUT K*LOG2 IN MEMEORY, FREE FP1 #--LOG(1+U) IS APPROXIMATED BY #--U + V*(A1+U*(A2+U*(A3+U*(A4+U*(A5+U*A6))))) WHICH IS #--[U + V*(A1+V*(A3+V*A5))] + [U*V*(A2+V*(A4+V*A6))] fmov.x %fp2,%fp3 fmov.x %fp2,%fp1 fmul.d LOGA6(%pc),%fp1 # V*A6 fmul.d LOGA5(%pc),%fp2 # V*A5 fadd.d LOGA4(%pc),%fp1 # A4+V*A6 fadd.d LOGA3(%pc),%fp2 # A3+V*A5 fmul.x %fp3,%fp1 # V*(A4+V*A6) fmul.x %fp3,%fp2 # V*(A3+V*A5) fadd.d LOGA2(%pc),%fp1 # A2+V*(A4+V*A6) fadd.d LOGA1(%pc),%fp2 # A1+V*(A3+V*A5) fmul.x %fp3,%fp1 # V*(A2+V*(A4+V*A6)) add.l &16,%a0 # ADDRESS OF LOG(F) fmul.x %fp3,%fp2 # V*(A1+V*(A3+V*A5)) fmul.x %fp0,%fp1 # U*V*(A2+V*(A4+V*A6)) fadd.x %fp2,%fp0 # U+V*(A1+V*(A3+V*A5)) fadd.x (%a0),%fp1 # LOG(F)+U*V*(A2+V*(A4+V*A6)) fmovm.x (%sp)+,&0x30 # RESTORE FP2-3 fadd.x %fp1,%fp0 # FP0 IS LOG(F) + LOG(1+U) fmov.l %d0,%fpcr fadd.x KLOG2(%a6),%fp0 # FINAL ADD bra t_inx2 LOGNEAR1: # if the input is exactly equal to one, then exit through ld_pzero. # if these 2 lines weren't here, the correct answer would be returned # but the INEX2 bit would be set. fcmp.b %fp0,&0x1 # is it equal to one? fbeq.l ld_pzero # yes #--REGISTERS SAVED: FPCR, FP1. FP0 CONTAINS THE INPUT. fmov.x %fp0,%fp1 fsub.s one(%pc),%fp1 # FP1 IS X-1 fadd.s one(%pc),%fp0 # FP0 IS X+1 fadd.x %fp1,%fp1 # FP1 IS 2(X-1) #--LOG(X) = LOG(1+U/2)-LOG(1-U/2) WHICH IS AN ODD POLYNOMIAL #--IN U, U = 2(X-1)/(X+1) = FP1/FP0 LP1CONT2: #--THIS IS AN RE-ENTRY POINT FOR LOGNP1 fdiv.x %fp0,%fp1 # FP1 IS U fmovm.x &0xc,-(%sp) # SAVE FP2-3 #--REGISTERS SAVED ARE NOW FPCR,FP1,FP2,FP3 #--LET V=U*U, W=V*V, CALCULATE #--U + U*V*(B1 + V*(B2 + V*(B3 + V*(B4 + V*B5)))) BY #--U + U*V*( [B1 + W*(B3 + W*B5)] + [V*(B2 + W*B4)] ) fmov.x %fp1,%fp0 fmul.x %fp0,%fp0 # FP0 IS V fmov.x %fp1,SAVEU(%a6) # STORE U IN MEMORY, FREE FP1 fmov.x %fp0,%fp1 fmul.x %fp1,%fp1 # FP1 IS W fmov.d LOGB5(%pc),%fp3 fmov.d LOGB4(%pc),%fp2 fmul.x %fp1,%fp3 # W*B5 fmul.x %fp1,%fp2 # W*B4 fadd.d LOGB3(%pc),%fp3 # B3+W*B5 fadd.d LOGB2(%pc),%fp2 # B2+W*B4 fmul.x %fp3,%fp1 # W*(B3+W*B5), FP3 RELEASED fmul.x %fp0,%fp2 # V*(B2+W*B4) fadd.d LOGB1(%pc),%fp1 # B1+W*(B3+W*B5) fmul.x SAVEU(%a6),%fp0 # FP0 IS U*V fadd.x %fp2,%fp1 # B1+W*(B3+W*B5) + V*(B2+W*B4), FP2 RELEASED fmovm.x (%sp)+,&0x30 # FP2-3 RESTORED fmul.x %fp1,%fp0 # U*V*( [B1+W*(B3+W*B5)] + [V*(B2+W*B4)] ) fmov.l %d0,%fpcr fadd.x SAVEU(%a6),%fp0 bra t_inx2 #--REGISTERS SAVED FPCR. LOG(-VE) IS INVALID LOGNEG: bra t_operr global slognd slognd: #--ENTRY POINT FOR LOG(X) FOR DENORMALIZED INPUT mov.l &-100,ADJK(%a6) # INPUT = 2^(ADJK) * FP0 #----normalize the input value by left shifting k bits (k to be determined #----below), adjusting exponent and storing -k to ADJK #----the value TWOTO100 is no longer needed. #----Note that this code assumes the denormalized input is NON-ZERO. movm.l &0x3f00,-(%sp) # save some registers {d2-d7} mov.l (%a0),%d3 # D3 is exponent of smallest norm. # mov.l 4(%a0),%d4 mov.l 8(%a0),%d5 # (D4,D5) is (Hi_X,Lo_X) clr.l %d2 # D2 used for holding K tst.l %d4 bne.b Hi_not0 Hi_0: mov.l %d5,%d4 clr.l %d5 mov.l &32,%d2 clr.l %d6 bfffo %d4{&0:&32},%d6 lsl.l %d6,%d4 add.l %d6,%d2 # (D3,D4,D5) is normalized mov.l %d3,X(%a6) mov.l %d4,XFRAC(%a6) mov.l %d5,XFRAC+4(%a6) neg.l %d2 mov.l %d2,ADJK(%a6) fmov.x X(%a6),%fp0 movm.l (%sp)+,&0xfc # restore registers {d2-d7} lea X(%a6),%a0 bra.w LOGBGN # begin regular log(X) Hi_not0: clr.l %d6 bfffo %d4{&0:&32},%d6 # find first 1 mov.l %d6,%d2 # get k lsl.l %d6,%d4 mov.l %d5,%d7 # a copy of D5 lsl.l %d6,%d5 neg.l %d6 add.l &32,%d6 lsr.l %d6,%d7 or.l %d7,%d4 # (D3,D4,D5) normalized mov.l %d3,X(%a6) mov.l %d4,XFRAC(%a6) mov.l %d5,XFRAC+4(%a6) neg.l %d2 mov.l %d2,ADJK(%a6) fmov.x X(%a6),%fp0 movm.l (%sp)+,&0xfc # restore registers {d2-d7} lea X(%a6),%a0 bra.w LOGBGN # begin regular log(X) global slognp1 #--ENTRY POINT FOR LOG(1+X) FOR X FINITE, NON-ZERO, NOT NAN'S slognp1: fmov.x (%a0),%fp0 # LOAD INPUT fabs.x %fp0 # test magnitude fcmp.x %fp0,LTHOLD(%pc) # compare with min threshold fbgt.w LP1REAL # if greater, continue fmov.l %d0,%fpcr mov.b &FMOV_OP,%d1 # last inst is MOVE fmov.x (%a0),%fp0 # return signed argument bra t_catch LP1REAL: fmov.x (%a0),%fp0 # LOAD INPUT mov.l &0x00000000,ADJK(%a6) fmov.x %fp0,%fp1 # FP1 IS INPUT Z fadd.s one(%pc),%fp0 # X := ROUND(1+Z) fmov.x %fp0,X(%a6) mov.w XFRAC(%a6),XDCARE(%a6) mov.l X(%a6),%d1 cmp.l %d1,&0 ble.w LP1NEG0 # LOG OF ZERO OR -VE cmp.l %d1,&0x3ffe8000 # IS BOUNDS [1/2,3/2]? blt.w LOGMAIN cmp.l %d1,&0x3fffc000 bgt.w LOGMAIN #--IF 1+Z > 3/2 OR 1+Z < 1/2, THEN X, WHICH IS ROUNDING 1+Z, #--CONTAINS AT LEAST 63 BITS OF INFORMATION OF Z. IN THAT CASE, #--SIMPLY INVOKE LOG(X) FOR LOG(1+Z). LP1NEAR1: #--NEXT SEE IF EXP(-1/16) < X < EXP(1/16) cmp.l %d1,&0x3ffef07d blt.w LP1CARE cmp.l %d1,&0x3fff8841 bgt.w LP1CARE LP1ONE16: #--EXP(-1/16) < X < EXP(1/16). LOG(1+Z) = LOG(1+U/2) - LOG(1-U/2) #--WHERE U = 2Z/(2+Z) = 2Z/(1+X). fadd.x %fp1,%fp1 # FP1 IS 2Z fadd.s one(%pc),%fp0 # FP0 IS 1+X #--U = FP1/FP0 bra.w LP1CONT2 LP1CARE: #--HERE WE USE THE USUAL TABLE DRIVEN APPROACH. CARE HAS TO BE #--TAKEN BECAUSE 1+Z CAN HAVE 67 BITS OF INFORMATION AND WE MUST #--PRESERVE ALL THE INFORMATION. BECAUSE 1+Z IS IN [1/2,3/2], #--THERE ARE ONLY TWO CASES. #--CASE 1: 1+Z < 1, THEN K = -1 AND Y-F = (2-F) + 2Z #--CASE 2: 1+Z > 1, THEN K = 0 AND Y-F = (1-F) + Z #--ON RETURNING TO LP1CONT1, WE MUST HAVE K IN FP1, ADDRESS OF #--(1/F) IN A0, Y-F IN FP0, AND FP2 SAVED. mov.l XFRAC(%a6),FFRAC(%a6) and.l &0xFE000000,FFRAC(%a6) or.l &0x01000000,FFRAC(%a6) # F OBTAINED cmp.l %d1,&0x3FFF8000 # SEE IF 1+Z > 1 bge.b KISZERO KISNEG1: fmov.s TWO(%pc),%fp0 mov.l &0x3fff0000,F(%a6) clr.l F+8(%a6) fsub.x F(%a6),%fp0 # 2-F mov.l FFRAC(%a6),%d1 and.l &0x7E000000,%d1 asr.l &8,%d1 asr.l &8,%d1 asr.l &4,%d1 # D0 CONTAINS DISPLACEMENT FOR 1/F fadd.x %fp1,%fp1 # GET 2Z fmovm.x &0xc,-(%sp) # SAVE FP2 {%fp2/%fp3} fadd.x %fp1,%fp0 # FP0 IS Y-F = (2-F)+2Z lea LOGTBL(%pc),%a0 # A0 IS ADDRESS OF 1/F add.l %d1,%a0 fmov.s negone(%pc),%fp1 # FP1 IS K = -1 bra.w LP1CONT1 KISZERO: fmov.s one(%pc),%fp0 mov.l &0x3fff0000,F(%a6) clr.l F+8(%a6) fsub.x F(%a6),%fp0 # 1-F mov.l FFRAC(%a6),%d1 and.l &0x7E000000,%d1 asr.l &8,%d1 asr.l &8,%d1 asr.l &4,%d1 fadd.x %fp1,%fp0 # FP0 IS Y-F fmovm.x &0xc,-(%sp) # FP2 SAVED {%fp2/%fp3} lea LOGTBL(%pc),%a0 add.l %d1,%a0 # A0 IS ADDRESS OF 1/F fmov.s zero(%pc),%fp1 # FP1 IS K = 0 bra.w LP1CONT1 LP1NEG0: #--FPCR SAVED. D0 IS X IN COMPACT FORM. cmp.l %d1,&0 blt.b LP1NEG LP1ZERO: fmov.s negone(%pc),%fp0 fmov.l %d0,%fpcr bra t_dz LP1NEG: fmov.s zero(%pc),%fp0 fmov.l %d0,%fpcr bra t_operr global slognp1d #--ENTRY POINT FOR LOG(1+Z) FOR DENORMALIZED INPUT # Simply return the denorm slognp1d: bra t_extdnrm ######################################################################### # satanh(): computes the inverse hyperbolic tangent of a norm input # # satanhd(): computes the inverse hyperbolic tangent of a denorm input # # # # INPUT *************************************************************** # # a0 = pointer to extended precision input # # d0 = round precision,mode # # # # OUTPUT ************************************************************** # # fp0 = arctanh(X) # # # # ACCURACY and MONOTONICITY ******************************************* # # The returned result is within 3 ulps in 64 significant bit, # # i.e. within 0.5001 ulp to 53 bits if the result is subsequently # # rounded to double precision. The result is provably monotonic # # in double precision. # # # # ALGORITHM *********************************************************** # # # # ATANH # # 1. If |X| >= 1, go to 3. # # # # 2. (|X| < 1) Calculate atanh(X) by # # sgn := sign(X) # # y := |X| # # z := 2y/(1-y) # # atanh(X) := sgn * (1/2) * logp1(z) # # Exit. # # # # 3. If |X| > 1, go to 5. # # # # 4. (|X| = 1) Generate infinity with an appropriate sign and # # divide-by-zero by # # sgn := sign(X) # # atan(X) := sgn / (+0). # # Exit. # # # # 5. (|X| > 1) Generate an invalid operation by 0 * infinity. # # Exit. # # # ######################################################################### global satanh satanh: mov.l (%a0),%d1 mov.w 4(%a0),%d1 and.l &0x7FFFFFFF,%d1 cmp.l %d1,&0x3FFF8000 bge.b ATANHBIG #--THIS IS THE USUAL CASE, |X| < 1 #--Y = |X|, Z = 2Y/(1-Y), ATANH(X) = SIGN(X) * (1/2) * LOG1P(Z). fabs.x (%a0),%fp0 # Y = |X| fmov.x %fp0,%fp1 fneg.x %fp1 # -Y fadd.x %fp0,%fp0 # 2Y fadd.s &0x3F800000,%fp1 # 1-Y fdiv.x %fp1,%fp0 # 2Y/(1-Y) mov.l (%a0),%d1 and.l &0x80000000,%d1 or.l &0x3F000000,%d1 # SIGN(X)*HALF mov.l %d1,-(%sp) mov.l %d0,-(%sp) # save rnd prec,mode clr.l %d0 # pass ext prec,RN fmovm.x &0x01,-(%sp) # save Z on stack lea (%sp),%a0 # pass ptr to Z bsr slognp1 # LOG1P(Z) add.l &0xc,%sp # clear Z from stack mov.l (%sp)+,%d0 # fetch old prec,mode fmov.l %d0,%fpcr # load it mov.b &FMUL_OP,%d1 # last inst is MUL fmul.s (%sp)+,%fp0 bra t_catch ATANHBIG: fabs.x (%a0),%fp0 # |X| fcmp.s %fp0,&0x3F800000 fbgt t_operr bra t_dz global satanhd #--ATANH(X) = X FOR DENORMALIZED X satanhd: bra t_extdnrm ######################################################################### # slog10(): computes the base-10 logarithm of a normalized input # # slog10d(): computes the base-10 logarithm of a denormalized input # # slog2(): computes the base-2 logarithm of a normalized input # # slog2d(): computes the base-2 logarithm of a denormalized input # # # # INPUT *************************************************************** # # a0 = pointer to extended precision input # # d0 = round precision,mode # # # # OUTPUT ************************************************************** # # fp0 = log_10(X) or log_2(X) # # # # ACCURACY and MONOTONICITY ******************************************* # # The returned result is within 1.7 ulps in 64 significant bit, # # i.e. within 0.5003 ulp to 53 bits if the result is subsequently # # rounded to double precision. The result is provably monotonic # # in double precision. # # # # ALGORITHM *********************************************************** # # # # slog10d: # # # # Step 0. If X < 0, create a NaN and raise the invalid operation # # flag. Otherwise, save FPCR in D1; set FpCR to default. # # Notes: Default means round-to-nearest mode, no floating-point # # traps, and precision control = double extended. # # # # Step 1. Call slognd to obtain Y = log(X), the natural log of X. # # Notes: Even if X is denormalized, log(X) is always normalized. # # # # Step 2. Compute log_10(X) = log(X) * (1/log(10)). # # 2.1 Restore the user FPCR # # 2.2 Return ans := Y * INV_L10. # # # # slog10: # # # # Step 0. If X < 0, create a NaN and raise the invalid operation # # flag. Otherwise, save FPCR in D1; set FpCR to default. # # Notes: Default means round-to-nearest mode, no floating-point # # traps, and precision control = double extended. # # # # Step 1. Call sLogN to obtain Y = log(X), the natural log of X. # # # # Step 2. Compute log_10(X) = log(X) * (1/log(10)). # # 2.1 Restore the user FPCR # # 2.2 Return ans := Y * INV_L10. # # # # sLog2d: # # # # Step 0. If X < 0, create a NaN and raise the invalid operation # # flag. Otherwise, save FPCR in D1; set FpCR to default. # # Notes: Default means round-to-nearest mode, no floating-point # # traps, and precision control = double extended. # # # # Step 1. Call slognd to obtain Y = log(X), the natural log of X. # # Notes: Even if X is denormalized, log(X) is always normalized. # # # # Step 2. Compute log_10(X) = log(X) * (1/log(2)). # # 2.1 Restore the user FPCR # # 2.2 Return ans := Y * INV_L2. # # # # sLog2: # # # # Step 0. If X < 0, create a NaN and raise the invalid operation # # flag. Otherwise, save FPCR in D1; set FpCR to default. # # Notes: Default means round-to-nearest mode, no floating-point # # traps, and precision control = double extended. # # # # Step 1. If X is not an integer power of two, i.e., X != 2^k, # # go to Step 3. # # # # Step 2. Return k. # # 2.1 Get integer k, X = 2^k. # # 2.2 Restore the user FPCR. # # 2.3 Return ans := convert-to-double-extended(k). # # # # Step 3. Call sLogN to obtain Y = log(X), the natural log of X. # # # # Step 4. Compute log_2(X) = log(X) * (1/log(2)). # # 4.1 Restore the user FPCR # # 4.2 Return ans := Y * INV_L2. # # # ######################################################################### INV_L10: long 0x3FFD0000,0xDE5BD8A9,0x37287195,0x00000000 INV_L2: long 0x3FFF0000,0xB8AA3B29,0x5C17F0BC,0x00000000 global slog10 #--entry point for Log10(X), X is normalized slog10: fmov.b &0x1,%fp0 fcmp.x %fp0,(%a0) # if operand == 1, fbeq.l ld_pzero # return an EXACT zero mov.l (%a0),%d1 blt.w invalid mov.l %d0,-(%sp) clr.l %d0 bsr slogn # log(X), X normal. fmov.l (%sp)+,%fpcr fmul.x INV_L10(%pc),%fp0 bra t_inx2 global slog10d #--entry point for Log10(X), X is denormalized slog10d: mov.l (%a0),%d1 blt.w invalid mov.l %d0,-(%sp) clr.l %d0 bsr slognd # log(X), X denorm. fmov.l (%sp)+,%fpcr fmul.x INV_L10(%pc),%fp0 bra t_minx2 global slog2 #--entry point for Log2(X), X is normalized slog2: mov.l (%a0),%d1 blt.w invalid mov.l 8(%a0),%d1 bne.b continue # X is not 2^k mov.l 4(%a0),%d1 and.l &0x7FFFFFFF,%d1 bne.b continue #--X = 2^k. mov.w (%a0),%d1 and.l &0x00007FFF,%d1 sub.l &0x3FFF,%d1 beq.l ld_pzero fmov.l %d0,%fpcr fmov.l %d1,%fp0 bra t_inx2 continue: mov.l %d0,-(%sp) clr.l %d0 bsr slogn # log(X), X normal. fmov.l (%sp)+,%fpcr fmul.x INV_L2(%pc),%fp0 bra t_inx2 invalid: bra t_operr global slog2d #--entry point for Log2(X), X is denormalized slog2d: mov.l (%a0),%d1 blt.w invalid mov.l %d0,-(%sp) clr.l %d0 bsr slognd # log(X), X denorm. fmov.l (%sp)+,%fpcr fmul.x INV_L2(%pc),%fp0 bra t_minx2 ######################################################################### # stwotox(): computes 2**X for a normalized input # # stwotoxd(): computes 2**X for a denormalized input # # stentox(): computes 10**X for a normalized input # # stentoxd(): computes 10**X for a denormalized input # # # # INPUT *************************************************************** # # a0 = pointer to extended precision input # # d0 = round precision,mode # # # # OUTPUT ************************************************************** # # fp0 = 2**X or 10**X # # # # ACCURACY and MONOTONICITY ******************************************* # # The returned result is within 2 ulps in 64 significant bit, # # i.e. within 0.5001 ulp to 53 bits if the result is subsequently # # rounded to double precision. The result is provably monotonic # # in double precision. # # # # ALGORITHM *********************************************************** # # # # twotox # # 1. If |X| > 16480, go to ExpBig. # # # # 2. If |X| < 2**(-70), go to ExpSm. # # # # 3. Decompose X as X = N/64 + r where |r| <= 1/128. Furthermore # # decompose N as # # N = 64(M + M') + j, j = 0,1,2,...,63. # # # # 4. Overwrite r := r * log2. Then # # 2**X = 2**(M') * 2**(M) * 2**(j/64) * exp(r). # # Go to expr to compute that expression. # # # # tentox # # 1. If |X| > 16480*log_10(2) (base 10 log of 2), go to ExpBig. # # # # 2. If |X| < 2**(-70), go to ExpSm. # # # # 3. Set y := X*log_2(10)*64 (base 2 log of 10). Set # # N := round-to-int(y). Decompose N as # # N = 64(M + M') + j, j = 0,1,2,...,63. # # # # 4. Define r as # # r := ((X - N*L1)-N*L2) * L10 # # where L1, L2 are the leading and trailing parts of # # log_10(2)/64 and L10 is the natural log of 10. Then # # 10**X = 2**(M') * 2**(M) * 2**(j/64) * exp(r). # # Go to expr to compute that expression. # # # # expr # # 1. Fetch 2**(j/64) from table as Fact1 and Fact2. # # # # 2. Overwrite Fact1 and Fact2 by # # Fact1 := 2**(M) * Fact1 # # Fact2 := 2**(M) * Fact2 # # Thus Fact1 + Fact2 = 2**(M) * 2**(j/64). # # # # 3. Calculate P where 1 + P approximates exp(r): # # P = r + r*r*(A1+r*(A2+...+r*A5)). # # # # 4. Let AdjFact := 2**(M'). Return # # AdjFact * ( Fact1 + ((Fact1*P) + Fact2) ). # # Exit. # # # # ExpBig # # 1. Generate overflow by Huge * Huge if X > 0; otherwise, # # generate underflow by Tiny * Tiny. # # # # ExpSm # # 1. Return 1 + X. # # # ######################################################################### L2TEN64: long 0x406A934F,0x0979A371 # 64LOG10/LOG2 L10TWO1: long 0x3F734413,0x509F8000 # LOG2/64LOG10 L10TWO2: long 0xBFCD0000,0xC0219DC1,0xDA994FD2,0x00000000 LOG10: long 0x40000000,0x935D8DDD,0xAAA8AC17,0x00000000 LOG2: long 0x3FFE0000,0xB17217F7,0xD1CF79AC,0x00000000 EXPA5: long 0x3F56C16D,0x6F7BD0B2 EXPA4: long 0x3F811112,0x302C712C EXPA3: long 0x3FA55555,0x55554CC1 EXPA2: long 0x3FC55555,0x55554A54 EXPA1: long 0x3FE00000,0x00000000,0x00000000,0x00000000 TEXPTBL: long 0x3FFF0000,0x80000000,0x00000000,0x3F738000 long 0x3FFF0000,0x8164D1F3,0xBC030773,0x3FBEF7CA long 0x3FFF0000,0x82CD8698,0xAC2BA1D7,0x3FBDF8A9 long 0x3FFF0000,0x843A28C3,0xACDE4046,0x3FBCD7C9 long 0x3FFF0000,0x85AAC367,0xCC487B15,0xBFBDE8DA long 0x3FFF0000,0x871F6196,0x9E8D1010,0x3FBDE85C long 0x3FFF0000,0x88980E80,0x92DA8527,0x3FBEBBF1 long 0x3FFF0000,0x8A14D575,0x496EFD9A,0x3FBB80CA long 0x3FFF0000,0x8B95C1E3,0xEA8BD6E7,0xBFBA8373 long 0x3FFF0000,0x8D1ADF5B,0x7E5BA9E6,0xBFBE9670 long 0x3FFF0000,0x8EA4398B,0x45CD53C0,0x3FBDB700 long 0x3FFF0000,0x9031DC43,0x1466B1DC,0x3FBEEEB0 long 0x3FFF0000,0x91C3D373,0xAB11C336,0x3FBBFD6D long 0x3FFF0000,0x935A2B2F,0x13E6E92C,0xBFBDB319 long 0x3FFF0000,0x94F4EFA8,0xFEF70961,0x3FBDBA2B long 0x3FFF0000,0x96942D37,0x20185A00,0x3FBE91D5 long 0x3FFF0000,0x9837F051,0x8DB8A96F,0x3FBE8D5A long 0x3FFF0000,0x99E04593,0x20B7FA65,0xBFBCDE7B long 0x3FFF0000,0x9B8D39B9,0xD54E5539,0xBFBEBAAF long 0x3FFF0000,0x9D3ED9A7,0x2CFFB751,0xBFBD86DA long 0x3FFF0000,0x9EF53260,0x91A111AE,0xBFBEBEDD long 0x3FFF0000,0xA0B0510F,0xB9714FC2,0x3FBCC96E long 0x3FFF0000,0xA2704303,0x0C496819,0xBFBEC90B long 0x3FFF0000,0xA43515AE,0x09E6809E,0x3FBBD1DB long 0x3FFF0000,0xA5FED6A9,0xB15138EA,0x3FBCE5EB long 0x3FFF0000,0xA7CD93B4,0xE965356A,0xBFBEC274 long 0x3FFF0000,0xA9A15AB4,0xEA7C0EF8,0x3FBEA83C long 0x3FFF0000,0xAB7A39B5,0xA93ED337,0x3FBECB00 long 0x3FFF0000,0xAD583EEA,0x42A14AC6,0x3FBE9301 long 0x3FFF0000,0xAF3B78AD,0x690A4375,0xBFBD8367 long 0x3FFF0000,0xB123F581,0xD2AC2590,0xBFBEF05F long 0x3FFF0000,0xB311C412,0xA9112489,0x3FBDFB3C long 0x3FFF0000,0xB504F333,0xF9DE6484,0x3FBEB2FB long 0x3FFF0000,0xB6FD91E3,0x28D17791,0x3FBAE2CB long 0x3FFF0000,0xB8FBAF47,0x62FB9EE9,0x3FBCDC3C long 0x3FFF0000,0xBAFF5AB2,0x133E45FB,0x3FBEE9AA long 0x3FFF0000,0xBD08A39F,0x580C36BF,0xBFBEAEFD long 0x3FFF0000,0xBF1799B6,0x7A731083,0xBFBCBF51 long 0x3FFF0000,0xC12C4CCA,0x66709456,0x3FBEF88A long 0x3FFF0000,0xC346CCDA,0x24976407,0x3FBD83B2 long 0x3FFF0000,0xC5672A11,0x5506DADD,0x3FBDF8AB long 0x3FFF0000,0xC78D74C8,0xABB9B15D,0xBFBDFB17 long 0x3FFF0000,0xC9B9BD86,0x6E2F27A3,0xBFBEFE3C long 0x3FFF0000,0xCBEC14FE,0xF2727C5D,0xBFBBB6F8 long 0x3FFF0000,0xCE248C15,0x1F8480E4,0xBFBCEE53 long 0x3FFF0000,0xD06333DA,0xEF2B2595,0xBFBDA4AE long 0x3FFF0000,0xD2A81D91,0xF12AE45A,0x3FBC9124 long 0x3FFF0000,0xD4F35AAB,0xCFEDFA1F,0x3FBEB243 long 0x3FFF0000,0xD744FCCA,0xD69D6AF4,0x3FBDE69A long 0x3FFF0000,0xD99D15C2,0x78AFD7B6,0xBFB8BC61 long 0x3FFF0000,0xDBFBB797,0xDAF23755,0x3FBDF610 long 0x3FFF0000,0xDE60F482,0x5E0E9124,0xBFBD8BE1 long 0x3FFF0000,0xE0CCDEEC,0x2A94E111,0x3FBACB12 long 0x3FFF0000,0xE33F8972,0xBE8A5A51,0x3FBB9BFE long 0x3FFF0000,0xE5B906E7,0x7C8348A8,0x3FBCF2F4 long 0x3FFF0000,0xE8396A50,0x3C4BDC68,0x3FBEF22F long 0x3FFF0000,0xEAC0C6E7,0xDD24392F,0xBFBDBF4A long 0x3FFF0000,0xED4F301E,0xD9942B84,0x3FBEC01A long 0x3FFF0000,0xEFE4B99B,0xDCDAF5CB,0x3FBE8CAC long 0x3FFF0000,0xF281773C,0x59FFB13A,0xBFBCBB3F long 0x3FFF0000,0xF5257D15,0x2486CC2C,0x3FBEF73A long 0x3FFF0000,0xF7D0DF73,0x0AD13BB9,0xBFB8B795 long 0x3FFF0000,0xFA83B2DB,0x722A033A,0x3FBEF84B long 0x3FFF0000,0xFD3E0C0C,0xF486C175,0xBFBEF581 set INT,L_SCR1 set X,FP_SCR0 set XDCARE,X+2 set XFRAC,X+4 set ADJFACT,FP_SCR0 set FACT1,FP_SCR0 set FACT1HI,FACT1+4 set FACT1LOW,FACT1+8 set FACT2,FP_SCR1 set FACT2HI,FACT2+4 set FACT2LOW,FACT2+8 global stwotox #--ENTRY POINT FOR 2**(X), HERE X IS FINITE, NON-ZERO, AND NOT NAN'S stwotox: fmovm.x (%a0),&0x80 # LOAD INPUT mov.l (%a0),%d1 mov.w 4(%a0),%d1 fmov.x %fp0,X(%a6) and.l &0x7FFFFFFF,%d1 cmp.l %d1,&0x3FB98000 # |X| >= 2**(-70)? bge.b TWOOK1 bra.w EXPBORS TWOOK1: cmp.l %d1,&0x400D80C0 # |X| > 16480? ble.b TWOMAIN bra.w EXPBORS TWOMAIN: #--USUAL CASE, 2^(-70) <= |X| <= 16480 fmov.x %fp0,%fp1 fmul.s &0x42800000,%fp1 # 64 * X fmov.l %fp1,INT(%a6) # N = ROUND-TO-INT(64 X) mov.l %d2,-(%sp) lea TEXPTBL(%pc),%a1 # LOAD ADDRESS OF TABLE OF 2^(J/64) fmov.l INT(%a6),%fp1 # N --> FLOATING FMT mov.l INT(%a6),%d1 mov.l %d1,%d2 and.l &0x3F,%d1 # D0 IS J asl.l &4,%d1 # DISPLACEMENT FOR 2^(J/64) add.l %d1,%a1 # ADDRESS FOR 2^(J/64) asr.l &6,%d2 # d2 IS L, N = 64L + J mov.l %d2,%d1 asr.l &1,%d1 # D0 IS M sub.l %d1,%d2 # d2 IS M', N = 64(M+M') + J add.l &0x3FFF,%d2 #--SUMMARY: a1 IS ADDRESS FOR THE LEADING PORTION OF 2^(J/64), #--D0 IS M WHERE N = 64(M+M') + J. NOTE THAT |M| <= 16140 BY DESIGN. #--ADJFACT = 2^(M'). #--REGISTERS SAVED SO FAR ARE (IN ORDER) FPCR, D0, FP1, a1, AND FP2. fmovm.x &0x0c,-(%sp) # save fp2/fp3 fmul.s &0x3C800000,%fp1 # (1/64)*N mov.l (%a1)+,FACT1(%a6) mov.l (%a1)+,FACT1HI(%a6) mov.l (%a1)+,FACT1LOW(%a6) mov.w (%a1)+,FACT2(%a6) fsub.x %fp1,%fp0 # X - (1/64)*INT(64 X) mov.w (%a1)+,FACT2HI(%a6) clr.w FACT2HI+2(%a6) clr.l FACT2LOW(%a6) add.w %d1,FACT1(%a6) fmul.x LOG2(%pc),%fp0 # FP0 IS R add.w %d1,FACT2(%a6) bra.w expr EXPBORS: #--FPCR, D0 SAVED cmp.l %d1,&0x3FFF8000 bgt.b TEXPBIG #--|X| IS SMALL, RETURN 1 + X fmov.l %d0,%fpcr # restore users round prec,mode fadd.s &0x3F800000,%fp0 # RETURN 1 + X bra t_pinx2 TEXPBIG: #--|X| IS LARGE, GENERATE OVERFLOW IF X > 0; ELSE GENERATE UNDERFLOW #--REGISTERS SAVE SO FAR ARE FPCR AND D0 mov.l X(%a6),%d1 cmp.l %d1,&0 blt.b EXPNEG bra t_ovfl2 # t_ovfl expects positive value EXPNEG: bra t_unfl2 # t_unfl expects positive value global stwotoxd stwotoxd: #--ENTRY POINT FOR 2**(X) FOR DENORMALIZED ARGUMENT fmov.l %d0,%fpcr # set user's rounding mode/precision fmov.s &0x3F800000,%fp0 # RETURN 1 + X mov.l (%a0),%d1 or.l &0x00800001,%d1 fadd.s %d1,%fp0 bra t_pinx2 global stentox #--ENTRY POINT FOR 10**(X), HERE X IS FINITE, NON-ZERO, AND NOT NAN'S stentox: fmovm.x (%a0),&0x80 # LOAD INPUT mov.l (%a0),%d1 mov.w 4(%a0),%d1 fmov.x %fp0,X(%a6) and.l &0x7FFFFFFF,%d1 cmp.l %d1,&0x3FB98000 # |X| >= 2**(-70)? bge.b TENOK1 bra.w EXPBORS TENOK1: cmp.l %d1,&0x400B9B07 # |X| <= 16480*log2/log10 ? ble.b TENMAIN bra.w EXPBORS TENMAIN: #--USUAL CASE, 2^(-70) <= |X| <= 16480 LOG 2 / LOG 10 fmov.x %fp0,%fp1 fmul.d L2TEN64(%pc),%fp1 # X*64*LOG10/LOG2 fmov.l %fp1,INT(%a6) # N=INT(X*64*LOG10/LOG2) mov.l %d2,-(%sp) lea TEXPTBL(%pc),%a1 # LOAD ADDRESS OF TABLE OF 2^(J/64) fmov.l INT(%a6),%fp1 # N --> FLOATING FMT mov.l INT(%a6),%d1 mov.l %d1,%d2 and.l &0x3F,%d1 # D0 IS J asl.l &4,%d1 # DISPLACEMENT FOR 2^(J/64) add.l %d1,%a1 # ADDRESS FOR 2^(J/64) asr.l &6,%d2 # d2 IS L, N = 64L + J mov.l %d2,%d1 asr.l &1,%d1 # D0 IS M sub.l %d1,%d2 # d2 IS M', N = 64(M+M') + J add.l &0x3FFF,%d2 #--SUMMARY: a1 IS ADDRESS FOR THE LEADING PORTION OF 2^(J/64), #--D0 IS M WHERE N = 64(M+M') + J. NOTE THAT |M| <= 16140 BY DESIGN. #--ADJFACT = 2^(M'). #--REGISTERS SAVED SO FAR ARE (IN ORDER) FPCR, D0, FP1, a1, AND FP2. fmovm.x &0x0c,-(%sp) # save fp2/fp3 fmov.x %fp1,%fp2 fmul.d L10TWO1(%pc),%fp1 # N*(LOG2/64LOG10)_LEAD mov.l (%a1)+,FACT1(%a6) fmul.x L10TWO2(%pc),%fp2 # N*(LOG2/64LOG10)_TRAIL mov.l (%a1)+,FACT1HI(%a6) mov.l (%a1)+,FACT1LOW(%a6) fsub.x %fp1,%fp0 # X - N L_LEAD mov.w (%a1)+,FACT2(%a6) fsub.x %fp2,%fp0 # X - N L_TRAIL mov.w (%a1)+,FACT2HI(%a6) clr.w FACT2HI+2(%a6) clr.l FACT2LOW(%a6) fmul.x LOG10(%pc),%fp0 # FP0 IS R add.w %d1,FACT1(%a6) add.w %d1,FACT2(%a6) expr: #--FPCR, FP2, FP3 ARE SAVED IN ORDER AS SHOWN. #--ADJFACT CONTAINS 2**(M'), FACT1 + FACT2 = 2**(M) * 2**(J/64). #--FP0 IS R. THE FOLLOWING CODE COMPUTES #-- 2**(M'+M) * 2**(J/64) * EXP(R) fmov.x %fp0,%fp1 fmul.x %fp1,%fp1 # FP1 IS S = R*R fmov.d EXPA5(%pc),%fp2 # FP2 IS A5 fmov.d EXPA4(%pc),%fp3 # FP3 IS A4 fmul.x %fp1,%fp2 # FP2 IS S*A5 fmul.x %fp1,%fp3 # FP3 IS S*A4 fadd.d EXPA3(%pc),%fp2 # FP2 IS A3+S*A5 fadd.d EXPA2(%pc),%fp3 # FP3 IS A2+S*A4 fmul.x %fp1,%fp2 # FP2 IS S*(A3+S*A5) fmul.x %fp1,%fp3 # FP3 IS S*(A2+S*A4) fadd.d EXPA1(%pc),%fp2 # FP2 IS A1+S*(A3+S*A5) fmul.x %fp0,%fp3 # FP3 IS R*S*(A2+S*A4) fmul.x %fp1,%fp2 # FP2 IS S*(A1+S*(A3+S*A5)) fadd.x %fp3,%fp0 # FP0 IS R+R*S*(A2+S*A4) fadd.x %fp2,%fp0 # FP0 IS EXP(R) - 1 fmovm.x (%sp)+,&0x30 # restore fp2/fp3 #--FINAL RECONSTRUCTION PROCESS #--EXP(X) = 2^M*2^(J/64) + 2^M*2^(J/64)*(EXP(R)-1) - (1 OR 0) fmul.x FACT1(%a6),%fp0 fadd.x FACT2(%a6),%fp0 fadd.x FACT1(%a6),%fp0 fmov.l %d0,%fpcr # restore users round prec,mode mov.w %d2,ADJFACT(%a6) # INSERT EXPONENT mov.l (%sp)+,%d2 mov.l &0x80000000,ADJFACT+4(%a6) clr.l ADJFACT+8(%a6) mov.b &FMUL_OP,%d1 # last inst is MUL fmul.x ADJFACT(%a6),%fp0 # FINAL ADJUSTMENT bra t_catch global stentoxd stentoxd: #--ENTRY POINT FOR 10**(X) FOR DENORMALIZED ARGUMENT fmov.l %d0,%fpcr # set user's rounding mode/precision fmov.s &0x3F800000,%fp0 # RETURN 1 + X mov.l (%a0),%d1 or.l &0x00800001,%d1 fadd.s %d1,%fp0 bra t_pinx2 ######################################################################### # sscale(): computes the destination operand scaled by the source # # operand. If the absoulute value of the source operand is # # >= 2^14, an overflow or underflow is returned. # # # # INPUT *************************************************************** # # a0 = pointer to double-extended source operand X # # a1 = pointer to double-extended destination operand Y # # # # OUTPUT ************************************************************** # # fp0 = scale(X,Y) # # # ######################################################################### set SIGN, L_SCR1 global sscale sscale: mov.l %d0,-(%sp) # store off ctrl bits for now mov.w DST_EX(%a1),%d1 # get dst exponent smi.b SIGN(%a6) # use SIGN to hold dst sign andi.l &0x00007fff,%d1 # strip sign from dst exp mov.w SRC_EX(%a0),%d0 # check src bounds andi.w &0x7fff,%d0 # clr src sign bit cmpi.w %d0,&0x3fff # is src ~ ZERO? blt.w src_small # yes cmpi.w %d0,&0x400c # no; is src too big? bgt.w src_out # yes # # Source is within 2^14 range. # src_ok: fintrz.x SRC(%a0),%fp0 # calc int of src fmov.l %fp0,%d0 # int src to d0 # don't want any accrued bits from the fintrz showing up later since # we may need to read the fpsr for the last fp op in t_catch2(). fmov.l &0x0,%fpsr tst.b DST_HI(%a1) # is dst denormalized? bmi.b sok_norm # the dst is a DENORM. normalize the DENORM and add the adjustment to # the src value. then, jump to the norm part of the routine. sok_dnrm: mov.l %d0,-(%sp) # save src for now mov.w DST_EX(%a1),FP_SCR0_EX(%a6) # make a copy mov.l DST_HI(%a1),FP_SCR0_HI(%a6) mov.l DST_LO(%a1),FP_SCR0_LO(%a6) lea FP_SCR0(%a6),%a0 # pass ptr to DENORM bsr.l norm # normalize the DENORM neg.l %d0 add.l (%sp)+,%d0 # add adjustment to src fmovm.x FP_SCR0(%a6),&0x80 # load normalized DENORM cmpi.w %d0,&-0x3fff # is the shft amt really low? bge.b sok_norm2 # thank goodness no # the multiply factor that we're trying to create should be a denorm # for the multiply to work. therefore, we're going to actually do a # multiply with a denorm which will cause an unimplemented data type # exception to be put into the machine which will be caught and corrected # later. we don't do this with the DENORMs above because this method # is slower. but, don't fret, I don't see it being used much either. fmov.l (%sp)+,%fpcr # restore user fpcr mov.l &0x80000000,%d1 # load normalized mantissa subi.l &-0x3fff,%d0 # how many should we shift? neg.l %d0 # make it positive cmpi.b %d0,&0x20 # is it > 32? bge.b sok_dnrm_32 # yes lsr.l %d0,%d1 # no; bit stays in upper lw clr.l -(%sp) # insert zero low mantissa mov.l %d1,-(%sp) # insert new high mantissa clr.l -(%sp) # make zero exponent bra.b sok_norm_cont sok_dnrm_32: subi.b &0x20,%d0 # get shift count lsr.l %d0,%d1 # make low mantissa longword mov.l %d1,-(%sp) # insert new low mantissa clr.l -(%sp) # insert zero high mantissa clr.l -(%sp) # make zero exponent bra.b sok_norm_cont # the src will force the dst to a DENORM value or worse. so, let's # create an fp multiply that will create the result. sok_norm: fmovm.x DST(%a1),&0x80 # load fp0 with normalized src sok_norm2: fmov.l (%sp)+,%fpcr # restore user fpcr addi.w &0x3fff,%d0 # turn src amt into exp value swap %d0 # put exponent in high word clr.l -(%sp) # insert new exponent mov.l &0x80000000,-(%sp) # insert new high mantissa mov.l %d0,-(%sp) # insert new lo mantissa sok_norm_cont: fmov.l %fpcr,%d0 # d0 needs fpcr for t_catch2 mov.b &FMUL_OP,%d1 # last inst is MUL fmul.x (%sp)+,%fp0 # do the multiply bra t_catch2 # catch any exceptions # # Source is outside of 2^14 range. Test the sign and branch # to the appropriate exception handler. # src_out: mov.l (%sp)+,%d0 # restore ctrl bits exg %a0,%a1 # swap src,dst ptrs tst.b SRC_EX(%a1) # is src negative? bmi t_unfl # yes; underflow bra t_ovfl_sc # no; overflow # # The source input is below 1, so we check for denormalized numbers # and set unfl. # src_small: tst.b DST_HI(%a1) # is dst denormalized? bpl.b ssmall_done # yes mov.l (%sp)+,%d0 fmov.l %d0,%fpcr # no; load control bits mov.b &FMOV_OP,%d1 # last inst is MOVE fmov.x DST(%a1),%fp0 # simply return dest bra t_catch2 ssmall_done: mov.l (%sp)+,%d0 # load control bits into d1 mov.l %a1,%a0 # pass ptr to dst bra t_resdnrm ######################################################################### # smod(): computes the fp MOD of the input values X,Y. # # srem(): computes the fp (IEEE) REM of the input values X,Y. # # # # INPUT *************************************************************** # # a0 = pointer to extended precision input X # # a1 = pointer to extended precision input Y # # d0 = round precision,mode # # # # The input operands X and Y can be either normalized or # # denormalized. # # # # OUTPUT ************************************************************** # # fp0 = FREM(X,Y) or FMOD(X,Y) # # # # ALGORITHM *********************************************************** # # # # Step 1. Save and strip signs of X and Y: signX := sign(X), # # signY := sign(Y), X := |X|, Y := |Y|, # # signQ := signX EOR signY. Record whether MOD or REM # # is requested. # # # # Step 2. Set L := expo(X)-expo(Y), k := 0, Q := 0. # # If (L < 0) then # # R := X, go to Step 4. # # else # # R := 2^(-L)X, j := L. # # endif # # # # Step 3. Perform MOD(X,Y) # # 3.1 If R = Y, go to Step 9. # # 3.2 If R > Y, then { R := R - Y, Q := Q + 1} # # 3.3 If j = 0, go to Step 4. # # 3.4 k := k + 1, j := j - 1, Q := 2Q, R := 2R. Go to # # Step 3.1. # # # # Step 4. At this point, R = X - QY = MOD(X,Y). Set # # Last_Subtract := false (used in Step 7 below). If # # MOD is requested, go to Step 6. # # # # Step 5. R = MOD(X,Y), but REM(X,Y) is requested. # # 5.1 If R < Y/2, then R = MOD(X,Y) = REM(X,Y). Go to # # Step 6. # # 5.2 If R > Y/2, then { set Last_Subtract := true, # # Q := Q + 1, Y := signY*Y }. Go to Step 6. # # 5.3 This is the tricky case of R = Y/2. If Q is odd, # # then { Q := Q + 1, signX := -signX }. # # # # Step 6. R := signX*R. # # # # Step 7. If Last_Subtract = true, R := R - Y. # # # # Step 8. Return signQ, last 7 bits of Q, and R as required. # # # # Step 9. At this point, R = 2^(-j)*X - Q Y = Y. Thus, # # X = 2^(j)*(Q+1)Y. set Q := 2^(j)*(Q+1), # # R := 0. Return signQ, last 7 bits of Q, and R. # # # ######################################################################### set Mod_Flag,L_SCR3 set Sc_Flag,L_SCR3+1 set SignY,L_SCR2 set SignX,L_SCR2+2 set SignQ,L_SCR3+2 set Y,FP_SCR0 set Y_Hi,Y+4 set Y_Lo,Y+8 set R,FP_SCR1 set R_Hi,R+4 set R_Lo,R+8 Scale: long 0x00010000,0x80000000,0x00000000,0x00000000 global smod smod: clr.b FPSR_QBYTE(%a6) mov.l %d0,-(%sp) # save ctrl bits clr.b Mod_Flag(%a6) bra.b Mod_Rem global srem srem: clr.b FPSR_QBYTE(%a6) mov.l %d0,-(%sp) # save ctrl bits mov.b &0x1,Mod_Flag(%a6) Mod_Rem: #..Save sign of X and Y movm.l &0x3f00,-(%sp) # save data registers mov.w SRC_EX(%a0),%d3 mov.w %d3,SignY(%a6) and.l &0x00007FFF,%d3 # Y := |Y| # mov.l SRC_HI(%a0),%d4 mov.l SRC_LO(%a0),%d5 # (D3,D4,D5) is |Y| tst.l %d3 bne.b Y_Normal mov.l &0x00003FFE,%d3 # $3FFD + 1 tst.l %d4 bne.b HiY_not0 HiY_0: mov.l %d5,%d4 clr.l %d5 sub.l &32,%d3 clr.l %d6 bfffo %d4{&0:&32},%d6 lsl.l %d6,%d4 sub.l %d6,%d3 # (D3,D4,D5) is normalized # ...with bias $7FFD bra.b Chk_X HiY_not0: clr.l %d6 bfffo %d4{&0:&32},%d6 sub.l %d6,%d3 lsl.l %d6,%d4 mov.l %d5,%d7 # a copy of D5 lsl.l %d6,%d5 neg.l %d6 add.l &32,%d6 lsr.l %d6,%d7 or.l %d7,%d4 # (D3,D4,D5) normalized # ...with bias $7FFD bra.b Chk_X Y_Normal: add.l &0x00003FFE,%d3 # (D3,D4,D5) normalized # ...with bias $7FFD Chk_X: mov.w DST_EX(%a1),%d0 mov.w %d0,SignX(%a6) mov.w SignY(%a6),%d1 eor.l %d0,%d1 and.l &0x00008000,%d1 mov.w %d1,SignQ(%a6) # sign(Q) obtained and.l &0x00007FFF,%d0 mov.l DST_HI(%a1),%d1 mov.l DST_LO(%a1),%d2 # (D0,D1,D2) is |X| tst.l %d0 bne.b X_Normal mov.l &0x00003FFE,%d0 tst.l %d1 bne.b HiX_not0 HiX_0: mov.l %d2,%d1 clr.l %d2 sub.l &32,%d0 clr.l %d6 bfffo %d1{&0:&32},%d6 lsl.l %d6,%d1 sub.l %d6,%d0 # (D0,D1,D2) is normalized # ...with bias $7FFD bra.b Init HiX_not0: clr.l %d6 bfffo %d1{&0:&32},%d6 sub.l %d6,%d0 lsl.l %d6,%d1 mov.l %d2,%d7 # a copy of D2 lsl.l %d6,%d2 neg.l %d6 add.l &32,%d6 lsr.l %d6,%d7 or.l %d7,%d1 # (D0,D1,D2) normalized # ...with bias $7FFD bra.b Init X_Normal: add.l &0x00003FFE,%d0 # (D0,D1,D2) normalized # ...with bias $7FFD Init: # mov.l %d3,L_SCR1(%a6) # save biased exp(Y) mov.l %d0,-(%sp) # save biased exp(X) sub.l %d3,%d0 # L := expo(X)-expo(Y) clr.l %d6 # D6 := carry <- 0 clr.l %d3 # D3 is Q mov.l &0,%a1 # A1 is k; j+k=L, Q=0 #..(Carry,D1,D2) is R tst.l %d0 bge.b Mod_Loop_pre #..expo(X) < expo(Y). Thus X = mod(X,Y) # mov.l (%sp)+,%d0 # restore d0 bra.w Get_Mod Mod_Loop_pre: addq.l &0x4,%sp # erase exp(X) #..At this point R = 2^(-L)X; Q = 0; k = 0; and k+j = L Mod_Loop: tst.l %d6 # test carry bit bgt.b R_GT_Y #..At this point carry = 0, R = (D1,D2), Y = (D4,D5) cmp.l %d1,%d4 # compare hi(R) and hi(Y) bne.b R_NE_Y cmp.l %d2,%d5 # compare lo(R) and lo(Y) bne.b R_NE_Y #..At this point, R = Y bra.w Rem_is_0 R_NE_Y: #..use the borrow of the previous compare bcs.b R_LT_Y # borrow is set iff R < Y R_GT_Y: #..If Carry is set, then Y < (Carry,D1,D2) < 2Y. Otherwise, Carry = 0 #..and Y < (D1,D2) < 2Y. Either way, perform R - Y sub.l %d5,%d2 # lo(R) - lo(Y) subx.l %d4,%d1 # hi(R) - hi(Y) clr.l %d6 # clear carry addq.l &1,%d3 # Q := Q + 1 R_LT_Y: #..At this point, Carry=0, R < Y. R = 2^(k-L)X - QY; k+j = L; j >= 0. tst.l %d0 # see if j = 0. beq.b PostLoop add.l %d3,%d3 # Q := 2Q add.l %d2,%d2 # lo(R) = 2lo(R) roxl.l &1,%d1 # hi(R) = 2hi(R) + carry scs %d6 # set Carry if 2(R) overflows addq.l &1,%a1 # k := k+1 subq.l &1,%d0 # j := j - 1 #..At this point, R=(Carry,D1,D2) = 2^(k-L)X - QY, j+k=L, j >= 0, R < 2Y. bra.b Mod_Loop PostLoop: #..k = L, j = 0, Carry = 0, R = (D1,D2) = X - QY, R < Y. #..normalize R. mov.l L_SCR1(%a6),%d0 # new biased expo of R tst.l %d1 bne.b HiR_not0 HiR_0: mov.l %d2,%d1 clr.l %d2 sub.l &32,%d0 clr.l %d6 bfffo %d1{&0:&32},%d6 lsl.l %d6,%d1 sub.l %d6,%d0 # (D0,D1,D2) is normalized # ...with bias $7FFD bra.b Get_Mod HiR_not0: clr.l %d6 bfffo %d1{&0:&32},%d6 bmi.b Get_Mod # already normalized sub.l %d6,%d0 lsl.l %d6,%d1 mov.l %d2,%d7 # a copy of D2 lsl.l %d6,%d2 neg.l %d6 add.l &32,%d6 lsr.l %d6,%d7 or.l %d7,%d1 # (D0,D1,D2) normalized # Get_Mod: cmp.l %d0,&0x000041FE bge.b No_Scale Do_Scale: mov.w %d0,R(%a6) mov.l %d1,R_Hi(%a6) mov.l %d2,R_Lo(%a6) mov.l L_SCR1(%a6),%d6 mov.w %d6,Y(%a6) mov.l %d4,Y_Hi(%a6) mov.l %d5,Y_Lo(%a6) fmov.x R(%a6),%fp0 # no exception mov.b &1,Sc_Flag(%a6) bra.b ModOrRem No_Scale: mov.l %d1,R_Hi(%a6) mov.l %d2,R_Lo(%a6) sub.l &0x3FFE,%d0 mov.w %d0,R(%a6) mov.l L_SCR1(%a6),%d6 sub.l &0x3FFE,%d6 mov.l %d6,L_SCR1(%a6) fmov.x R(%a6),%fp0 mov.w %d6,Y(%a6) mov.l %d4,Y_Hi(%a6) mov.l %d5,Y_Lo(%a6) clr.b Sc_Flag(%a6) # ModOrRem: tst.b Mod_Flag(%a6) beq.b Fix_Sign mov.l L_SCR1(%a6),%d6 # new biased expo(Y) subq.l &1,%d6 # biased expo(Y/2) cmp.l %d0,%d6 blt.b Fix_Sign bgt.b Last_Sub cmp.l %d1,%d4 bne.b Not_EQ cmp.l %d2,%d5 bne.b Not_EQ bra.w Tie_Case Not_EQ: bcs.b Fix_Sign Last_Sub: # fsub.x Y(%a6),%fp0 # no exceptions addq.l &1,%d3 # Q := Q + 1 # Fix_Sign: #..Get sign of X mov.w SignX(%a6),%d6 bge.b Get_Q fneg.x %fp0 #..Get Q # Get_Q: clr.l %d6 mov.w SignQ(%a6),%d6 # D6 is sign(Q) mov.l &8,%d7 lsr.l %d7,%d6 and.l &0x0000007F,%d3 # 7 bits of Q or.l %d6,%d3 # sign and bits of Q # swap %d3 # fmov.l %fpsr,%d6 # and.l &0xFF00FFFF,%d6 # or.l %d3,%d6 # fmov.l %d6,%fpsr # put Q in fpsr mov.b %d3,FPSR_QBYTE(%a6) # put Q in fpsr # Restore: movm.l (%sp)+,&0xfc # {%d2-%d7} mov.l (%sp)+,%d0 fmov.l %d0,%fpcr tst.b Sc_Flag(%a6) beq.b Finish mov.b &FMUL_OP,%d1 # last inst is MUL fmul.x Scale(%pc),%fp0 # may cause underflow bra t_catch2 # the '040 package did this apparently to see if the dst operand for the # preceding fmul was a denorm. but, it better not have been since the # algorithm just got done playing with fp0 and expected no exceptions # as a result. trust me... # bra t_avoid_unsupp # check for denorm as a # ;result of the scaling Finish: mov.b &FMOV_OP,%d1 # last inst is MOVE fmov.x %fp0,%fp0 # capture exceptions & round bra t_catch2 Rem_is_0: #..R = 2^(-j)X - Q Y = Y, thus R = 0 and quotient = 2^j (Q+1) addq.l &1,%d3 cmp.l %d0,&8 # D0 is j bge.b Q_Big lsl.l %d0,%d3 bra.b Set_R_0 Q_Big: clr.l %d3 Set_R_0: fmov.s &0x00000000,%fp0 clr.b Sc_Flag(%a6) bra.w Fix_Sign Tie_Case: #..Check parity of Q mov.l %d3,%d6 and.l &0x00000001,%d6 tst.l %d6 beq.w Fix_Sign # Q is even #..Q is odd, Q := Q + 1, signX := -signX addq.l &1,%d3 mov.w SignX(%a6),%d6 eor.l &0x00008000,%d6 mov.w %d6,SignX(%a6) bra.w Fix_Sign ######################################################################### # XDEF **************************************************************** # # tag(): return the optype of the input ext fp number # # # # This routine is used by the 060FPLSP. # # # # XREF **************************************************************** # # None # # # # INPUT *************************************************************** # # a0 = pointer to extended precision operand # # # # OUTPUT ************************************************************** # # d0 = value of type tag # # one of: NORM, INF, QNAN, SNAN, DENORM, ZERO # # # # ALGORITHM *********************************************************** # # Simply test the exponent, j-bit, and mantissa values to # # determine the type of operand. # # If it's an unnormalized zero, alter the operand and force it # # to be a normal zero. # # # ######################################################################### global tag tag: mov.w FTEMP_EX(%a0), %d0 # extract exponent andi.w &0x7fff, %d0 # strip off sign cmpi.w %d0, &0x7fff # is (EXP == MAX)? beq.b inf_or_nan_x not_inf_or_nan_x: btst &0x7,FTEMP_HI(%a0) beq.b not_norm_x is_norm_x: mov.b &NORM, %d0 rts not_norm_x: tst.w %d0 # is exponent = 0? bne.b is_unnorm_x not_unnorm_x: tst.l FTEMP_HI(%a0) bne.b is_denorm_x tst.l FTEMP_LO(%a0) bne.b is_denorm_x is_zero_x: mov.b &ZERO, %d0 rts is_denorm_x: mov.b &DENORM, %d0 rts is_unnorm_x: bsr.l unnorm_fix # convert to norm,denorm,or zero rts is_unnorm_reg_x: mov.b &UNNORM, %d0 rts inf_or_nan_x: tst.l FTEMP_LO(%a0) bne.b is_nan_x mov.l FTEMP_HI(%a0), %d0 and.l &0x7fffffff, %d0 # msb is a don't care! bne.b is_nan_x is_inf_x: mov.b &INF, %d0 rts is_nan_x: mov.b &QNAN, %d0 rts ############################################################# qnan: long 0x7fff0000, 0xffffffff, 0xffffffff ######################################################################### # XDEF **************************************************************** # # t_dz(): Handle 060FPLSP dz exception for "flogn" emulation. # # t_dz2(): Handle 060FPLSP dz exception for "fatanh" emulation. # # # # These rouitnes are used by the 060FPLSP package. # # # # XREF **************************************************************** # # None # # # # INPUT *************************************************************** # # a0 = pointer to extended precision source operand. # # # # OUTPUT ************************************************************** # # fp0 = default DZ result. # # # # ALGORITHM *********************************************************** # # Transcendental emulation for the 060FPLSP has detected that # # a DZ exception should occur for the instruction. If DZ is disabled, # # return the default result. # # If DZ is enabled, the dst operand should be returned unscathed # # in fp0 while fp1 is used to create a DZ exception so that the # # operating system can log that such an event occurred. # # # ######################################################################### global t_dz t_dz: tst.b SRC_EX(%a0) # check sign for neg or pos bpl.b dz_pinf # branch if pos sign global t_dz2 t_dz2: ori.l &dzinf_mask+neg_mask,USER_FPSR(%a6) # set N/I/DZ/ADZ btst &dz_bit,FPCR_ENABLE(%a6) bne.b dz_minf_ena # dz is disabled. return a -INF. fmov.s &0xff800000,%fp0 # return -INF rts # dz is enabled. create a dz exception so the user can record it # but use fp1 instead. return the dst operand unscathed in fp0. dz_minf_ena: fmovm.x EXC_FP0(%a6),&0x80 # return fp0 unscathed fmov.l USER_FPCR(%a6),%fpcr fmov.s &0xbf800000,%fp1 # load -1 fdiv.s &0x00000000,%fp1 # -1 / 0 rts dz_pinf: ori.l &dzinf_mask,USER_FPSR(%a6) # set I/DZ/ADZ btst &dz_bit,FPCR_ENABLE(%a6) bne.b dz_pinf_ena # dz is disabled. return a +INF. fmov.s &0x7f800000,%fp0 # return +INF rts # dz is enabled. create a dz exception so the user can record it # but use fp1 instead. return the dst operand unscathed in fp0. dz_pinf_ena: fmovm.x EXC_FP0(%a6),&0x80 # return fp0 unscathed fmov.l USER_FPCR(%a6),%fpcr fmov.s &0x3f800000,%fp1 # load +1 fdiv.s &0x00000000,%fp1 # +1 / 0 rts ######################################################################### # XDEF **************************************************************** # # t_operr(): Handle 060FPLSP OPERR exception during emulation. # # # # This routine is used by the 060FPLSP package. # # # # XREF **************************************************************** # # None. # # # # INPUT *************************************************************** # # fp1 = source operand # # # # OUTPUT ************************************************************** # # fp0 = default result # # fp1 = unchanged # # # # ALGORITHM *********************************************************** # # An operand error should occur as the result of transcendental # # emulation in the 060FPLSP. If OPERR is disabled, just return a NAN # # in fp0. If OPERR is enabled, return the dst operand unscathed in fp0 # # and the source operand in fp1. Use fp2 to create an OPERR exception # # so that the operating system can log the event. # # # ######################################################################### global t_operr t_operr: ori.l &opnan_mask,USER_FPSR(%a6) # set NAN/OPERR/AIOP btst &operr_bit,FPCR_ENABLE(%a6) bne.b operr_ena # operr is disabled. return a QNAN in fp0 fmovm.x qnan(%pc),&0x80 # return QNAN rts # operr is enabled. create an operr exception so the user can record it # but use fp2 instead. return the dst operand unscathed in fp0. operr_ena: fmovm.x EXC_FP0(%a6),&0x80 # return fp0 unscathed fmov.l USER_FPCR(%a6),%fpcr fmovm.x &0x04,-(%sp) # save fp2 fmov.s &0x7f800000,%fp2 # load +INF fmul.s &0x00000000,%fp2 # +INF x 0 fmovm.x (%sp)+,&0x20 # restore fp2 rts pls_huge: long 0x7ffe0000,0xffffffff,0xffffffff mns_huge: long 0xfffe0000,0xffffffff,0xffffffff pls_tiny: long 0x00000000,0x80000000,0x00000000 mns_tiny: long 0x80000000,0x80000000,0x00000000 ######################################################################### # XDEF **************************************************************** # # t_unfl(): Handle 060FPLSP underflow exception during emulation. # # t_unfl2(): Handle 060FPLSP underflow exception during # # emulation. result always positive. # # # # This routine is used by the 060FPLSP package. # # # # XREF **************************************************************** # # None. # # # # INPUT *************************************************************** # # a0 = pointer to extended precision source operand # # # # OUTPUT ************************************************************** # # fp0 = default underflow result # # # # ALGORITHM *********************************************************** # # An underflow should occur as the result of transcendental # # emulation in the 060FPLSP. Create an underflow by using "fmul" # # and two very small numbers of appropriate sign so the operating # # system can log the event. # # # ######################################################################### global t_unfl t_unfl: tst.b SRC_EX(%a0) bpl.b unf_pos global t_unfl2 t_unfl2: ori.l &unfinx_mask+neg_mask,USER_FPSR(%a6) # set N/UNFL/INEX2/AUNFL/AINEX fmov.l USER_FPCR(%a6),%fpcr fmovm.x mns_tiny(%pc),&0x80 fmul.x pls_tiny(%pc),%fp0 fmov.l %fpsr,%d0 rol.l &0x8,%d0 mov.b %d0,FPSR_CC(%a6) rts unf_pos: ori.w &unfinx_mask,FPSR_EXCEPT(%a6) # set UNFL/INEX2/AUNFL/AINEX fmov.l USER_FPCR(%a6),%fpcr fmovm.x pls_tiny(%pc),&0x80 fmul.x %fp0,%fp0 fmov.l %fpsr,%d0 rol.l &0x8,%d0 mov.b %d0,FPSR_CC(%a6) rts ######################################################################### # XDEF **************************************************************** # # t_ovfl(): Handle 060FPLSP overflow exception during emulation. # # (monadic) # # t_ovfl2(): Handle 060FPLSP overflow exception during # # emulation. result always positive. (dyadic) # # t_ovfl_sc(): Handle 060FPLSP overflow exception during # # emulation for "fscale". # # # # This routine is used by the 060FPLSP package. # # # # XREF **************************************************************** # # None. # # # # INPUT *************************************************************** # # a0 = pointer to extended precision source operand # # # # OUTPUT ************************************************************** # # fp0 = default underflow result # # # # ALGORITHM *********************************************************** # # An overflow should occur as the result of transcendental # # emulation in the 060FPLSP. Create an overflow by using "fmul" # # and two very lareg numbers of appropriate sign so the operating # # system can log the event. # # For t_ovfl_sc() we take special care not to lose the INEX2 bit. # # # ######################################################################### global t_ovfl_sc t_ovfl_sc: ori.l &ovfl_inx_mask,USER_FPSR(%a6) # set OVFL/AOVFL/AINEX mov.b %d0,%d1 # fetch rnd prec,mode andi.b &0xc0,%d1 # extract prec beq.w ovfl_work # dst op is a DENORM. we have to normalize the mantissa to see if the # result would be inexact for the given precision. make a copy of the # dst so we don't screw up the version passed to us. mov.w LOCAL_EX(%a0),FP_SCR0_EX(%a6) mov.l LOCAL_HI(%a0),FP_SCR0_HI(%a6) mov.l LOCAL_LO(%a0),FP_SCR0_LO(%a6) lea FP_SCR0(%a6),%a0 # pass ptr to FP_SCR0 movm.l &0xc080,-(%sp) # save d0-d1/a0 bsr.l norm # normalize mantissa movm.l (%sp)+,&0x0103 # restore d0-d1/a0 cmpi.b %d1,&0x40 # is precision sgl? bne.b ovfl_sc_dbl # no; dbl ovfl_sc_sgl: tst.l LOCAL_LO(%a0) # is lo lw of sgl set? bne.b ovfl_sc_inx # yes tst.b 3+LOCAL_HI(%a0) # is lo byte of hi lw set? bne.b ovfl_sc_inx # yes bra.w ovfl_work # don't set INEX2 ovfl_sc_dbl: mov.l LOCAL_LO(%a0),%d1 # are any of lo 11 bits of andi.l &0x7ff,%d1 # dbl mantissa set? beq.w ovfl_work # no; don't set INEX2 ovfl_sc_inx: ori.l &inex2_mask,USER_FPSR(%a6) # set INEX2 bra.b ovfl_work # continue global t_ovfl t_ovfl: ori.w &ovfinx_mask,FPSR_EXCEPT(%a6) # set OVFL/INEX2/AOVFL/AINEX ovfl_work: tst.b SRC_EX(%a0) bpl.b ovfl_p ovfl_m: fmov.l USER_FPCR(%a6),%fpcr fmovm.x mns_huge(%pc),&0x80 fmul.x pls_huge(%pc),%fp0 fmov.l %fpsr,%d0 rol.l &0x8,%d0 ori.b &neg_mask,%d0 mov.b %d0,FPSR_CC(%a6) rts ovfl_p: fmov.l USER_FPCR(%a6),%fpcr fmovm.x pls_huge(%pc),&0x80 fmul.x pls_huge(%pc),%fp0 fmov.l %fpsr,%d0 rol.l &0x8,%d0 mov.b %d0,FPSR_CC(%a6) rts global t_ovfl2 t_ovfl2: ori.w &ovfinx_mask,FPSR_EXCEPT(%a6) # set OVFL/INEX2/AOVFL/AINEX fmov.l USER_FPCR(%a6),%fpcr fmovm.x pls_huge(%pc),&0x80 fmul.x pls_huge(%pc),%fp0 fmov.l %fpsr,%d0 rol.l &0x8,%d0 mov.b %d0,FPSR_CC(%a6) rts ######################################################################### # XDEF **************************************************************** # # t_catch(): Handle 060FPLSP OVFL,UNFL,or INEX2 exception during # # emulation. # # t_catch2(): Handle 060FPLSP OVFL,UNFL,or INEX2 exception during # # emulation. # # # # These routines are used by the 060FPLSP package. # # # # XREF **************************************************************** # # None. # # # # INPUT *************************************************************** # # fp0 = default underflow or overflow result # # # # OUTPUT ************************************************************** # # fp0 = default result # # # # ALGORITHM *********************************************************** # # If an overflow or underflow occurred during the last # # instruction of transcendental 060FPLSP emulation, then it has already # # occurred and has been logged. Now we need to see if an inexact # # exception should occur. # # # ######################################################################### global t_catch2 t_catch2: fmov.l %fpsr,%d0 or.l %d0,USER_FPSR(%a6) bra.b inx2_work global t_catch t_catch: fmov.l %fpsr,%d0 or.l %d0,USER_FPSR(%a6) ######################################################################### # XDEF **************************************************************** # # t_inx2(): Handle inexact 060FPLSP exception during emulation. # # t_pinx2(): Handle inexact 060FPLSP exception for "+" results. # # t_minx2(): Handle inexact 060FPLSP exception for "-" results. # # # # XREF **************************************************************** # # None. # # # # INPUT *************************************************************** # # fp0 = default result # # # # OUTPUT ************************************************************** # # fp0 = default result # # # # ALGORITHM *********************************************************** # # The last instruction of transcendental emulation for the # # 060FPLSP should be inexact. So, if inexact is enabled, then we create # # the event here by adding a large and very small number together # # so that the operating system can log the event. # # Must check, too, if the result was zero, in which case we just # # set the FPSR bits and return. # # # ######################################################################### global t_inx2 t_inx2: fblt.w t_minx2 fbeq.w inx2_zero global t_pinx2 t_pinx2: ori.w &inx2a_mask,FPSR_EXCEPT(%a6) # set INEX2/AINEX bra.b inx2_work global t_minx2 t_minx2: ori.l &inx2a_mask+neg_mask,USER_FPSR(%a6) inx2_work: btst &inex2_bit,FPCR_ENABLE(%a6) # is inexact enabled? bne.b inx2_work_ena # yes rts inx2_work_ena: fmov.l USER_FPCR(%a6),%fpcr # insert user's exceptions fmov.s &0x3f800000,%fp1 # load +1 fadd.x pls_tiny(%pc),%fp1 # cause exception rts inx2_zero: mov.b &z_bmask,FPSR_CC(%a6) ori.w &inx2a_mask,2+USER_FPSR(%a6) # set INEX/AINEX rts ######################################################################### # XDEF **************************************************************** # # t_extdnrm(): Handle DENORM inputs in 060FPLSP. # # t_resdnrm(): Handle DENORM inputs in 060FPLSP for "fscale". # # # # This routine is used by the 060FPLSP package. # # # # XREF **************************************************************** # # None. # # # # INPUT *************************************************************** # # a0 = pointer to extended precision input operand # # # # OUTPUT ************************************************************** # # fp0 = default result # # # # ALGORITHM *********************************************************** # # For all functions that have a denormalized input and that # # f(x)=x, this is the entry point. # # DENORM value is moved using "fmove" which triggers an exception # # if enabled so the operating system can log the event. # # # ######################################################################### global t_extdnrm t_extdnrm: fmov.l USER_FPCR(%a6),%fpcr fmov.x SRC_EX(%a0),%fp0 fmov.l %fpsr,%d0 ori.l &unfinx_mask,%d0 or.l %d0,USER_FPSR(%a6) rts global t_resdnrm t_resdnrm: fmov.l USER_FPCR(%a6),%fpcr fmov.x SRC_EX(%a0),%fp0 fmov.l %fpsr,%d0 or.l %d0,USER_FPSR(%a6) rts ########################################## # # sto_cos: # This is used by fsincos library emulation. The correct # values are already in fp0 and fp1 so we do nothing here. # global sto_cos sto_cos: rts ########################################## # # dst_qnan --- force result when destination is a NaN # global dst_qnan dst_qnan: fmov.x DST(%a1),%fp0 tst.b DST_EX(%a1) bmi.b dst_qnan_m dst_qnan_p: mov.b &nan_bmask,FPSR_CC(%a6) rts dst_qnan_m: mov.b &nan_bmask+neg_bmask,FPSR_CC(%a6) rts # # src_qnan --- force result when source is a NaN # global src_qnan src_qnan: fmov.x SRC(%a0),%fp0 tst.b SRC_EX(%a0) bmi.b src_qnan_m src_qnan_p: mov.b &nan_bmask,FPSR_CC(%a6) rts src_qnan_m: mov.b &nan_bmask+neg_bmask,FPSR_CC(%a6) rts ########################################## # # Native instruction support # # Some systems may need entry points even for 68060 native # instructions. These routines are provided for # convenience. # global _fadds_ _fadds_: fmov.l %fpcr,-(%sp) # save fpcr fmov.l &0x00000000,%fpcr # clear fpcr for load fmov.s 0x8(%sp),%fp0 # load sgl dst fmov.l (%sp)+,%fpcr # restore fpcr fadd.s 0x8(%sp),%fp0 # fadd w/ sgl src rts global _faddd_ _faddd_: fmov.l %fpcr,-(%sp) # save fpcr fmov.l &0x00000000,%fpcr # clear fpcr for load fmov.d 0x8(%sp),%fp0 # load dbl dst fmov.l (%sp)+,%fpcr # restore fpcr fadd.d 0xc(%sp),%fp0 # fadd w/ dbl src rts global _faddx_ _faddx_: fmovm.x 0x4(%sp),&0x80 # load ext dst fadd.x 0x10(%sp),%fp0 # fadd w/ ext src rts global _fsubs_ _fsubs_: fmov.l %fpcr,-(%sp) # save fpcr fmov.l &0x00000000,%fpcr # clear fpcr for load fmov.s 0x8(%sp),%fp0 # load sgl dst fmov.l (%sp)+,%fpcr # restore fpcr fsub.s 0x8(%sp),%fp0 # fsub w/ sgl src rts global _fsubd_ _fsubd_: fmov.l %fpcr,-(%sp) # save fpcr fmov.l &0x00000000,%fpcr # clear fpcr for load fmov.d 0x8(%sp),%fp0 # load dbl dst fmov.l (%sp)+,%fpcr # restore fpcr fsub.d 0xc(%sp),%fp0 # fsub w/ dbl src rts global _fsubx_ _fsubx_: fmovm.x 0x4(%sp),&0x80 # load ext dst fsub.x 0x10(%sp),%fp0 # fsub w/ ext src rts global _fmuls_ _fmuls_: fmov.l %fpcr,-(%sp) # save fpcr fmov.l &0x00000000,%fpcr # clear fpcr for load fmov.s 0x8(%sp),%fp0 # load sgl dst fmov.l (%sp)+,%fpcr # restore fpcr fmul.s 0x8(%sp),%fp0 # fmul w/ sgl src rts global _fmuld_ _fmuld_: fmov.l %fpcr,-(%sp) # save fpcr fmov.l &0x00000000,%fpcr # clear fpcr for load fmov.d 0x8(%sp),%fp0 # load dbl dst fmov.l (%sp)+,%fpcr # restore fpcr fmul.d 0xc(%sp),%fp0 # fmul w/ dbl src rts global _fmulx_ _fmulx_: fmovm.x 0x4(%sp),&0x80 # load ext dst fmul.x 0x10(%sp),%fp0 # fmul w/ ext src rts global _fdivs_ _fdivs_: fmov.l %fpcr,-(%sp) # save fpcr fmov.l &0x00000000,%fpcr # clear fpcr for load fmov.s 0x8(%sp),%fp0 # load sgl dst fmov.l (%sp)+,%fpcr # restore fpcr fdiv.s 0x8(%sp),%fp0 # fdiv w/ sgl src rts global _fdivd_ _fdivd_: fmov.l %fpcr,-(%sp) # save fpcr fmov.l &0x00000000,%fpcr # clear fpcr for load fmov.d 0x8(%sp),%fp0 # load dbl dst fmov.l (%sp)+,%fpcr # restore fpcr fdiv.d 0xc(%sp),%fp0 # fdiv w/ dbl src rts global _fdivx_ _fdivx_: fmovm.x 0x4(%sp),&0x80 # load ext dst fdiv.x 0x10(%sp),%fp0 # fdiv w/ ext src rts global _fabss_ _fabss_: fabs.s 0x4(%sp),%fp0 # fabs w/ sgl src rts global _fabsd_ _fabsd_: fabs.d 0x4(%sp),%fp0 # fabs w/ dbl src rts global _fabsx_ _fabsx_: fabs.x 0x4(%sp),%fp0 # fabs w/ ext src rts global _fnegs_ _fnegs_: fneg.s 0x4(%sp),%fp0 # fneg w/ sgl src rts global _fnegd_ _fnegd_: fneg.d 0x4(%sp),%fp0 # fneg w/ dbl src rts global _fnegx_ _fnegx_: fneg.x 0x4(%sp),%fp0 # fneg w/ ext src rts global _fsqrts_ _fsqrts_: fsqrt.s 0x4(%sp),%fp0 # fsqrt w/ sgl src rts global _fsqrtd_ _fsqrtd_: fsqrt.d 0x4(%sp),%fp0 # fsqrt w/ dbl src rts global _fsqrtx_ _fsqrtx_: fsqrt.x 0x4(%sp),%fp0 # fsqrt w/ ext src rts global _fints_ _fints_: fint.s 0x4(%sp),%fp0 # fint w/ sgl src rts global _fintd_ _fintd_: fint.d 0x4(%sp),%fp0 # fint w/ dbl src rts global _fintx_ _fintx_: fint.x 0x4(%sp),%fp0 # fint w/ ext src rts global _fintrzs_ _fintrzs_: fintrz.s 0x4(%sp),%fp0 # fintrz w/ sgl src rts global _fintrzd_ _fintrzd_: fintrz.d 0x4(%sp),%fp0 # fintrx w/ dbl src rts global _fintrzx_ _fintrzx_: fintrz.x 0x4(%sp),%fp0 # fintrz w/ ext src rts ######################################################################## ######################################################################### # src_zero(): Return signed zero according to sign of src operand. # ######################################################################### global src_zero src_zero: tst.b SRC_EX(%a0) # get sign of src operand bmi.b ld_mzero # if neg, load neg zero # # ld_pzero(): return a positive zero. # global ld_pzero ld_pzero: fmov.s &0x00000000,%fp0 # load +0 mov.b &z_bmask,FPSR_CC(%a6) # set 'Z' ccode bit rts # ld_mzero(): return a negative zero. global ld_mzero ld_mzero: fmov.s &0x80000000,%fp0 # load -0 mov.b &neg_bmask+z_bmask,FPSR_CC(%a6) # set 'N','Z' ccode bits rts ######################################################################### # dst_zero(): Return signed zero according to sign of dst operand. # ######################################################################### global dst_zero dst_zero: tst.b DST_EX(%a1) # get sign of dst operand bmi.b ld_mzero # if neg, load neg zero bra.b ld_pzero # load positive zero ######################################################################### # src_inf(): Return signed inf according to sign of src operand. # ######################################################################### global src_inf src_inf: tst.b SRC_EX(%a0) # get sign of src operand bmi.b ld_minf # if negative branch # # ld_pinf(): return a positive infinity. # global ld_pinf ld_pinf: fmov.s &0x7f800000,%fp0 # load +INF mov.b &inf_bmask,FPSR_CC(%a6) # set 'INF' ccode bit rts # # ld_minf():return a negative infinity. # global ld_minf ld_minf: fmov.s &0xff800000,%fp0 # load -INF mov.b &neg_bmask+inf_bmask,FPSR_CC(%a6) # set 'N','I' ccode bits rts ######################################################################### # dst_inf(): Return signed inf according to sign of dst operand. # ######################################################################### global dst_inf dst_inf: tst.b DST_EX(%a1) # get sign of dst operand bmi.b ld_minf # if negative branch bra.b ld_pinf global szr_inf ################################################################# # szr_inf(): Return +ZERO for a negative src operand or # # +INF for a positive src operand. # # Routine used for fetox, ftwotox, and ftentox. # ################################################################# szr_inf: tst.b SRC_EX(%a0) # check sign of source bmi.b ld_pzero bra.b ld_pinf ######################################################################### # sopr_inf(): Return +INF for a positive src operand or # # jump to operand error routine for a negative src operand. # # Routine used for flogn, flognp1, flog10, and flog2. # ######################################################################### global sopr_inf sopr_inf: tst.b SRC_EX(%a0) # check sign of source bmi.w t_operr bra.b ld_pinf ################################################################# # setoxm1i(): Return minus one for a negative src operand or # # positive infinity for a positive src operand. # # Routine used for fetoxm1. # ################################################################# global setoxm1i setoxm1i: tst.b SRC_EX(%a0) # check sign of source bmi.b ld_mone bra.b ld_pinf ######################################################################### # src_one(): Return signed one according to sign of src operand. # ######################################################################### global src_one src_one: tst.b SRC_EX(%a0) # check sign of source bmi.b ld_mone # # ld_pone(): return positive one. # global ld_pone ld_pone: fmov.s &0x3f800000,%fp0 # load +1 clr.b FPSR_CC(%a6) rts # # ld_mone(): return negative one. # global ld_mone ld_mone: fmov.s &0xbf800000,%fp0 # load -1 mov.b &neg_bmask,FPSR_CC(%a6) # set 'N' ccode bit rts ppiby2: long 0x3fff0000, 0xc90fdaa2, 0x2168c235 mpiby2: long 0xbfff0000, 0xc90fdaa2, 0x2168c235 ################################################################# # spi_2(): Return signed PI/2 according to sign of src operand. # ################################################################# global spi_2 spi_2: tst.b SRC_EX(%a0) # check sign of source bmi.b ld_mpi2 # # ld_ppi2(): return positive PI/2. # global ld_ppi2 ld_ppi2: fmov.l %d0,%fpcr fmov.x ppiby2(%pc),%fp0 # load +pi/2 bra.w t_pinx2 # set INEX2 # # ld_mpi2(): return negative PI/2. # global ld_mpi2 ld_mpi2: fmov.l %d0,%fpcr fmov.x mpiby2(%pc),%fp0 # load -pi/2 bra.w t_minx2 # set INEX2 #################################################### # The following routines give support for fsincos. # #################################################### # # ssincosz(): When the src operand is ZERO, store a one in the # cosine register and return a ZERO in fp0 w/ the same sign # as the src operand. # global ssincosz ssincosz: fmov.s &0x3f800000,%fp1 tst.b SRC_EX(%a0) # test sign bpl.b sincoszp fmov.s &0x80000000,%fp0 # return sin result in fp0 mov.b &z_bmask+neg_bmask,FPSR_CC(%a6) rts sincoszp: fmov.s &0x00000000,%fp0 # return sin result in fp0 mov.b &z_bmask,FPSR_CC(%a6) rts # # ssincosi(): When the src operand is INF, store a QNAN in the cosine # register and jump to the operand error routine for negative # src operands. # global ssincosi ssincosi: fmov.x qnan(%pc),%fp1 # load NAN bra.w t_operr # # ssincosqnan(): When the src operand is a QNAN, store the QNAN in the cosine # register and branch to the src QNAN routine. # global ssincosqnan ssincosqnan: fmov.x LOCAL_EX(%a0),%fp1 bra.w src_qnan ######################################################################## global smod_sdnrm global smod_snorm smod_sdnrm: smod_snorm: mov.b DTAG(%a6),%d1 beq.l smod cmpi.b %d1,&ZERO beq.w smod_zro cmpi.b %d1,&INF beq.l t_operr cmpi.b %d1,&DENORM beq.l smod bra.l dst_qnan global smod_szero smod_szero: mov.b DTAG(%a6),%d1 beq.l t_operr cmpi.b %d1,&ZERO beq.l t_operr cmpi.b %d1,&INF beq.l t_operr cmpi.b %d1,&DENORM beq.l t_operr bra.l dst_qnan global smod_sinf smod_sinf: mov.b DTAG(%a6),%d1 beq.l smod_fpn cmpi.b %d1,&ZERO beq.l smod_zro cmpi.b %d1,&INF beq.l t_operr cmpi.b %d1,&DENORM beq.l smod_fpn bra.l dst_qnan smod_zro: srem_zro: mov.b SRC_EX(%a0),%d1 # get src sign mov.b DST_EX(%a1),%d0 # get dst sign eor.b %d0,%d1 # get qbyte sign andi.b &0x80,%d1 mov.b %d1,FPSR_QBYTE(%a6) tst.b %d0 bpl.w ld_pzero bra.w ld_mzero smod_fpn: srem_fpn: clr.b FPSR_QBYTE(%a6) mov.l %d0,-(%sp) mov.b SRC_EX(%a0),%d1 # get src sign mov.b DST_EX(%a1),%d0 # get dst sign eor.b %d0,%d1 # get qbyte sign andi.b &0x80,%d1 mov.b %d1,FPSR_QBYTE(%a6) cmpi.b DTAG(%a6),&DENORM bne.b smod_nrm lea DST(%a1),%a0 mov.l (%sp)+,%d0 bra t_resdnrm smod_nrm: fmov.l (%sp)+,%fpcr fmov.x DST(%a1),%fp0 tst.b DST_EX(%a1) bmi.b smod_nrm_neg rts smod_nrm_neg: mov.b &neg_bmask,FPSR_CC(%a6) # set 'N' code rts ######################################################################### global srem_snorm global srem_sdnrm srem_sdnrm: srem_snorm: mov.b DTAG(%a6),%d1 beq.l srem cmpi.b %d1,&ZERO beq.w srem_zro cmpi.b %d1,&INF beq.l t_operr cmpi.b %d1,&DENORM beq.l srem bra.l dst_qnan global srem_szero srem_szero: mov.b DTAG(%a6),%d1 beq.l t_operr cmpi.b %d1,&ZERO beq.l t_operr cmpi.b %d1,&INF beq.l t_operr cmpi.b %d1,&DENORM beq.l t_operr bra.l dst_qnan global srem_sinf srem_sinf: mov.b DTAG(%a6),%d1 beq.w srem_fpn cmpi.b %d1,&ZERO beq.w srem_zro cmpi.b %d1,&INF beq.l t_operr cmpi.b %d1,&DENORM beq.l srem_fpn bra.l dst_qnan ######################################################################### global sscale_snorm global sscale_sdnrm sscale_snorm: sscale_sdnrm: mov.b DTAG(%a6),%d1 beq.l sscale cmpi.b %d1,&ZERO beq.l dst_zero cmpi.b %d1,&INF beq.l dst_inf cmpi.b %d1,&DENORM beq.l sscale bra.l dst_qnan global sscale_szero sscale_szero: mov.b DTAG(%a6),%d1 beq.l sscale cmpi.b %d1,&ZERO beq.l dst_zero cmpi.b %d1,&INF beq.l dst_inf cmpi.b %d1,&DENORM beq.l sscale bra.l dst_qnan global sscale_sinf sscale_sinf: mov.b DTAG(%a6),%d1 beq.l t_operr cmpi.b %d1,&QNAN beq.l dst_qnan bra.l t_operr ######################################################################## global sop_sqnan sop_sqnan: mov.b DTAG(%a6),%d1 cmpi.b %d1,&QNAN beq.l dst_qnan bra.l src_qnan ######################################################################### # norm(): normalize the mantissa of an extended precision input. the # # input operand should not be normalized already. # # # # XDEF **************************************************************** # # norm() # # # # XREF **************************************************************** # # none # # # # INPUT *************************************************************** # # a0 = pointer fp extended precision operand to normalize # # # # OUTPUT ************************************************************** # # d0 = number of bit positions the mantissa was shifted # # a0 = the input operand's mantissa is normalized; the exponent # # is unchanged. # # # ######################################################################### global norm norm: mov.l %d2, -(%sp) # create some temp regs mov.l %d3, -(%sp) mov.l FTEMP_HI(%a0), %d0 # load hi(mantissa) mov.l FTEMP_LO(%a0), %d1 # load lo(mantissa) bfffo %d0{&0:&32}, %d2 # how many places to shift? beq.b norm_lo # hi(man) is all zeroes! norm_hi: lsl.l %d2, %d0 # left shift hi(man) bfextu %d1{&0:%d2}, %d3 # extract lo bits or.l %d3, %d0 # create hi(man) lsl.l %d2, %d1 # create lo(man) mov.l %d0, FTEMP_HI(%a0) # store new hi(man) mov.l %d1, FTEMP_LO(%a0) # store new lo(man) mov.l %d2, %d0 # return shift amount mov.l (%sp)+, %d3 # restore temp regs mov.l (%sp)+, %d2 rts norm_lo: bfffo %d1{&0:&32}, %d2 # how many places to shift? lsl.l %d2, %d1 # shift lo(man) add.l &32, %d2 # add 32 to shft amount mov.l %d1, FTEMP_HI(%a0) # store hi(man) clr.l FTEMP_LO(%a0) # lo(man) is now zero mov.l %d2, %d0 # return shift amount mov.l (%sp)+, %d3 # restore temp regs mov.l (%sp)+, %d2 rts ######################################################################### # unnorm_fix(): - changes an UNNORM to one of NORM, DENORM, or ZERO # # - returns corresponding optype tag # # # # XDEF **************************************************************** # # unnorm_fix() # # # # XREF **************************************************************** # # norm() - normalize the mantissa # # # # INPUT *************************************************************** # # a0 = pointer to unnormalized extended precision number # # # # OUTPUT ************************************************************** # # d0 = optype tag - is corrected to one of NORM, DENORM, or ZERO # # a0 = input operand has been converted to a norm, denorm, or # # zero; both the exponent and mantissa are changed. # # # ######################################################################### global unnorm_fix unnorm_fix: bfffo FTEMP_HI(%a0){&0:&32}, %d0 # how many shifts are needed? bne.b unnorm_shift # hi(man) is not all zeroes # # hi(man) is all zeroes so see if any bits in lo(man) are set # unnorm_chk_lo: bfffo FTEMP_LO(%a0){&0:&32}, %d0 # is operand really a zero? beq.w unnorm_zero # yes add.w &32, %d0 # no; fix shift distance # # d0 = # shifts needed for complete normalization # unnorm_shift: clr.l %d1 # clear top word mov.w FTEMP_EX(%a0), %d1 # extract exponent and.w &0x7fff, %d1 # strip off sgn cmp.w %d0, %d1 # will denorm push exp < 0? bgt.b unnorm_nrm_zero # yes; denorm only until exp = 0 # # exponent would not go < 0. therefore, number stays normalized # sub.w %d0, %d1 # shift exponent value mov.w FTEMP_EX(%a0), %d0 # load old exponent and.w &0x8000, %d0 # save old sign or.w %d0, %d1 # {sgn,new exp} mov.w %d1, FTEMP_EX(%a0) # insert new exponent bsr.l norm # normalize UNNORM mov.b &NORM, %d0 # return new optype tag rts # # exponent would go < 0, so only denormalize until exp = 0 # unnorm_nrm_zero: cmp.b %d1, &32 # is exp <= 32? bgt.b unnorm_nrm_zero_lrg # no; go handle large exponent bfextu FTEMP_HI(%a0){%d1:&32}, %d0 # extract new hi(man) mov.l %d0, FTEMP_HI(%a0) # save new hi(man) mov.l FTEMP_LO(%a0), %d0 # fetch old lo(man) lsl.l %d1, %d0 # extract new lo(man) mov.l %d0, FTEMP_LO(%a0) # save new lo(man) and.w &0x8000, FTEMP_EX(%a0) # set exp = 0 mov.b &DENORM, %d0 # return new optype tag rts # # only mantissa bits set are in lo(man) # unnorm_nrm_zero_lrg: sub.w &32, %d1 # adjust shft amt by 32 mov.l FTEMP_LO(%a0), %d0 # fetch old lo(man) lsl.l %d1, %d0 # left shift lo(man) mov.l %d0, FTEMP_HI(%a0) # store new hi(man) clr.l FTEMP_LO(%a0) # lo(man) = 0 and.w &0x8000, FTEMP_EX(%a0) # set exp = 0 mov.b &DENORM, %d0 # return new optype tag rts # # whole mantissa is zero so this UNNORM is actually a zero # unnorm_zero: and.w &0x8000, FTEMP_EX(%a0) # force exponent to zero mov.b &ZERO, %d0 # fix optype tag rts