	.file "acos.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 Arcsine and Arccosine Functions
  /
  /
  / Functional Description:
  /	This routine implements the double precision arcsine/cosine functions.
  /	This routine contains two entry points: one for ASIN and one for ACOS.
  /	The algorithms used for these routines were obtained from the
  /	original PASCAL library that this replaces.
  /
  /	The algorithm for ASIN/ACOS is as follows:
  /
  /	x = abs(ARG)
  /	IF (x .GT. 1.0)
  /		return error
  /	ELSE
  /		IF (x .LT. 0.7071)
  /			reduced = FALSE
  /		ELSE
  /			x = sqrt((1.0-x) * (1.0+x))
  /			reduced = TRUE
  /		ENDIF
  /		xsq = sqr(x)
  /		result = x +
  /			(((((( +0.004751624376434203) * xsq
  /			       -0.592413491400993952) * xsq
  /			       +5.031785600674824666) * xsq
  /			      -14.350406308005313946) * xsq
  /			      +16.647746863878756233) * xsq
  /			       -6.773695835107418535) * xsq * x /
  /		    ((((( xsq -13.925210930636176476) * xsq
  /			      +63.723096250580563708) * xsq
  /			     -128.395097929241385370) * xsq
  /			     +118.175459937604538160) * xsq
  /			      -40.642175010638165982)
  /		IF (ASIN)
  /			IF (reduced)
  /				result = PI/2 - result
  /			ENDIF
  /			IF (ARG .LT. 0)
  /				result = -result
  /			ENDIF
  /		ELSE
  /			IF (ARG .LT. 0)
  /				IF (reduced)
  /					result = PI - result
  /				ELSE
  /					result = PI/2 + result
  /				ENDIF
  /			ELSEIF (.NOT. reduced)
  /				result = PI/2 - result
  /			ENDIF
  /		ENDIF
  /	ENDIF
  /
  / Created:
  /	12/17/86 	BS - Quantitative Technology Corporation for
  /				Sequent Computer Systems
  /
	.data
  /
  /	sign	dh			 holds sign flag 
  /	reduce	ecx			 holds reduction flag 
  /	x	fp2			 computation register and result 
  /	arg	fp2			 holds argument 
  /	xsq	fp4			 square of x 
  /	templ	fp6			 temporary reg 
  /	templ1	fp8			 temporary reg 
  /
pi:	.double	0Dx400921fb54442d18	/   3.141592654
pidiv2:	.double	0Dx3ff921fb54442d18	/   1.570796327 (pi/2)
cnsta:	.double	0Dx3f73767074cb69a4	/  +0.004751624376434203
cnstb:	.double 0Dxbfe2f50d2368d8a5	/  -0.592413491400993952
cnstc:	.double	0Dx4014208c678d8742	/  +5.031785600674824666
cnstd:	.double	0Dxc02cb36874a263cd	/ -14.350406308005313946
cnste:	.double	0Dx4030a5d2bd0c7221	/ +16.647746863878756233
cnstf:	.double 0Dxc01b1843b89359e0	/  -6.773695835107418535
cnstg:	.double	0Dxc02bd9b53f41f7dc	/ -13.925210930636176476
cnsth:	.double	0Dx404fdc8e6afe0d47	/ +63.723096250580563708
cnsti:	.double	0Dxc0600ca4a46999e3	/-128.395097929241385370
cnstj:	.double	0Dx405d8b3abc517142	/+118.175459937604538160
cnstk:	.double	0Dxc0445232ca6e7feb	/ -40.642175010638165982
one:	.double	0Dx3ff0000000000000	/   1.0
sqrt2div2: .double 0Dx3fe6a0902de00d1b	/   sqrt(2) / 2
  /
  /
#include "sys.s"

ACOSERR1:
	.byte	0x61,0x63,0x6f,0x73,0x00
ACOSERR2:
	.byte	0x61,0x63,0x6f,0x73,0x3a,0x20,0x44,0x4f,0x4d,0x41
	.byte	0x49,0x4e,0x20,0x65,0x72,0x72,0x6f,0x72,0x0a,0x00
ZERO:
	.double	0Dx0000000000000000
	.data
	.align	2

ENTRY(acos)
	wloadl	4(%esp),%fp2		/get argument
	wtstl	%fp2			/argument < 0?
	wstctx  %eax			/transfer contents of control reg
	sahf				/receive to flags
	setb	%dh			/if argument < 0, set sign flag 
	wabsl	%fp2,%fp2		/ get abs(arg)
	wcmpl	one,%fp2		/ x <= 1.0?
	wstctx  %eax			/transfer contents of control reg
	sahf				/receive to flags
	jae	cont			/if argument <= 1.0, continue (jge)

 / |arg| > 1 is an input error

	wloadl	4(%esp),%fp2		/get argument
	subl	$0x20,%esp		/allocate struct exception exc
	wstorl	%fp2,0x8(%esp)		/exc.arg1 = x
	movl	$0x1,(%esp)		/exc.type = DOMAIN
	movl	$ACOSERR1,0x4(%esp)	/exc.name = "acos"
	wloadl	ZERO,%fp2		/exc.retval = 0.0
	wstorl	%fp2,0x18(%esp)
	leal	(%esp),%eax
	pushl	%eax
	call	matherr
	popl	%ecx
	testl	%eax,%eax
	jne	acos_exit

	pushl	$0x13			/length of err string
	pushl	$ACOSERR2		/"acos: DOMAIN error\n"
	pushl	$0x2			/write stderr
	call	write
	addl	$0xc,%esp		/pop args off stack
	movl	$0x21,errno
