1*	$NetBSD: do_func.sa,v 1.2 1994/10/26 07:49:02 cgd Exp $
2
3*	MOTOROLA MICROPROCESSOR & MEMORY TECHNOLOGY GROUP
4*	M68000 Hi-Performance Microprocessor Division
5*	M68040 Software Package 
6*
7*	M68040 Software Package Copyright (c) 1993, 1994 Motorola Inc.
8*	All rights reserved.
9*
10*	THE SOFTWARE is provided on an "AS IS" basis and without warranty.
11*	To the maximum extent permitted by applicable law,
12*	MOTOROLA DISCLAIMS ALL WARRANTIES WHETHER EXPRESS OR IMPLIED,
13*	INCLUDING IMPLIED WARRANTIES OF MERCHANTABILITY OR FITNESS FOR A
14*	PARTICULAR PURPOSE and any warranty against infringement with
15*	regard to the SOFTWARE (INCLUDING ANY MODIFIED VERSIONS THEREOF)
16*	and any accompanying written materials. 
17*
18*	To the maximum extent permitted by applicable law,
19*	IN NO EVENT SHALL MOTOROLA BE LIABLE FOR ANY DAMAGES WHATSOEVER
20*	(INCLUDING WITHOUT LIMITATION, DAMAGES FOR LOSS OF BUSINESS
21*	PROFITS, BUSINESS INTERRUPTION, LOSS OF BUSINESS INFORMATION, OR
22*	OTHER PECUNIARY LOSS) ARISING OF THE USE OR INABILITY TO USE THE
23*	SOFTWARE.  Motorola assumes no responsibility for the maintenance
24*	and support of the SOFTWARE.  
25*
26*	You are hereby granted a copyright license to use, modify, and
27*	distribute the SOFTWARE so long as this entire notice is retained
28*	without alteration in any modified and/or redistributed versions,
29*	and that such modified versions are clearly identified as such.
30*	No licenses are granted by implication, estoppel or otherwise
31*	under any patents or trademarks of Motorola, Inc.
32
33*
34*	do_func.sa 3.4 2/18/91
35*
36* Do_func performs the unimplemented operation.  The operation
37* to be performed is determined from the lower 7 bits of the
38* extension word (except in the case of fmovecr and fsincos).
39* The opcode and tag bits form an index into a jump table in 
40* tbldo.sa.  Cases of zero, infinity and NaN are handled in 
41* do_func by forcing the default result.  Normalized and
42* denormalized (there are no unnormalized numbers at this
43* point) are passed onto the emulation code.  
44*
45* CMDREG1B and STAG are extracted from the fsave frame
46* and combined to form the table index.  The function called
47* will start with a0 pointing to the ETEMP operand.  Dyadic
48* functions can find FPTEMP at -12(a0).
49*
50* Called functions return their result in fp0.  Sincos returns
51* sin(x) in fp0 and cos(x) in fp1.
52*
53
54DO_FUNC	IDNT    2,1 Motorola 040 Floating Point Software Package
55
56	section	8
57
58	include	fpsp.h
59
60	xref	t_dz2
61	xref	t_operr
62	xref	t_inx2
63	xref 	t_resdnrm
64	xref	dst_nan
65	xref	src_nan
66	xref	nrm_set
67	xref	sto_cos
68
69	xref	tblpre
70	xref	slognp1,slogn,slog10,slog2
71	xref	slognd,slog10d,slog2d
72	xref	smod,srem
73	xref	sscale
74	xref	smovcr
75
76PONE	dc.l	$3fff0000,$80000000,$00000000	;+1
77MONE	dc.l	$bfff0000,$80000000,$00000000	;-1
78PZERO	dc.l	$00000000,$00000000,$00000000	;+0
79MZERO	dc.l	$80000000,$00000000,$00000000	;-0
80PINF	dc.l	$7fff0000,$00000000,$00000000	;+inf
81MINF	dc.l	$ffff0000,$00000000,$00000000	;-inf
82QNAN	dc.l	$7fff0000,$ffffffff,$ffffffff	;non-signaling nan
83PPIBY2  dc.l	$3FFF0000,$C90FDAA2,$2168C235	;+PI/2
84MPIBY2  dc.l	$bFFF0000,$C90FDAA2,$2168C235	;-PI/2
85
86	xdef	do_func
87do_func:
88	clr.b	CU_ONLY(a6)
89*
90* Check for fmovecr.  It does not follow the format of fp gen
91* unimplemented instructions.  The test is on the upper 6 bits;
92* if they are $17, the inst is fmovecr.  Call entry smovcr
93* directly.
94*
95	bfextu	CMDREG1B(a6){0:6},d0 ;get opclass and src fields
96	cmpi.l	#$17,d0		;if op class and size fields are $17, 
97*				;it is FMOVECR; if not, continue
98	bne.b	not_fmovecr
99	jmp	smovcr		;fmovecr; jmp directly to emulation
100
101not_fmovecr:
102	move.w	CMDREG1B(a6),d0
103	and.l	#$7F,d0
104	cmpi.l	#$38,d0		;if the extension is >= $38, 
105	bge.b	short_serror	;it is illegal
106	bfextu	STAG(a6){0:3},d1
107	lsl.l	#3,d0		;make room for STAG
108	add.l	d1,d0		;combine for final index into table
109	lea.l	tblpre,a1	;start of monster jump table
110	move.l	(a1,d0.w*4),a1	;real target address
111	lea.l	ETEMP(a6),a0	;a0 is pointer to src op
112	move.l	USER_FPCR(a6),d1
113	and.l	#$FF,d1		; discard all but rounding mode/prec
114	fmove.l	#0,fpcr
115	jmp	(a1)
116*
117*	ERROR
118*
119	xdef	serror
120serror:
121short_serror:
122	st.b	STORE_FLG(a6)
123	rts
124*
125* These routines load forced values into fp0.  They are called
126* by index into tbldo.
127*
128* Load a signed zero to fp0 and set inex2/ainex
129*
130	xdef	snzrinx
131snzrinx:
132	btst.b	#sign_bit,LOCAL_EX(a0)	;get sign of source operand
133	bne.b	ld_mzinx	;if negative, branch
134	bsr	ld_pzero	;bsr so we can return and set inx
135	bra	t_inx2		;now, set the inx for the next inst
136ld_mzinx:
137	bsr	ld_mzero	;if neg, load neg zero, return here
138	bra	t_inx2		;now, set the inx for the next inst
139*
140* Load a signed zero to fp0; do not set inex2/ainex 
141*
142	xdef	szero
143szero:
144	btst.b	#sign_bit,LOCAL_EX(a0) ;get sign of source operand
145	bne	ld_mzero	;if neg, load neg zero
146	bra	ld_pzero	;load positive zero
147*
148* Load a signed infinity to fp0; do not set inex2/ainex 
149*
150	xdef	sinf
151sinf:
152	btst.b	#sign_bit,LOCAL_EX(a0)	;get sign of source operand
153	bne	ld_minf			;if negative branch
154	bra	ld_pinf
155*
156* Load a signed one to fp0; do not set inex2/ainex 
157*
158	xdef	sone
159sone:
160	btst.b	#sign_bit,LOCAL_EX(a0)	;check sign of source
161	bne	ld_mone
162	bra	ld_pone
163*
164* Load a signed pi/2 to fp0; do not set inex2/ainex 
165*
166	xdef	spi_2
167spi_2:
168	btst.b	#sign_bit,LOCAL_EX(a0)	;check sign of source
169	bne	ld_mpi2
170	bra	ld_ppi2
171*
172* Load either a +0 or +inf for plus/minus operand
173*
174	xdef	szr_inf
175szr_inf:
176	btst.b	#sign_bit,LOCAL_EX(a0)	;check sign of source
177	bne	ld_pzero
178	bra	ld_pinf
179*
180* Result is either an operr or +inf for plus/minus operand
181* [Used by slogn, slognp1, slog10, and slog2]
182*
183	xdef	sopr_inf
184sopr_inf:
185	btst.b	#sign_bit,LOCAL_EX(a0)	;check sign of source
186	bne	t_operr
187	bra	ld_pinf
188*
189*	FLOGNP1 
190*
191	xdef	sslognp1
192sslognp1:
193	fmovem.x (a0),fp0
194	fcmp.b	#-1,fp0
195	fbgt	slognp1		
196	fbeq	t_dz2		;if = -1, divide by zero exception
197	fmove.l	#0,FPSR		;clr N flag
198	bra	t_operr		;take care of operands < -1
199*
200*	FETOXM1
201*
202	xdef	setoxm1i
203setoxm1i:
204	btst.b	#sign_bit,LOCAL_EX(a0)	;check sign of source
205	bne	ld_mone
206	bra	ld_pinf
207*
208*	FLOGN
209*
210* Test for 1.0 as an input argument, returning +zero.  Also check
211* the sign and return operr if negative.
212*
213	xdef	sslogn
214sslogn:
215	btst.b	#sign_bit,LOCAL_EX(a0) 
216	bne	t_operr		;take care of operands < 0
217	cmpi.w	#$3fff,LOCAL_EX(a0) ;test for 1.0 input
218	bne	slogn
219	cmpi.l	#$80000000,LOCAL_HI(a0)
220	bne	slogn
221	tst.l	LOCAL_LO(a0)
222	bne	slogn
223	fmove.x	PZERO,fp0
224	rts
225
226	xdef	sslognd
227sslognd:
228	btst.b	#sign_bit,LOCAL_EX(a0) 
229	beq	slognd
230	bra	t_operr		;take care of operands < 0
231
232*
233*	FLOG10
234*
235	xdef	sslog10
236sslog10:
237	btst.b	#sign_bit,LOCAL_EX(a0)
238	bne	t_operr		;take care of operands < 0
239	cmpi.w	#$3fff,LOCAL_EX(a0) ;test for 1.0 input
240	bne	slog10
241	cmpi.l	#$80000000,LOCAL_HI(a0)
242	bne	slog10
243	tst.l	LOCAL_LO(a0)
244	bne	slog10
245	fmove.x	PZERO,fp0
246	rts
247
248	xdef	sslog10d
249sslog10d:
250	btst.b	#sign_bit,LOCAL_EX(a0) 
251	beq	slog10d
252	bra	t_operr		;take care of operands < 0
253
254*
255*	FLOG2
256*
257	xdef	sslog2
258sslog2:
259	btst.b	#sign_bit,LOCAL_EX(a0)
260	bne	t_operr		;take care of operands < 0
261	cmpi.w	#$3fff,LOCAL_EX(a0) ;test for 1.0 input
262	bne	slog2
263	cmpi.l	#$80000000,LOCAL_HI(a0)
264	bne	slog2
265	tst.l	LOCAL_LO(a0)
266	bne	slog2
267	fmove.x	PZERO,fp0
268	rts
269
270	xdef	sslog2d
271sslog2d:
272	btst.b	#sign_bit,LOCAL_EX(a0) 
273	beq	slog2d
274	bra	t_operr		;take care of operands < 0
275
276*
277*	FMOD
278*
279pmodt:
280*				;$21 fmod
281*				;dtag,stag
282	dc.l	smod		;  00,00  norm,norm = normal
283	dc.l	smod_oper	;  00,01  norm,zero = nan with operr
284	dc.l	smod_fpn	;  00,10  norm,inf  = fpn
285	dc.l	smod_snan	;  00,11  norm,nan  = nan
286	dc.l	smod_zro	;  01,00  zero,norm = +-zero
287	dc.l	smod_oper	;  01,01  zero,zero = nan with operr
288	dc.l	smod_zro	;  01,10  zero,inf  = +-zero
289	dc.l	smod_snan	;  01,11  zero,nan  = nan
290	dc.l	smod_oper	;  10,00  inf,norm  = nan with operr
291	dc.l	smod_oper	;  10,01  inf,zero  = nan with operr
292	dc.l	smod_oper	;  10,10  inf,inf   = nan with operr
293	dc.l	smod_snan	;  10,11  inf,nan   = nan
294	dc.l	smod_dnan	;  11,00  nan,norm  = nan
295	dc.l	smod_dnan	;  11,01  nan,zero  = nan
296	dc.l	smod_dnan	;  11,10  nan,inf   = nan
297	dc.l	smod_dnan	;  11,11  nan,nan   = nan
298
299	xdef	pmod
300pmod:
301	clr.b	FPSR_QBYTE(a6) ; clear quotient field
302	bfextu	STAG(a6){0:3},d0 ;stag = d0
303	bfextu	DTAG(a6){0:3},d1 ;dtag = d1
304
305*
306* Alias extended denorms to norms for the jump table.
307*
308	bclr.l	#2,d0
309	bclr.l	#2,d1
310
311	lsl.b	#2,d1
312	or.b	d0,d1		;d1{3:2} = dtag, d1{1:0} = stag
313*				;Tag values:
314*				;00 = norm or denorm
315*				;01 = zero
316*				;10 = inf
317*				;11 = nan
318	lea	pmodt,a1
319	move.l	(a1,d1.w*4),a1
320	jmp	(a1)
321
322smod_snan:
323	bra	src_nan
324smod_dnan:
325	bra	dst_nan
326smod_oper:
327	bra	t_operr
328smod_zro:
329	move.b	ETEMP(a6),d1	;get sign of src op
330	move.b	FPTEMP(a6),d0	;get sign of dst op
331	eor.b	d0,d1		;get exor of sign bits
332	btst.l	#7,d1		;test for sign
333	beq.b	smod_zsn	;if clr, do not set sign big
334	bset.b	#q_sn_bit,FPSR_QBYTE(a6) ;set q-byte sign bit
335smod_zsn:
336	btst.l	#7,d0		;test if + or -
337	beq	ld_pzero	;if pos then load +0
338	bra	ld_mzero	;else neg load -0
339	
340smod_fpn:
341	move.b	ETEMP(a6),d1	;get sign of src op
342	move.b	FPTEMP(a6),d0	;get sign of dst op
343	eor.b	d0,d1		;get exor of sign bits
344	btst.l	#7,d1		;test for sign
345	beq.b	smod_fsn	;if clr, do not set sign big
346	bset.b	#q_sn_bit,FPSR_QBYTE(a6) ;set q-byte sign bit
347smod_fsn:
348	tst.b	DTAG(a6)	;filter out denormal destination case
349	bpl.b	smod_nrm	;
350	lea.l	FPTEMP(a6),a0	;a0<- addr(FPTEMP)
351	bra	t_resdnrm	;force UNFL(but exact) result
352smod_nrm:
353	fmove.l USER_FPCR(a6),fpcr ;use user's rmode and precision
354	fmove.x FPTEMP(a6),fp0	;return dest to fp0
355	rts
356		
357*
358*	FREM
359*
360premt:
361*				;$25 frem
362*				;dtag,stag
363	dc.l	srem		;  00,00  norm,norm = normal
364	dc.l	srem_oper	;  00,01  norm,zero = nan with operr
365	dc.l	srem_fpn	;  00,10  norm,inf  = fpn
366	dc.l	srem_snan	;  00,11  norm,nan  = nan
367	dc.l	srem_zro	;  01,00  zero,norm = +-zero
368	dc.l	srem_oper	;  01,01  zero,zero = nan with operr
369	dc.l	srem_zro	;  01,10  zero,inf  = +-zero
370	dc.l	srem_snan	;  01,11  zero,nan  = nan
371	dc.l	srem_oper	;  10,00  inf,norm  = nan with operr
372	dc.l	srem_oper	;  10,01  inf,zero  = nan with operr
373	dc.l	srem_oper	;  10,10  inf,inf   = nan with operr
374	dc.l	srem_snan	;  10,11  inf,nan   = nan
375	dc.l	srem_dnan	;  11,00  nan,norm  = nan
376	dc.l	srem_dnan	;  11,01  nan,zero  = nan
377	dc.l	srem_dnan	;  11,10  nan,inf   = nan
378	dc.l	srem_dnan	;  11,11  nan,nan   = nan
379
380	xdef	prem
381prem:
382	clr.b	FPSR_QBYTE(a6)   ;clear quotient field
383	bfextu	STAG(a6){0:3},d0 ;stag = d0
384	bfextu	DTAG(a6){0:3},d1 ;dtag = d1
385*
386* Alias extended denorms to norms for the jump table.
387*
388	bclr	#2,d0
389	bclr	#2,d1
390
391	lsl.b	#2,d1
392	or.b	d0,d1		;d1{3:2} = dtag, d1{1:0} = stag
393*				;Tag values:
394*				;00 = norm or denorm
395*				;01 = zero
396*				;10 = inf
397*				;11 = nan
398	lea	premt,a1
399	move.l	(a1,d1.w*4),a1
400	jmp	(a1)
401	
402srem_snan:
403	bra	src_nan
404srem_dnan:
405	bra	dst_nan
406srem_oper:
407	bra	t_operr
408srem_zro:
409	move.b	ETEMP(a6),d1	;get sign of src op
410	move.b	FPTEMP(a6),d0	;get sign of dst op
411	eor.b	d0,d1		;get exor of sign bits
412	btst.l	#7,d1		;test for sign
413	beq.b	srem_zsn	;if clr, do not set sign big
414	bset.b	#q_sn_bit,FPSR_QBYTE(a6) ;set q-byte sign bit
415srem_zsn:
416	btst.l	#7,d0		;test if + or -
417	beq	ld_pzero	;if pos then load +0
418	bra	ld_mzero	;else neg load -0
419	
420srem_fpn:
421	move.b	ETEMP(a6),d1	;get sign of src op
422	move.b	FPTEMP(a6),d0	;get sign of dst op
423	eor.b	d0,d1		;get exor of sign bits
424	btst.l	#7,d1		;test for sign
425	beq.b	srem_fsn	;if clr, do not set sign big
426	bset.b	#q_sn_bit,FPSR_QBYTE(a6) ;set q-byte sign bit
427srem_fsn:
428	tst.b	DTAG(a6)	;filter out denormal destination case
429	bpl.b	srem_nrm	;
430	lea.l	FPTEMP(a6),a0	;a0<- addr(FPTEMP)
431	bra	t_resdnrm	;force UNFL(but exact) result
432srem_nrm:
433	fmove.l USER_FPCR(a6),fpcr ;use user's rmode and precision
434	fmove.x FPTEMP(a6),fp0	;return dest to fp0
435	rts
436*
437*	FSCALE
438*
439pscalet:
440*				;$26 fscale
441*				;dtag,stag
442	dc.l	sscale		;  00,00  norm,norm = result
443	dc.l	sscale		;  00,01  norm,zero = fpn
444	dc.l	scl_opr		;  00,10  norm,inf  = nan with operr
445	dc.l	scl_snan	;  00,11  norm,nan  = nan
446	dc.l	scl_zro		;  01,00  zero,norm = +-zero
447	dc.l	scl_zro		;  01,01  zero,zero = +-zero
448	dc.l	scl_opr		;  01,10  zero,inf  = nan with operr
449	dc.l	scl_snan	;  01,11  zero,nan  = nan
450	dc.l	scl_inf		;  10,00  inf,norm  = +-inf
451	dc.l	scl_inf		;  10,01  inf,zero  = +-inf
452	dc.l	scl_opr		;  10,10  inf,inf   = nan with operr
453 	dc.l	scl_snan	;  10,11  inf,nan   = nan
454 	dc.l	scl_dnan	;  11,00  nan,norm  = nan
455 	dc.l	scl_dnan	;  11,01  nan,zero  = nan
456 	dc.l	scl_dnan	;  11,10  nan,inf   = nan
457	dc.l	scl_dnan	;  11,11  nan,nan   = nan
458
459	xdef	pscale
460pscale:
461	bfextu	STAG(a6){0:3},d0 ;stag in d0
462	bfextu	DTAG(a6){0:3},d1 ;dtag in d1
463	bclr.l	#2,d0		;alias  denorm into norm
464	bclr.l	#2,d1		;alias  denorm into norm
465	lsl.b	#2,d1
466	or.b	d0,d1		;d1{4:2} = dtag, d1{1:0} = stag
467*				;dtag values     stag values:
468*				;000 = norm      00 = norm
469*				;001 = zero	 01 = zero
470*				;010 = inf	 10 = inf
471*				;011 = nan	 11 = nan
472*				;100 = dnrm
473*
474*
475	lea.l	pscalet,a1	;load start of jump table
476	move.l	(a1,d1.w*4),a1	;load a1 with label depending on tag
477	jmp	(a1)		;go to the routine
478
479scl_opr:
480	bra	t_operr
481
482scl_dnan:
483	bra	dst_nan
484
485scl_zro:
486	btst.b	#sign_bit,FPTEMP_EX(a6)	;test if + or -
487	beq	ld_pzero		;if pos then load +0
488	bra	ld_mzero		;if neg then load -0
489scl_inf:
490	btst.b	#sign_bit,FPTEMP_EX(a6)	;test if + or -
491	beq	ld_pinf			;if pos then load +inf
492	bra	ld_minf			;else neg load -inf
493scl_snan:
494	bra	src_nan
495*
496*	FSINCOS
497*
498	xdef	ssincosz
499ssincosz:
500	btst.b	#sign_bit,ETEMP(a6)	;get sign
501	beq.b	sincosp
502	fmove.x	MZERO,fp0
503	bra.b	sincoscom
504sincosp:
505	fmove.x PZERO,fp0
506sincoscom:
507  	fmovem.x PONE,fp1	;do not allow FPSR to be affected
508	bra	sto_cos		;store cosine result
509
510	xdef	ssincosi
511ssincosi:
512	fmove.x QNAN,fp1	;load NAN
513	bsr	sto_cos		;store cosine result
514	fmove.x QNAN,fp0	;load NAN
515	bra	t_operr
516
517	xdef	ssincosnan
518ssincosnan:
519	move.l	ETEMP_EX(a6),FP_SCR1(a6)
520	move.l	ETEMP_HI(a6),FP_SCR1+4(a6)
521	move.l	ETEMP_LO(a6),FP_SCR1+8(a6)
522	bset.b	#signan_bit,FP_SCR1+4(a6)
523	fmovem.x FP_SCR1(a6),fp1
524	bsr	sto_cos
525	bra	src_nan
526*
527* This code forces default values for the zero, inf, and nan cases 
528* in the transcendentals code.  The CC bits must be set in the
529* stacked FPSR to be correctly reported.
530*
531***Returns +PI/2
532	xdef	ld_ppi2
533ld_ppi2:
534	fmove.x PPIBY2,fp0		;load +pi/2
535	bra	t_inx2			;set inex2 exc
536
537***Returns -PI/2
538	xdef	ld_mpi2
539ld_mpi2:
540	fmove.x MPIBY2,fp0		;load -pi/2
541	or.l	#neg_mask,USER_FPSR(a6)	;set N bit
542	bra	t_inx2			;set inex2 exc
543
544***Returns +inf
545	xdef	ld_pinf
546ld_pinf:
547	fmove.x PINF,fp0		;load +inf
548	or.l	#inf_mask,USER_FPSR(a6)	;set I bit
549	rts
550
551***Returns -inf
552	xdef	ld_minf
553ld_minf:
554	fmove.x MINF,fp0		;load -inf
555	or.l	#neg_mask+inf_mask,USER_FPSR(a6)	;set N and I bits
556	rts
557
558***Returns +1
559	xdef	ld_pone
560ld_pone:
561	fmove.x PONE,fp0		;load +1
562	rts
563
564***Returns -1
565	xdef	ld_mone
566ld_mone:
567	fmove.x MONE,fp0		;load -1
568	or.l	#neg_mask,USER_FPSR(a6)	;set N bit
569	rts
570
571***Returns +0
572	xdef	ld_pzero
573ld_pzero:
574	fmove.x PZERO,fp0		;load +0
575	or.l	#z_mask,USER_FPSR(a6)	;set Z bit
576	rts
577
578***Returns -0
579	xdef	ld_mzero
580ld_mzero:
581	fmove.x MZERO,fp0		;load -0
582	or.l	#neg_mask+z_mask,USER_FPSR(a6)	;set N and Z bits
583	rts
584
585	end
586