X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fvmdef.lisp;h=5af6cd488683e1175b8b09f05c30db4557d08e93;hb=ba38798a5ca26b90647a1993f348806cb32f2d1b;hp=3e50b3901f6d433b48ce1efa5fce0275e5f11b0d;hpb=a530bbe337109d898d5b4a001fc8f1afa3b5dc39;p=sbcl.git diff --git a/src/compiler/vmdef.lisp b/src/compiler/vmdef.lisp index 3e50b39..5af6cd4 100644 --- a/src/compiler/vmdef.lisp +++ b/src/compiler/vmdef.lisp @@ -12,17 +12,14 @@ (in-package "SB!C") -(file-comment - "$Header$") - ;;; Return the template having the specified name, or die trying. (defun template-or-lose (x) (the template (or (gethash x *backend-template-names*) (error "~S is not a defined template." x)))) -;;; Return the SC structure, SB structure or SC number corresponding to a -;;; name, or die trying. +;;; Return the SC structure, SB structure or SC number corresponding +;;; to a name, or die trying. (defun sc-or-lose (x) (the sc (or (gethash x *backend-sc-names*) @@ -34,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*) @@ -48,7 +45,7 @@ (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 any) @@ -77,15 +74,15 @@ ;;;; primitive type definition -;;; Return the primitive type corresponding to the specified name, or die -;;; trying. +;;; Return the primitive type corresponding to the specified name, or +;;; die trying. (defun primitive-type-or-lose (name) (the primitive-type (or (gethash name *backend-primitive-type-names*) (error "~S is not a defined primitive type." name)))) -;;; Return true if SC is either one of Ptype's SC's, or one of those SC's -;;; alternate or constant SCs. +;;; Return true if SC is either one of PTYPE's SC's, or one of those +;;; SC's alternate or constant SCs. (defun sc-allowed-by-primitive-type (sc ptype) (declare (type sc sc) (type primitive-type ptype)) (let ((scn (sc-number sc))) @@ -99,7 +96,13 @@ ;;;; generation of emit functions -(defconstant max-vop-tn-refs 256) +(eval-when (:compile-toplevel :load-toplevel :execute) + ;; 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 + (defconstant max-vop-tn-refs 256)) (defvar *vop-tn-refs* (make-array max-vop-tn-refs :initial-element nil)) (defvar *using-vop-tn-refs* nil) @@ -151,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 @@ -200,14 +206,14 @@ (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 (lambda (type) + (type-specifier + (primitive-type-type + type))) (rest x)))) - (:constant `(constant-argument ,(third x))))))) + (:constant `(constant-arg ,(third x))))))) `(,@(mapcar #'frob types) ,@(when more-types `(&rest ,(frob more-types)))))))