X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fglobaldb.lisp;h=6c116775c0602442c4dd049b9b37d9c9e6bf1139;hb=70c6facc145eaf5ca368528b04df63f730746b1f;hp=45e10d8d6e09793d921ac2aca56e238a68148af3;hpb=c103e75ed3eaf47bda3407d663fd64f09215dc11;p=sbcl.git diff --git a/src/compiler/globaldb.lisp b/src/compiler/globaldb.lisp index 45e10d8..6c11677 100644 --- a/src/compiler/globaldb.lisp +++ b/src/compiler/globaldb.lisp @@ -583,11 +583,11 @@ :element-type 'compact-info-entry)) (sorted (sort (names) #+sb-xc-host #'< - ;; (This MAKE-FIXNUM hack implements - ;; pointer comparison, as explained above.) + ;; POINTER-HASH hack implements pointer + ;; comparison, as explained above. #-sb-xc-host (lambda (x y) - (< (%primitive make-fixnum x) - (%primitive make-fixnum y)))))) + (< (pointer-hash x) + (pointer-hash y)))))) (/show0 "done making/sorting vectors in COMPACT-INFO-ENVIRONMENT") (let ((entries-idx 0)) (dolist (types sorted) @@ -788,27 +788,33 @@ new-value))) new-value) #!-sb-fluid -(define-compiler-macro (setf info) (&whole whole - new-value - 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. - (if (and (keywordp class) (keywordp type)) - (let* ((info (type-info-or-lose class type)) - (tin (type-info-number info))) - (if env-list-p - `(set-info-value ,name - ,tin - ,new-value - (get-write-info-env ,env-list)) - `(set-info-value ,name - ,tin - ,new-value)))) - whole) +(progn + ;; Not all xc hosts are happy about SETF compiler macros: CMUCL 19 + ;; does not accept them at all, and older SBCLs give a full warning. + ;; So the easy thing is to hide this optimization from all xc hosts. + #-sb-xc-host + (define-compiler-macro (setf info) (&whole whole + new-value + 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. + (if (and (keywordp class) (keywordp type)) + (let* ((info (type-info-or-lose class type)) + (tin (type-info-number info))) + (if env-list-p + `(set-info-value ,name + ,tin + ,new-value + (get-write-info-env ,env-list)) + `(set-info-value ,name + ,tin + ,new-value)))) + whole)) ;;; the maximum density of the hashtable in a volatile env (in ;;; names/bucket) @@ -930,7 +936,7 @@ :default #+sb-xc-host (specifier-type 'function) #-sb-xc-host (if (fboundp name) - (extract-fun-type (fdefinition name)) + (specifier-type (sb!impl::%fun-type (fdefinition name))) (specifier-type 'function))) ;;; the ASSUMED-TYPE for this function, if we have to infer the type @@ -947,15 +953,18 @@ ;;; where this information came from: ;;; :ASSUMED = from uses of the object ;;; :DEFINED = from examination of the definition +;;; :DEFINED-METHOD = implicit, incremental declaration by CLOS. ;;; :DECLARED = from a declaration -;;; :DEFINED trumps :ASSUMED, and :DECLARED trumps :DEFINED. +;;; :DEFINED trumps :ASSUMED, :DEFINED-METHOD trumps :DEFINED, +;;; and :DECLARED trumps :DEFINED-METHOD. ;;; :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. +;;; :DEFINED-METHOD and :DECLARED are 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 - :type-spec (member :declared :assumed :defined) + :type-spec (member :declared :defined-method :assumed :defined) :default ;; Again (as in DEFINE-INFO-TYPE :CLASS :FUNCTION :TYPE :KIND) it's ;; not clear how to generalize the FBOUNDP expression to the @@ -1044,6 +1053,12 @@ :type :definition :type-spec (or fdefn null) :default nil) + +(define-info-type + :class :function + :type :structure-accessor + :type-spec (or defstruct-description null) + :default nil) ;;;; definitions for other miscellaneous information @@ -1054,7 +1069,7 @@ :class :variable :type :kind :type-spec (member :special :constant :macro :global :alien) - :default (if (symbol-self-evaluating-p name) + :default (if (typep name '(or boolean keyword)) :constant :global)) @@ -1072,21 +1087,14 @@ :type-spec (member :declared :assumed :defined) :default :assumed) -;;; the Lisp object which is the value of this constant, if known +;;; We only need a mechanism different from the +;;; usual SYMBOL-VALUE for the cross compiler. +#+sb-xc-host (define-info-type :class :variable - :type :constant-value + :type :xc-constant-value :type-spec t - ;; CMU CL used to return two values for (INFO :VARIABLE :CONSTANT-VALUE ..). - ;; Now we don't: it was the last remaining multiple-value return from - ;; the INFO system, and bringing it down to one value lets us simplify - ;; things, especially simplifying the declaration of return types. - ;; Software which used to check the second value (for "is it defined - ;; as a constant?") should check (EQL (INFO :VARIABLE :KIND ..) :CONSTANT) - ;; instead. - :default (if (symbol-self-evaluating-p name) - name - (bug "constant lookup of nonconstant ~S" name))) + :default nil) ;;; the macro-expansion for symbol-macros (define-info-type @@ -1157,17 +1165,6 @@ :type-spec (or ctype null) :default nil) -;;; If this is a class name, then the value is a cons (NAME . CLASS), -;;; where CLASS may be null if the class hasn't been defined yet. Note -;;; that for built-in classes, the kind may be :PRIMITIVE and not -;;; :INSTANCE. The name is in the cons so that we can signal a -;;; meaningful error if we only have the cons. -(define-info-type - :class :type - :type :classoid - :type-spec (or sb!kernel::classoid-cell null) - :default nil) - ;;; layout for this type being used by the compiler (define-info-type :class :type