source: rtems/c/src/lib/libcpu/m68k/m68040/fpsp/res_func.S @ 42e243e

4.104.115
Last change on this file since 42e243e was 42e243e, checked in by Ralf Corsepius <ralf.corsepius@…>, on 12/04/09 at 04:27:21

Whitespace removal.

  • Property mode set to 100644
File size: 53.0 KB
Line 
1//
2//      $Id$
3//
4//      res_func.sa 3.9 7/29/91
5//
6// Normalizes denormalized numbers if necessary and updates the
7// stack frame.  The function is then restored back into the
8// machine and the 040 completes the operation.  This routine
9// is only used by the unsupported data type/format handler.
10// (Exception vector 55).
11//
12// For packed move out (fmove.p fpm,<ea>) the operation is
13// completed here; data is packed and moved to user memory.
14// The stack is restored to the 040 only in the case of a
15// reportable exception in the conversion.
16//
17//
18//              Copyright (C) Motorola, Inc. 1990
19//                      All Rights Reserved
20//
21//      THIS IS UNPUBLISHED PROPRIETARY SOURCE CODE OF MOTOROLA
22//      The copyright notice above does not evidence any
23//      actual or intended publication of such source code.
24
25RES_FUNC:    //idnt    2,1 | Motorola 040 Floating Point Software Package
26
27        |section        8
28
29#include "fpsp.defs"
30
31sp_bnds:        .short  0x3f81,0x407e
32                .short  0x3f6a,0x0000
33dp_bnds:        .short  0x3c01,0x43fe
34                .short  0x3bcd,0x0000
35
36        |xref   mem_write
37        |xref   bindec
38        |xref   get_fline
39        |xref   round
40        |xref   denorm
41        |xref   dest_ext
42        |xref   dest_dbl
43        |xref   dest_sgl
44        |xref   unf_sub
45        |xref   nrm_set
46        |xref   dnrm_lp
47        |xref   ovf_res
48        |xref   reg_dest
49        |xref   t_ovfl
50        |xref   t_unfl
51
52        .global res_func
53        .global         p_move
54
55res_func:
56        clrb    DNRM_FLG(%a6)
57        clrb    RES_FLG(%a6)
58        clrb    CU_ONLY(%a6)
59        tstb    DY_MO_FLG(%a6)
60        beqs    monadic
61dyadic:
62        btstb   #7,DTAG(%a6)    //if dop = norm=000, zero=001,
63//                              ;inf=010 or nan=011
64        beqs    monadic         //then branch
65//                              ;else denorm
66// HANDLE DESTINATION DENORM HERE
67//                              ;set dtag to norm
68//                              ;write the tag & fpte15 to the fstack
69        leal    FPTEMP(%a6),%a0
70
71        bclrb   #sign_bit,LOCAL_EX(%a0)
72        sne     LOCAL_SGN(%a0)
73
74        bsr     nrm_set         //normalize number (exp will go negative)
75        bclrb   #sign_bit,LOCAL_EX(%a0) //get rid of false sign
76        bfclr   LOCAL_SGN(%a0){#0:#8}   //change back to IEEE ext format
77        beqs    dpos
78        bsetb   #sign_bit,LOCAL_EX(%a0)
79dpos:
80        bfclr   DTAG(%a6){#0:#4}        //set tag to normalized, FPTE15 = 0
81        bsetb   #4,DTAG(%a6)    //set FPTE15
82        orb     #0x0f,DNRM_FLG(%a6)
83monadic:
84        leal    ETEMP(%a6),%a0
85        btstb   #direction_bit,CMDREG1B(%a6)    //check direction
86        bne     opclass3                        //it is a mv out
87//
88// At this point, only opclass 0 and 2 possible
89//
90        btstb   #7,STAG(%a6)    //if sop = norm=000, zero=001,
91//                              ;inf=010 or nan=011
92        bne     mon_dnrm        //else denorm
93        tstb    DY_MO_FLG(%a6)  //all cases of dyadic instructions would
94        bne     normal          //require normalization of denorm
95
96// At this point:
97//      monadic instructions:   fabs  = $18  fneg   = $1a  ftst   = $3a
98//                              fmove = $00  fsmove = $40  fdmove = $44
99//                              fsqrt = $05* fssqrt = $41  fdsqrt = $45
100//                              (*fsqrt reencoded to $05)
101//
102        movew   CMDREG1B(%a6),%d0       //get command register
103        andil   #0x7f,%d0                       //strip to only command word
104//
105// At this point, fabs, fneg, fsmove, fdmove, ftst, fsqrt, fssqrt, and
106// fdsqrt are possible.
107// For cases fabs, fneg, fsmove, and fdmove goto spos (do not normalize)
108// For cases fsqrt, fssqrt, and fdsqrt goto nrm_src (do normalize)
109//
110        btstl   #0,%d0
111        bne     normal                  //weed out fsqrt instructions
112//
113// cu_norm handles fmove in instructions with normalized inputs.
114// The routine round is used to correctly round the input for the
115// destination precision and mode.
116//
117cu_norm:
118        st      CU_ONLY(%a6)            //set cu-only inst flag
119        movew   CMDREG1B(%a6),%d0
120        andib   #0x3b,%d0               //isolate bits to select inst
121        tstb    %d0
122        beql    cu_nmove        //if zero, it is an fmove
123        cmpib   #0x18,%d0
124        beql    cu_nabs         //if $18, it is fabs
125        cmpib   #0x1a,%d0
126        beql    cu_nneg         //if $1a, it is fneg
127//
128// Inst is ftst.  Check the source operand and set the cc's accordingly.
129// No write is done, so simply rts.
130//
131cu_ntst:
132        movew   LOCAL_EX(%a0),%d0
133        bclrl   #15,%d0
134        sne     LOCAL_SGN(%a0)
135        beqs    cu_ntpo
136        orl     #neg_mask,USER_FPSR(%a6) //set N
137cu_ntpo:
138        cmpiw   #0x7fff,%d0     //test for inf/nan
139        bnes    cu_ntcz
140        tstl    LOCAL_HI(%a0)
141        bnes    cu_ntn
142        tstl    LOCAL_LO(%a0)
143        bnes    cu_ntn
144        orl     #inf_mask,USER_FPSR(%a6)
145        rts
146cu_ntn:
147        orl     #nan_mask,USER_FPSR(%a6)
148        movel   ETEMP_EX(%a6),FPTEMP_EX(%a6)    //set up fptemp sign for
149//                                              ;snan handler
150
151        rts
152cu_ntcz:
153        tstl    LOCAL_HI(%a0)
154        bnel    cu_ntsx
155        tstl    LOCAL_LO(%a0)
156        bnel    cu_ntsx
157        orl     #z_mask,USER_FPSR(%a6)
158cu_ntsx:
159        rts
160//
161// Inst is fabs.  Execute the absolute value function on the input.
162// Branch to the fmove code.  If the operand is NaN, do nothing.
163//
164cu_nabs:
165        moveb   STAG(%a6),%d0
166        btstl   #5,%d0                  //test for NaN or zero
167        bne     wr_etemp                //if either, simply write it
168        bclrb   #7,LOCAL_EX(%a0)                //do abs
169        bras    cu_nmove                //fmove code will finish
170//
171// Inst is fneg.  Execute the negate value function on the input.
172// Fall though to the fmove code.  If the operand is NaN, do nothing.
173//
174cu_nneg:
175        moveb   STAG(%a6),%d0
176        btstl   #5,%d0                  //test for NaN or zero
177        bne     wr_etemp                //if either, simply write it
178        bchgb   #7,LOCAL_EX(%a0)                //do neg
179//
180// Inst is fmove.  This code also handles all result writes.
181// If bit 2 is set, round is forced to double.  If it is clear,
182// and bit 6 is set, round is forced to single.  If both are clear,
183// the round precision is found in the fpcr.  If the rounding precision
184// is double or single, round the result before the write.
185//
186cu_nmove:
187        moveb   STAG(%a6),%d0
188        andib   #0xe0,%d0                       //isolate stag bits
189        bne     wr_etemp                //if not norm, simply write it
190        btstb   #2,CMDREG1B+1(%a6)      //check for rd
191        bne     cu_nmrd
192        btstb   #6,CMDREG1B+1(%a6)      //check for rs
193        bne     cu_nmrs
194//
195// The move or operation is not with forced precision.  Test for
196// nan or inf as the input; if so, simply write it to FPn.  Use the
197// FPCR_MODE byte to get rounding on norms and zeros.
198//
199cu_nmnr:
200        bfextu  FPCR_MODE(%a6){#0:#2},%d0
201        tstb    %d0                     //check for extended
202        beq     cu_wrexn                //if so, just write result
203        cmpib   #1,%d0                  //check for single
204        beq     cu_nmrs                 //fall through to double
205//
206// The move is fdmove or round precision is double.
207//
208cu_nmrd:
209        movel   #2,%d0                  //set up the size for denorm
210        movew   LOCAL_EX(%a0),%d1               //compare exponent to double threshold
211        andw    #0x7fff,%d1
212        cmpw    #0x3c01,%d1
213        bls     cu_nunfl
214        bfextu  FPCR_MODE(%a6){#2:#2},%d1       //get rmode
215        orl     #0x00020000,%d1         //or in rprec (double)
216        clrl    %d0                     //clear g,r,s for round
217        bclrb   #sign_bit,LOCAL_EX(%a0) //convert to internal format
218        sne     LOCAL_SGN(%a0)
219        bsrl    round
220        bfclr   LOCAL_SGN(%a0){#0:#8}
221        beqs    cu_nmrdc
222        bsetb   #sign_bit,LOCAL_EX(%a0)
223cu_nmrdc:
224        movew   LOCAL_EX(%a0),%d1               //check for overflow
225        andw    #0x7fff,%d1
226        cmpw    #0x43ff,%d1
227        bge     cu_novfl                //take care of overflow case
228        bra     cu_wrexn
229//
230// The move is fsmove or round precision is single.
231//
232cu_nmrs:
233        movel   #1,%d0
234        movew   LOCAL_EX(%a0),%d1
235        andw    #0x7fff,%d1
236        cmpw    #0x3f81,%d1
237        bls     cu_nunfl
238        bfextu  FPCR_MODE(%a6){#2:#2},%d1
239        orl     #0x00010000,%d1
240        clrl    %d0
241        bclrb   #sign_bit,LOCAL_EX(%a0)
242        sne     LOCAL_SGN(%a0)
243        bsrl    round
244        bfclr   LOCAL_SGN(%a0){#0:#8}
245        beqs    cu_nmrsc
246        bsetb   #sign_bit,LOCAL_EX(%a0)
247cu_nmrsc:
248        movew   LOCAL_EX(%a0),%d1
249        andw    #0x7FFF,%d1
250        cmpw    #0x407f,%d1
251        blt     cu_wrexn
252//
253// The operand is above precision boundaries.  Use t_ovfl to
254// generate the correct value.
255//
256cu_novfl:
257        bsr     t_ovfl
258        bra     cu_wrexn
259//
260// The operand is below precision boundaries.  Use denorm to
261// generate the correct value.
262//
263cu_nunfl:
264        bclrb   #sign_bit,LOCAL_EX(%a0)
265        sne     LOCAL_SGN(%a0)
266        bsr     denorm
267        bfclr   LOCAL_SGN(%a0){#0:#8}   //change back to IEEE ext format
268        beqs    cu_nucont
269        bsetb   #sign_bit,LOCAL_EX(%a0)
270cu_nucont:
271        bfextu  FPCR_MODE(%a6){#2:#2},%d1
272        btstb   #2,CMDREG1B+1(%a6)      //check for rd
273        bne     inst_d
274        btstb   #6,CMDREG1B+1(%a6)      //check for rs
275        bne     inst_s
276        swap    %d1
277        moveb   FPCR_MODE(%a6),%d1
278        lsrb    #6,%d1
279        swap    %d1
280        bra     inst_sd
281inst_d:
282        orl     #0x00020000,%d1
283        bra     inst_sd
284inst_s:
285        orl     #0x00010000,%d1
286inst_sd:
287        bclrb   #sign_bit,LOCAL_EX(%a0)
288        sne     LOCAL_SGN(%a0)
289        bsrl    round
290        bfclr   LOCAL_SGN(%a0){#0:#8}
291        beqs    cu_nuflp
292        bsetb   #sign_bit,LOCAL_EX(%a0)
293cu_nuflp:
294        btstb   #inex2_bit,FPSR_EXCEPT(%a6)
295        beqs    cu_nuninx
296        orl     #aunfl_mask,USER_FPSR(%a6) //if the round was inex, set AUNFL
297cu_nuninx:
298        tstl    LOCAL_HI(%a0)           //test for zero
299        bnes    cu_nunzro
300        tstl    LOCAL_LO(%a0)
301        bnes    cu_nunzro
302//
303// The mantissa is zero from the denorm loop.  Check sign and rmode
304// to see if rounding should have occurred which would leave the lsb.
305//
306        movel   USER_FPCR(%a6),%d0
307        andil   #0x30,%d0               //isolate rmode
308        cmpil   #0x20,%d0
309        blts    cu_nzro
310        bnes    cu_nrp
311cu_nrm:
312        tstw    LOCAL_EX(%a0)   //if positive, set lsb
313        bges    cu_nzro
314        btstb   #7,FPCR_MODE(%a6) //check for double
315        beqs    cu_nincs
316        bras    cu_nincd
317cu_nrp:
318        tstw    LOCAL_EX(%a0)   //if positive, set lsb
319        blts    cu_nzro
320        btstb   #7,FPCR_MODE(%a6) //check for double
321        beqs    cu_nincs
322cu_nincd:
323        orl     #0x800,LOCAL_LO(%a0) //inc for double
324        bra     cu_nunzro
325cu_nincs:
326        orl     #0x100,LOCAL_HI(%a0) //inc for single
327        bra     cu_nunzro
328cu_nzro:
329        orl     #z_mask,USER_FPSR(%a6)
330        moveb   STAG(%a6),%d0
331        andib   #0xe0,%d0
332        cmpib   #0x40,%d0               //check if input was tagged zero
333        beqs    cu_numv
334cu_nunzro:
335        orl     #unfl_mask,USER_FPSR(%a6) //set unfl
336cu_numv:
337        movel   (%a0),ETEMP(%a6)
338        movel   4(%a0),ETEMP_HI(%a6)
339        movel   8(%a0),ETEMP_LO(%a6)
340//
341// Write the result to memory, setting the fpsr cc bits.  NaN and Inf
342// bypass cu_wrexn.
343//
344cu_wrexn:
345        tstw    LOCAL_EX(%a0)           //test for zero
346        beqs    cu_wrzero
347        cmpw    #0x8000,LOCAL_EX(%a0)   //test for zero
348        bnes    cu_wreon
349cu_wrzero:
350        orl     #z_mask,USER_FPSR(%a6)  //set Z bit
351cu_wreon:
352        tstw    LOCAL_EX(%a0)
353        bpl     wr_etemp
354        orl     #neg_mask,USER_FPSR(%a6)
355        bra     wr_etemp
356
357//
358// HANDLE SOURCE DENORM HERE
359//
360//                              ;clear denorm stag to norm
361//                              ;write the new tag & ete15 to the fstack
362mon_dnrm:
363//
364// At this point, check for the cases in which normalizing the
365// denorm produces incorrect results.
366//
367        tstb    DY_MO_FLG(%a6)  //all cases of dyadic instructions would
368        bnes    nrm_src         //require normalization of denorm
369
370// At this point:
371//      monadic instructions:   fabs  = $18  fneg   = $1a  ftst   = $3a
372//                              fmove = $00  fsmove = $40  fdmove = $44
373//                              fsqrt = $05* fssqrt = $41  fdsqrt = $45
374//                              (*fsqrt reencoded to $05)
375//
376        movew   CMDREG1B(%a6),%d0       //get command register
377        andil   #0x7f,%d0                       //strip to only command word
378//
379// At this point, fabs, fneg, fsmove, fdmove, ftst, fsqrt, fssqrt, and
380// fdsqrt are possible.
381// For cases fabs, fneg, fsmove, and fdmove goto spos (do not normalize)
382// For cases fsqrt, fssqrt, and fdsqrt goto nrm_src (do normalize)
383//
384        btstl   #0,%d0
385        bnes    nrm_src         //weed out fsqrt instructions
386        st      CU_ONLY(%a6)    //set cu-only inst flag
387        bra     cu_dnrm         //fmove, fabs, fneg, ftst
388//                              ;cases go to cu_dnrm
389nrm_src:
390        bclrb   #sign_bit,LOCAL_EX(%a0)
391        sne     LOCAL_SGN(%a0)
392        bsr     nrm_set         //normalize number (exponent will go
393//                              ; negative)
394        bclrb   #sign_bit,LOCAL_EX(%a0) //get rid of false sign
395
396        bfclr   LOCAL_SGN(%a0){#0:#8}   //change back to IEEE ext format
397        beqs    spos
398        bsetb   #sign_bit,LOCAL_EX(%a0)
399spos:
400        bfclr   STAG(%a6){#0:#4}        //set tag to normalized, FPTE15 = 0
401        bsetb   #4,STAG(%a6)    //set ETE15
402        orb     #0xf0,DNRM_FLG(%a6)
403normal:
404        tstb    DNRM_FLG(%a6)   //check if any of the ops were denorms
405        bne     ck_wrap         //if so, check if it is a potential
406//                              ;wrap-around case
407fix_stk:
408        moveb   #0xfe,CU_SAVEPC(%a6)
409        bclrb   #E1,E_BYTE(%a6)
410
411        clrw    NMNEXC(%a6)
412
413        st      RES_FLG(%a6)    //indicate that a restore is needed
414        rts
415
416//
417// cu_dnrm handles all cu-only instructions (fmove, fabs, fneg, and
418// ftst) completely in software without an frestore to the 040.
419//
420cu_dnrm:
421        st      CU_ONLY(%a6)
422        movew   CMDREG1B(%a6),%d0
423        andib   #0x3b,%d0               //isolate bits to select inst
424        tstb    %d0
425        beql    cu_dmove        //if zero, it is an fmove
426        cmpib   #0x18,%d0
427        beql    cu_dabs         //if $18, it is fabs
428        cmpib   #0x1a,%d0
429        beql    cu_dneg         //if $1a, it is fneg
430//
431// Inst is ftst.  Check the source operand and set the cc's accordingly.
432// No write is done, so simply rts.
433//
434cu_dtst:
435        movew   LOCAL_EX(%a0),%d0
436        bclrl   #15,%d0
437        sne     LOCAL_SGN(%a0)
438        beqs    cu_dtpo
439        orl     #neg_mask,USER_FPSR(%a6) //set N
440cu_dtpo:
441        cmpiw   #0x7fff,%d0     //test for inf/nan
442        bnes    cu_dtcz
443        tstl    LOCAL_HI(%a0)
444        bnes    cu_dtn
445        tstl    LOCAL_LO(%a0)
446        bnes    cu_dtn
447        orl     #inf_mask,USER_FPSR(%a6)
448        rts
449cu_dtn:
450        orl     #nan_mask,USER_FPSR(%a6)
451        movel   ETEMP_EX(%a6),FPTEMP_EX(%a6)    //set up fptemp sign for
452//                                              ;snan handler
453        rts
454cu_dtcz:
455        tstl    LOCAL_HI(%a0)
456        bnel    cu_dtsx
457        tstl    LOCAL_LO(%a0)
458        bnel    cu_dtsx
459        orl     #z_mask,USER_FPSR(%a6)
460cu_dtsx:
461        rts
462//
463// Inst is fabs.  Execute the absolute value function on the input.
464// Branch to the fmove code.
465//
466cu_dabs:
467        bclrb   #7,LOCAL_EX(%a0)                //do abs
468        bras    cu_dmove                //fmove code will finish
469//
470// Inst is fneg.  Execute the negate value function on the input.
471// Fall though to the fmove code.
472//
473cu_dneg:
474        bchgb   #7,LOCAL_EX(%a0)                //do neg
475//
476// Inst is fmove.  This code also handles all result writes.
477// If bit 2 is set, round is forced to double.  If it is clear,
478// and bit 6 is set, round is forced to single.  If both are clear,
479// the round precision is found in the fpcr.  If the rounding precision
480// is double or single, the result is zero, and the mode is checked
481// to determine if the lsb of the result should be set.
482//
483cu_dmove:
484        btstb   #2,CMDREG1B+1(%a6)      //check for rd
485        bne     cu_dmrd
486        btstb   #6,CMDREG1B+1(%a6)      //check for rs
487        bne     cu_dmrs
488//
489// The move or operation is not with forced precision.  Use the
490// FPCR_MODE byte to get rounding.
491//
492cu_dmnr:
493        bfextu  FPCR_MODE(%a6){#0:#2},%d0
494        tstb    %d0                     //check for extended
495        beq     cu_wrexd                //if so, just write result
496        cmpib   #1,%d0                  //check for single
497        beq     cu_dmrs                 //fall through to double
498//
499// The move is fdmove or round precision is double.  Result is zero.
500// Check rmode for rp or rm and set lsb accordingly.
501//
502cu_dmrd:
503        bfextu  FPCR_MODE(%a6){#2:#2},%d1       //get rmode
504        tstw    LOCAL_EX(%a0)           //check sign
505        blts    cu_dmdn
506        cmpib   #3,%d1                  //check for rp
507        bne     cu_dpd                  //load double pos zero
508        bra     cu_dpdr                 //load double pos zero w/lsb
509cu_dmdn:
510        cmpib   #2,%d1                  //check for rm
511        bne     cu_dnd                  //load double neg zero
512        bra     cu_dndr                 //load double neg zero w/lsb
513//
514// The move is fsmove or round precision is single.  Result is zero.
515// Check for rp or rm and set lsb accordingly.
516//
517cu_dmrs:
518        bfextu  FPCR_MODE(%a6){#2:#2},%d1       //get rmode
519        tstw    LOCAL_EX(%a0)           //check sign
520        blts    cu_dmsn
521        cmpib   #3,%d1                  //check for rp
522        bne     cu_spd                  //load single pos zero
523        bra     cu_spdr                 //load single pos zero w/lsb
524cu_dmsn:
525        cmpib   #2,%d1                  //check for rm
526        bne     cu_snd                  //load single neg zero
527        bra     cu_sndr                 //load single neg zero w/lsb
528//
529// The precision is extended, so the result in etemp is correct.
530// Simply set unfl (not inex2 or aunfl) and write the result to
531// the correct fp register.
532cu_wrexd:
533        orl     #unfl_mask,USER_FPSR(%a6)
534        tstw    LOCAL_EX(%a0)
535        beq     wr_etemp
536        orl     #neg_mask,USER_FPSR(%a6)
537        bra     wr_etemp
538//
539// These routines write +/- zero in double format.  The routines
540// cu_dpdr and cu_dndr set the double lsb.
541//
542cu_dpd:
543        movel   #0x3c010000,LOCAL_EX(%a0)       //force pos double zero
544        clrl    LOCAL_HI(%a0)
545        clrl    LOCAL_LO(%a0)
546        orl     #z_mask,USER_FPSR(%a6)
547        orl     #unfinx_mask,USER_FPSR(%a6)
548        bra     wr_etemp
549cu_dpdr:
550        movel   #0x3c010000,LOCAL_EX(%a0)       //force pos double zero
551        clrl    LOCAL_HI(%a0)
552        movel   #0x800,LOCAL_LO(%a0)    //with lsb set
553        orl     #unfinx_mask,USER_FPSR(%a6)
554        bra     wr_etemp
555cu_dnd:
556        movel   #0xbc010000,LOCAL_EX(%a0)       //force pos double zero
557        clrl    LOCAL_HI(%a0)
558        clrl    LOCAL_LO(%a0)
559        orl     #z_mask,USER_FPSR(%a6)
560        orl     #neg_mask,USER_FPSR(%a6)
561        orl     #unfinx_mask,USER_FPSR(%a6)
562        bra     wr_etemp
563cu_dndr:
564        movel   #0xbc010000,LOCAL_EX(%a0)       //force pos double zero
565        clrl    LOCAL_HI(%a0)
566        movel   #0x800,LOCAL_LO(%a0)    //with lsb set
567        orl     #neg_mask,USER_FPSR(%a6)
568        orl     #unfinx_mask,USER_FPSR(%a6)
569        bra     wr_etemp
570//
571// These routines write +/- zero in single format.  The routines
572// cu_dpdr and cu_dndr set the single lsb.
573//
574cu_spd:
575        movel   #0x3f810000,LOCAL_EX(%a0)       //force pos single zero
576        clrl    LOCAL_HI(%a0)
577        clrl    LOCAL_LO(%a0)
578        orl     #z_mask,USER_FPSR(%a6)
579        orl     #unfinx_mask,USER_FPSR(%a6)
580        bra     wr_etemp
581cu_spdr:
582        movel   #0x3f810000,LOCAL_EX(%a0)       //force pos single zero
583        movel   #0x100,LOCAL_HI(%a0)    //with lsb set
584        clrl    LOCAL_LO(%a0)
585        orl     #unfinx_mask,USER_FPSR(%a6)
586        bra     wr_etemp
587cu_snd:
588        movel   #0xbf810000,LOCAL_EX(%a0)       //force pos single zero
589        clrl    LOCAL_HI(%a0)
590        clrl    LOCAL_LO(%a0)
591        orl     #z_mask,USER_FPSR(%a6)
592        orl     #neg_mask,USER_FPSR(%a6)
593        orl     #unfinx_mask,USER_FPSR(%a6)
594        bra     wr_etemp
595cu_sndr:
596        movel   #0xbf810000,LOCAL_EX(%a0)       //force pos single zero
597        movel   #0x100,LOCAL_HI(%a0)    //with lsb set
598        clrl    LOCAL_LO(%a0)
599        orl     #neg_mask,USER_FPSR(%a6)
600        orl     #unfinx_mask,USER_FPSR(%a6)
601        bra     wr_etemp
602
603//
604// This code checks for 16-bit overflow conditions on dyadic
605// operations which are not restorable into the floating-point
606// unit and must be completed in software.  Basically, this
607// condition exists with a very large norm and a denorm.  One
608// of the operands must be denormalized to enter this code.
609//
610// Flags used:
611//      DY_MO_FLG contains 0 for monadic op, $ff for dyadic
612//      DNRM_FLG contains $00 for neither op denormalized
613//                        $0f for the destination op denormalized
614//                        $f0 for the source op denormalized
615//                        $ff for both ops denormalized
616//
617// The wrap-around condition occurs for add, sub, div, and cmp
618// when
619//
620//      abs(dest_exp - src_exp) >= $8000
621//
622// and for mul when
623//
624//      (dest_exp + src_exp) < $0
625//
626// we must process the operation here if this case is true.
627//
628// The rts following the frcfpn routine is the exit from res_func
629// for this condition.  The restore flag (RES_FLG) is left clear.
630// No frestore is done unless an exception is to be reported.
631//
632// For fadd:
633//      if(sign_of(dest) != sign_of(src))
634//              replace exponent of src with $3fff (keep sign)
635//              use fpu to perform dest+new_src (user's rmode and X)
636//              clr sticky
637//      else
638//              set sticky
639//      call round with user's precision and mode
640//      move result to fpn and wbtemp
641//
642// For fsub:
643//      if(sign_of(dest) == sign_of(src))
644//              replace exponent of src with $3fff (keep sign)
645//              use fpu to perform dest+new_src (user's rmode and X)
646//              clr sticky
647//      else
648//              set sticky
649//      call round with user's precision and mode
650//      move result to fpn and wbtemp
651//
652// For fdiv/fsgldiv:
653//      if(both operands are denorm)
654//              restore_to_fpu;
655//      if(dest is norm)
656//              force_ovf;
657//      else(dest is denorm)
658//              force_unf:
659//
660// For fcmp:
661//      if(dest is norm)
662//              N = sign_of(dest);
663//      else(dest is denorm)
664//              N = sign_of(src);
665//
666// For fmul:
667//      if(both operands are denorm)
668//              force_unf;
669//      if((dest_exp + src_exp) < 0)
670//              force_unf:
671//      else
672//              restore_to_fpu;
673//
674// local equates:
675        .set    addcode,0x22
676        .set    subcode,0x28
677        .set    mulcode,0x23
678        .set    divcode,0x20
679        .set    cmpcode,0x38
680ck_wrap:
681        | tstb  DY_MO_FLG(%a6)  ;check for fsqrt
682        beq     fix_stk         //if zero, it is fsqrt
683        movew   CMDREG1B(%a6),%d0
684        andiw   #0x3b,%d0               //strip to command bits
685        cmpiw   #addcode,%d0
686        beq     wrap_add
687        cmpiw   #subcode,%d0
688        beq     wrap_sub
689        cmpiw   #mulcode,%d0
690        beq     wrap_mul
691        cmpiw   #cmpcode,%d0
692        beq     wrap_cmp
693//
694// Inst is fdiv.
695//
696wrap_div:
697        cmpb    #0xff,DNRM_FLG(%a6) //if both ops denorm,
698        beq     fix_stk          //restore to fpu
699//
700// One of the ops is denormalized.  Test for wrap condition
701// and force the result.
702//
703        cmpb    #0x0f,DNRM_FLG(%a6) //check for dest denorm
704        bnes    div_srcd
705div_destd:
706        bsrl    ckinf_ns
707        bne     fix_stk
708        bfextu  ETEMP_EX(%a6){#1:#15},%d0       //get src exp (always pos)
709        bfexts  FPTEMP_EX(%a6){#1:#15},%d1      //get dest exp (always neg)
710        subl    %d1,%d0                 //subtract dest from src
711        cmpl    #0x7fff,%d0
712        blt     fix_stk                 //if less, not wrap case
713        clrb    WBTEMP_SGN(%a6)
714        movew   ETEMP_EX(%a6),%d0               //find the sign of the result
715        movew   FPTEMP_EX(%a6),%d1
716        eorw    %d1,%d0
717        andiw   #0x8000,%d0
718        beq     force_unf
719        st      WBTEMP_SGN(%a6)
720        bra     force_unf
721
722ckinf_ns:
723        moveb   STAG(%a6),%d0           //check source tag for inf or nan
724        bra     ck_in_com
725ckinf_nd:
726        moveb   DTAG(%a6),%d0           //check destination tag for inf or nan
727ck_in_com:
728        andib   #0x60,%d0                       //isolate tag bits
729        cmpb    #0x40,%d0                       //is it inf?
730        beq     nan_or_inf              //not wrap case
731        cmpb    #0x60,%d0                       //is it nan?
732        beq     nan_or_inf              //yes, not wrap case?
733        cmpb    #0x20,%d0                       //is it a zero?
734        beq     nan_or_inf              //yes
735        clrl    %d0
736        rts                             //then ; it is either a zero of norm,
737//                                      ;check wrap case
738nan_or_inf:
739        moveql  #-1,%d0
740        rts
741
742
743
744div_srcd:
745        bsrl    ckinf_nd
746        bne     fix_stk
747        bfextu  FPTEMP_EX(%a6){#1:#15},%d0      //get dest exp (always pos)
748        bfexts  ETEMP_EX(%a6){#1:#15},%d1       //get src exp (always neg)
749        subl    %d1,%d0                 //subtract src from dest
750        cmpl    #0x8000,%d0
751        blt     fix_stk                 //if less, not wrap case
752        clrb    WBTEMP_SGN(%a6)
753        movew   ETEMP_EX(%a6),%d0               //find the sign of the result
754        movew   FPTEMP_EX(%a6),%d1
755        eorw    %d1,%d0
756        andiw   #0x8000,%d0
757        beqs    force_ovf
758        st      WBTEMP_SGN(%a6)
759//
760// This code handles the case of the instruction resulting in
761// an overflow condition.
762//
763force_ovf:
764        bclrb   #E1,E_BYTE(%a6)
765        orl     #ovfl_inx_mask,USER_FPSR(%a6)
766        clrw    NMNEXC(%a6)
767        leal    WBTEMP(%a6),%a0         //point a0 to memory location
768        movew   CMDREG1B(%a6),%d0
769        btstl   #6,%d0                  //test for forced precision
770        beqs    frcovf_fpcr
771        btstl   #2,%d0                  //check for double
772        bnes    frcovf_dbl
773        movel   #0x1,%d0                        //inst is forced single
774        bras    frcovf_rnd
775frcovf_dbl:
776        movel   #0x2,%d0                        //inst is forced double
777        bras    frcovf_rnd
778frcovf_fpcr:
779        bfextu  FPCR_MODE(%a6){#0:#2},%d0       //inst not forced - use fpcr prec
780frcovf_rnd:
781
782// The 881/882 does not set inex2 for the following case, so the
783// line is commented out to be compatible with 881/882
784//      tst.b   %d0
785//      beq.b   frcovf_x
786//      or.l    #inex2_mask,USER_FPSR(%a6) ;if prec is s or d, set inex2
787
788//frcovf_x:
789        bsrl    ovf_res                 //get correct result based on
790//                                      ;round precision/mode.  This
791//                                      ;sets FPSR_CC correctly
792//                                      ;returns in external format
793        bfclr   WBTEMP_SGN(%a6){#0:#8}
794        beq     frcfpn
795        bsetb   #sign_bit,WBTEMP_EX(%a6)
796        bra     frcfpn
797//
798// Inst is fadd.
799//
800wrap_add:
801        cmpb    #0xff,DNRM_FLG(%a6) //if both ops denorm,
802        beq     fix_stk          //restore to fpu
803//
804// One of the ops is denormalized.  Test for wrap condition
805// and complete the instruction.
806//
807        cmpb    #0x0f,DNRM_FLG(%a6) //check for dest denorm
808        bnes    add_srcd
809add_destd:
810        bsrl    ckinf_ns
811        bne     fix_stk
812        bfextu  ETEMP_EX(%a6){#1:#15},%d0       //get src exp (always pos)
813        bfexts  FPTEMP_EX(%a6){#1:#15},%d1      //get dest exp (always neg)
814        subl    %d1,%d0                 //subtract dest from src
815        cmpl    #0x8000,%d0
816        blt     fix_stk                 //if less, not wrap case
817        bra     add_wrap
818add_srcd:
819        bsrl    ckinf_nd
820        bne     fix_stk
821        bfextu  FPTEMP_EX(%a6){#1:#15},%d0      //get dest exp (always pos)
822        bfexts  ETEMP_EX(%a6){#1:#15},%d1       //get src exp (always neg)
823        subl    %d1,%d0                 //subtract src from dest
824        cmpl    #0x8000,%d0
825        blt     fix_stk                 //if less, not wrap case
826//
827// Check the signs of the operands.  If they are unlike, the fpu
828// can be used to add the norm and 1.0 with the sign of the
829// denorm and it will correctly generate the result in extended
830// precision.  We can then call round with no sticky and the result
831// will be correct for the user's rounding mode and precision.  If
832// the signs are the same, we call round with the sticky bit set
833// and the result will be correct for the user's rounding mode and
834// precision.
835//
836add_wrap:
837        movew   ETEMP_EX(%a6),%d0
838        movew   FPTEMP_EX(%a6),%d1
839        eorw    %d1,%d0
840        andiw   #0x8000,%d0
841        beq     add_same
842//
843// The signs are unlike.
844//
845        cmpb    #0x0f,DNRM_FLG(%a6) //is dest the denorm?
846        bnes    add_u_srcd
847        movew   FPTEMP_EX(%a6),%d0
848        andiw   #0x8000,%d0
849        orw     #0x3fff,%d0     //force the exponent to +/- 1
850        movew   %d0,FPTEMP_EX(%a6) //in the denorm
851        movel   USER_FPCR(%a6),%d0
852        andil   #0x30,%d0
853        fmovel  %d0,%fpcr               //set up users rmode and X
854        fmovex  ETEMP(%a6),%fp0
855        faddx   FPTEMP(%a6),%fp0
856        leal    WBTEMP(%a6),%a0 //point a0 to wbtemp in frame
857        fmovel  %fpsr,%d1
858        orl     %d1,USER_FPSR(%a6) //capture cc's and inex from fadd
859        fmovex  %fp0,WBTEMP(%a6)        //write result to memory
860        lsrl    #4,%d0          //put rmode in lower 2 bits
861        movel   USER_FPCR(%a6),%d1
862        andil   #0xc0,%d1
863        lsrl    #6,%d1          //put precision in upper word
864        swap    %d1
865        orl     %d0,%d1         //set up for round call
866        clrl    %d0             //force sticky to zero
867        bclrb   #sign_bit,WBTEMP_EX(%a6)
868        sne     WBTEMP_SGN(%a6)
869        bsrl    round           //round result to users rmode & prec
870        bfclr   WBTEMP_SGN(%a6){#0:#8}  //convert back to IEEE ext format
871        beq     frcfpnr
872        bsetb   #sign_bit,WBTEMP_EX(%a6)
873        bra     frcfpnr
874add_u_srcd:
875        movew   ETEMP_EX(%a6),%d0
876        andiw   #0x8000,%d0
877        orw     #0x3fff,%d0     //force the exponent to +/- 1
878        movew   %d0,ETEMP_EX(%a6) //in the denorm
879        movel   USER_FPCR(%a6),%d0
880        andil   #0x30,%d0
881        fmovel  %d0,%fpcr               //set up users rmode and X
882        fmovex  ETEMP(%a6),%fp0
883        faddx   FPTEMP(%a6),%fp0
884        fmovel  %fpsr,%d1
885        orl     %d1,USER_FPSR(%a6) //capture cc's and inex from fadd
886        leal    WBTEMP(%a6),%a0 //point a0 to wbtemp in frame
887        fmovex  %fp0,WBTEMP(%a6)        //write result to memory
888        lsrl    #4,%d0          //put rmode in lower 2 bits
889        movel   USER_FPCR(%a6),%d1
890        andil   #0xc0,%d1
891        lsrl    #6,%d1          //put precision in upper word
892        swap    %d1
893        orl     %d0,%d1         //set up for round call
894        clrl    %d0             //force sticky to zero
895        bclrb   #sign_bit,WBTEMP_EX(%a6)
896        sne     WBTEMP_SGN(%a6) //use internal format for round
897        bsrl    round           //round result to users rmode & prec
898        bfclr   WBTEMP_SGN(%a6){#0:#8}  //convert back to IEEE ext format
899        beq     frcfpnr
900        bsetb   #sign_bit,WBTEMP_EX(%a6)
901        bra     frcfpnr
902//
903// Signs are alike:
904//
905add_same:
906        cmpb    #0x0f,DNRM_FLG(%a6) //is dest the denorm?
907        bnes    add_s_srcd
908add_s_destd:
909        leal    ETEMP(%a6),%a0
910        movel   USER_FPCR(%a6),%d0
911        andil   #0x30,%d0
912        lsrl    #4,%d0          //put rmode in lower 2 bits
913        movel   USER_FPCR(%a6),%d1
914        andil   #0xc0,%d1
915        lsrl    #6,%d1          //put precision in upper word
916        swap    %d1
917        orl     %d0,%d1         //set up for round call
918        movel   #0x20000000,%d0 //set sticky for round
919        bclrb   #sign_bit,ETEMP_EX(%a6)
920        sne     ETEMP_SGN(%a6)
921        bsrl    round           //round result to users rmode & prec
922        bfclr   ETEMP_SGN(%a6){#0:#8}   //convert back to IEEE ext format
923        beqs    add_s_dclr
924        bsetb   #sign_bit,ETEMP_EX(%a6)
925add_s_dclr:
926        leal    WBTEMP(%a6),%a0
927        movel   ETEMP(%a6),(%a0)        //write result to wbtemp
928        movel   ETEMP_HI(%a6),4(%a0)
929        movel   ETEMP_LO(%a6),8(%a0)
930        tstw    ETEMP_EX(%a6)
931        bgt     add_ckovf
932        orl     #neg_mask,USER_FPSR(%a6)
933        bra     add_ckovf
934add_s_srcd:
935        leal    FPTEMP(%a6),%a0
936        movel   USER_FPCR(%a6),%d0
937        andil   #0x30,%d0
938        lsrl    #4,%d0          //put rmode in lower 2 bits
939        movel   USER_FPCR(%a6),%d1
940        andil   #0xc0,%d1
941        lsrl    #6,%d1          //put precision in upper word
942        swap    %d1
943        orl     %d0,%d1         //set up for round call
944        movel   #0x20000000,%d0 //set sticky for round
945        bclrb   #sign_bit,FPTEMP_EX(%a6)
946        sne     FPTEMP_SGN(%a6)
947        bsrl    round           //round result to users rmode & prec
948        bfclr   FPTEMP_SGN(%a6){#0:#8}  //convert back to IEEE ext format
949        beqs    add_s_sclr
950        bsetb   #sign_bit,FPTEMP_EX(%a6)
951add_s_sclr:
952        leal    WBTEMP(%a6),%a0
953        movel   FPTEMP(%a6),(%a0)       //write result to wbtemp
954        movel   FPTEMP_HI(%a6),4(%a0)
955        movel   FPTEMP_LO(%a6),8(%a0)
956        tstw    FPTEMP_EX(%a6)
957        bgt     add_ckovf
958        orl     #neg_mask,USER_FPSR(%a6)
959add_ckovf:
960        movew   WBTEMP_EX(%a6),%d0
961        andiw   #0x7fff,%d0
962        cmpiw   #0x7fff,%d0
963        bne     frcfpnr
964//
965// The result has overflowed to $7fff exponent.  Set I, ovfl,
966// and aovfl, and clr the mantissa (incorrectly set by the
967// round routine.)
968//
969        orl     #inf_mask+ovfl_inx_mask,USER_FPSR(%a6)
970        clrl    4(%a0)
971        bra     frcfpnr
972//
973// Inst is fsub.
974//
975wrap_sub:
976        cmpb    #0xff,DNRM_FLG(%a6) //if both ops denorm,
977        beq     fix_stk          //restore to fpu
978//
979// One of the ops is denormalized.  Test for wrap condition
980// and complete the instruction.
981//
982        cmpb    #0x0f,DNRM_FLG(%a6) //check for dest denorm
983        bnes    sub_srcd
984sub_destd:
985        bsrl    ckinf_ns
986        bne     fix_stk
987        bfextu  ETEMP_EX(%a6){#1:#15},%d0       //get src exp (always pos)
988        bfexts  FPTEMP_EX(%a6){#1:#15},%d1      //get dest exp (always neg)
989        subl    %d1,%d0                 //subtract src from dest
990        cmpl    #0x8000,%d0
991        blt     fix_stk                 //if less, not wrap case
992        bra     sub_wrap
993sub_srcd:
994        bsrl    ckinf_nd
995        bne     fix_stk
996        bfextu  FPTEMP_EX(%a6){#1:#15},%d0      //get dest exp (always pos)
997        bfexts  ETEMP_EX(%a6){#1:#15},%d1       //get src exp (always neg)
998        subl    %d1,%d0                 //subtract dest from src
999        cmpl    #0x8000,%d0
1000        blt     fix_stk                 //if less, not wrap case
1001//
1002// Check the signs of the operands.  If they are alike, the fpu
1003// can be used to subtract from the norm 1.0 with the sign of the
1004// denorm and it will correctly generate the result in extended
1005// precision.  We can then call round with no sticky and the result
1006// will be correct for the user's rounding mode and precision.  If
1007// the signs are unlike, we call round with the sticky bit set
1008// and the result will be correct for the user's rounding mode and
1009// precision.
1010//
1011sub_wrap:
1012        movew   ETEMP_EX(%a6),%d0
1013        movew   FPTEMP_EX(%a6),%d1
1014        eorw    %d1,%d0
1015        andiw   #0x8000,%d0
1016        bne     sub_diff
1017//
1018// The signs are alike.
1019//
1020        cmpb    #0x0f,DNRM_FLG(%a6) //is dest the denorm?
1021        bnes    sub_u_srcd
1022        movew   FPTEMP_EX(%a6),%d0
1023        andiw   #0x8000,%d0
1024        orw     #0x3fff,%d0     //force the exponent to +/- 1
1025        movew   %d0,FPTEMP_EX(%a6) //in the denorm
1026        movel   USER_FPCR(%a6),%d0
1027        andil   #0x30,%d0
1028        fmovel  %d0,%fpcr               //set up users rmode and X
1029        fmovex  FPTEMP(%a6),%fp0
1030        fsubx   ETEMP(%a6),%fp0
1031        fmovel  %fpsr,%d1
1032        orl     %d1,USER_FPSR(%a6) //capture cc's and inex from fadd
1033        leal    WBTEMP(%a6),%a0 //point a0 to wbtemp in frame
1034        fmovex  %fp0,WBTEMP(%a6)        //write result to memory
1035        lsrl    #4,%d0          //put rmode in lower 2 bits
1036        movel   USER_FPCR(%a6),%d1
1037        andil   #0xc0,%d1
1038        lsrl    #6,%d1          //put precision in upper word
1039        swap    %d1
1040        orl     %d0,%d1         //set up for round call
1041        clrl    %d0             //force sticky to zero
1042        bclrb   #sign_bit,WBTEMP_EX(%a6)
1043        sne     WBTEMP_SGN(%a6)
1044        bsrl    round           //round result to users rmode & prec
1045        bfclr   WBTEMP_SGN(%a6){#0:#8}  //convert back to IEEE ext format
1046        beq     frcfpnr
1047        bsetb   #sign_bit,WBTEMP_EX(%a6)
1048        bra     frcfpnr
1049sub_u_srcd:
1050        movew   ETEMP_EX(%a6),%d0
1051        andiw   #0x8000,%d0
1052        orw     #0x3fff,%d0     //force the exponent to +/- 1
1053        movew   %d0,ETEMP_EX(%a6) //in the denorm
1054        movel   USER_FPCR(%a6),%d0
1055        andil   #0x30,%d0
1056        fmovel  %d0,%fpcr               //set up users rmode and X
1057        fmovex  FPTEMP(%a6),%fp0
1058        fsubx   ETEMP(%a6),%fp0
1059        fmovel  %fpsr,%d1
1060        orl     %d1,USER_FPSR(%a6) //capture cc's and inex from fadd
1061        leal    WBTEMP(%a6),%a0 //point a0 to wbtemp in frame
1062        fmovex  %fp0,WBTEMP(%a6)        //write result to memory
1063        lsrl    #4,%d0          //put rmode in lower 2 bits
1064        movel   USER_FPCR(%a6),%d1
1065        andil   #0xc0,%d1
1066        lsrl    #6,%d1          //put precision in upper word
1067        swap    %d1
1068        orl     %d0,%d1         //set up for round call
1069        clrl    %d0             //force sticky to zero
1070        bclrb   #sign_bit,WBTEMP_EX(%a6)
1071        sne     WBTEMP_SGN(%a6)
1072        bsrl    round           //round result to users rmode & prec
1073        bfclr   WBTEMP_SGN(%a6){#0:#8}  //convert back to IEEE ext format
1074        beq     frcfpnr
1075        bsetb   #sign_bit,WBTEMP_EX(%a6)
1076        bra     frcfpnr
1077//
1078// Signs are unlike:
1079//
1080sub_diff:
1081        cmpb    #0x0f,DNRM_FLG(%a6) //is dest the denorm?
1082        bnes    sub_s_srcd
1083sub_s_destd:
1084        leal    ETEMP(%a6),%a0
1085        movel   USER_FPCR(%a6),%d0
1086        andil   #0x30,%d0
1087        lsrl    #4,%d0          //put rmode in lower 2 bits
1088        movel   USER_FPCR(%a6),%d1
1089        andil   #0xc0,%d1
1090        lsrl    #6,%d1          //put precision in upper word
1091        swap    %d1
1092        orl     %d0,%d1         //set up for round call
1093        movel   #0x20000000,%d0 //set sticky for round
1094//
1095// Since the dest is the denorm, the sign is the opposite of the
1096// norm sign.
1097//
1098        eoriw   #0x8000,ETEMP_EX(%a6)   //flip sign on result
1099        tstw    ETEMP_EX(%a6)
1100        bgts    sub_s_dwr
1101        orl     #neg_mask,USER_FPSR(%a6)
1102sub_s_dwr:
1103        bclrb   #sign_bit,ETEMP_EX(%a6)
1104        sne     ETEMP_SGN(%a6)
1105        bsrl    round           //round result to users rmode & prec
1106        bfclr   ETEMP_SGN(%a6){#0:#8}   //convert back to IEEE ext format
1107        beqs    sub_s_dclr
1108        bsetb   #sign_bit,ETEMP_EX(%a6)
1109sub_s_dclr:
1110        leal    WBTEMP(%a6),%a0
1111        movel   ETEMP(%a6),(%a0)        //write result to wbtemp
1112        movel   ETEMP_HI(%a6),4(%a0)
1113        movel   ETEMP_LO(%a6),8(%a0)
1114        bra     sub_ckovf
1115sub_s_srcd:
1116        leal    FPTEMP(%a6),%a0
1117        movel   USER_FPCR(%a6),%d0
1118        andil   #0x30,%d0
1119        lsrl    #4,%d0          //put rmode in lower 2 bits
1120        movel   USER_FPCR(%a6),%d1
1121        andil   #0xc0,%d1
1122        lsrl    #6,%d1          //put precision in upper word
1123        swap    %d1
1124        orl     %d0,%d1         //set up for round call
1125        movel   #0x20000000,%d0 //set sticky for round
1126        bclrb   #sign_bit,FPTEMP_EX(%a6)
1127        sne     FPTEMP_SGN(%a6)
1128        bsrl    round           //round result to users rmode & prec
1129        bfclr   FPTEMP_SGN(%a6){#0:#8}  //convert back to IEEE ext format
1130        beqs    sub_s_sclr
1131        bsetb   #sign_bit,FPTEMP_EX(%a6)
1132sub_s_sclr:
1133        leal    WBTEMP(%a6),%a0
1134        movel   FPTEMP(%a6),(%a0)       //write result to wbtemp
1135        movel   FPTEMP_HI(%a6),4(%a0)
1136        movel   FPTEMP_LO(%a6),8(%a0)
1137        tstw    FPTEMP_EX(%a6)
1138        bgt     sub_ckovf
1139        orl     #neg_mask,USER_FPSR(%a6)
1140sub_ckovf:
1141        movew   WBTEMP_EX(%a6),%d0
1142        andiw   #0x7fff,%d0
1143        cmpiw   #0x7fff,%d0
1144        bne     frcfpnr
1145//
1146// The result has overflowed to $7fff exponent.  Set I, ovfl,
1147// and aovfl, and clr the mantissa (incorrectly set by the
1148// round routine.)
1149//
1150        orl     #inf_mask+ovfl_inx_mask,USER_FPSR(%a6)
1151        clrl    4(%a0)
1152        bra     frcfpnr
1153//
1154// Inst is fcmp.
1155//
1156wrap_cmp:
1157        cmpb    #0xff,DNRM_FLG(%a6) //if both ops denorm,
1158        beq     fix_stk          //restore to fpu
1159//
1160// One of the ops is denormalized.  Test for wrap condition
1161// and complete the instruction.
1162//
1163        cmpb    #0x0f,DNRM_FLG(%a6) //check for dest denorm
1164        bnes    cmp_srcd
1165cmp_destd:
1166        bsrl    ckinf_ns
1167        bne     fix_stk
1168        bfextu  ETEMP_EX(%a6){#1:#15},%d0       //get src exp (always pos)
1169        bfexts  FPTEMP_EX(%a6){#1:#15},%d1      //get dest exp (always neg)
1170        subl    %d1,%d0                 //subtract dest from src
1171        cmpl    #0x8000,%d0
1172        blt     fix_stk                 //if less, not wrap case
1173        tstw    ETEMP_EX(%a6)           //set N to ~sign_of(src)
1174        bge     cmp_setn
1175        rts
1176cmp_srcd:
1177        bsrl    ckinf_nd
1178        bne     fix_stk
1179        bfextu  FPTEMP_EX(%a6){#1:#15},%d0      //get dest exp (always pos)
1180        bfexts  ETEMP_EX(%a6){#1:#15},%d1       //get src exp (always neg)
1181        subl    %d1,%d0                 //subtract src from dest
1182        cmpl    #0x8000,%d0
1183        blt     fix_stk                 //if less, not wrap case
1184        tstw    FPTEMP_EX(%a6)          //set N to sign_of(dest)
1185        blt     cmp_setn
1186        rts
1187cmp_setn:
1188        orl     #neg_mask,USER_FPSR(%a6)
1189        rts
1190
1191//
1192// Inst is fmul.
1193//
1194wrap_mul:
1195        cmpb    #0xff,DNRM_FLG(%a6) //if both ops denorm,
1196        beq     force_unf       //force an underflow (really!)
1197//
1198// One of the ops is denormalized.  Test for wrap condition
1199// and complete the instruction.
1200//
1201        cmpb    #0x0f,DNRM_FLG(%a6) //check for dest denorm
1202        bnes    mul_srcd
1203mul_destd:
1204        bsrl    ckinf_ns
1205        bne     fix_stk
1206        bfextu  ETEMP_EX(%a6){#1:#15},%d0       //get src exp (always pos)
1207        bfexts  FPTEMP_EX(%a6){#1:#15},%d1      //get dest exp (always neg)
1208        addl    %d1,%d0                 //subtract dest from src
1209        bgt     fix_stk
1210        bra     force_unf
1211mul_srcd:
1212        bsrl    ckinf_nd
1213        bne     fix_stk
1214        bfextu  FPTEMP_EX(%a6){#1:#15},%d0      //get dest exp (always pos)
1215        bfexts  ETEMP_EX(%a6){#1:#15},%d1       //get src exp (always neg)
1216        addl    %d1,%d0                 //subtract src from dest
1217        bgt     fix_stk
1218
1219//
1220// This code handles the case of the instruction resulting in
1221// an underflow condition.
1222//
1223force_unf:
1224        bclrb   #E1,E_BYTE(%a6)
1225        orl     #unfinx_mask,USER_FPSR(%a6)
1226        clrw    NMNEXC(%a6)
1227        clrb    WBTEMP_SGN(%a6)
1228        movew   ETEMP_EX(%a6),%d0               //find the sign of the result
1229        movew   FPTEMP_EX(%a6),%d1
1230        eorw    %d1,%d0
1231        andiw   #0x8000,%d0
1232        beqs    frcunfcont
1233        st      WBTEMP_SGN(%a6)
1234frcunfcont:
1235        lea     WBTEMP(%a6),%a0         //point a0 to memory location
1236        movew   CMDREG1B(%a6),%d0
1237        btstl   #6,%d0                  //test for forced precision
1238        beqs    frcunf_fpcr
1239        btstl   #2,%d0                  //check for double
1240        bnes    frcunf_dbl
1241        movel   #0x1,%d0                        //inst is forced single
1242        bras    frcunf_rnd
1243frcunf_dbl:
1244        movel   #0x2,%d0                        //inst is forced double
1245        bras    frcunf_rnd
1246frcunf_fpcr:
1247        bfextu  FPCR_MODE(%a6){#0:#2},%d0       //inst not forced - use fpcr prec
1248frcunf_rnd:
1249        bsrl    unf_sub                 //get correct result based on
1250//                                      ;round precision/mode.  This
1251//                                      ;sets FPSR_CC correctly
1252        bfclr   WBTEMP_SGN(%a6){#0:#8}  //convert back to IEEE ext format
1253        beqs    frcfpn
1254        bsetb   #sign_bit,WBTEMP_EX(%a6)
1255        bra     frcfpn
1256
1257//
1258// Write the result to the user's fpn.  All results must be HUGE to be
1259// written; otherwise the results would have overflowed or underflowed.
1260// If the rounding precision is single or double, the ovf_res routine
1261// is needed to correctly supply the max value.
1262//
1263frcfpnr:
1264        movew   CMDREG1B(%a6),%d0
1265        btstl   #6,%d0                  //test for forced precision
1266        beqs    frcfpn_fpcr
1267        btstl   #2,%d0                  //check for double
1268        bnes    frcfpn_dbl
1269        movel   #0x1,%d0                        //inst is forced single
1270        bras    frcfpn_rnd
1271frcfpn_dbl:
1272        movel   #0x2,%d0                        //inst is forced double
1273        bras    frcfpn_rnd
1274frcfpn_fpcr:
1275        bfextu  FPCR_MODE(%a6){#0:#2},%d0       //inst not forced - use fpcr prec
1276        tstb    %d0
1277        beqs    frcfpn                  //if extended, write what you got
1278frcfpn_rnd:
1279        bclrb   #sign_bit,WBTEMP_EX(%a6)
1280        sne     WBTEMP_SGN(%a6)
1281        bsrl    ovf_res                 //get correct result based on
1282//                                      ;round precision/mode.  This
1283//                                      ;sets FPSR_CC correctly
1284        bfclr   WBTEMP_SGN(%a6){#0:#8}  //convert back to IEEE ext format
1285        beqs    frcfpn_clr
1286        bsetb   #sign_bit,WBTEMP_EX(%a6)
1287frcfpn_clr:
1288        orl     #ovfinx_mask,USER_FPSR(%a6)
1289//
1290// Perform the write.
1291//
1292frcfpn:
1293        bfextu  CMDREG1B(%a6){#6:#3},%d0        //extract fp destination register
1294        cmpib   #3,%d0
1295        bles    frc0123                 //check if dest is fp0-fp3
1296        movel   #7,%d1
1297        subl    %d0,%d1
1298        clrl    %d0
1299        bsetl   %d1,%d0
1300        fmovemx WBTEMP(%a6),%d0
1301        rts
1302frc0123:
1303        cmpib   #0,%d0
1304        beqs    frc0_dst
1305        cmpib   #1,%d0
1306        beqs    frc1_dst
1307        cmpib   #2,%d0
1308        beqs    frc2_dst
1309frc3_dst:
1310        movel   WBTEMP_EX(%a6),USER_FP3(%a6)
1311        movel   WBTEMP_HI(%a6),USER_FP3+4(%a6)
1312        movel   WBTEMP_LO(%a6),USER_FP3+8(%a6)
1313        rts
1314frc2_dst:
1315        movel   WBTEMP_EX(%a6),USER_FP2(%a6)
1316        movel   WBTEMP_HI(%a6),USER_FP2+4(%a6)
1317        movel   WBTEMP_LO(%a6),USER_FP2+8(%a6)
1318        rts
1319frc1_dst:
1320        movel   WBTEMP_EX(%a6),USER_FP1(%a6)
1321        movel   WBTEMP_HI(%a6),USER_FP1+4(%a6)
1322        movel   WBTEMP_LO(%a6),USER_FP1+8(%a6)
1323        rts
1324frc0_dst:
1325        movel   WBTEMP_EX(%a6),USER_FP0(%a6)
1326        movel   WBTEMP_HI(%a6),USER_FP0+4(%a6)
1327        movel   WBTEMP_LO(%a6),USER_FP0+8(%a6)
1328        rts
1329
1330//
1331// Write etemp to fpn.
1332// A check is made on enabled and signalled snan exceptions,
1333// and the destination is not overwritten if this condition exists.
1334// This code is designed to make fmoveins of unsupported data types
1335// faster.
1336//
1337wr_etemp:
1338        btstb   #snan_bit,FPSR_EXCEPT(%a6)      //if snan is set, and
1339        beqs    fmoveinc                //enabled, force restore
1340        btstb   #snan_bit,FPCR_ENABLE(%a6) //and don't overwrite
1341        beqs    fmoveinc                //the dest
1342        movel   ETEMP_EX(%a6),FPTEMP_EX(%a6)    //set up fptemp sign for
1343//                                              ;snan handler
1344        tstb    ETEMP(%a6)              //check for negative
1345        blts    snan_neg
1346        rts
1347snan_neg:
1348        orl     #neg_bit,USER_FPSR(%a6) //snan is negative; set N
1349        rts
1350fmoveinc:
1351        clrw    NMNEXC(%a6)
1352        bclrb   #E1,E_BYTE(%a6)
1353        moveb   STAG(%a6),%d0           //check if stag is inf
1354        andib   #0xe0,%d0
1355        cmpib   #0x40,%d0
1356        bnes    fminc_cnan
1357        orl     #inf_mask,USER_FPSR(%a6) //if inf, nothing yet has set I
1358        tstw    LOCAL_EX(%a0)           //check sign
1359        bges    fminc_con
1360        orl     #neg_mask,USER_FPSR(%a6)
1361        bra     fminc_con
1362fminc_cnan:
1363        cmpib   #0x60,%d0                       //check if stag is NaN
1364        bnes    fminc_czero
1365        orl     #nan_mask,USER_FPSR(%a6) //if nan, nothing yet has set NaN
1366        movel   ETEMP_EX(%a6),FPTEMP_EX(%a6)    //set up fptemp sign for
1367//                                              ;snan handler
1368        tstw    LOCAL_EX(%a0)           //check sign
1369        bges    fminc_con
1370        orl     #neg_mask,USER_FPSR(%a6)
1371        bra     fminc_con
1372fminc_czero:
1373        cmpib   #0x20,%d0                       //check if zero
1374        bnes    fminc_con
1375        orl     #z_mask,USER_FPSR(%a6)  //if zero, set Z
1376        tstw    LOCAL_EX(%a0)           //check sign
1377        bges    fminc_con
1378        orl     #neg_mask,USER_FPSR(%a6)
1379fminc_con:
1380        bfextu  CMDREG1B(%a6){#6:#3},%d0        //extract fp destination register
1381        cmpib   #3,%d0
1382        bles    fp0123                  //check if dest is fp0-fp3
1383        movel   #7,%d1
1384        subl    %d0,%d1
1385        clrl    %d0
1386        bsetl   %d1,%d0
1387        fmovemx ETEMP(%a6),%d0
1388        rts
1389
1390fp0123:
1391        cmpib   #0,%d0
1392        beqs    fp0_dst
1393        cmpib   #1,%d0
1394        beqs    fp1_dst
1395        cmpib   #2,%d0
1396        beqs    fp2_dst
1397fp3_dst:
1398        movel   ETEMP_EX(%a6),USER_FP3(%a6)
1399        movel   ETEMP_HI(%a6),USER_FP3+4(%a6)
1400        movel   ETEMP_LO(%a6),USER_FP3+8(%a6)
1401        rts
1402fp2_dst:
1403        movel   ETEMP_EX(%a6),USER_FP2(%a6)
1404        movel   ETEMP_HI(%a6),USER_FP2+4(%a6)
1405        movel   ETEMP_LO(%a6),USER_FP2+8(%a6)
1406        rts
1407fp1_dst:
1408        movel   ETEMP_EX(%a6),USER_FP1(%a6)
1409        movel   ETEMP_HI(%a6),USER_FP1+4(%a6)
1410        movel   ETEMP_LO(%a6),USER_FP1+8(%a6)
1411        rts
1412fp0_dst:
1413        movel   ETEMP_EX(%a6),USER_FP0(%a6)
1414        movel   ETEMP_HI(%a6),USER_FP0+4(%a6)
1415        movel   ETEMP_LO(%a6),USER_FP0+8(%a6)
1416        rts
1417
1418opclass3:
1419        st      CU_ONLY(%a6)
1420        movew   CMDREG1B(%a6),%d0       //check if packed moveout
1421        andiw   #0x0c00,%d0     //isolate last 2 bits of size field
1422        cmpiw   #0x0c00,%d0     //if size is 011 or 111, it is packed
1423        beq     pack_out        //else it is norm or denorm
1424        bra     mv_out
1425
1426
1427//
1428//      MOVE OUT
1429//
1430
1431mv_tbl:
1432        .long   li
1433        .long   sgp
1434        .long   xp
1435        .long   mvout_end       //should never be taken
1436        .long   wi
1437        .long   dp
1438        .long   bi
1439        .long   mvout_end       //should never be taken
1440mv_out:
1441        bfextu  CMDREG1B(%a6){#3:#3},%d1        //put source specifier in d1
1442        leal    mv_tbl,%a0
1443        movel   %a0@(%d1:l:4),%a0
1444        jmp     (%a0)
1445
1446//
1447// This exit is for move-out to memory.  The aunfl bit is
1448// set if the result is inex and unfl is signalled.
1449//
1450mvout_end:
1451        btstb   #inex2_bit,FPSR_EXCEPT(%a6)
1452        beqs    no_aufl
1453        btstb   #unfl_bit,FPSR_EXCEPT(%a6)
1454        beqs    no_aufl
1455        bsetb   #aunfl_bit,FPSR_AEXCEPT(%a6)
1456no_aufl:
1457        clrw    NMNEXC(%a6)
1458        bclrb   #E1,E_BYTE(%a6)
1459        fmovel  #0,%FPSR                        //clear any cc bits from res_func
1460//
1461// Return ETEMP to extended format from internal extended format so
1462// that gen_except will have a correctly signed value for ovfl/unfl
1463// handlers.
1464//
1465        bfclr   ETEMP_SGN(%a6){#0:#8}
1466        beqs    mvout_con
1467        bsetb   #sign_bit,ETEMP_EX(%a6)
1468mvout_con:
1469        rts
1470//
1471// This exit is for move-out to int register.  The aunfl bit is
1472// not set in any case for this move.
1473//
1474mvouti_end:
1475        clrw    NMNEXC(%a6)
1476        bclrb   #E1,E_BYTE(%a6)
1477        fmovel  #0,%FPSR                        //clear any cc bits from res_func
1478//
1479// Return ETEMP to extended format from internal extended format so
1480// that gen_except will have a correctly signed value for ovfl/unfl
1481// handlers.
1482//
1483        bfclr   ETEMP_SGN(%a6){#0:#8}
1484        beqs    mvouti_con
1485        bsetb   #sign_bit,ETEMP_EX(%a6)
1486mvouti_con:
1487        rts
1488//
1489// li is used to handle a long integer source specifier
1490//
1491
1492li:
1493        moveql  #4,%d0          //set byte count
1494
1495        btstb   #7,STAG(%a6)    //check for extended denorm
1496        bne     int_dnrm        //if so, branch
1497
1498        fmovemx ETEMP(%a6),%fp0-%fp0
1499        fcmpd   #0x41dfffffffc00000,%fp0
1500// 41dfffffffc00000 in dbl prec = 401d0000fffffffe00000000 in ext prec
1501        fbge    lo_plrg
1502        fcmpd   #0xc1e0000000000000,%fp0
1503// c1e0000000000000 in dbl prec = c01e00008000000000000000 in ext prec
1504        fble    lo_nlrg
1505//
1506// at this point, the answer is between the largest pos and neg values
1507//
1508        movel   USER_FPCR(%a6),%d1      //use user's rounding mode
1509        andil   #0x30,%d1
1510        fmovel  %d1,%fpcr
1511        fmovel  %fp0,L_SCR1(%a6)        //let the 040 perform conversion
1512        fmovel %fpsr,%d1
1513        orl     %d1,USER_FPSR(%a6)      //capture inex2/ainex if set
1514        bra     int_wrt
1515
1516
1517lo_plrg:
1518        movel   #0x7fffffff,L_SCR1(%a6) //answer is largest positive int
1519        fbeq    int_wrt                 //exact answer
1520        fcmpd   #0x41dfffffffe00000,%fp0
1521// 41dfffffffe00000 in dbl prec = 401d0000ffffffff00000000 in ext prec
1522        fbge    int_operr               //set operr
1523        bra     int_inx                 //set inexact
1524
1525lo_nlrg:
1526        movel   #0x80000000,L_SCR1(%a6)
1527        fbeq    int_wrt                 //exact answer
1528        fcmpd   #0xc1e0000000100000,%fp0
1529// c1e0000000100000 in dbl prec = c01e00008000000080000000 in ext prec
1530        fblt    int_operr               //set operr
1531        bra     int_inx                 //set inexact
1532
1533//
1534// wi is used to handle a word integer source specifier
1535//
1536
1537wi:
1538        moveql  #2,%d0          //set byte count
1539
1540        btstb   #7,STAG(%a6)    //check for extended denorm
1541        bne     int_dnrm        //branch if so
1542
1543        fmovemx ETEMP(%a6),%fp0-%fp0
1544        fcmps   #0x46fffe00,%fp0
1545// 46fffe00 in sgl prec = 400d0000fffe000000000000 in ext prec
1546        fbge    wo_plrg
1547        fcmps   #0xc7000000,%fp0
1548// c7000000 in sgl prec = c00e00008000000000000000 in ext prec
1549        fble    wo_nlrg
1550
1551//
1552// at this point, the answer is between the largest pos and neg values
1553//
1554        movel   USER_FPCR(%a6),%d1      //use user's rounding mode
1555        andil   #0x30,%d1
1556        fmovel  %d1,%fpcr
1557        fmovew  %fp0,L_SCR1(%a6)        //let the 040 perform conversion
1558        fmovel %fpsr,%d1
1559        orl     %d1,USER_FPSR(%a6)      //capture inex2/ainex if set
1560        bra     int_wrt
1561
1562wo_plrg:
1563        movew   #0x7fff,L_SCR1(%a6)     //answer is largest positive int
1564        fbeq    int_wrt                 //exact answer
1565        fcmps   #0x46ffff00,%fp0
1566// 46ffff00 in sgl prec = 400d0000ffff000000000000 in ext prec
1567        fbge    int_operr               //set operr
1568        bra     int_inx                 //set inexact
1569
1570wo_nlrg:
1571        movew   #0x8000,L_SCR1(%a6)
1572        fbeq    int_wrt                 //exact answer
1573        fcmps   #0xc7000080,%fp0
1574// c7000080 in sgl prec = c00e00008000800000000000 in ext prec
1575        fblt    int_operr               //set operr
1576        bra     int_inx                 //set inexact
1577
1578//
1579// bi is used to handle a byte integer source specifier
1580//
1581
1582bi:
1583        moveql  #1,%d0          //set byte count
1584
1585        btstb   #7,STAG(%a6)    //check for extended denorm
1586        bne     int_dnrm        //branch if so
1587
1588        fmovemx ETEMP(%a6),%fp0-%fp0
1589        fcmps   #0x42fe0000,%fp0
1590// 42fe0000 in sgl prec = 40050000fe00000000000000 in ext prec
1591        fbge    by_plrg
1592        fcmps   #0xc3000000,%fp0
1593// c3000000 in sgl prec = c00600008000000000000000 in ext prec
1594        fble    by_nlrg
1595
1596//
1597// at this point, the answer is between the largest pos and neg values
1598//
1599        movel   USER_FPCR(%a6),%d1      //use user's rounding mode
1600        andil   #0x30,%d1
1601        fmovel  %d1,%fpcr
1602        fmoveb  %fp0,L_SCR1(%a6)        //let the 040 perform conversion
1603        fmovel %fpsr,%d1
1604        orl     %d1,USER_FPSR(%a6)      //capture inex2/ainex if set
1605        bra     int_wrt
1606
1607by_plrg:
1608        moveb   #0x7f,L_SCR1(%a6)               //answer is largest positive int
1609        fbeq    int_wrt                 //exact answer
1610        fcmps   #0x42ff0000,%fp0
1611// 42ff0000 in sgl prec = 40050000ff00000000000000 in ext prec
1612        fbge    int_operr               //set operr
1613        bra     int_inx                 //set inexact
1614
1615by_nlrg:
1616        moveb   #0x80,L_SCR1(%a6)
1617        fbeq    int_wrt                 //exact answer
1618        fcmps   #0xc3008000,%fp0
1619// c3008000 in sgl prec = c00600008080000000000000 in ext prec
1620        fblt    int_operr               //set operr
1621        bra     int_inx                 //set inexact
1622
1623//
1624// Common integer routines
1625//
1626// int_drnrm---account for possible nonzero result for round up with positive
1627// operand and round down for negative answer.  In the first case (result = 1)
1628// byte-width (store in d0) of result must be honored.  In the second case,
1629// -1 in L_SCR1(a6) will cover all contingencies (FMOVE.B/W/L out).
1630
1631int_dnrm:
1632        movel   #0,L_SCR1(%a6)  // initialize result to 0
1633        bfextu  FPCR_MODE(%a6){#2:#2},%d1       // d1 is the rounding mode
1634        cmpb    #2,%d1
1635        bmis    int_inx         // if RN or RZ, done
1636        bnes    int_rp          // if RP, continue below
1637        tstw    ETEMP(%a6)      // RM: store -1 in L_SCR1 if src is negative
1638        bpls    int_inx         // otherwise result is 0
1639        movel   #-1,L_SCR1(%a6)
1640        bras    int_inx
1641int_rp:
1642        tstw    ETEMP(%a6)      // RP: store +1 of proper width in L_SCR1 if
1643//                              ; source is greater than 0
1644        bmis    int_inx         // otherwise, result is 0
1645        lea     L_SCR1(%a6),%a1 // a1 is address of L_SCR1
1646        addal   %d0,%a1         // offset by destination width -1
1647        subal   #1,%a1
1648        bsetb   #0,(%a1)                // set low bit at a1 address
1649int_inx:
1650        oril    #inx2a_mask,USER_FPSR(%a6)
1651        bras    int_wrt
1652int_operr:
1653        fmovemx %fp0-%fp0,FPTEMP(%a6)   //FPTEMP must contain the extended
1654//                              ;precision source that needs to be
1655//                              ;converted to integer this is required
1656//                              ;if the operr exception is enabled.
1657//                              ;set operr/aiop (no inex2 on int ovfl)
1658
1659        oril    #opaop_mask,USER_FPSR(%a6)
1660//                              ;fall through to perform int_wrt
1661int_wrt:
1662        movel   EXC_EA(%a6),%a1 //load destination address
1663        tstl    %a1             //check to see if it is a dest register
1664        beqs    wrt_dn          //write data register
1665        lea     L_SCR1(%a6),%a0 //point to supervisor source address
1666        bsrl    mem_write
1667        bra     mvouti_end
1668
1669wrt_dn:
1670        movel   %d0,-(%sp)      //d0 currently contains the size to write
1671        bsrl    get_fline       //get_fline returns Dn in d0
1672        andiw   #0x7,%d0                //isolate register
1673        movel   (%sp)+,%d1      //get size
1674        cmpil   #4,%d1          //most frequent case
1675        beqs    sz_long
1676        cmpil   #2,%d1
1677        bnes    sz_con
1678        orl     #8,%d0          //add 'word' size to register#
1679        bras    sz_con
1680sz_long:
1681        orl     #0x10,%d0               //add 'long' size to register#
1682sz_con:
1683        movel   %d0,%d1         //reg_dest expects size:reg in d1
1684        bsrl    reg_dest        //load proper data register
1685        bra     mvouti_end
1686xp:
1687        lea     ETEMP(%a6),%a0
1688        bclrb   #sign_bit,LOCAL_EX(%a0)
1689        sne     LOCAL_SGN(%a0)
1690        btstb   #7,STAG(%a6)    //check for extended denorm
1691        bne     xdnrm
1692        clrl    %d0
1693        bras    do_fp           //do normal case
1694sgp:
1695        lea     ETEMP(%a6),%a0
1696        bclrb   #sign_bit,LOCAL_EX(%a0)
1697        sne     LOCAL_SGN(%a0)
1698        btstb   #7,STAG(%a6)    //check for extended denorm
1699        bne     sp_catas        //branch if so
1700        movew   LOCAL_EX(%a0),%d0
1701        lea     sp_bnds,%a1
1702        cmpw    (%a1),%d0
1703        blt     sp_under
1704        cmpw    2(%a1),%d0
1705        bgt     sp_over
1706        movel   #1,%d0          //set destination format to single
1707        bras    do_fp           //do normal case
1708dp:
1709        lea     ETEMP(%a6),%a0
1710        bclrb   #sign_bit,LOCAL_EX(%a0)
1711        sne     LOCAL_SGN(%a0)
1712
1713        btstb   #7,STAG(%a6)    //check for extended denorm
1714        bne     dp_catas        //branch if so
1715
1716        movew   LOCAL_EX(%a0),%d0
1717        lea     dp_bnds,%a1
1718
1719        cmpw    (%a1),%d0
1720        blt     dp_under
1721        cmpw    2(%a1),%d0
1722        bgt     dp_over
1723
1724        movel   #2,%d0          //set destination format to double
1725//                              ;fall through to do_fp
1726//
1727do_fp:
1728        bfextu  FPCR_MODE(%a6){#2:#2},%d1       //rnd mode in d1
1729        swap    %d0                     //rnd prec in upper word
1730        addl    %d0,%d1                 //d1 has PREC/MODE info
1731
1732        clrl    %d0                     //clear g,r,s
1733
1734        bsrl    round                   //round
1735
1736        movel   %a0,%a1
1737        movel   EXC_EA(%a6),%a0
1738
1739        bfextu  CMDREG1B(%a6){#3:#3},%d1        //extract destination format
1740//                                      ;at this point only the dest
1741//                                      ;formats sgl, dbl, ext are
1742//                                      ;possible
1743        cmpb    #2,%d1
1744        bgts    ddbl                    //double=5, extended=2, single=1
1745        bnes    dsgl
1746//                                      ;fall through to dext
1747dext:
1748        bsrl    dest_ext
1749        bra     mvout_end
1750dsgl:
1751        bsrl    dest_sgl
1752        bra     mvout_end
1753ddbl:
1754        bsrl    dest_dbl
1755        bra     mvout_end
1756
1757//
1758// Handle possible denorm or catastrophic underflow cases here
1759//
1760xdnrm:
1761        bsr     set_xop         //initialize WBTEMP
1762        bsetb   #wbtemp15_bit,WB_BYTE(%a6) //set wbtemp15
1763
1764        movel   %a0,%a1
1765        movel   EXC_EA(%a6),%a0 //a0 has the destination pointer
1766        bsrl    dest_ext        //store to memory
1767        bsetb   #unfl_bit,FPSR_EXCEPT(%a6)
1768        bra     mvout_end
1769
1770sp_under:
1771        bsetb   #etemp15_bit,STAG(%a6)
1772
1773        cmpw    4(%a1),%d0
1774        blts    sp_catas        //catastrophic underflow case
1775
1776        movel   #1,%d0          //load in round precision
1777        movel   #sgl_thresh,%d1 //load in single denorm threshold
1778        bsrl    dpspdnrm        //expects d1 to have the proper
1779//                              ;denorm threshold
1780        bsrl    dest_sgl        //stores value to destination
1781        bsetb   #unfl_bit,FPSR_EXCEPT(%a6)
1782        bra     mvout_end       //exit
1783
1784dp_under:
1785        bsetb   #etemp15_bit,STAG(%a6)
1786
1787        cmpw    4(%a1),%d0
1788        blts    dp_catas        //catastrophic underflow case
1789
1790        movel   #dbl_thresh,%d1 //load in double precision threshold
1791        movel   #2,%d0
1792        bsrl    dpspdnrm        //expects d1 to have proper
1793//                              ;denorm threshold
1794//                              ;expects d0 to have round precision
1795        bsrl    dest_dbl        //store value to destination
1796        bsetb   #unfl_bit,FPSR_EXCEPT(%a6)
1797        bra     mvout_end       //exit
1798
1799//
1800// Handle catastrophic underflow cases here
1801//
1802sp_catas:
1803// Temp fix for z bit set in unf_sub
1804        movel   USER_FPSR(%a6),-(%a7)
1805
1806        movel   #1,%d0          //set round precision to sgl
1807
1808        bsrl    unf_sub         //a0 points to result
1809
1810        movel   (%a7)+,USER_FPSR(%a6)
1811
1812        movel   #1,%d0
1813        subw    %d0,LOCAL_EX(%a0) //account for difference between
1814//                              ;denorm/norm bias
1815
1816        movel   %a0,%a1         //a1 has the operand input
1817        movel   EXC_EA(%a6),%a0 //a0 has the destination pointer
1818
1819        bsrl    dest_sgl        //store the result
1820        oril    #unfinx_mask,USER_FPSR(%a6)
1821        bra     mvout_end
1822
1823dp_catas:
1824// Temp fix for z bit set in unf_sub
1825        movel   USER_FPSR(%a6),-(%a7)
1826
1827        movel   #2,%d0          //set round precision to dbl
1828        bsrl    unf_sub         //a0 points to result
1829
1830        movel   (%a7)+,USER_FPSR(%a6)
1831
1832        movel   #1,%d0
1833        subw    %d0,LOCAL_EX(%a0) //account for difference between
1834//                              ;denorm/norm bias
1835
1836        movel   %a0,%a1         //a1 has the operand input
1837        movel   EXC_EA(%a6),%a0 //a0 has the destination pointer
1838
1839        bsrl    dest_dbl        //store the result
1840        oril    #unfinx_mask,USER_FPSR(%a6)
1841        bra     mvout_end
1842
1843//
1844// Handle catastrophic overflow cases here
1845//
1846sp_over:
1847// Temp fix for z bit set in unf_sub
1848        movel   USER_FPSR(%a6),-(%a7)
1849
1850        movel   #1,%d0
1851        leal    FP_SCR1(%a6),%a0        //use FP_SCR1 for creating result
1852        movel   ETEMP_EX(%a6),(%a0)
1853        movel   ETEMP_HI(%a6),4(%a0)
1854        movel   ETEMP_LO(%a6),8(%a0)
1855        bsrl    ovf_res
1856
1857        movel   (%a7)+,USER_FPSR(%a6)
1858
1859        movel   %a0,%a1
1860        movel   EXC_EA(%a6),%a0
1861        bsrl    dest_sgl
1862        orl     #ovfinx_mask,USER_FPSR(%a6)
1863        bra     mvout_end
1864
1865dp_over:
1866// Temp fix for z bit set in ovf_res
1867        movel   USER_FPSR(%a6),-(%a7)
1868
1869        movel   #2,%d0
1870        leal    FP_SCR1(%a6),%a0        //use FP_SCR1 for creating result
1871        movel   ETEMP_EX(%a6),(%a0)
1872        movel   ETEMP_HI(%a6),4(%a0)
1873        movel   ETEMP_LO(%a6),8(%a0)
1874        bsrl    ovf_res
1875
1876        movel   (%a7)+,USER_FPSR(%a6)
1877
1878        movel   %a0,%a1
1879        movel   EXC_EA(%a6),%a0
1880        bsrl    dest_dbl
1881        orl     #ovfinx_mask,USER_FPSR(%a6)
1882        bra     mvout_end
1883
1884//
1885//      DPSPDNRM
1886//
1887// This subroutine takes an extended normalized number and denormalizes
1888// it to the given round precision. This subroutine also decrements
1889// the input operand's exponent by 1 to account for the fact that
1890// dest_sgl or dest_dbl expects a normalized number's bias.
1891//
1892// Input: a0  points to a normalized number in internal extended format
1893//       d0  is the round precision (=1 for sgl; =2 for dbl)
1894//       d1  is the the single precision or double precision
1895//           denorm threshold
1896//
1897// Output: (In the format for dest_sgl or dest_dbl)
1898//       a0   points to the destination
1899//       a1   points to the operand
1900//
1901// Exceptions: Reports inexact 2 exception by setting USER_FPSR bits
1902//
1903dpspdnrm:
1904        movel   %d0,-(%a7)      //save round precision
1905        clrl    %d0             //clear initial g,r,s
1906        bsrl    dnrm_lp         //careful with d0, it's needed by round
1907
1908        bfextu  FPCR_MODE(%a6){#2:#2},%d1 //get rounding mode
1909        swap    %d1
1910        movew   2(%a7),%d1      //set rounding precision
1911        swap    %d1             //at this point d1 has PREC/MODE info
1912        bsrl    round           //round result, sets the inex bit in
1913//                              ;USER_FPSR if needed
1914
1915        movew   #1,%d0
1916        subw    %d0,LOCAL_EX(%a0) //account for difference in denorm
1917//                              ;vs norm bias
1918
1919        movel   %a0,%a1         //a1 has the operand input
1920        movel   EXC_EA(%a6),%a0 //a0 has the destination pointer
1921        addw    #4,%a7          //pop stack
1922        rts
1923//
1924// SET_XOP initialized WBTEMP with the value pointed to by a0
1925// input: a0 points to input operand in the internal extended format
1926//
1927set_xop:
1928        movel   LOCAL_EX(%a0),WBTEMP_EX(%a6)
1929        movel   LOCAL_HI(%a0),WBTEMP_HI(%a6)
1930        movel   LOCAL_LO(%a0),WBTEMP_LO(%a6)
1931        bfclr   WBTEMP_SGN(%a6){#0:#8}
1932        beqs    sxop
1933        bsetb   #sign_bit,WBTEMP_EX(%a6)
1934sxop:
1935        bfclr   STAG(%a6){#5:#4}        //clear wbtm66,wbtm1,wbtm0,sbit
1936        rts
1937//
1938//      P_MOVE
1939//
1940p_movet:
1941        .long   p_move
1942        .long   p_movez
1943        .long   p_movei
1944        .long   p_moven
1945        .long   p_move
1946p_regd:
1947        .long   p_dyd0
1948        .long   p_dyd1
1949        .long   p_dyd2
1950        .long   p_dyd3
1951        .long   p_dyd4
1952        .long   p_dyd5
1953        .long   p_dyd6
1954        .long   p_dyd7
1955
1956pack_out:
1957        leal    p_movet,%a0     //load jmp table address
1958        movew   STAG(%a6),%d0   //get source tag
1959        bfextu  %d0{#16:#3},%d0 //isolate source bits
1960        movel   (%a0,%d0.w*4),%a0       //load a0 with routine label for tag
1961        jmp     (%a0)           //go to the routine
1962
1963p_write:
1964        movel   #0x0c,%d0       //get byte count
1965        movel   EXC_EA(%a6),%a1 //get the destination address
1966        bsr     mem_write       //write the user's destination
1967        moveb   #0,CU_SAVEPC(%a6) //set the cu save pc to all 0's
1968
1969//
1970// Also note that the dtag must be set to norm here - this is because
1971// the 040 uses the dtag to execute the correct microcode.
1972//
1973        bfclr    DTAG(%a6){#0:#3}  //set dtag to norm
1974
1975        rts
1976
1977// Notes on handling of special case (zero, inf, and nan) inputs:
1978//      1. Operr is not signalled if the k-factor is greater than 18.
1979//      2. Per the manual, status bits are not set.
1980//
1981
1982p_move:
1983        movew   CMDREG1B(%a6),%d0
1984        btstl   #kfact_bit,%d0  //test for dynamic k-factor
1985        beqs    statick         //if clear, k-factor is static
1986dynamick:
1987        bfextu  %d0{#25:#3},%d0 //isolate register for dynamic k-factor
1988        lea     p_regd,%a0
1989        movel   %a0@(%d0:l:4),%a0
1990        jmp     (%a0)
1991statick:
1992        andiw   #0x007f,%d0     //get k-factor
1993        bfexts  %d0{#25:#7},%d0 //sign extend d0 for bindec
1994        leal    ETEMP(%a6),%a0  //a0 will point to the packed decimal
1995        bsrl    bindec          //perform the convert; data at a6
1996        leal    FP_SCR1(%a6),%a0        //load a0 with result address
1997        bral    p_write
1998p_movez:
1999        leal    ETEMP(%a6),%a0  //a0 will point to the packed decimal
2000        clrw    2(%a0)          //clear lower word of exp
2001        clrl    4(%a0)          //load second lword of ZERO
2002        clrl    8(%a0)          //load third lword of ZERO
2003        bra     p_write         //go write results
2004p_movei:
2005        fmovel  #0,%FPSR                //clear aiop
2006        leal    ETEMP(%a6),%a0  //a0 will point to the packed decimal
2007        clrw    2(%a0)          //clear lower word of exp
2008        bra     p_write         //go write the result
2009p_moven:
2010        leal    ETEMP(%a6),%a0  //a0 will point to the packed decimal
2011        clrw    2(%a0)          //clear lower word of exp
2012        bra     p_write         //go write the result
2013
2014//
2015// Routines to read the dynamic k-factor from Dn.
2016//
2017p_dyd0:
2018        movel   USER_D0(%a6),%d0
2019        bras    statick
2020p_dyd1:
2021        movel   USER_D1(%a6),%d0
2022        bras    statick
2023p_dyd2:
2024        movel   %d2,%d0
2025        bras    statick
2026p_dyd3:
2027        movel   %d3,%d0
2028        bras    statick
2029p_dyd4:
2030        movel   %d4,%d0
2031        bras    statick
2032p_dyd5:
2033        movel   %d5,%d0
2034        bras    statick
2035p_dyd6:
2036        movel   %d6,%d0
2037        bra     statick
2038p_dyd7:
2039        movel   %d7,%d0
2040        bra     statick
2041
2042        |end
Note: See TracBrowser for help on using the repository browser.