1|
2|	kernel_ex.sa 3.3 12/19/90
3|
4| This file contains routines to force exception status in the
5| fpu for exceptional cases detected or reported within the
6| transcendental functions.  Typically, the t_xx routine will
7| set the appropriate bits in the USER_FPSR word on the stack.
8| The bits are tested in gen_except.sa to determine if an exceptional
9| situation needs to be created on return from the FPSP.
10|
11
12|		Copyright (C) Motorola, Inc. 1990
13|			All Rights Reserved
14|
15|       For details on the license for this file, please see the
16|       file, README, in this same directory.
17
18KERNEL_EX:    |idnt    2,1 | Motorola 040 Floating Point Software Package
19
20	|section    8
21
22#include "fpsp.h"
23
24mns_inf:  .long 0xffff0000,0x00000000,0x00000000
25pls_inf:  .long 0x7fff0000,0x00000000,0x00000000
26nan:      .long 0x7fff0000,0xffffffff,0xffffffff
27huge:     .long 0x7ffe0000,0xffffffff,0xffffffff
28
29	|xref	  ovf_r_k
30	|xref	  unf_sub
31	|xref	  nrm_set
32
33	.global	  t_dz
34	.global      t_dz2
35	.global      t_operr
36	.global      t_unfl
37	.global      t_ovfl
38	.global      t_ovfl2
39	.global      t_inx2
40	.global	  t_frcinx
41	.global	  t_extdnrm
42	.global	  t_resdnrm
43	.global	  dst_nan
44	.global	  src_nan
45|
46|	DZ exception
47|
48|
49|	if dz trap disabled
50|		store properly signed inf (use sign of etemp) into fp0
51|		set FPSR exception status dz bit, condition code
52|		inf bit, and accrued dz bit
53|		return
54|		frestore the frame into the machine (done by unimp_hd)
55|
56|	else dz trap enabled
57|		set exception status bit & accrued bits in FPSR
58|		set flag to disable sto_res from corrupting fp register
59|		return
60|		frestore the frame into the machine (done by unimp_hd)
61|
62| t_dz2 is used by monadic functions such as flogn (from do_func).
63| t_dz is used by monadic functions such as satanh (from the
64| transcendental function).
65|
66t_dz2:
67	bsetb	#neg_bit,FPSR_CC(%a6)	|set neg bit in FPSR
68	fmovel	#0,%FPSR			|clr status bits (Z set)
69	btstb	#dz_bit,FPCR_ENABLE(%a6)	|test FPCR for dz exc enabled
70	bnes	dz_ena_end
71	bras	m_inf			|flogx always returns -inf
72t_dz:
73	fmovel	#0,%FPSR			|clr status bits (Z set)
74	btstb	#dz_bit,FPCR_ENABLE(%a6)	|test FPCR for dz exc enabled
75	bnes	dz_ena
76|
77|	dz disabled
78|
79	btstb	#sign_bit,ETEMP_EX(%a6)	|check sign for neg or pos
80	beqs	p_inf			|branch if pos sign
81
82m_inf:
83	fmovemx mns_inf,%fp0-%fp0		|load -inf
84	bsetb	#neg_bit,FPSR_CC(%a6)	|set neg bit in FPSR
85	bras	set_fpsr
86p_inf:
87	fmovemx pls_inf,%fp0-%fp0		|load +inf
88set_fpsr:
89	orl	#dzinf_mask,USER_FPSR(%a6) |set I,DZ,ADZ
90	rts
91|
92|	dz enabled
93|
94dz_ena:
95	btstb	#sign_bit,ETEMP_EX(%a6)	|check sign for neg or pos
96	beqs	dz_ena_end
97	bsetb	#neg_bit,FPSR_CC(%a6)	|set neg bit in FPSR
98dz_ena_end:
99	orl	#dzinf_mask,USER_FPSR(%a6) |set I,DZ,ADZ
100	st	STORE_FLG(%a6)
101	rts
102|
103|	OPERR exception
104|
105|	if (operr trap disabled)
106|		set FPSR exception status operr bit, condition code
107|		nan bit; Store default NAN into fp0
108|		frestore the frame into the machine (done by unimp_hd)
109|
110|	else (operr trap enabled)
111|		set FPSR exception status operr bit, accrued operr bit
112|		set flag to disable sto_res from corrupting fp register
113|		frestore the frame into the machine (done by unimp_hd)
114|
115t_operr:
116	orl	#opnan_mask,USER_FPSR(%a6) |set NaN, OPERR, AIOP
117
118	btstb	#operr_bit,FPCR_ENABLE(%a6) |test FPCR for operr enabled
119	bnes	op_ena
120
121	fmovemx nan,%fp0-%fp0		|load default nan
122	rts
123op_ena:
124	st	STORE_FLG(%a6)		|do not corrupt destination
125	rts
126
127|
128|	t_unfl --- UNFL exception
129|
130| This entry point is used by all routines requiring unfl, inex2,
131| aunfl, and ainex to be set on exit.
132|
133| On entry, a0 points to the exceptional operand.  The final exceptional
134| operand is built in FP_SCR1 and only the sign from the original operand
135| is used.
136|
137t_unfl:
138	clrl	FP_SCR1(%a6)		|set exceptional operand to zero
139	clrl	FP_SCR1+4(%a6)
140	clrl	FP_SCR1+8(%a6)
141	tstb	(%a0)			|extract sign from caller's exop
142	bpls	unfl_signok
143	bset	#sign_bit,FP_SCR1(%a6)
144unfl_signok:
145	leal	FP_SCR1(%a6),%a0
146	orl	#unfinx_mask,USER_FPSR(%a6)
147|					;set UNFL, INEX2, AUNFL, AINEX
148unfl_con:
149	btstb	#unfl_bit,FPCR_ENABLE(%a6)
150	beqs	unfl_dis
151
152unfl_ena:
153	bfclr	STAG(%a6){#5:#3}		|clear wbtm66,wbtm1,wbtm0
154	bsetb	#wbtemp15_bit,WB_BYTE(%a6) |set wbtemp15
155	bsetb	#sticky_bit,STICKY(%a6)	|set sticky bit
156
157	bclrb	#E1,E_BYTE(%a6)
158
159unfl_dis:
160	bfextu	FPCR_MODE(%a6){#0:#2},%d0	|get round precision
161
162	bclrb	#sign_bit,LOCAL_EX(%a0)
163	sne	LOCAL_SGN(%a0)		|convert to internal ext format
164
165	bsr	unf_sub			|returns IEEE result at a0
166|					;and sets FPSR_CC accordingly
167
168	bfclr	LOCAL_SGN(%a0){#0:#8}	|convert back to IEEE ext format
169	beqs	unfl_fin
170
171	bsetb	#sign_bit,LOCAL_EX(%a0)
172	bsetb	#sign_bit,FP_SCR1(%a6)	|set sign bit of exc operand
173
174unfl_fin:
175	fmovemx (%a0),%fp0-%fp0		|store result in fp0
176	rts
177
178
179|
180|	t_ovfl2 --- OVFL exception (without inex2 returned)
181|
182| This entry is used by scale to force catastrophic overflow.  The
183| ovfl, aovfl, and ainex bits are set, but not the inex2 bit.
184|
185t_ovfl2:
186	orl	#ovfl_inx_mask,USER_FPSR(%a6)
187	movel	ETEMP(%a6),FP_SCR1(%a6)
188	movel	ETEMP_HI(%a6),FP_SCR1+4(%a6)
189	movel	ETEMP_LO(%a6),FP_SCR1+8(%a6)
190|
191| Check for single or double round precision.  If single, check if
192| the lower 40 bits of ETEMP are zero; if not, set inex2.  If double,
193| check if the lower 21 bits are zero; if not, set inex2.
194|
195	moveb	FPCR_MODE(%a6),%d0
196	andib	#0xc0,%d0
197	beq	t_work		|if extended, finish ovfl processing
198	cmpib	#0x40,%d0		|test for single
199	bnes	t_dbl
200t_sgl:
201	tstb	ETEMP_LO(%a6)
202	bnes	t_setinx2
203	movel	ETEMP_HI(%a6),%d0
204	andil	#0xff,%d0		|look at only lower 8 bits
205	bnes	t_setinx2
206	bra	t_work
207t_dbl:
208	movel	ETEMP_LO(%a6),%d0
209	andil	#0x7ff,%d0	|look at only lower 11 bits
210	beq	t_work
211t_setinx2:
212	orl	#inex2_mask,USER_FPSR(%a6)
213	bras	t_work
214|
215|	t_ovfl --- OVFL exception
216|
217|** Note: the exc operand is returned in ETEMP.
218|
219t_ovfl:
220	orl	#ovfinx_mask,USER_FPSR(%a6)
221t_work:
222	btstb	#ovfl_bit,FPCR_ENABLE(%a6) |test FPCR for ovfl enabled
223	beqs	ovf_dis
224
225ovf_ena:
226	clrl	FP_SCR1(%a6)		|set exceptional operand
227	clrl	FP_SCR1+4(%a6)
228	clrl	FP_SCR1+8(%a6)
229
230	bfclr	STAG(%a6){#5:#3}		|clear wbtm66,wbtm1,wbtm0
231	bclrb	#wbtemp15_bit,WB_BYTE(%a6) |clear wbtemp15
232	bsetb	#sticky_bit,STICKY(%a6)	|set sticky bit
233
234	bclrb	#E1,E_BYTE(%a6)
235|					;fall through to disabled case
236
237| For disabled overflow call 'ovf_r_k'.  This routine loads the
238| correct result based on the rounding precision, destination
239| format, rounding mode and sign.
240|
241ovf_dis:
242	bsr	ovf_r_k			|returns unsigned ETEMP_EX
243|					;and sets FPSR_CC accordingly.
244	bfclr	ETEMP_SGN(%a6){#0:#8}	|fix sign
245	beqs	ovf_pos
246	bsetb	#sign_bit,ETEMP_EX(%a6)
247	bsetb	#sign_bit,FP_SCR1(%a6)	|set exceptional operand sign
248ovf_pos:
249	fmovemx ETEMP(%a6),%fp0-%fp0		|move the result to fp0
250	rts
251
252
253|
254|	INEX2 exception
255|
256| The inex2 and ainex bits are set.
257|
258t_inx2:
259	orl	#inx2a_mask,USER_FPSR(%a6) |set INEX2, AINEX
260	rts
261
262|
263|	Force Inex2
264|
265| This routine is called by the transcendental routines to force
266| the inex2 exception bits set in the FPSR.  If the underflow bit
267| is set, but the underflow trap was not taken, the aunfl bit in
268| the FPSR must be set.
269|
270t_frcinx:
271	orl	#inx2a_mask,USER_FPSR(%a6) |set INEX2, AINEX
272	btstb	#unfl_bit,FPSR_EXCEPT(%a6) |test for unfl bit set
273	beqs	no_uacc1		|if clear, do not set aunfl
274	bsetb	#aunfl_bit,FPSR_AEXCEPT(%a6)
275no_uacc1:
276	rts
277
278|
279|	DST_NAN
280|
281| Determine if the destination nan is signalling or non-signalling,
282| and set the FPSR bits accordingly.  See the MC68040 User's Manual
283| section 3.2.2.5 NOT-A-NUMBERS.
284|
285dst_nan:
286	btstb	#sign_bit,FPTEMP_EX(%a6) |test sign of nan
287	beqs	dst_pos			|if clr, it was positive
288	bsetb	#neg_bit,FPSR_CC(%a6)	|set N bit
289dst_pos:
290	btstb	#signan_bit,FPTEMP_HI(%a6) |check if signalling
291	beqs	dst_snan		|branch if signalling
292
293	fmovel	%d1,%fpcr			|restore user's rmode/prec
294	fmovex FPTEMP(%a6),%fp0		|return the non-signalling nan
295|
296| Check the source nan.  If it is signalling, snan will be reported.
297|
298	moveb	STAG(%a6),%d0
299	andib	#0xe0,%d0
300	cmpib	#0x60,%d0
301	bnes	no_snan
302	btstb	#signan_bit,ETEMP_HI(%a6) |check if signalling
303	bnes	no_snan
304	orl	#snaniop_mask,USER_FPSR(%a6) |set NAN, SNAN, AIOP
305no_snan:
306	rts
307
308dst_snan:
309	btstb	#snan_bit,FPCR_ENABLE(%a6) |check if trap enabled
310	beqs	dst_dis			|branch if disabled
311
312	orb	#nan_tag,DTAG(%a6)	|set up dtag for nan
313	st	STORE_FLG(%a6)		|do not store a result
314	orl	#snaniop_mask,USER_FPSR(%a6) |set NAN, SNAN, AIOP
315	rts
316
317dst_dis:
318	bsetb	#signan_bit,FPTEMP_HI(%a6) |set SNAN bit in sop
319	fmovel	%d1,%fpcr			|restore user's rmode/prec
320	fmovex FPTEMP(%a6),%fp0		|load non-sign. nan
321	orl	#snaniop_mask,USER_FPSR(%a6) |set NAN, SNAN, AIOP
322	rts
323
324|
325|	SRC_NAN
326|
327| Determine if the source nan is signalling or non-signalling,
328| and set the FPSR bits accordingly.  See the MC68040 User's Manual
329| section 3.2.2.5 NOT-A-NUMBERS.
330|
331src_nan:
332	btstb	#sign_bit,ETEMP_EX(%a6) |test sign of nan
333	beqs	src_pos			|if clr, it was positive
334	bsetb	#neg_bit,FPSR_CC(%a6)	|set N bit
335src_pos:
336	btstb	#signan_bit,ETEMP_HI(%a6) |check if signalling
337	beqs	src_snan		|branch if signalling
338	fmovel	%d1,%fpcr			|restore user's rmode/prec
339	fmovex ETEMP(%a6),%fp0		|return the non-signalling nan
340	rts
341
342src_snan:
343	btstb	#snan_bit,FPCR_ENABLE(%a6) |check if trap enabled
344	beqs	src_dis			|branch if disabled
345	bsetb	#signan_bit,ETEMP_HI(%a6) |set SNAN bit in sop
346	orb	#norm_tag,DTAG(%a6)	|set up dtag for norm
347	orb	#nan_tag,STAG(%a6)	|set up stag for nan
348	st	STORE_FLG(%a6)		|do not store a result
349	orl	#snaniop_mask,USER_FPSR(%a6) |set NAN, SNAN, AIOP
350	rts
351
352src_dis:
353	bsetb	#signan_bit,ETEMP_HI(%a6) |set SNAN bit in sop
354	fmovel	%d1,%fpcr			|restore user's rmode/prec
355	fmovex ETEMP(%a6),%fp0		|load non-sign. nan
356	orl	#snaniop_mask,USER_FPSR(%a6) |set NAN, SNAN, AIOP
357	rts
358
359|
360| For all functions that have a denormalized input and that f(x)=x,
361| this is the entry point
362|
363t_extdnrm:
364	orl	#unfinx_mask,USER_FPSR(%a6)
365|					;set UNFL, INEX2, AUNFL, AINEX
366	bras	xdnrm_con
367|
368| Entry point for scale with extended denorm.  The function does
369| not set inex2, aunfl, or ainex.
370|
371t_resdnrm:
372	orl	#unfl_mask,USER_FPSR(%a6)
373
374xdnrm_con:
375	btstb	#unfl_bit,FPCR_ENABLE(%a6)
376	beqs	xdnrm_dis
377
378|
379| If exceptions are enabled, the additional task of setting up WBTEMP
380| is needed so that when the underflow exception handler is entered,
381| the user perceives no difference between what the 040 provides vs.
382| what the FPSP provides.
383|
384xdnrm_ena:
385	movel	%a0,-(%a7)
386
387	movel	LOCAL_EX(%a0),FP_SCR1(%a6)
388	movel	LOCAL_HI(%a0),FP_SCR1+4(%a6)
389	movel	LOCAL_LO(%a0),FP_SCR1+8(%a6)
390
391	lea	FP_SCR1(%a6),%a0
392
393	bclrb	#sign_bit,LOCAL_EX(%a0)
394	sne	LOCAL_SGN(%a0)		|convert to internal ext format
395	tstw	LOCAL_EX(%a0)		|check if input is denorm
396	beqs	xdnrm_dn		|if so, skip nrm_set
397	bsr	nrm_set			|normalize the result (exponent
398|					;will be negative
399xdnrm_dn:
400	bclrb	#sign_bit,LOCAL_EX(%a0)	|take off false sign
401	bfclr	LOCAL_SGN(%a0){#0:#8}	|change back to IEEE ext format
402	beqs	xdep
403	bsetb	#sign_bit,LOCAL_EX(%a0)
404xdep:
405	bfclr	STAG(%a6){#5:#3}		|clear wbtm66,wbtm1,wbtm0
406	bsetb	#wbtemp15_bit,WB_BYTE(%a6) |set wbtemp15
407	bclrb	#sticky_bit,STICKY(%a6)	|clear sticky bit
408	bclrb	#E1,E_BYTE(%a6)
409	movel	(%a7)+,%a0
410xdnrm_dis:
411	bfextu	FPCR_MODE(%a6){#0:#2},%d0	|get round precision
412	bnes	not_ext			|if not round extended, store
413|					;IEEE defaults
414is_ext:
415	btstb	#sign_bit,LOCAL_EX(%a0)
416	beqs	xdnrm_store
417
418	bsetb	#neg_bit,FPSR_CC(%a6)	|set N bit in FPSR_CC
419
420	bras	xdnrm_store
421
422not_ext:
423	bclrb	#sign_bit,LOCAL_EX(%a0)
424	sne	LOCAL_SGN(%a0)		|convert to internal ext format
425	bsr	unf_sub			|returns IEEE result pointed by
426|					;a0; sets FPSR_CC accordingly
427	bfclr	LOCAL_SGN(%a0){#0:#8}	|convert back to IEEE ext format
428	beqs	xdnrm_store
429	bsetb	#sign_bit,LOCAL_EX(%a0)
430xdnrm_store:
431	fmovemx (%a0),%fp0-%fp0		|store result in fp0
432	rts
433
434|
435| This subroutine is used for dyadic operations that use an extended
436| denorm within the kernel. The approach used is to capture the frame,
437| fix/restore.
438|
439	.global	t_avoid_unsupp
440t_avoid_unsupp:
441	link	%a2,#-LOCAL_SIZE		|so that a2 fpsp.h negative
442|					;offsets may be used
443	fsave	-(%a7)
444	tstb	1(%a7)			|check if idle, exit if so
445	beq	idle_end
446	btstb	#E1,E_BYTE(%a2)		|check for an E1 exception if
447|					;enabled, there is an unsupp
448	beq	end_avun		|else, exit
449	btstb	#7,DTAG(%a2)		|check for denorm destination
450	beqs	src_den			|else, must be a source denorm
451|
452| handle destination denorm
453|
454	lea	FPTEMP(%a2),%a0
455	btstb	#sign_bit,LOCAL_EX(%a0)
456	sne	LOCAL_SGN(%a0)		|convert to internal ext format
457	bclrb	#7,DTAG(%a2)		|set DTAG to norm
458	bsr	nrm_set			|normalize result, exponent
459|					;will become negative
460	bclrb	#sign_bit,LOCAL_EX(%a0)	|get rid of fake sign
461	bfclr	LOCAL_SGN(%a0){#0:#8}	|convert back to IEEE ext format
462	beqs	ck_src_den		|check if source is also denorm
463	bsetb	#sign_bit,LOCAL_EX(%a0)
464ck_src_den:
465	btstb	#7,STAG(%a2)
466	beqs	end_avun
467src_den:
468	lea	ETEMP(%a2),%a0
469	btstb	#sign_bit,LOCAL_EX(%a0)
470	sne	LOCAL_SGN(%a0)		|convert to internal ext format
471	bclrb	#7,STAG(%a2)		|set STAG to norm
472	bsr	nrm_set			|normalize result, exponent
473|					;will become negative
474	bclrb	#sign_bit,LOCAL_EX(%a0)	|get rid of fake sign
475	bfclr	LOCAL_SGN(%a0){#0:#8}	|convert back to IEEE ext format
476	beqs	den_com
477	bsetb	#sign_bit,LOCAL_EX(%a0)
478den_com:
479	moveb	#0xfe,CU_SAVEPC(%a2)	|set continue frame
480	clrw	NMNEXC(%a2)		|clear NMNEXC
481	bclrb	#E1,E_BYTE(%a2)
482|	fmove.l	%FPSR,FPSR_SHADOW(%a2)
483|	bset.b	#SFLAG,E_BYTE(%a2)
484|	bset.b	#XFLAG,T_BYTE(%a2)
485end_avun:
486	frestore (%a7)+
487	unlk	%a2
488	rts
489idle_end:
490	addl	#4,%a7
491	unlk	%a2
492	rts
493	|end
494