Quelle  fplsp.S

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
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 <ea>

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)+ <ea>
set mda7_flg,  0x08   # flag bit: -(a7) <ea>
set fmovm_flg,  0x40   # flag bit: fmovm instruction
set immed_flg,  0x80   # flag bit: &<data> <ea>

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