X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fsparc%2Finsts.lisp;h=801be79e9cdb31c8ae4dcef9f00063b4af49b3f2;hb=6a9bbe6f36179cee92001a1f9ed5ff38be512644;hp=c378b73b60f32b6d741bae1cd3c70c99f8d082d5;hpb=ea775867d48327bf1179eb570263427f28083880;p=sbcl.git diff --git a/src/compiler/sparc/insts.lisp b/src/compiler/sparc/insts.lisp index c378b73..801be79 100644 --- a/src/compiler/sparc/insts.lisp +++ b/src/compiler/sparc/insts.lisp @@ -11,10 +11,9 @@ (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)) ;;; Constants, types, conversion functions, some disassembler stuff. (defun reg-tn-encoding (tn) @@ -117,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) - (defconstant 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. @@ -199,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. @@ -276,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 @@ -325,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) @@ -381,7 +314,7 @@ about function addresses and register values.") (error "Unknown branch condition: ~S~%Must be one of: ~S" condition branch-conditions))) -(defconstant branch-cond-true +(def!constant branch-cond-true #b1000) (defconstant-eqx branch-fp-conditions @@ -699,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 @@ -762,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) @@ -929,7 +863,7 @@ about function addresses and register values.") (eval-when (:compile-toplevel :execute) -;;; have to do this because defconstant is evalutated in the null lex env. +;;; have to do this because def!constant is evalutated in the null lex env. (defmacro with-ref-format (printer) `(let* ((addend '(:choose (:plus-integer immed) ("+" rs2))) @@ -946,7 +880,7 @@ about function addresses and register values.") (with-ref-format `(:NAME :TAB rd ", " ,ref-format)) #'equalp) -) ; eval-when (compile eval) +) ; EVAL-WHEN (macrolet ((define-f3-inst (name op op3 &key fixup load-store (dest-kind 'reg) (printer :default) reads writes flushable print-name) @@ -1210,12 +1144,12 @@ about function addresses and register values.") ;; registers. (define-instruction rdy (segment dst) (:declare (type tn dst)) - (:printer format-3-immed ((op #b10) (op3 #b101000) (rs1 0) (immed 0)) + (:printer format-3-reg ((op #b10) (op3 #b101000) (rs1 0) (immed 0)) '('RD :tab '%Y ", " rd)) (:dependencies (reads :y) (writes dst)) (:delay 0) - (:emitter (emit-format-3-immed segment #b10 (reg-tn-encoding dst) #b101000 - 0 0 0))) + (:emitter (emit-format-3-reg segment #b10 (reg-tn-encoding dst) #b101000 + 0 0 0 0))) (defconstant-eqx wry-printer '('WR :tab rs1 (:unless (:constant 0) ", " (:choose immed rs2)) ", " '%Y) @@ -1675,8 +1609,8 @@ about function addresses and register values.") (define-unary-fp-inst fxtoq #b010001100 :reads :fsr :extended t) ; v9 - ;; I (toy@rtp.ericsson.se) don't think these f{sd}toir instructions - ;; exist on any Ultrasparc, but I only have a V9 manual. The code in + ;; I (Raymond Toy) don't think these f{sd}toir instructions exist on + ;; any Ultrasparc, but I only have a V9 manual. The code in ;; float.lisp seems to indicate that they only existed on non-sun4 ;; machines (sun3 68K machines?). (define-unary-fp-inst fstoir #b011000001 :reads :fsr)