xref: /minix3/lib/libm/arch/vax/n_support.S (revision 0a6a1f1d05b60e214de2f05a7310ddd1f0e590e7)
1*0a6a1f1dSLionel Sambuc/*	$NetBSD: n_support.S,v 1.10 2014/11/14 14:53:17 joerg Exp $	*/
284d9c625SLionel Sambuc/*
384d9c625SLionel Sambuc * Copyright (c) 1985, 1993
484d9c625SLionel Sambuc *	The Regents of the University of California.  All rights reserved.
584d9c625SLionel Sambuc *
684d9c625SLionel Sambuc * Redistribution and use in source and binary forms, with or without
784d9c625SLionel Sambuc * modification, are permitted provided that the following conditions
884d9c625SLionel Sambuc * are met:
984d9c625SLionel Sambuc * 1. Redistributions of source code must retain the above copyright
1084d9c625SLionel Sambuc *    notice, this list of conditions and the following disclaimer.
1184d9c625SLionel Sambuc * 2. Redistributions in binary form must reproduce the above copyright
1284d9c625SLionel Sambuc *    notice, this list of conditions and the following disclaimer in the
1384d9c625SLionel Sambuc *    documentation and/or other materials provided with the distribution.
1484d9c625SLionel Sambuc * 3. Neither the name of the University nor the names of its contributors
1584d9c625SLionel Sambuc *    may be used to endorse or promote products derived from this software
1684d9c625SLionel Sambuc *    without specific prior written permission.
1784d9c625SLionel Sambuc *
1884d9c625SLionel Sambuc * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
1984d9c625SLionel Sambuc * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
2084d9c625SLionel Sambuc * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
2184d9c625SLionel Sambuc * ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
2284d9c625SLionel Sambuc * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
2384d9c625SLionel Sambuc * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
2484d9c625SLionel Sambuc * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
2584d9c625SLionel Sambuc * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
2684d9c625SLionel Sambuc * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
2784d9c625SLionel Sambuc * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
2884d9c625SLionel Sambuc * SUCH DAMAGE.
2984d9c625SLionel Sambuc *
3084d9c625SLionel Sambuc *	@(#)support.s	8.1 (Berkeley) 6/4/93
3184d9c625SLionel Sambuc */
3284d9c625SLionel Sambuc#include <machine/asm.h>
3384d9c625SLionel Sambuc
34*0a6a1f1dSLionel SambucWEAK_ALIAS(logbl,logb)
35*0a6a1f1dSLionel SambucWEAK_ALIAS(copysignl, _copysignl)
36*0a6a1f1dSLionel SambucWEAK_ALIAS(_copysignl, copysign)
37*0a6a1f1dSLionel Sambuc
3884d9c625SLionel Sambuc	.text
3984d9c625SLionel Sambuc_sccsid:
4084d9c625SLionel Sambuc	.asciz "@(#)support.s\t1.3 (Berkeley) 8/21/85; 8.1 (ucb.elefunt) 6/4/93"
4184d9c625SLionel Sambuc
4284d9c625SLionel Sambuc/*
4384d9c625SLionel Sambuc * copysign(x,y),
4484d9c625SLionel Sambuc * logb(x),
4584d9c625SLionel Sambuc * scalb(x,N),
4684d9c625SLionel Sambuc * finite(x),
4784d9c625SLionel Sambuc * drem(x,y),
4884d9c625SLionel Sambuc * Coded in vax assembly language by K.C. Ng,  3/14/85.
4984d9c625SLionel Sambuc * Revised by K.C. Ng on 4/9/85.
5084d9c625SLionel Sambuc */
5184d9c625SLionel Sambuc
5284d9c625SLionel Sambuc/*
5384d9c625SLionel Sambuc * double copysign(double x,double y)
5484d9c625SLionel Sambuc */
5584d9c625SLionel Sambuc
5684d9c625SLionel SambucENTRY(copysign, 0)
5784d9c625SLionel Sambuc	movq	4(%ap),%r0		# load x into %r0
5884d9c625SLionel Sambuc	bicw3	$0x807f,%r0,%r2		# mask off the exponent of x
5984d9c625SLionel Sambuc	beql	Lz			# if zero or reserved op then return x
6084d9c625SLionel Sambuc	bicw3	$0x7fff,12(%ap),%r2	# copy the sign bit of y into %r2
6184d9c625SLionel Sambuc	bicw2	$0x8000,%r0		# replace x by |x|
6284d9c625SLionel Sambuc	bisw2	%r2,%r0			# copy the sign bit of y to x
6384d9c625SLionel SambucLz:	ret
6484d9c625SLionel Sambuc
65*0a6a1f1dSLionel SambucENTRY(copysignf, 0)
66*0a6a1f1dSLionel Sambuc	movl	4(%ap),%r0		# load x into %r0
67*0a6a1f1dSLionel Sambuc	bicw3	$0x807f,%r0,%r2		# mask off the exponent of x
68*0a6a1f1dSLionel Sambuc	beql	1f			# if zero or reserved op then return x
69*0a6a1f1dSLionel Sambuc	bicw3	$0x7fff,8(%ap),%r2	# copy the sign bit of y into %r2
70*0a6a1f1dSLionel Sambuc	bicw2	$0x8000,%r0		# replace x by |x|
71*0a6a1f1dSLionel Sambuc	bisw2	%r2,%r0			# copy the sign bit of y to x
72*0a6a1f1dSLionel Sambuc1:	ret
73*0a6a1f1dSLionel Sambuc
74*0a6a1f1dSLionel Sambuc/*
75*0a6a1f1dSLionel Sambuc * float logbf(float x);
76*0a6a1f1dSLionel Sambuc */
77*0a6a1f1dSLionel SambucENTRY(logbf, 0)
78*0a6a1f1dSLionel Sambuc	cvtfd   4(%ap),-(%sp)
79*0a6a1f1dSLionel Sambuc	calls   $2,_C_LABEL(logb)
80*0a6a1f1dSLionel Sambuc	cvtdf   %r0,%r0
81*0a6a1f1dSLionel Sambuc	ret
82*0a6a1f1dSLionel Sambuc
8384d9c625SLionel Sambuc/*
8484d9c625SLionel Sambuc * double logb(double x);
8584d9c625SLionel Sambuc */
8684d9c625SLionel SambucENTRY(logb, 0)
8784d9c625SLionel Sambuc	bicl3	$0xffff807f,4(%ap),%r0	# mask off the exponent of x
8884d9c625SLionel Sambuc	beql    Ln
8984d9c625SLionel Sambuc	ashl	$-7,%r0,%r0		# get the bias exponent
9084d9c625SLionel Sambuc	subl2	$129,%r0			# get the unbias exponent
9184d9c625SLionel Sambuc	cvtld	%r0,%r0			# return the answer in double
9284d9c625SLionel Sambuc	ret
9384d9c625SLionel SambucLn:	movq	4(%ap),%r0		# %r0:1 = x (zero or reserved op)
9484d9c625SLionel Sambuc	bneq	1f			# simply return if reserved op
9584d9c625SLionel Sambuc	movq 	$0x0000fe00ffffcfff,%r0  # -2147483647.0
9684d9c625SLionel Sambuc1:	ret
9784d9c625SLionel Sambuc
9884d9c625SLionel Sambuc/*
9984d9c625SLionel Sambuc * long finite(double x);
10084d9c625SLionel Sambuc */
10184d9c625SLionel Sambuc#ifndef __GFLOAT__
10284d9c625SLionel Sambuc	.globl finitef
10384d9c625SLionel Sambucfinitef = finite
10484d9c625SLionel Sambuc#endif
10584d9c625SLionel SambucENTRY(finite, 0)
10684d9c625SLionel Sambuc	bicw3	$0x7f,4(%ap),%r0	# mask off the mantissa
10784d9c625SLionel Sambuc	cmpw	%r0,$0x8000		# to see if x is the reserved op
10884d9c625SLionel Sambuc	beql	1f			# if so, return FALSE (0)
10984d9c625SLionel Sambuc	movl	$1,%r0			# else return TRUE (1)
11084d9c625SLionel Sambuc	ret
11184d9c625SLionel Sambuc1:	clrl	%r0
11284d9c625SLionel Sambuc	ret
11384d9c625SLionel Sambuc
11484d9c625SLionel Sambuc/* int isnan(double x);
11584d9c625SLionel Sambuc */
11684d9c625SLionel Sambuc#if 0
11784d9c625SLionel SambucENTRY(isnan, 0)
11884d9c625SLionel Sambuc	clrl	%r0
11984d9c625SLionel Sambuc	ret
12084d9c625SLionel Sambuc#endif
12184d9c625SLionel Sambuc
12284d9c625SLionel Sambuc/* int isnanf(float x);
12384d9c625SLionel Sambuc */
12484d9c625SLionel SambucENTRY(isnanf, 0)
12584d9c625SLionel Sambuc	clrl	%r0
12684d9c625SLionel Sambuc	ret
12784d9c625SLionel Sambuc
12884d9c625SLionel Sambuc/*
12984d9c625SLionel Sambuc * double scalb(x,N)
13084d9c625SLionel Sambuc * double x; double N;
13184d9c625SLionel Sambuc */
13284d9c625SLionel Sambuc	.set	ERANGE,34
13384d9c625SLionel Sambuc
13484d9c625SLionel SambucENTRY(scalb, 0)
13584d9c625SLionel Sambuc	movq	4(%ap),%r0
13684d9c625SLionel Sambuc	bicl3	$0xffff807f,%r0,%r3
13784d9c625SLionel Sambuc	beql	ret1			# 0 or reserved operand
13884d9c625SLionel Sambuc	movq	12(%ap),%r4
13984d9c625SLionel Sambuc	cvtdl	%r4, %r2
14084d9c625SLionel Sambuc	cmpl	%r2,$0x12c
14184d9c625SLionel Sambuc	bgeq	ovfl
14284d9c625SLionel Sambuc	cmpl	%r2,$-0x12c
14384d9c625SLionel Sambuc	bleq	unfl
14484d9c625SLionel Sambuc	ashl	$7,%r2,%r2
14584d9c625SLionel Sambuc	addl2	%r2,%r3
14684d9c625SLionel Sambuc	bleq	unfl
14784d9c625SLionel Sambuc	cmpl	%r3,$0x8000
14884d9c625SLionel Sambuc	bgeq	ovfl
14984d9c625SLionel Sambuc	addl2	%r2,%r0
15084d9c625SLionel Sambuc	ret
15184d9c625SLionel Sambucovfl:	pushl	$ERANGE
15284d9c625SLionel Sambuc	calls	$1,_C_LABEL(infnan)	# if it returns
15384d9c625SLionel Sambuc	bicw3	$0x7fff,4(%ap),%r2	# get the sign of input arg
15484d9c625SLionel Sambuc	bisw2	%r2,%r0			# re-attach the sign to %r0/1
15584d9c625SLionel Sambuc	ret
15684d9c625SLionel Sambucunfl:	movq	$0,%r0
15784d9c625SLionel Sambucret1:	ret
15884d9c625SLionel Sambuc
15984d9c625SLionel Sambuc/*
16084d9c625SLionel Sambuc * DREM(X,Y)
16184d9c625SLionel Sambuc * RETURN X REM Y =X-N*Y, N=[X/Y] ROUNDED (ROUNDED TO EVEN IN THE HALF WAY CASE)
16284d9c625SLionel Sambuc * DOUBLE PRECISION (VAX D format 56 bits)
16384d9c625SLionel Sambuc * CODED IN VAX ASSEMBLY LANGUAGE BY K.C. NG, 4/8/85.
16484d9c625SLionel Sambuc */
16584d9c625SLionel Sambuc	.set	EDOM,33
16684d9c625SLionel Sambuc
16784d9c625SLionel SambucENTRY(drem, 0x0fc0)
16884d9c625SLionel Sambuc	subl2	$12,%sp
16984d9c625SLionel Sambuc	movq	4(%ap),%r0		#%r0=x
17084d9c625SLionel Sambuc	movq	12(%ap),%r2		#%r2=y
17184d9c625SLionel Sambuc	jeql	Rop			#if y=0 then generate reserved op fault
17284d9c625SLionel Sambuc	bicw3	$0x007f,%r0,%r4		#check if x is Rop
17384d9c625SLionel Sambuc	cmpw	%r4,$0x8000
17484d9c625SLionel Sambuc	jeql	Ret			#if x is Rop then return Rop
17584d9c625SLionel Sambuc	bicl3	$0x007f,%r2,%r4		#check if y is Rop
17684d9c625SLionel Sambuc	cmpw	%r4,$0x8000
17784d9c625SLionel Sambuc	jeql	Ret			#if y is Rop then return Rop
17884d9c625SLionel Sambuc	bicw2	$0x8000,%r2		#y  := |y|
17984d9c625SLionel Sambuc	movw	$0,-4(%fp)		#-4(%fp) = nx := 0
18084d9c625SLionel Sambuc	cmpw	%r2,$0x1c80		#yexp ? 57
18184d9c625SLionel Sambuc	bgtr	C1			#if yexp > 57 goto C1
18284d9c625SLionel Sambuc	addw2	$0x1c80,%r2		#scale up y by 2**57
18384d9c625SLionel Sambuc	movw	$0x1c80,-4(%fp)		#nx := 57 (exponent field)
18484d9c625SLionel SambucC1:
18584d9c625SLionel Sambuc	movw	-4(%fp),-8(%fp)		#-8(%fp) = nf := nx
18684d9c625SLionel Sambuc	bicw3	$0x7fff,%r0,-12(%fp)	#-12(%fp) = sign of x
18784d9c625SLionel Sambuc	bicw2	$0x8000,%r0		#x  := |x|
18884d9c625SLionel Sambuc	movq	%r2,%r10			#y1 := y
18984d9c625SLionel Sambuc	bicl2	$0xffff07ff,%r11		#clear the last 27 bits of y1
19084d9c625SLionel Sambucloop:
19184d9c625SLionel Sambuc	cmpd	%r0,%r2			#x ? y
19284d9c625SLionel Sambuc	bleq	E1			#if x <= y goto E1
19384d9c625SLionel Sambuc /* begin argument reduction */
19484d9c625SLionel Sambuc	movq	%r2,%r4			#t =y
19584d9c625SLionel Sambuc	movq	%r10,%r6			#t1=y1
19684d9c625SLionel Sambuc	bicw3	$0x807f,%r0,%r8		#xexp= exponent of x
19784d9c625SLionel Sambuc	bicw3	$0x807f,%r2,%r9		#yexp= exponent fo y
19884d9c625SLionel Sambuc	subw2	%r9,%r8			#xexp-yexp
19984d9c625SLionel Sambuc	subw2	$0x0c80,%r8		#k=xexp-yexp-25(exponent bit field)
20084d9c625SLionel Sambuc	blss	C2			#if k<0 goto C2
20184d9c625SLionel Sambuc	addw2	%r8,%r4			#t +=k
20284d9c625SLionel Sambuc	addw2	%r8,%r6			#t1+=k, scale up t and t1
20384d9c625SLionel SambucC2:
20484d9c625SLionel Sambuc	divd3	%r4,%r0,%r8		#x/t
20584d9c625SLionel Sambuc	cvtdl	%r8,%r8			#n=[x/t] truncated
20684d9c625SLionel Sambuc	cvtld	%r8,%r8			#float(n)
20784d9c625SLionel Sambuc	subd2	%r6,%r4			#t:=t-t1
20884d9c625SLionel Sambuc	muld2	%r8,%r4			#n*(t-t1)
20984d9c625SLionel Sambuc	muld2	%r8,%r6			#n*t1
21084d9c625SLionel Sambuc	subd2	%r6,%r0			#x-n*t1
21184d9c625SLionel Sambuc	subd2	%r4,%r0			#(x-n*t1)-n*(t-t1)
21284d9c625SLionel Sambuc	jbr	loop
21384d9c625SLionel SambucE1:
21484d9c625SLionel Sambuc	movw	-4(%fp),%r6		#%r6=nx
21584d9c625SLionel Sambuc	beql	C3			#if nx=0 goto C3
21684d9c625SLionel Sambuc	addw2	%r6,%r0			#x:=x*2**57 scale up x by nx
21784d9c625SLionel Sambuc	movw	$0,-4(%fp)		#clear nx
21884d9c625SLionel Sambuc	jbr	loop
21984d9c625SLionel SambucC3:
22084d9c625SLionel Sambuc	movq	%r2,%r4			#%r4 = y
22184d9c625SLionel Sambuc	subw2	$0x80,%r4		#%r4 = y/2
22284d9c625SLionel Sambuc	cmpd	%r0,%r4			#x:y/2
22384d9c625SLionel Sambuc	blss	E2			#if x < y/2 goto E2
22484d9c625SLionel Sambuc	bgtr	C4			#if x > y/2 goto C4
22584d9c625SLionel Sambuc	cvtdl	%r8,%r8			#ifix(float(n))
22684d9c625SLionel Sambuc	blbc	%r8,E2			#if the last bit is zero, goto E2
22784d9c625SLionel SambucC4:
22884d9c625SLionel Sambuc	subd2	%r2,%r0			#x-y
22984d9c625SLionel SambucE2:
23084d9c625SLionel Sambuc	xorw2	-12(%fp),%r0		#x^sign (exclusive or)
23184d9c625SLionel Sambuc	movw	-8(%fp),%r6		#%r6=nf
23284d9c625SLionel Sambuc	bicw3	$0x807f,%r0,%r8		#%r8=exponent of x
23384d9c625SLionel Sambuc	bicw2	$0x7f80,%r0		#clear the exponent of x
23484d9c625SLionel Sambuc	subw2	%r6,%r8			#%r8=xexp-nf
23584d9c625SLionel Sambuc	bgtr	C5			#if xexp-nf is positive goto C5
23684d9c625SLionel Sambuc	movw	$0,%r8			#clear %r8
23784d9c625SLionel Sambuc	movq	$0,%r0			#x underflow to zero
23884d9c625SLionel SambucC5:
23984d9c625SLionel Sambuc	bisw2	%r8,%r0			/* put %r8 into x's exponent field */
24084d9c625SLionel Sambuc	ret
24184d9c625SLionel SambucRop:					#Reserved operand
24284d9c625SLionel Sambuc	pushl	$EDOM
24384d9c625SLionel Sambuc	calls	$1,_C_LABEL(infnan)	#generate reserved op fault
24484d9c625SLionel Sambuc	ret
24584d9c625SLionel SambucRet:
24684d9c625SLionel Sambuc	movq	$0x8000,%r0		#propagate reserved op
24784d9c625SLionel Sambuc	ret
248