-#+nil ;; will we need this?
-(macrolet ((frob (trans from-sc from-type round-p)
- `(define-vop (,(symbolicate trans "/" from-type "=>UNSIGNED"))
- (:args (x :scs (,from-sc) :target fr0))
- (:temporary (:sc double-reg :offset fr0-offset
- :from :argument :to :result) fr0)
- ,@(unless round-p
- '((:temporary (:sc unsigned-stack) stack-temp)
- (:temporary (:sc unsigned-stack) scw)
- (:temporary (:sc any-reg) rcw)))
- (:results (y :scs (unsigned-reg)))
- (:arg-types ,from-type)
- (:result-types unsigned-num)
- (:translate ,trans)
- (:policy :fast-safe)
- (:note "inline float truncate")
- (:vop-var vop)
- (:save-p :compute-only)
- (:generator 5
- ,@(unless round-p
- '((note-this-location vop :internal-error)
- ;; Catch any pending FPE exceptions.
- (inst wait)))
- ;; Normal mode (for now) is "round to best".
- (unless (zerop (tn-offset x))
- (copy-fp-reg-to-fr0 x))
- ,@(unless round-p
- '((inst fnstcw scw) ; save current control word
- (move rcw scw) ; into 16-bit register
- (inst or rcw (ash #b11 10)) ; CHOP
- (move stack-temp rcw)
- (inst fldcw stack-temp)))
- (inst sub rsp-tn 8)
- (inst fistpl (make-ea :dword :base rsp-tn))
- (inst pop y)
- (inst fld fr0) ; copy fr0 to at least restore stack.
- (inst add rsp-tn 8)
- ,@(unless round-p
- '((inst fldcw scw)))))))
- (frob %unary-truncate single-reg single-float nil)
- (frob %unary-truncate double-reg double-float nil)
- (frob %unary-round single-reg single-float t)
- (frob %unary-round double-reg double-float t))
-