acos_exit:
	wloadl	0x18(%esp),%fp2		/return exc.retval
	addl	$0x20,%esp		/deallocate struct exception exc
	ret

cont:
	wcmpl	sqrt2div2,%fp2		/x < 0.7071?
	wstctx  %eax			/transfer contents of control reg
	sahf				/receive to flags
	movl	$0,%ecx			/init reduce to FALSE
	ja	noredu			/if x < 0.7071, don't reduce (jg)
					/
	wnegl	%fp2,%fp6		/ form 1.0 - x
	waddl	one,%fp6		/
	waddl	one,%fp2		/ form 1.0 + x
	wmull	%fp6,%fp2		/ form (1.0-x) * (1.0+x)

	pushl	%edx			/save sign
	subl	$8,%esp
	wstorl	%fp2,(%esp)		/compute sqrt((1.0-x) * (1.0+x))
	call	sqrt
	addl	$8,%esp
	popl	%edx			/restore sign
	movl	$1,%ecx			/ set reduce to TRUE

noredu:
	wloadl	%fp2,%fp4		/ form sqr(x)
	wmull	%fp4,%fp4		/
	wloadl	%fp4,%fp6		/ templ gets xsq
	wmull	cnsta,%fp6		/ A * xsq
	waddl	cnstb,%fp6		/ (A*xsq) + B)
	wmull	%fp4,%fp6		/ ((A*xsq)+B) * xsq
	waddl	cnstc,%fp6		/ (((A*xsq)+B)*xsq) + C
	wmull	%fp4,%fp6		/ ((((A*xsq)+B)*xsq)+C) * xsq
	waddl	cnstd,%fp6			/ (((((A*xsq)+B)*xsq)+C)*xsq) + D
	wmull	%fp4,%fp6		/ ((((((A*xsq)+B)*xsq)+C)*xsq)+D) * xsq
	waddl	cnste,%fp6		/ (((((((A*xsq)+B)*xsq)+C)*xsq)+D)*xsq)
					/  + E
	wmull	%fp4,%fp6		/ ((((((((A*xsq)+B)*xsq)+C)*xsq)+D)*xsq)
					/  +E) * xsq
	waddl	cnstf,%fp6			/ (((((((((A*xsq)+B)*xsq)+C)*xsq)+D)*xsq)
					/  +E)*xsq) + F
	wmull	%fp4,%fp6		/ ((((((((((A*xsq)+B)*xsq)+C)*xsq)+D)
					/  *xsq)+E)*xsq)+F) * xsq
	wmull	%fp2,%fp6			/ ((((((((((A*xsq)+B)*xsq)+C)*xsq)+D)
					/  *xsq)+E)*xsq)+F) * xsq * x
	pushl	%fp8			/ Save user registers fp8/9
	pushl	%fp9			/  so we can use them.
	wloadl	%fp4,%fp8		/ get xsq
	waddl	cnstg,%fp8		/ xsq + G
	wmull	%fp4,%fp8		/ (xsq+G) * xsq
	waddl	cnsth,%fp8		/ ((xsq+G)*xsq) + H
	wmull	%fp4,%fp8		/ (((xsq+G)*xsq)+H) * xsq
	waddl	cnsti,%fp8		/ ((((xsq+G)*xsq)+H)*xsq) + I
	wmull	%fp4,%fp8		/ (((((xsq+G)*xsq)+H)*xsq)+I) * xsq
	waddl	cnstj,%fp8		/ ((((((xsq+G)*xsq)+H)*xsq)+I)*xsq) + J
	wmull	%fp4,%fp8		/ (((((((xsq+G)*xsq)+H)*xsq)+I)*xsq)+J)
					/  * xsq
	waddl	cnstk,%fp8		/ ((((((((xsq+G)*xsq)+H)*xsq)+I)*xsq)+J)
					/ *xsq) + K
	wdivl	%fp6,%fp8		/ divide two quantities
	waddl	%fp8,%fp2		/ add in x
	popl	%fp9			/ Restore user registers fp8/9
	popl	%fp8
	cmpb	$0,%dh			/ ARG >= 0?
	jz	acos2			/ if so, go check reduction
	cmpl	$0,%ecx			/ reduction occur?
	jz	acos1			/ if not, go add PI/2
	wnegl	%fp2,%fp2		/ if so, form -x
	waddl	pi,%fp2			/ result = PI - x
	ret

acos1:
	waddl	pidiv2,%fp2		/ result = PI/2 + x
	ret
  /
  /	ACOS: ARG >= 0			
  /
acos2:
	cmpl	$0,%ecx			/ reduction occur?
	jnz	retn			/ if so, go return
	wnegl	%fp2,%fp2		/ if not, form -x
	waddl	pidiv2,%fp2		/ result = PI/2 - x
retn:
	ret
