xref: /csrg-svn/lib/libm/tahoe/support.s (revision 34128)
1/*
2 * Copyright (c) 1987 Regents of the University of California.
3 * All rights reserved.
4 *
5 * Redistribution and use in source and binary forms are permitted
6 * provided that this notice is preserved and that due credit is given
7 * to the University of California at Berkeley. The name of the University
8 * may not be used to endorse or promote products derived from this
9 * software without specific prior written permission. This software
10 * is provided ``as is'' without express or implied warranty.
11 *
12 * All recipients should regard themselves as participants in an ongoing
13 * research project and hence should feel obligated to report their
14 * experiences (good or bad) with these elementary function codes, using
15 * the sendbug(8) program, to the authors.
16 */
17	.data
18	.align	2
19_sccsid:
20	.asciz	"@(#)support.s	5.3	(ucb.elefunt)	04/29/88"
21/*
22 * copysign(x,y),
23 * logb(x),
24 * scalb(x,N),
25 * finite(x),
26 * drem(x,y),
27 * Coded in vax assembly language by K. C. Ng 4/9/85.
28 * Re-coded in tahoe assembly language by Z. Alex Liu 7/13/87.
29 */
30/*
31 * double copysign(x,y)
32 * double x,y;
33 */
34	.globl	_copysign
35	.text
36	.align	2
37_copysign:
38	.word	0x0004			# save r2
39	movl	8(fp),r1
40	movl	4(fp),r0		# r0:r1 = x
41	andl3	$0x7f800000,r0,r2	# r2 = biased exponent of x
42	beql	1f			# if 0 or reserved op then return x
43	andl3	$0x80000000,12(fp),r2	# r2 = sign bit of y at bit-31
44	andl2	$0x7fffffff,r0		# replace x by |x|
45	orl2	r2,r0			# copy the sign bit of y to x
461:	ret
47/*
48 * double logb(x)
49 * double x;
50 */
51	.globl	_logb
52	.text
53	.align	2
54_logb:
55	.word	0x0000			# save nothing
56	andl3	$0x7f800000,4(fp),r0	# r0[b23:b30] = biased exponent of x
57	beql    1f
58	shrl	$23,r0,r0		# r0[b0:b7] = biased exponent of x
59	subl2	$129,r0			# r0 = unbiased exponent of x
60	cvld	r0			# acc = unbiased exponent of x (double)
61	std	r0			# r0 =  unbiased exponent of x (double)
62	ret
631:	movl	8(fp),r1		# 8(fp) must be moved first
64	movl	4(fp),r0		# r0:r1 = x (zero or reserved op)
65	blss	2f			# simply return if reserved op
66	movl	$0xfe000000,r1
67	movl	$0xcfffffff,r0		# -2147483647.0
682:	ret
69/*
70 * long finite(x)
71 * double x;
72 */
73	.globl	_finite
74	.text
75	.align	2
76_finite:
77	.word	0x0000			# save nothing
78	andl3	$0xff800000,4(fp),r0	# r0 = sign of x & its biased exponent
79	cmpl	r0,$0x80000000		# is x a reserved op?
80	beql	1f			# if so, return FALSE (0)
81	movl	$1,r0			# else return TRUE (1)
82	ret
831:	clrl	r0
84	ret
85/*
86 * double scalb(x,N)
87 * double x; int N;
88 */
89	.globl	_scalb
90	.set	ERANGE,34
91	.text
92	.align	2
93_scalb:
94	.word	0x000c			# save r2-r3
95	movl	8(fp),r1
96	movl	4(fp),r0		# r0:r1 = x (-128 <= Ex <= 126)
97	andl3	$0x7f800000,r0,r3	# r3[b23:b30] = biased exponent of x
98	beql	1f			# is x a 0 or a reserved operand?
99	movl	12(fp),r2		# r2 = N
100	cmpl	r2,$0xff		# if N >= 255
101	bgeq	2f			# then the result must overflow
102	cmpl	r2,$-0xff		# if N <= -255
103	bleq	3f			# then the result must underflow
104	shrl	$23,r3,r3		# r3[b0:b7] = biased exponent of x
105	addl2	r2,r3			# r3 = biased exponent of the result
106	bleq	3f			# if <= 0 then the result underflows
107	cmpl	r3,$0x100		# if >= 256 then the result overflows
108	bgeq	2f
109	shll	$23,r3,r3		# r3[b23:b30] = biased exponent of res.
110	andl2	$0x807fffff,r0
111	orl2	r3,r0			# r0:r1 = x*2^N
1121:	ret
1132:	pushl	$ERANGE			# if the result would overflow
114	callf	$8,_infnan		# and _infnan returns
115	andl3	$0x80000000,4(fp),r2	# get the sign of input arg
116	orl2	r2,r0			# re-attach the sign to r0:r1
117	ret
1183:	clrl	r1			# if the result would underflow
119	clrl	r0			# then return 0
120	ret
121/*
122 * double drem(x,y)
123 * double x,y;
124 * Returns x-n*y where n=[x/y] rounded (to even in the half way case).
125 */
126	.globl	_drem
127	.set	EDOM,33
128	.text
129	.align	2
130_drem:
131	.word	0x1ffc			# save r2-r12
132	movl	16(fp),r3
133	movl	12(fp),r2		# r2:r3 = y
134	movl	8(fp),r1
135	movl	4(fp),r0		# r0:r1 = x
136	andl3	$0xff800000,r0,r4
137	cmpl	r4,$0x80000000		# is x a reserved operand?
138	beql	1f			# if yes then propagate x and return
139	andl3	$0xff800000,r2,r4
140	cmpl	r4,$0x80000000		# is y a reserved operand?
141	bneq	2f
142	movl	r3,r1
143	movl	r2,r0			# if yes then propagate y and return
1441:	ret
145
1462:	tstl	r4			# is y a 0?
147	bneq	3f
148	pushl	$EDOM			# if so then generate reserved op fault
149	callf	$8,_infnan
150	ret
151
1523:	andl2	$0x7fffffff,r2		# r2:r3 = y <- |y|
153	clrl	r12			# r12 = nx := 0
154	cmpl	r2,$0x1c800000		# Ey ? 57
155	bgtr	4f			# if Ey > 57 goto 4
156	addl2	$0x1c800000,r2		# scale up y by 2**57
157	movl	$0x1c800000,r12		# r12[b23:b30] = nx = 57
1584:	pushl	r12			# pushed onto stack: nf := nx
159	andl3	$0x80000000,r0,-(sp)	# pushed onto stack: sign of x
160	andl2	$0x7fffffff,r0		# r0:r1 = x <- |x|
161	movl	r3,r11			# r10:r11 = y1 = y w/ last 27 bits 0
162	andl3	$0xf8000000,r10,r11	# clear last 27 bits of y1
163
164Loop:	cmpd2	r0,r2			# x ? y
165	bleq	6f			# if x <= y goto 6
166 /* 					# begin argument reduction */
167	movl	r3,r5
168	movl	r2,r4			# r4:r5 = t = y
169	movl	r11,r7
170	movl	r10,r6			# r6:r7 = t1 = y1
171	andl3	$0x7f800000,r0,r8	# r8[b23:b30] = Ex:biased exponent of x
172	andl3	$0x7f800000,r2,r9	# r9[b23:b30] = Ey:biased exponent of y
173	subl2	r9,r8			# r8[b23:b30] = Ex-Ey
174	subl2	$0x0c800000,r8		# r8[b23:b30] = k = Ex-Ey-25
175	blss	5f			# if k < 0 goto 5
176	addl2	r8,r4			# t += k
177	addl2	r8,r6			# t1 += k, scale up t and t1
1785:	ldd	r0			# acc = x
179	divd	r4			# acc = x/t
180	cvdl	r8			# r8 = n = [x/t] truncated
181	cvld	r8			# acc = dble(n)
182	std	r8			# r8:r9 = dble(n)
183	ldd	r4			# acc = t
184	subd	r6			# acc = t-t1
185	muld	r8			# acc = n*(t-t1)
186	std	r4			# r4:r5 = n*(t-t1)
187	ldd	r6			# acc = t1
188	muld	r8			# acc = n*t1
189	subd	r0			# acc = n*t1-x
190	negd				# acc = x-n*t1
191	subd	r4			# acc = (x-n*t1)-n*(t-t1)
192	std	r0			# r0:r1 = (x-n*t1)-n*(t-t1)
193	brb	Loop
194
1956:	movl	r12,r6			# r6 = nx
196	beql	7f			# if nx == 0 goto 7
197	addl2	r6,r0			# x <- x*2**57:scale x up by nx
198	clrl	r12			# clear nx
199	brb	Loop
200
2017:	movl	r3,r5
202	movl	r2,r4			# r4:r5 = y
203	subl2	$0x800000,r4		# r4:r5 = y/2
204	cmpd2	r0,r4			# x ? y/2
205	blss	9f			# if x < y/2 goto 9
206	bgtr	8f			# if x > y/2 goto 8
207	ldd	r8			# acc = dble(n)
208	cvdl	r8			# r8 = ifix(dble(n))
209	bbc	$0,r8,9f		# if the last bit is zero, goto 9
2108:	ldd	r0			# acc = x
211	subd	r2			# acc = x-y
212	std	r0			# r0:r1 = x-y
2139:	xorl2	(sp)+,r0		# x^sign (exclusive or)
214	movl	(sp)+,r6		# r6 = nf
215	andl3	$0x7f800000,r0,r8	# r8 = biased exponent of x
216	andl2	$0x807fffff,r0		# r0 = x w/ exponent zapped
217	subl2	r6,r8			# r8 = Ex-nf
218	bgtr	0f			# if Ex-nf > 0 goto 0
219	clrl	r8			# clear r8
220	clrl	r0
221	clrl	r1			# x underflows to zero
2220:	orl2	r8,r0			# put r8 into x's exponent field
223	ret
224