xref: /netbsd/lib/libm/arch/vax/n_cabs.S (revision bf9ec67e)
1/*	$NetBSD: n_cabs.S,v 1.4 2002/02/24 01:06:21 matt Exp $	*/
2/*
3 * Copyright (c) 1985, 1993
4 *	The Regents of the University of California.  All rights reserved.
5 *
6 * Redistribution and use in source and binary forms, with or without
7 * modification, are permitted provided that the following conditions
8 * are met:
9 * 1. Redistributions of source code must retain the above copyright
10 *    notice, this list of conditions and the following disclaimer.
11 * 2. Redistributions in binary form must reproduce the above copyright
12 *    notice, this list of conditions and the following disclaimer in the
13 *    documentation and/or other materials provided with the distribution.
14 * 3. All advertising materials mentioning features or use of this software
15 *    must display the following acknowledgement:
16 *	This product includes software developed by the University of
17 *	California, Berkeley and its contributors.
18 * 4. Neither the name of the University nor the names of its contributors
19 *    may be used to endorse or promote products derived from this software
20 *    without specific prior written permission.
21 *
22 * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
23 * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
24 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
25 * ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
26 * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
27 * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
28 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
29 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
30 * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
31 * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
32 * SUCH DAMAGE.
33 *
34 *	@(#)cabs.s	8.1 (Berkeley) 6/4/93
35 */
36
37#include <machine/asm.h>
38
39	.globl	_C_LABEL(__libm_dsqrt_r5)
40/*
41 * double precision complex absolute value
42 * CABS by W. Kahan, 9/7/80.
43 * Revised for reserved operands by E. LeBlanc, 8/18/82
44 * argument for complex absolute value by reference, *4(%ap)
45 * argument for cabs and hypot (C fcns) by value, 4(%ap)
46 * output is in %r0:%r1 (error less than 0.86 ulps)
47 */
48
49/*	entry for c functions cabs and hypot */
50ALTENTRY(cabs)
51ENTRY(hypot, 0x8040) 		# save %r6, enable floating overflow
52	movq	4(%ap),%r0	# %r0:1 = x
53	movq	12(%ap),%r2	# %r2:3 = y
54	jbr	cabs2
55
56/*	entry for Fortran use, call by:   d = abs(z) */
57ENTRY(z_abs, 0x8040)		# save %r6, enable floating overflow
58	movl	4(%ap),%r2	# indirect addressing is necessary here
59	movq	(%r2)+,%r0	# %r0:1 = x
60	movq	(%r2),%r2		# %r2:3 = y
61
62cabs2:
63	bicw3	$0x7f,%r0,%r4	# %r4 has signed biased exp of x
64	cmpw	$0x8000,%r4
65	jeql	return		# x is a reserved operand, so return it
66	bicw3	$0x7f,%r2,%r5	# %r5 has signed biased exp of y
67	cmpw	$0x8000,%r5
68	jneq	cont		/* y isn't a reserved operand */
69	movq	%r2,%r0		/* return y if it's reserved */
70	ret
71
72cont:
73	bsbb	regs_set	# %r0:1 = dsqrt(x^2+y^2)/2^%r6
74	addw2	%r6,%r0		# unscaled cdabs in %r0:1
75	jvc	return		# unless it overflows
76	subw2	$0x80,%r0	# halve %r0 to get meaningful overflow
77	addd2	%r0,%r0		# overflow; %r0 is half of true abs value
78return:
79	ret
80
81ENTRY(__libm_cdabs_r6,0)	# ENTRY POINT for cdsqrt
82				# calculates a scaled (factor in %r6)
83				# complex absolute value
84
85	movq	(%r4)+,%r0	# %r0:%r1 = x via indirect addressing
86	movq	(%r4),%r2		# %r2:%r3 = y via indirect addressing
87
88	bicw3	$0x7f,%r0,%r5	# %r5 has signed biased exp of x
89	cmpw	$0x8000,%r5
90	jeql	cdreserved	# x is a reserved operand
91	bicw3	$0x7f,%r2,%r5	# %r5 has signed biased exp of y
92	cmpw	$0x8000,%r5
93	jneq	regs_set	/* y isn't a reserved operand either? */
94
95cdreserved:
96	movl	*4(%ap),%r4	# %r4 -> (u,v), if x or y is reserved
97	movq	%r0,(%r4)+	# copy u and v as is and return
98	movq	%r2,(%r4)		# (again addressing is indirect)
99	ret
100
101regs_set:
102	bicw2	$0x8000,%r0	# %r0:%r1 = dabs(x)
103	bicw2	$0x8000,%r2	# %r2:%r3 = dabs(y)
104	cmpw	%r0,%r2
105	jgeq	ordered
106	movq	%r0,%r4
107	movq	%r2,%r0
108	movq	%r4,%r2		# force y's exp <= x's exp
109ordered:
110	bicw3	$0x7f,%r0,%r6	# %r6 = exponent(x) + bias(129)
111	jeql	retsb		# if x = y = 0 then cdabs(x,y) = 0
112	subw2	$0x4780,%r6	# %r6 = exponent(x) - 14
113	subw2	%r6,%r0		# 2^14 <= scaled x < 2^15
114	bitw	$0xff80,%r2
115	jeql	retsb		# if y = 0 return dabs(x)
116	subw2	%r6,%r2
117	cmpw	$0x3780,%r2	# if scaled y < 2^-18
118	jgtr	retsb		#   return dabs(x)
119	emodd	%r0,$0,%r0,%r4,%r0	# %r4 + %r0:1 = scaled x^2
120	emodd	%r2,$0,%r2,%r5,%r2	# %r5 + %r2:3 = scaled y^2
121	addd2	%r2,%r0
122	addl2	%r5,%r4
123	cvtld	%r4,%r2
124	addd2	%r2,%r0		# %r0:1 = scaled x^2 + y^2
125	jmp	_C_LABEL(__libm_dsqrt_r5)+2
126				# %r0:1 = dsqrt(x^2+y^2)/2^%r6
127retsb:
128	rsb			# error < 0.86 ulp
129