X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fmeta-vmdef.lisp;h=98c4600c2f1a592aedfed91ea866dd4ba5029fdf;hb=0e3c4b4db102bd204a30402d7e5a0de44aea57ce;hp=6fe1a05ef4c09ac251ad82a6209fb024a08e5e87;hpb=0408e5d19ea46776d7bdad4a46f643e5e9c27bfe;p=sbcl.git diff --git a/src/compiler/meta-vmdef.lisp b/src/compiler/meta-vmdef.lisp index 6fe1a05..98c4600 100644 --- a/src/compiler/meta-vmdef.lisp +++ b/src/compiler/meta-vmdef.lisp @@ -27,7 +27,8 @@ ;;; ;;; We enter the basic structure at meta-compile time, and then fill ;;; in the missing slots at load time. -(defmacro define-storage-base (name kind &key size) +(defmacro define-storage-base (name kind &key size (size-increment size) + (size-alignment 1)) (declare (type symbol name)) (declare (type (member :finite :unbounded :non-packed) kind)) @@ -39,11 +40,16 @@ (error "A size specification is meaningless in a ~S SB." kind))) ((:finite :unbounded) (unless size (error "Size is not specified in a ~S SB." kind)) - (aver (typep size 'unsigned-byte)))) + (aver (typep size 'unsigned-byte)) + (aver (= 1 (logcount size-alignment))) + (aver (not (logtest size (1- size-alignment)))) + (aver (not (logtest size-increment (1- size-alignment)))))) (let ((res (if (eq kind :non-packed) (make-sb :name name :kind kind) - (make-finite-sb :name name :kind kind :size size)))) + (make-finite-sb :name name :kind kind :size size + :size-increment size-increment + :size-alignment size-alignment)))) `(progn (eval-when (:compile-toplevel :load-toplevel :execute) (/show0 "about to SETF GETHASH META-SB-NAMES in DEFINE-STORAGE-BASE") @@ -614,16 +620,14 @@ 1) (ash (meta-sc-number-or-lose sc) 1)))) (incf index)) - ;; KLUDGE: As in the other COERCEs wrapped around with - ;; MAKE-SPECIALIZABLE-ARRAY results in COMPUTE-REF-ORDERING, - ;; this coercion could be removed by a sufficiently smart - ;; compiler, but I dunno whether Python is that smart. It - ;; would be good to check this and help it if it's not smart - ;; enough to remove it for itself. However, it's probably not - ;; urgent, since the overhead of an extra no-op conversion is - ;; unlikely to be large compared to consing and corresponding - ;; GC. -- WHN ca. 19990701 - `(coerce ,results '(specializable-vector ,element-type)))))) + ;; KLUDGE: The load-time MAKE-ARRAY here is an artifact of our + ;; cross-compilation strategy, and the conservative + ;; assumptions we are forced to make on which specialized + ;; arrays exist on the host lisp that the cross-compiler is + ;; running on. (We used to use COERCE here, but that caused + ;; SUBTYPEP calls too early in cold-init for comfort). -- + ;; CSR, 2009-10-30 + `(make-array ,(length results) :element-type '(specializable ,element-type) :initial-contents ',results))))) (defun compute-ref-ordering (parse) (let* ((num-args (+ (length (vop-parse-args parse)) @@ -640,7 +644,7 @@ (let ((target (find-operand (operand-parse-target op) parse '(:temporary :result)))) ;; KLUDGE: These formulas must be consistent with those in - ;; %EMIT-GENERIC-VOP, and this is currently maintained by + ;; EMIT-VOP, and this is currently maintained by ;; hand. -- WHN 2002-01-30, paraphrasing APD (targets (+ (* index max-vop-tn-refs) (ecase (operand-parse-kind target) @@ -700,34 +704,18 @@ (incf index))) `(:num-args ,num-args :num-results ,num-results - ;; KLUDGE: The (COERCE .. (SPECIALIZABLE-VECTOR ..)) wrapper - ;; here around the result returned by - ;; MAKE-SPECIALIZABLE-ARRAY above was of course added to - ;; help with cross-compilation. "A sufficiently smart - ;; compiler" should be able to optimize all this away in the - ;; final target Lisp, leaving a single MAKE-ARRAY with no - ;; subsequent coercion. However, I don't know whether Python - ;; is that smart. (Can it figure out the return type of - ;; MAKE-ARRAY? Does it know that COERCE can be optimized - ;; away if the input type is known to be the same as the - ;; COERCEd-to type?) At some point it would be good to test - ;; to see whether this construct is in fact causing run-time - ;; overhead, and fix it if so. (Some declarations of the - ;; types returned by MAKE-ARRAY might be enough to fix it.) - ;; However, it's probably not urgent to fix this, since it's - ;; hard to imagine that any overhead caused by calling - ;; COERCE and letting it decide to bail out could be large - ;; compared to the cost of consing and GCing the vectors in - ;; the first place. -- WHN ca. 19990701 - :ref-ordering (coerce ',ordering - '(specializable-vector ,oe-type)) + ;; KLUDGE: see the comment regarding MAKE-ARRAY in + ;; COMPUTE-TEMPORARIES-DESCRIPTION. -- CSR, 2009-10-30 + :ref-ordering (make-array ,(length ordering) + :initial-contents ',ordering + :element-type '(specializable ,oe-type)) ,@(when (targets) - `(:targets (coerce ',(targets) - '(specializable-vector ,te-type))))))))) + `(:targets (make-array ,(length (targets)) + :initial-contents ',(targets) + :element-type '(specializable ,te-type))))))))) (defun make-emit-function-and-friends (parse) - `(:emit-function #'emit-generic-vop - :temps ,(compute-temporaries-description parse) + `(:temps ,(compute-temporaries-description parse) ,@(compute-ref-ordering parse))) ;;;; generator functions @@ -1425,14 +1413,18 @@ ((symbolp type) ``(:or ,(primitive-type-or-lose ',type))) (t - (ecase (first type) + (ecase (car type) (:or ``(:or ,,@(mapcar (lambda (type) `(primitive-type-or-lose ',type)) (rest type)))) (:constant ``(:constant ,#'(lambda (x) - (typep x ',(second type))) + ;; Can't handle SATISFIES during XC + ,(if (and (consp (second type)) + (eq (caadr type) 'satisfies)) + `(,(cadadr type) x) + `(sb!xc:typep x ',(second type)))) ,',(second type))))))) (defun specify-operand-types (types ops more-ops) @@ -1554,7 +1546,7 @@ ;;; :LOAD-IF EXPRESSION ;;; Controls whether automatic operand loading is done. ;;; EXPRESSION is evaluated with the fixed operand TNs bound. -;;; If EXPRESSION is true,then loading is done and the variable +;;; If EXPRESSION is true, then loading is done and the variable ;;; is bound to the load TN in the generator body. Otherwise, ;;; loading is not done, and the variable is bound to the actual ;;; operand. @@ -1759,15 +1751,8 @@ ;;; Call the emit function for TEMPLATE, linking the result in at the ;;; end of BLOCK. (defmacro emit-template (node block template args results &optional info) - (with-unique-names (first last) - (once-only ((n-node node) - (n-block block) - (n-template template)) - `(multiple-value-bind (,first ,last) - (funcall (template-emit-function ,n-template) - ,n-node ,n-block ,n-template ,args ,results - ,@(when info `(,info))) - (insert-vop-sequence ,first ,last ,n-block nil))))) + `(emit-and-insert-vop ,node ,block ,template ,args ,results nil + ,@(when info `(,info)))) ;;; VOP Name Node Block Arg* Info* Result* ;;;