	.file "tanh.s"
/*
 * $Copyright:	$
 * Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990 
 * Sequent Computer Systems, Inc.   All rights reserved.
 *  
 * This software is furnished under a license and may be used
 * only in accordance with the terms of that license and with the
 * inclusion of the above copyright notice.   This software may not
 * be provided or otherwise made available to, or used by, any
 * other person.  No title to or ownership of the software is
 * hereby transferred.
 *
 */

  / "Double Precision Hyperbolic Sine, Cosine, and Tangent Functions"
  /
  / 
  / Functional Description:
  / 	These functions are the top level entry points for the double
  / 	precision hyperbolic sine, cosine, and tangent functions. 
  /	For hyperbolic sine and cosine, the routines set the sin/cos flag 
  / 	to specify which value should be computed and then call the routine 
  / 	which actually does the computation. For the hyperbolic tangent, 
  / 	the following algorithm was used. It was obtained from the original
  / 	PASCAL library that these routines replace.
  / 
  / 	IF (abs(arg) > 19.1)
  / 		return error and NAN
  /	ENDIF
  / 	IF (arg == 0.0)
  / 		result = 1.0 and return
  /	ENDIF
  /	IF (arg < 0.0)
  /	    signf = 1
  /	ELSE
  /	    signf = 0
  /	ENDIF
  /	x = abs(arg)
  /	IF (x < 0.75)
  /	    xsq = x * x
  /	    result =  x + ((((-0.96445016240077) * xsq
  / 			+    -99.41819453693073) * xsq
  /			+  -1617.38247611662225) * xsq * x /
  /		   ((( xsq + 112.95299835936588) * xsq
  /			+   2239.11355495022451) * xsq
  /			+   4852.14742834988424)
  /	ELSE  /* x >= 0.75 */
  /	    call exp_reduce(x + x)
  /	    temp = (q+p) * 2^mult
  /	    result = 1.0 - 2.0 * (q-p)/(temp + (q-p))
  /	ENDIF
  /	IF (signf == 1)
  /	    result = - result
  / 	ENDIF
  / 
  / Created:
  / 	12/19/86 	BS - Quantitative Technology Corporation for
  / 				Sequent Computer Systems
  /
  /
	.data
  /Constants
tanh_a:	.double	0Dxbfeedcc696444324	/      -0.96445016240077
tanh_b:	.double	0Dxc058dac3b304deef 	/     -99.41819453693073
tanh_c:	.double	0Dxc0994587a7d1b193	/   -1617.38247611662225
tanh_d:	.double	0Dx405c3cfdecd4a78f 	/     112.95299835936588
tanh_e:	.double	0Dx40a17e3a23dfdb06 	/    2239.11355495022451
tanh_f:	.double	0Dx40b2f425bddd4541 	/    4852.14742834988424
  /
tanhmx:	.double 0Dx4033800000000000	/    19.5 for Cody tests
  /tanhmx:	.double 0Dx4033199999999999	#    19.1
schmax:	.double 0Dx4086300000000000	/   710.0
cmpval:	.double 0Dx3fe8000000000000	/     0.75
negone:	.double 0Dxbff0000000000000	/    -1.0
zero:	.double 0Dx0000000000000000	/     0.0
two:	.double 0Dx4000000000000000	/     2.0
one:	.double 0Dx3ff0000000000000	/     1.0
half:	.double 0Dx3fe0000000000000	/     0.5
  /
  /       signf	%bh		 sign of argument
  /	 mult	%edx		 multiple
  /      result	%fp2		 holds original argument, final result
  /	    x	%fp4		 holds abs(arg) 
  /	  xsq	%fp6		 holds square of argument
  /	    p	%fp8		 reduction result
  /           q	%fp10		 reduction result
  /        temp	%fp12		 temporary register
  /
#include "sys.s"
ENTRY(tanh)
	wloadl	4(%esp),%fp2		/get argument
	pushl	%ebx			/save %ebx
	pushl	%fp8			/save user regs fp8-11, which we clobber
	pushl	%fp9
	pushl	%fp10
	pushl	%fp11
	wabsl	%fp2,%fp4		/take absolute value
 	wcmpl	tanhmx,%fp4		/is abs(argument) <= maximum value?
	wstctx	%eax			/transfer contents of control reg
	sahf				/receive to flags
	jae	zerochk			/(jge) if valid continue

  /#############################################################
  / Error return for hyperbolic tangent maximum value exceeded #
  /#############################################################
	
	wcmpl	%fp2,%fp4		/Return 1.0 or -1.0, depending
	wstctx	%eax			/on sign of arg
	sahf
	jne	ret_negone
	wloadl one,%fp2			/Cody tests only
	jmp tanhret			/Cody tests only
ret_negone:
	wloadl	negone,%fp2
	jmp	tanhret

zerochk:
 	wtstl	%fp2			/is arg = 0?
	wstctx	%eax			/transfer contents of control reg
	sahf				/receive to flags
	setb	%bh			/set signf
	jne	goodtanh		/if not continue computation
	wloadl	zero,%fp2		/if arg = 0, return a  zero
	jmp 	tanhret			/

  /
  / valid parameter input
  /
goodtanh:
	xorl	%edx,%edx		/initialize multiple
	wcmpl	cmpval,%fp4		/abs(agrument) < .75
	wstctx	%eax			/transfer contents of control reg
	sahf				/receive to flags
	jbe	tanh_reduce		/

tanh_noreduce:	
	wloadl	%fp4,%fp6		/form square
	wmull	%fp6,%fp6		/ of x
	wloadl	%fp6,%fp8		/get tan factor A
	wmull	tanh_a,%fp8		/A * xsq
	waddl	tanh_b,%fp8		/(A * xsq) + B
	wmull	%fp6,%fp8		/((A * xsq) + B) * xsq
	waddl	tanh_c,%fp8		/(((A * xsq) + B) * xsq) + C
	wmull	%fp6,%fp8		/((((A*xsq)+B)*xsq)+C)*xsq
	wmull	%fp4,%fp8		/((((A*xsq)+B)*xsq)+C)*xsq*x
	wloadl	%fp6,%fp10		/get xsq
	waddl	tanh_d,%fp10		/xsq + D
	wmull	%fp6,%fp10		/(xsq + D) * xsq
	waddl	tanh_e,%fp10		/((xsq + D) * xsq) + E
	wmull	%fp6,%fp10		/(((xsq + D) * xsq) + E) * xsq
	waddl	tanh_f,%fp10		/((((xsq + D) * xsq) + E) * xsq)+F
	wdivl	%fp8,%fp10		/divide two quantities
	waddl	%fp10,%fp4		/add in x
	wloadl	%fp4,%fp2		/move result 
	jmp 	signchk			/

tanh_reduce:
	pushl	%fp12			/This section of code (including the
	pushl	%fp13			/call to exp_reduce) also clobbers
	pushl	%fp14			/fp12-17
	pushl	%fp15
	pushl	%fp16
	pushl	%fp17
	waddl	%fp4,%fp4		/x + x
	call	exp_reduce		/reduce to compute tanh
	wloadl	%fp8,%fp12		/move p
	waddl	%fp10,%fp12		/p + q
	wstors	%fp12,%ecx		/get exponent of q + p
	rorl	$20,%ecx		/rotate exponent to low portion
	addw	%dx,%cx			/update exponent and
	roll	$20,%ecx		/put it back
	wloads	%ecx,%fp12		/temp = (q+p) * 2^mult
	wsubl	%fp10,%fp8		/form q-p
	waddl 	%fp8,%fp12		/temp + (q-p)
	wmull	two,%fp8		/2.0*(q-p)
	wdivl	%fp8,%fp12		/2.0*(q-p)/(temp + (q-p))
	wnegl	%fp12,%fp2		/-(2.0*(q-p)/(temp + (q-p)))
	waddl	one,%fp2		/1 - (2.0*(q-p)/(temp + (q-p)))
	popl	%fp17			/restore fp12-17
	popl	%fp16
	popl	%fp15
	popl	%fp14
	popl	%fp13
	popl	%fp12

signchk:
	testb	$1,%bh			/check signf
	je	tanhret			/sign is positive
	wnegl 	%fp2,%fp2		/result = -result

tanhret:
	popl	%fp11			/restore fp8-11
	popl	%fp10
	popl	%fp9
	popl	%fp8
	popl	%ebx			/restore %ebx
	ret
