X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fvmdef.lisp;h=3b6fb422cca94c841da9b95452c316493d102f6d;hb=35b5e97163c45e89659dbd75c91d653b49c758d3;hp=9ed8e2ba435323874ad2bc3ade30d2a96c0c894b;hpb=0c58c96998aab7f3179b74ef7462190e59563e2e;p=sbcl.git diff --git a/src/compiler/vmdef.lisp b/src/compiler/vmdef.lisp index 9ed8e2b..3b6fb42 100644 --- a/src/compiler/vmdef.lisp +++ b/src/compiler/vmdef.lisp @@ -31,9 +31,9 @@ (defun sc-number-or-lose (x) (the sc-number (sc-number (sc-or-lose x)))) -;;; Like the non-meta versions, but go for the meta-compile-time info. -;;; These should not be used after load time, since compiling the compiler -;;; changes the definitions. +;;; This is like the non-meta versions, except we go for the +;;; meta-compile-time info. These should not be used after load time, +;;; since compiling the compiler changes the definitions. (defun meta-sc-or-lose (x) (the sc (or (gethash x *backend-meta-sc-names*) @@ -45,9 +45,9 @@ (defun meta-sc-number-or-lose (x) (the sc-number (sc-number (meta-sc-or-lose x)))) -;;;; side-effect classes +;;;; side effect classes -(def-boolean-attribute vop +(!def-boolean-attribute vop any) ;;;; move/coerce definition @@ -97,7 +97,12 @@ ;;;; generation of emit functions (eval-when (:compile-toplevel :load-toplevel :execute) - (defconstant max-vop-tn-refs 256)) + ;; We need the EVAL-WHEN because %EMIT-GENERIC-VOP (below) + ;; uses #.MAX-VOP-TN-REFS, not just MAX-VOP-TN-REFS. + ;; -- AL 20010218 + ;; + ;; See also the description of VOP-INFO-TARGETS. -- APD, 2002-01-30 + (def!constant max-vop-tn-refs 256)) (defvar *vop-tn-refs* (make-array max-vop-tn-refs :initial-element nil)) (defvar *using-vop-tn-refs* nil) @@ -108,7 +113,7 @@ (pushnew 'flush-vop-tn-refs *before-gc-hooks*) -(defconstant sc-bits (integer-length (1- sc-number-limit))) +(def!constant sc-bits (integer-length (1- sc-number-limit))) (defun emit-generic-vop (node block template args results &optional info) (%emit-generic-vop node block template args results info)) @@ -149,6 +154,9 @@ (ash temp (- (1+ sc-bits)))) (make-restricted-tn nil (ash temp -1)))) (write-ref (reference-tn tn t))) + ;; KLUDGE: These formulas must be consistent with those in + ;; COMPUTE-REF-ORDERING, and this is currently + ;; maintained by hand. -- WHN 2002-01-30, paraphrasing APD (setf (aref refs index) (reference-tn tn nil)) (setf (aref refs (1+ index)) write-ref) (if prev @@ -191,21 +199,18 @@ #'<= :key #'template-cost)) -;;; Return a function type specifier describing Template's type computed +;;; Return a function type specifier describing TEMPLATE's type computed ;;; from the operand type restrictions. (defun template-type-specifier (template) (declare (type template template)) (flet ((convert (types more-types) (flet ((frob (x) (if (eq x '*) - 't + t (ecase (first x) - (:or `(or ,@(mapcar #'(lambda (type) - (type-specifier - (primitive-type-type - type))) + (:or `(or ,@(mapcar #'primitive-type-specifier (rest x)))) - (:constant `(constant-argument ,(third x))))))) + (:constant `(constant-arg ,(third x))))))) `(,@(mapcar #'frob types) ,@(when more-types `(&rest ,(frob more-types)))))))