(in-package "SB!VM")
-;;;FIXME: the analogue is commented out in alpha/insts.lisp
-;;;(def-assembler-params
-;;; :scheduler-p t
-;;; :max-locations 100)
(eval-when (:compile-toplevel :load-toplevel :execute)
(setf sb!assem:*assem-scheduler-p* t)
(setf sb!assem:*assem-max-locations* 100))
(error "~S isn't a floating-point register." tn))
(let ((offset (tn-offset tn)))
(cond ((> offset 31)
- (assert (member :sparc-v9 *backend-subfeatures*))
+ (aver (member :sparc-v9 *backend-subfeatures*))
;; No single register encoding greater than reg 31.
- (assert (zerop (mod offset 2)))
+ (aver (zerop (mod offset 2)))
;; Upper bit of the register number is encoded in the low bit.
(1+ (- offset 32)))
(t
(+ (tn-offset loc) 32))
(double-reg
(let ((offset (tn-offset loc)))
- (assert (zerop (mod offset 2)))
+ (aver (zerop (mod offset 2)))
(values (+ offset 32) 2)))
#!+long-float
(long-reg
(let ((offset (tn-offset loc)))
- (assert (zerop (mod offset 4)))
+ (aver (zerop (mod offset 4)))
(values (+ offset 32) 4)))))
(control-registers
96)
(- val (ash 1 13))
val))
-;;; Oh, come on, this is ridiculous. I'm not going to solve
-;;; bootstrapping issues for a disassembly note. Does this make me
-;;; lazy? Christophe, 2001-09-02. FIXME
-#+nil
-(macrolet
- ((frob (&rest names)
- (let ((results (mapcar (lambda (n)
- (let ((nn (intern (concatenate 'string (string n)
- "-TYPE"))))
- `(,(eval nn) ,nn)))
- names)))
- `(eval-when (:compile-toplevel :load-toplevel :execute)
- (def!constant header-word-type-alist
- ',results)))))
- ;; This is the same list as in objdefs.
- (frob bignum
- ratio
- single-float
- double-float
- #!+long-float long-float
- complex
- complex-single-float
- complex-double-float
- #!+long-float complex-long-float
-
- simple-array
- simple-string
- simple-bit-vector
- simple-vector
- simple-array-unsigned-byte-2
- simple-array-unsigned-byte-4
- simple-array-unsigned-byte-8
- simple-array-unsigned-byte-16
- simple-array-unsigned-byte-32
- simple-array-signed-byte-8
- simple-array-signed-byte-16
- simple-array-signed-byte-30
- simple-array-signed-byte-32
- simple-array-single-float
- simple-array-double-float
- #!+long-float simple-array-long-float
- simple-array-complex-single-float
- simple-array-complex-double-float
- #!+long-float simple-array-complex-long-float
- complex-string
- complex-bit-vector
- complex-vector
- complex-array
-
- code-header
- function-header
- closure-header
- funcallable-instance-header
- byte-code-function
- byte-code-closure
- closure-function-header
- #!-gengc return-pc-header
- #!+gengc forwarding-pointer
- value-cell-header
- symbol-header
- base-char
- sap
- unbound-marker
- weak-pointer
- instance-header
- fdefn
- #!+(or gengc gencgc) scavenger-hook))
-
;; Look at the current instruction and see if we can't add some notes
;; about what's happening.
(rd (ldb (byte 5 25) word))
(immed-p (not (zerop (ldb (byte 1 13) word))))
(immed-val (sign-extend-immed-value (ldb (byte 13 0) word))))
+ (declare (ignore immed-p))
;; Only the value of format and rd are guaranteed to be correct
;; because the disassembler is trying to print out the value of a
;; register. The other values may not be right.
dstate)))))))
(defun handle-jmpl-inst (rs1 immed-val rd dstate)
+ (declare (ignore rd))
(let* ((sethi (assoc rs1 *note-sethi-inst*)))
(when sethi
;; RS1 was used in a SETHI instruction. Assume that
(maybe-add-notes value dstate))))
(defparameter float-reg-symbols
- (coerce
- (loop for n from 0 to 63 collect (make-symbol (format nil "%F~d" n)))
- 'vector))
+ #.(coerce
+ (loop for n from 0 to 63 collect (make-symbol (format nil "%F~d" n)))
+ 'vector))
(sb!disassem:define-arg-type fp-reg
:printer (lambda (value stream dstate)
(defun cond-move-condition (condition-reg)
(or (position condition-reg cond-move-condition-registers)
- (error "Unknown conditional move condition register: ~S~%")))
+ (error "Unknown conditional move condition register: ~S~%"
+ condition-reg)))
(defconstant-eqx cond-move-printer
`(:name cond :tab
(defun register-condition (rcond)
(or (position rcond cond-move-integer-conditions)
- (error "Unknown register condition: ~S~%")))
+ (error "Unknown register condition: ~S~%" rcond)))
(sb!disassem:define-instruction-format
(format-4-cond-move-integer 32 :default-printer cond-move-integer-printer)
(cond (length-only
(values 0 (1+ length) nil nil))
(t
- (sb!kernel:copy-from-system-area sap (* n-byte-bits (1+ offset))
- vector (* n-word-bits
- vector-data-offset)
- (* length n-byte-bits))
+ (sb!kernel:copy-ub8-from-system-area sap (1+ offset)
+ vector 0 length)
(collect ((sc-offsets)
(lengths))
(lengths 1) ; the length byte
(defun emit-relative-branch-integer (segment a op2 cond-or-target target &optional (cc :icc) (pred :pt))
(declare (type integer-condition-register cc))
- (assert (member :sparc-v9 *backend-subfeatures*))
+ (aver (member :sparc-v9 *backend-subfeatures*))
(emit-back-patch segment 4
(lambda (segment posn)
(unless target
offset)))))
(defun emit-relative-branch-fp (segment a op2 cond-or-target target &optional (cc :fcc0) (pred :pt))
- (assert (member :sparc-v9 *backend-subfeatures*))
+ (aver (member :sparc-v9 *backend-subfeatures*))
(emit-back-patch segment 4
(lambda (segment posn)
(unless target
(integer-condition cc)
target))
(t
- (assert (null cc))
+ (aver (null cc))
(emit-format-3-immed segment #b10 (branch-condition condition)
#b111010 0 1 target)))))
(destructuring-bind (&optional fcc pred) args
(emit-relative-branch-fp segment 0 #b101 condition target (or fcc :fcc0) (or pred :pt))))
(t
- (assert (null args))
+ (aver (null args))
(emit-relative-branch segment 0 #b110 condition target t)))))
(define-instruction fbp (segment condition target &optional fcc pred)
projects / sbcl.git / blobdiff