dstate))))
(defparameter float-reg-symbols
- (coerce
- (loop for n from 0 to 31 collect (make-symbol (format nil "~D" n)))
- 'vector))
+ #.(coerce
+ (loop for n from 0 to 31 collect (make-symbol (format nil "~D" n)))
+ 'vector))
(sb!disassem:define-arg-type fp-reg
:printer (lambda (value stream dstate)
disp)))))
(define-memory lda #x08 :lda)
(define-memory ldah #x09 :ldah)
+ (define-memory ldbu #x0a) ; BWX extension
+ (define-memory ldwu #x0c) ; BWX extension
(define-memory ldl #x28)
(define-memory ldq #x29)
(define-memory ldl_l #x2a)
(define-memory ldq_q #x2b)
(define-memory ldq_u #x0b)
+ (define-memory stw #x0d) ; BWX extension
+ (define-memory stb #x0e) ; BWX extension
(define-memory stl #x2c)
(define-memory stq #x2d)
(define-memory stl_c #x2e)
(define-operate mulq/v #x13 #x60)
(define-operate mull/v #x13 #x40)
(define-operate umulh #x13 #x30)
- (define-operate mulq #x13 #x20))
+ (define-operate mulq #x13 #x20)
+
+ (define-operate ctpop #x1c #x30) ; CIX extension
+ (define-operate ctlz #x1c #x32) ; CIX extension
+ (define-operate cttz #x1c #x33)) ; CIX extension
(macrolet ((define-fp-operate (name op fn &optional (args 3))
(define-fp-operate subt #x16 #x0a1)
;;; IEEE support
- (defconstant +su+ #x500) ; software, underflow enabled
- (defconstant +sui+ #x700) ; software, inexact & underflow enabled
- (defconstant +sv+ #x500) ; software, interger overflow enabled
- (defconstant +svi+ #x700)
- (defconstant +rnd+ #x0c0) ; dynamic rounding mode
- (defconstant +sud+ #x5c0)
- (defconstant +svid+ #x7c0)
- (defconstant +suid+ #x7c0)
+ (def!constant +su+ #x500) ; software, underflow enabled
+ (def!constant +sui+ #x700) ; software, inexact & underflow enabled
+ (def!constant +sv+ #x500) ; software, interger overflow enabled
+ (def!constant +svi+ #x700)
+ (def!constant +rnd+ #x0c0) ; dynamic rounding mode
+ (def!constant +sud+ #x5c0)
+ (def!constant +svid+ #x7c0)
+ (def!constant +suid+ #x7c0)
(define-fp-operate cvtqs_su #x16 (logior +su+ #x0bc) 2)
+ (define-fp-operate cvtqs_sui #x16 (logior +sui+ #x0bc) 2)
(define-fp-operate cvtqt_su #x16 (logior +su+ #x0be) 2)
+ (define-fp-operate cvtqt_sui #x16 (logior +sui+ #x0be) 2)
(define-fp-operate cvtts_su #x16 (logior +su+ #x0ac) 2)
+ (define-fp-operate cvttq_sv #x16 (logior +su+ #x0af) 2)
+ (define-fp-operate cvttq/c_sv #x16 (logior +su+ #x02f) 2)
+
(define-fp-operate adds_su #x16 (logior +su+ #x080))
(define-fp-operate addt_su #x16 (logior +su+ #x0a0))
(define-fp-operate divs_su #x16 (logior +su+ #x083))
(define-instruction trapb (segment)
(:emitter (emit-lword segment #x63ff0000)))
+(define-instruction imb (segment)
+ (:emitter (emit-lword segment #x00000086)))
+
(define-instruction gentrap (segment code)
(:printer call-pal ((palcode #xaa0000)))
(:emitter
(unless (= high 0)
(inst ldah reg high reg)))))
((or (unsigned-byte 32) (signed-byte 64) (unsigned-byte 64))
+ ;; Since it took NJF and CSR a good deal of puzzling to work out
+ ;; (a) what a previous version of this was doing and (b) why it
+ ;; was wrong:
+ ;;
+ ;; write VALUE = a_63 * 2^63 + a_48-62 * 2^48
+ ;; + a_47 * 2^47 + a_32-46 * 2^32
+ ;; + a_31 * 2^31 + a_16-30 * 2^16
+ ;; + a_15 * 2^15 + a_0-14
+ ;;
+ ;; then, because of the wonders of sign-extension and
+ ;; twos-complement arithmetic modulo 2^64, if a_15 is set, LDA
+ ;; (which sign-extends its argument) will add
+ ;;
+ ;; (a_15 * 2^15 + a_0-14 - 65536).
+ ;;
+ ;; So we need to add that 65536 back on, which is what this
+ ;; LOGBITP business is doing. The same applies for bits 31 and
+ ;; 47 (bit 63 is taken care of by the fact that all of this
+ ;; arithmetic is mod 2^64 anyway), but we have to be careful that
+ ;; we consider the altered value, not the original value.
+ ;;
+ ;; I think, anyway. -- CSR, 2003-09-26
(let* ((value1 (if (logbitp 15 value) (+ value (ash 1 16)) value))
- (value2 (if (logbitp 31 value) (+ value (ash 1 32)) value1))
- (value3 (if (logbitp 47 value) (+ value (ash 1 48)) value2)))
+ (value2 (if (logbitp 31 value1) (+ value1 (ash 1 32)) value1))
+ (value3 (if (logbitp 47 value2) (+ value2 (ash 1 48)) value2)))
(inst lda reg (ldb (byte 16 32) value2) zero-tn)
+ ;; FIXME: Don't yet understand these conditionals. If I'm
+ ;; right, surely we can just consider the zeroness of the
+ ;; particular bitfield, not the zeroness of the whole thing?
+ ;; -- CSR, 2003-09-26
(unless (= value3 0)
(inst ldah reg (ldb (byte 16 48) value3) reg))
(unless (and (= value2 0) (= value3 0))