X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fsparc%2Finsts.lisp;h=2d508518d9c765a4a4f338f854bfc693bb82d920;hb=3a2c2a2217f77e0d1a44a581c83e0311ebc2594a;hp=174a2fb33720842957a450c13887783e1698cfe7;hpb=178128629005f3b6b8c40bbb510b498d7552f13c;p=sbcl.git diff --git a/src/compiler/sparc/insts.lisp b/src/compiler/sparc/insts.lisp index 174a2fb..2d50851 100644 --- a/src/compiler/sparc/insts.lisp +++ b/src/compiler/sparc/insts.lisp @@ -11,10 +11,6 @@ (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)) @@ -36,9 +32,9 @@ (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 @@ -68,12 +64,12 @@ Otherwise, use the Sparc register names") (+ (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) @@ -120,74 +116,6 @@ about function addresses and register values.") (- 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. @@ -202,6 +130,7 @@ about function addresses and register values.") (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. @@ -279,6 +208,7 @@ about function addresses and register values.") 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 @@ -328,9 +258,9 @@ about function addresses and register values.") (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) @@ -702,7 +632,8 @@ about function addresses and register values.") (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 @@ -765,7 +696,7 @@ about function addresses and register values.") (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) @@ -1252,10 +1183,8 @@ about function addresses and register values.") (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 @@ -1329,7 +1258,7 @@ about function addresses and register values.") (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 @@ -1347,7 +1276,7 @@ about function addresses and register values.") 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 @@ -1462,7 +1391,7 @@ about function addresses and register values.") (integer-condition cc) target)) (t - (assert (null cc)) + (aver (null cc)) (emit-format-3-immed segment #b10 (branch-condition condition) #b111010 0 1 target))))) @@ -1509,7 +1438,7 @@ about function addresses and register values.") (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)