X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fglobaldb.lisp;h=60c4c96ea2197eb7ec86bf51ed38d7618b12a490;hb=db55ad022ec7cc7a2f251918579fdeba7f17dbe0;hp=410745fcb59e31131412f41d40c189f39ebc21f7;hpb=68a83a65688bb578163c502e045da298d20a1f0c;p=sbcl.git diff --git a/src/compiler/globaldb.lisp b/src/compiler/globaldb.lisp index 410745f..60c4c96 100644 --- a/src/compiler/globaldb.lisp +++ b/src/compiler/globaldb.lisp @@ -84,8 +84,7 @@ (defun primify (x) (declare (type unsigned-byte x)) (do ((n (logior x 1) (+ n 2))) - ((sb!sys:positive-primep n) - n))) + ((positive-primep n) n))) ;;;; info classes, info types, and type numbers, part I: what's needed ;;;; not only at compile time but also at run time @@ -125,17 +124,25 @@ (:copier nil)) ;; name of this class (name nil :type keyword :read-only t) - ;; List of Type-Info structures for each type in this class. + ;; list of Type-Info structures for each type in this class (types () :type list)) ;;; a map from type numbers to TYPE-INFO objects. There is one type ;;; number for each defined CLASS/TYPE pair. ;;; -;;; We build its value at compile time (with calls to +;;; We build its value at build-the-cross-compiler time (with calls to ;;; DEFINE-INFO-TYPE), then generate code to recreate the compile time ;;; value, and arrange for that code to be called in cold load. +;;; KLUDGE: We don't try to reset its value when cross-compiling the +;;; compiler, since that creates too many bootstrapping problems, +;;; instead just reusing the built-in-the-cross-compiler version, +;;; which is theoretically a little bit ugly but pretty safe in +;;; practice because the cross-compiler is as close to the target +;;; compiler as we can make it, i.e. identical in most ways, including +;;; this one. -- WHN 2001-08-19 (defvar *info-types*) (declaim (type simple-vector *info-types*)) +#-sb-xc ; as per KLUDGE note above (eval-when (:compile-toplevel :execute) (setf *info-types* (make-array (ash 1 type-number-bits) :initial-element nil))) @@ -166,8 +173,12 @@ ;;; We build the value for this at compile time (with calls to ;;; DEFINE-INFO-CLASS), then generate code to recreate the compile time ;;; value, and arrange for that code to be called in cold load. +;;; KLUDGE: Just as for *INFO-TYPES*, we don't try to rebuild this +;;; when cross-compiling, but instead just reuse the cross-compiler's +;;; version for the target compiler. -- WHN 2001-08-19 (defvar *info-classes*) (declaim (hash-table *info-classes*)) +#-sb-xc ; as per KLUDGE note above (eval-when (:compile-toplevel :execute) (setf *info-classes* (make-hash-table))) @@ -791,15 +802,15 @@ ;;; foldable.) ;;; INFO is the standard way to access the database. It's settable. +;;; +;;; Return the information of the specified TYPE and CLASS for NAME. +;;; The second value returned is true if there is any such information +;;; recorded. If there is no information, the first value returned is +;;; the default and the second value returned is NIL. (defun info (class type name &optional (env-list nil env-list-p)) - #!+sb-doc - "Return the information of the specified TYPE and CLASS for NAME. - The second value returned is true if there is any such information - recorded. If there is no information, the first value returned is - the default and the second value returned is NIL." - ;; FIXME: At some point check systematically to make sure that the system - ;; doesn't do any full calls to INFO or (SETF INFO), or at least none in any - ;; inner loops. + ;; FIXME: At some point check systematically to make sure that the + ;; system doesn't do any full calls to INFO or (SETF INFO), or at + ;; least none in any inner loops. (let ((info (type-info-or-lose class type))) (if env-list-p (get-info-value name (type-info-number info) env-list) @@ -807,8 +818,8 @@ #!-sb-fluid (define-compiler-macro info (&whole whole class type name &optional (env-list nil env-list-p)) - ;; Constant CLASS and TYPE is an overwhelmingly common special case, and we - ;; can resolve it much more efficiently than the general case. + ;; Constant CLASS and TYPE is an overwhelmingly common special case, + ;; and we can resolve it much more efficiently than the general case. (if (and (constantp class) (constantp type)) (let ((info (type-info-or-lose class type))) `(the ,(type-info-type info) @@ -880,11 +891,11 @@ :table (make-array table-size :initial-element nil) :threshold size))) +;;; Clear the information of the specified TYPE and CLASS for NAME in +;;; the current environment, allowing any inherited info to become +;;; visible. We return true if there was any info. (defun clear-info (class type name) #!+sb-doc - "Clear the information of the specified Type and Class for Name in the - current environment, allowing any inherited info to become visible. We - return true if there was any info." (let ((info (type-info-or-lose class type))) (clear-info-value name (type-info-number info)))) #!-sb-fluid @@ -925,14 +936,21 @@ ;;; Check whether the name and type is in our cache, if so return it. ;;; Otherwise, search for the value and encache it. ;;; -;;; Return the value from the first environment which has it defined, or -;;; return the default if none does. We have a cache for the last name looked -;;; up in each environment. We don't compute the hash until the first time the -;;; cache misses. When the cache does miss, we invalidate it before calling the -;;; lookup routine to eliminate the possiblity of the cache being partially -;;; updated if the lookup is interrupted. +;;; Return the value from the first environment which has it defined, +;;; or return the default if none does. We have a cache for the last +;;; name looked up in each environment. We don't compute the hash +;;; until the first time the cache misses. When the cache does miss, +;;; we invalidate it before calling the lookup routine to eliminate +;;; the possibility of the cache being partially updated if the lookup +;;; is interrupted. (defun get-info-value (name0 type &optional (env-list nil env-list-p)) (declare (type type-number type)) + ;; sanity check: If we have screwed up initialization somehow, then + ;; *INFO-TYPES* could still be uninitialized at the time we try to + ;; get an info value, and then we'd be out of luck. (This happened, + ;; and was confusing to debug, when rewriting EVAL-WHEN in + ;; sbcl-0.pre7.x.) + (aver (aref *info-types* type)) (let ((name (uncross name0))) (flet ((lookup-ignoring-global-cache (env-list) (let ((hash nil)) @@ -952,11 +970,15 @@ (multiple-value-bind (value winp) (,cache env type) (when winp (return (values value t))))))) - (if (typep env 'volatile-info-env) - (frob volatile-info-lookup volatile-info-cache-hit - volatile-info-env-cache-name) - (frob compact-info-lookup compact-info-cache-hit - compact-info-env-cache-name))))))) + (etypecase env + (volatile-info-env (frob + volatile-info-lookup + volatile-info-cache-hit + volatile-info-env-cache-name)) + (compact-info-env (frob + compact-info-lookup + compact-info-cache-hit + compact-info-env-cache-name)))))))) (cond (env-list-p (lookup-ignoring-global-cache env-list)) (t @@ -1015,15 +1037,13 @@ :type-spec t) ;;; where this information came from: -;;; :DECLARED = from a declaration. -;;; :ASSUMED = from uses of the object. -;;; :DEFINED = from examination of the definition. -;;; FIXME: The :DEFINED assumption that the definition won't change -;;; isn't ANSI. KLUDGE: CMU CL uses function type information in a way -;;; which violates its "type declarations are assertions" principle, -;;; and SBCL has inherited that behavior. It would be really good to -;;; fix the compiler so that it tests the return types of functions.. -;;; -- WHN ca. 19990801 +;;; :ASSUMED = from uses of the object +;;; :DEFINED = from examination of the definition +;;; :DECLARED = from a declaration +;;; :DEFINED trumps :ASSUMED, and :DECLARED trumps :DEFINED. +;;; :DEFINED and :ASSUMED are useful for issuing compile-time warnings, +;;; and :DECLARED is useful for ANSIly specializing code which +;;; implements the function, or which uses the function's return values. (define-info-type :class :function :type :where-from @@ -1117,7 +1137,7 @@ (define-info-class :variable) -;;; The kind of variable-like thing described. +;;; the kind of variable-like thing described (define-info-type :class :variable :type :kind @@ -1127,21 +1147,21 @@ :constant :global)) -;;; The declared type for this variable. +;;; the declared type for this variable (define-info-type :class :variable :type :type :type-spec ctype :default *universal-type*) -;;; Where this type and kind information came from. +;;; where this type and kind information came from (define-info-type :class :variable :type :where-from :type-spec (member :declared :assumed :defined) :default :assumed) -;;; The lisp object which is the value of this constant, if known. +;;; the Lisp object which is the value of this constant, if known (define-info-type :class :variable :type :constant-value @@ -1164,15 +1184,15 @@ (define-info-class :type) -;;; The kind of type described. We return :INSTANCE for standard types that -;;; are implemented as structures. +;;; the kind of type described. We return :INSTANCE for standard types +;;; that are implemented as structures. (define-info-type :class :type :type :kind :type-spec (member :primitive :defined :instance nil) :default nil) -;;; Expander function for a defined type. +;;; the expander function for a defined type (define-info-type :class :type :type :expander