-;;;; float mode hackery
-
-(sb!xc:deftype float-modes () '(unsigned-byte 32)) ;actually 24 -dan
-(defknown floating-point-modes () float-modes (flushable))
-(defknown ((setf floating-point-modes)) (float-modes)
- float-modes)
-
-;;; Modes bits are (byte 12 52) of fpcr. Grab and return in low bits.
-(define-vop (floating-point-modes)
- (:results (res :scs (unsigned-reg)))
- (:result-types unsigned-num)
- (:translate floating-point-modes)
- (:policy :fast-safe)
- (:vop-var vop)
- (:temporary (:sc double-stack) temp)
- (:temporary (:sc double-reg) temp1)
- (:generator 5
- (let ((nfp (current-nfp-tn vop)))
- (inst excb)
- (inst mf_fpcr temp1 temp1 temp1)
- (inst excb)
- (inst stt temp1 (* n-word-bytes (tn-offset temp)) nfp)
- (inst ldl res (* (1+ (tn-offset temp)) n-word-bytes) nfp)
- (inst srl res 49 res))))
-
-(define-vop (set-floating-point-modes)
- (:args (new :scs (unsigned-reg) :target res))
- (:results (res :scs (unsigned-reg)))
- (:arg-types unsigned-num)
- (:result-types unsigned-num)
- (:translate (setf floating-point-modes))
- (:policy :fast-safe)
- (:temporary (:sc double-stack) temp)
- (:temporary (:sc double-reg) temp1)
- (:vop-var vop)
- (:generator 8
- (let ((nfp (current-nfp-tn vop)))
- (inst sll new 49 res)
- (inst stl zero-tn (* (tn-offset temp) n-word-bytes) nfp)
- (inst stl res (* (1+ (tn-offset temp)) n-word-bytes) nfp)
- (inst ldt temp1 (* (tn-offset temp) n-word-bytes) nfp)
- (inst excb)
- (inst mt_fpcr temp1 temp1 temp1)
- (inst excb)
- (move res new))))