Home | History | Annotate | Line # | Download | only in vax
n_support.S revision 1.2
      1  1.2  simonb /*	$NetBSD: n_support.S,v 1.2 1999/07/02 15:37:35 simonb Exp $	*/
      2  1.1   ragge /*
      3  1.1   ragge  * Copyright (c) 1985, 1993
      4  1.1   ragge  *	The Regents of the University of California.  All rights reserved.
      5  1.1   ragge  *
      6  1.1   ragge  * Redistribution and use in source and binary forms, with or without
      7  1.1   ragge  * modification, are permitted provided that the following conditions
      8  1.1   ragge  * are met:
      9  1.1   ragge  * 1. Redistributions of source code must retain the above copyright
     10  1.1   ragge  *    notice, this list of conditions and the following disclaimer.
     11  1.1   ragge  * 2. Redistributions in binary form must reproduce the above copyright
     12  1.1   ragge  *    notice, this list of conditions and the following disclaimer in the
     13  1.1   ragge  *    documentation and/or other materials provided with the distribution.
     14  1.1   ragge  * 3. All advertising materials mentioning features or use of this software
     15  1.1   ragge  *    must display the following acknowledgement:
     16  1.1   ragge  *	This product includes software developed by the University of
     17  1.1   ragge  *	California, Berkeley and its contributors.
     18  1.1   ragge  * 4. Neither the name of the University nor the names of its contributors
     19  1.1   ragge  *    may be used to endorse or promote products derived from this software
     20  1.1   ragge  *    without specific prior written permission.
     21  1.1   ragge  *
     22  1.1   ragge  * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
     23  1.1   ragge  * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
     24  1.1   ragge  * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
     25  1.1   ragge  * ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
     26  1.1   ragge  * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
     27  1.1   ragge  * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
     28  1.1   ragge  * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
     29  1.1   ragge  * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
     30  1.1   ragge  * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
     31  1.1   ragge  * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
     32  1.1   ragge  * SUCH DAMAGE.
     33  1.1   ragge  *
     34  1.1   ragge  *	@(#)support.s	8.1 (Berkeley) 6/4/93
     35  1.1   ragge  */
     36  1.1   ragge 	.data
     37  1.1   ragge 	.align	2
     38  1.1   ragge _sccsid:
     39  1.1   ragge .asciz	"@(#)support.s	1.3 (Berkeley) 8/21/85; 8.1 (ucb.elefunt) 6/4/93"
     40  1.1   ragge 
     41  1.1   ragge /*
     42  1.1   ragge  * copysign(x,y),
     43  1.1   ragge  * logb(x),
     44  1.1   ragge  * scalb(x,N),
     45  1.1   ragge  * finite(x),
     46  1.1   ragge  * drem(x,y),
     47  1.1   ragge  * Coded in vax assembly language by K.C. Ng,  3/14/85.
     48  1.1   ragge  * Revised by K.C. Ng on 4/9/85.
     49  1.1   ragge  */
     50  1.1   ragge 
     51  1.1   ragge /*
     52  1.1   ragge  * double copysign(x,y)
     53  1.1   ragge  * double x,y;
     54  1.1   ragge  */
     55  1.1   ragge 	.globl	_copysign
     56  1.1   ragge 	.text
     57  1.1   ragge 	.align	1
     58  1.1   ragge _copysign:
     59  1.1   ragge 	.word	0x4
     60  1.1   ragge 	movq	4(ap),r0		# load x into r0
     61  1.1   ragge 	bicw3	$0x807f,r0,r2		# mask off the exponent of x
     62  1.1   ragge 	beql	Lz			# if zero or reserved op then return x
     63  1.1   ragge 	bicw3	$0x7fff,12(ap),r2	# copy the sign bit of y into r2
     64  1.1   ragge 	bicw2	$0x8000,r0		# replace x by |x|
     65  1.1   ragge 	bisw2	r2,r0			# copy the sign bit of y to x
     66  1.1   ragge Lz:	ret
     67  1.1   ragge 
     68  1.1   ragge /*
     69  1.1   ragge  * double logb(x)
     70  1.1   ragge  * double x;
     71  1.1   ragge  */
     72  1.1   ragge 	.globl	_logb
     73  1.1   ragge 	.text
     74  1.1   ragge 	.align	1
     75  1.1   ragge _logb:
     76  1.1   ragge 	.word	0x0
     77  1.1   ragge 	bicl3	$0xffff807f,4(ap),r0	# mask off the exponent of x
     78  1.1   ragge 	beql    Ln
     79  1.1   ragge 	ashl	$-7,r0,r0		# get the bias exponent
     80  1.1   ragge 	subl2	$129,r0			# get the unbias exponent
     81  1.1   ragge 	cvtld	r0,r0			# return the answer in double
     82  1.1   ragge 	ret
     83  1.1   ragge Ln:	movq	4(ap),r0		# r0:1 = x (zero or reserved op)
     84  1.1   ragge 	bneq	1f			# simply return if reserved op
     85  1.1   ragge 	movq 	$0x0000fe00ffffcfff,r0  # -2147483647.0
     86  1.1   ragge 1:	ret
     87  1.1   ragge 
     88  1.1   ragge /*
     89  1.1   ragge  * long finite(x)
     90  1.1   ragge  * double x;
     91  1.1   ragge  */
     92  1.1   ragge 	.globl	_finite
     93  1.1   ragge 	.text
     94  1.1   ragge 	.align	1
     95  1.1   ragge _finite:
     96  1.1   ragge 	.word	0x0000
     97  1.1   ragge 	bicw3	$0x7f,4(ap),r0		# mask off the mantissa
     98  1.1   ragge 	cmpw	r0,$0x8000		# to see if x is the reserved op
     99  1.1   ragge 	beql	1f			# if so, return FALSE (0)
    100  1.1   ragge 	movl	$1,r0			# else return TRUE (1)
    101  1.1   ragge 	ret
    102  1.1   ragge 1:	clrl	r0
    103  1.1   ragge 	ret
    104  1.1   ragge 
    105  1.1   ragge /*
    106  1.1   ragge  * double scalb(x,N)
    107  1.1   ragge  * double x; double N;
    108  1.1   ragge  */
    109  1.1   ragge 	.globl	_scalb
    110  1.1   ragge 	.set	ERANGE,34
    111  1.1   ragge 	.text
    112  1.1   ragge 	.align	1
    113  1.1   ragge _scalb:
    114  1.1   ragge 	.word	0x3c
    115  1.1   ragge 	movq	4(ap),r0
    116  1.1   ragge 	bicl3	$0xffff807f,r0,r3
    117  1.1   ragge 	beql	ret1			# 0 or reserved operand
    118  1.1   ragge 	movq	12(ap),r4
    119  1.1   ragge 	cvtdl	r4, r2
    120  1.1   ragge 	cmpl	r2,$0x12c
    121  1.1   ragge 	bgeq	ovfl
    122  1.1   ragge 	cmpl	r2,$-0x12c
    123  1.1   ragge 	bleq	unfl
    124  1.1   ragge 	ashl	$7,r2,r2
    125  1.1   ragge 	addl2	r2,r3
    126  1.1   ragge 	bleq	unfl
    127  1.1   ragge 	cmpl	r3,$0x8000
    128  1.1   ragge 	bgeq	ovfl
    129  1.1   ragge 	addl2	r2,r0
    130  1.1   ragge 	ret
    131  1.1   ragge ovfl:	pushl	$ERANGE
    132  1.1   ragge 	calls	$1,_infnan		# if it returns
    133  1.1   ragge 	bicw3	$0x7fff,4(ap),r2	# get the sign of input arg
    134  1.1   ragge 	bisw2	r2,r0			# re-attach the sign to r0/1
    135  1.1   ragge 	ret
    136  1.1   ragge unfl:	movq	$0,r0
    137  1.1   ragge ret1:	ret
    138  1.1   ragge 
    139  1.1   ragge /*
    140  1.1   ragge  * DREM(X,Y)
    141  1.1   ragge  * RETURN X REM Y =X-N*Y, N=[X/Y] ROUNDED (ROUNDED TO EVEN IN THE HALF WAY CASE)
    142  1.1   ragge  * DOUBLE PRECISION (VAX D format 56 bits)
    143  1.1   ragge  * CODED IN VAX ASSEMBLY LANGUAGE BY K.C. NG, 4/8/85.
    144  1.1   ragge  */
    145  1.1   ragge 	.globl	_drem
    146  1.1   ragge 	.set	EDOM,33
    147  1.1   ragge 	.text
    148  1.1   ragge 	.align	1
    149  1.1   ragge _drem:
    150  1.1   ragge 	.word	0xffc
    151  1.2  simonb 	subl2	$12,sp
    152  1.1   ragge 	movq	4(ap),r0		#r0=x
    153  1.1   ragge 	movq	12(ap),r2		#r2=y
    154  1.1   ragge 	jeql	Rop			#if y=0 then generate reserved op fault
    155  1.1   ragge 	bicw3	$0x007f,r0,r4		#check if x is Rop
    156  1.1   ragge 	cmpw	r4,$0x8000
    157  1.1   ragge 	jeql	Ret			#if x is Rop then return Rop
    158  1.1   ragge 	bicl3	$0x007f,r2,r4		#check if y is Rop
    159  1.1   ragge 	cmpw	r4,$0x8000
    160  1.1   ragge 	jeql	Ret			#if y is Rop then return Rop
    161  1.1   ragge 	bicw2	$0x8000,r2		#y  := |y|
    162  1.1   ragge 	movw	$0,-4(fp)		#-4(fp) = nx := 0
    163  1.2  simonb 	cmpw	r2,$0x1c80		#yexp ? 57
    164  1.1   ragge 	bgtr	C1			#if yexp > 57 goto C1
    165  1.1   ragge 	addw2	$0x1c80,r2		#scale up y by 2**57
    166  1.1   ragge 	movw	$0x1c80,-4(fp)		#nx := 57 (exponent field)
    167  1.1   ragge C1:
    168  1.1   ragge 	movw	-4(fp),-8(fp)		#-8(fp) = nf := nx
    169  1.1   ragge 	bicw3	$0x7fff,r0,-12(fp)	#-12(fp) = sign of x
    170  1.1   ragge 	bicw2	$0x8000,r0		#x  := |x|
    171  1.1   ragge 	movq	r2,r10			#y1 := y
    172  1.1   ragge 	bicl2	$0xffff07ff,r11		#clear the last 27 bits of y1
    173  1.1   ragge loop:
    174  1.1   ragge 	cmpd	r0,r2			#x ? y
    175  1.1   ragge 	bleq	E1			#if x <= y goto E1
    176  1.1   ragge  /* begin argument reduction */
    177  1.1   ragge 	movq	r2,r4			#t =y
    178  1.1   ragge 	movq	r10,r6			#t1=y1
    179  1.1   ragge 	bicw3	$0x807f,r0,r8		#xexp= exponent of x
    180  1.1   ragge 	bicw3	$0x807f,r2,r9		#yexp= exponent fo y
    181  1.1   ragge 	subw2	r9,r8			#xexp-yexp
    182  1.1   ragge 	subw2	$0x0c80,r8		#k=xexp-yexp-25(exponent bit field)
    183  1.1   ragge 	blss	C2			#if k<0 goto C2
    184  1.2  simonb 	addw2	r8,r4			#t +=k
    185  1.1   ragge 	addw2	r8,r6			#t1+=k, scale up t and t1
    186  1.1   ragge C2:
    187  1.1   ragge 	divd3	r4,r0,r8		#x/t
    188  1.1   ragge 	cvtdl	r8,r8			#n=[x/t] truncated
    189  1.1   ragge 	cvtld	r8,r8			#float(n)
    190  1.1   ragge 	subd2	r6,r4			#t:=t-t1
    191  1.1   ragge 	muld2	r8,r4			#n*(t-t1)
    192  1.1   ragge 	muld2	r8,r6			#n*t1
    193  1.1   ragge 	subd2	r6,r0			#x-n*t1
    194  1.1   ragge 	subd2	r4,r0			#(x-n*t1)-n*(t-t1)
    195  1.1   ragge 	brb	loop
    196  1.1   ragge E1:
    197  1.1   ragge 	movw	-4(fp),r6		#r6=nx
    198  1.1   ragge 	beql	C3			#if nx=0 goto C3
    199  1.1   ragge 	addw2	r6,r0			#x:=x*2**57 scale up x by nx
    200  1.1   ragge 	movw	$0,-4(fp)		#clear nx
    201  1.1   ragge 	brb	loop
    202  1.1   ragge C3:
    203  1.1   ragge 	movq	r2,r4			#r4 = y
    204  1.1   ragge 	subw2	$0x80,r4		#r4 = y/2
    205  1.1   ragge 	cmpd	r0,r4			#x:y/2
    206  1.1   ragge 	blss	E2			#if x < y/2 goto E2
    207  1.1   ragge 	bgtr	C4			#if x > y/2 goto C4
    208  1.1   ragge 	cvtdl	r8,r8			#ifix(float(n))
    209  1.1   ragge 	blbc	r8,E2			#if the last bit is zero, goto E2
    210  1.1   ragge C4:
    211  1.1   ragge 	subd2	r2,r0			#x-y
    212  1.1   ragge E2:
    213  1.1   ragge 	xorw2	-12(fp),r0		#x^sign (exclusive or)
    214  1.1   ragge 	movw	-8(fp),r6		#r6=nf
    215  1.1   ragge 	bicw3	$0x807f,r0,r8		#r8=exponent of x
    216  1.1   ragge 	bicw2	$0x7f80,r0		#clear the exponent of x
    217  1.1   ragge 	subw2	r6,r8			#r8=xexp-nf
    218  1.1   ragge 	bgtr	C5			#if xexp-nf is positive goto C5
    219  1.1   ragge 	movw	$0,r8			#clear r8
    220  1.1   ragge 	movq	$0,r0			#x underflow to zero
    221  1.1   ragge C5:
    222  1.1   ragge 	bisw2	r8,r0			/* put r8 into x's exponent field */
    223  1.1   ragge 	ret
    224  1.1   ragge Rop:					#Reserved operand
    225  1.1   ragge 	pushl	$EDOM
    226  1.1   ragge 	calls	$1,_infnan		#generate reserved op fault
    227  1.1   ragge 	ret
    228  1.1   ragge Ret:
    229  1.1   ragge 	movq	$0x8000,r0		#propagate reserved op
    230  1.1   ragge 	ret
    231