Move globaldb functions out of SB!C package

contrib/sb-cltl2/env.lisp

@@ -499,7 +499,7 @@ the condition types that have been muffled."
  (sb-int:awhen (car (rassoc 'muffle-warning handled-conditions))
  (sb-kernel:type-specifier it))))
  (declaration
- (copy-list sb-c::*recognized-declarations*))
+ (copy-list sb-int:*recognized-declarations*))
  (t (if (info :declaration :handler declaration-name)
  (extra-decl-info
  declaration-name

make-host-2.lisp

@@ -119,7 +119,7 @@
 
 (when sb!c::*track-full-called-fnames*
  (let (possibly-suspicious likely-suspicious)
- (sb!c::call-with-each-globaldb-name
+ (sb!int:call-with-each-globaldb-name
  (lambda (name)
  (let* ((cell (sb!int:info :function :emitted-full-calls name))
  (inlinep (eq (sb!int:info :function :inlinep name) :inline))

make-target-2-load.lisp

@@ -114,7 +114,7 @@
  sb-int::
  (let ((ht (make-hash-table :test 'equalp))
  (old-count 0))
- (sb-c::call-with-each-globaldb-name
+ (sb-int:call-with-each-globaldb-name
  (lambda (name)
  (binding* ((info (info :function :info name) :exit-if-null)
  (shared-info (gethash info ht info)))

package-data-list.lisp-expr

@@ -1003,22 +1003,32 @@ possibly temporarily, because it might be used internally."
  ;; INFO stuff doesn't belong in a user-visible package, we
  ;; should be able to change it without apology.
  "*INFO-ENVIRONMENT*"
+ "*RECOGNIZED-DECLARATIONS*"
  "+INFOS-PER-WORD+"
  "+FDEFN-INFO-NUM+"
  "+NIL-PACKED-INFOS+"
+ "ATOMIC-SET-INFO-VALUE"
+ "CALL-WITH-EACH-GLOBALDB-NAME"
  "CLEAR-INFO"
+ "CLEAR-INFO-VALUES"
+ "DEFINE-INFO-TYPE"
  "FIND-FDEFN"
  "SYMBOL-FDEFN"
  "GET-INFO-VALUE-INITIALIZING"
+ "GLOBALDB-SXHASHOID"
  "INFO"
  "INFO-FIND-AUX-KEY/PACKED"
  "INFO-GETHASH"
  "INFO-NUMBER"
  "INFO-NUMBER-BITS"
  "INFO-VECTOR-FDEFN"
+ "MAKE-INFO-HASHTABLE"
+ "META-INFO"
+ "META-INFO-NUMBER"
  "PACKED-INFO-FIELD"
  "PACKED-INFO-INSERT"
  "PROCLAIMED-FTYPE"
+ "SET-INFO-VALUE"
  "UPDATE-SYMBOL-INFO"
  "WITH-GLOBALDB-NAME"
 

src/code/target-alieneval.lisp

@@ -672,7 +672,7 @@ null byte."
 ;;; so it would be a more invasive change.
 ;;;
 (defun-cached (coerce-to-interpreted-function
- :hash-bits 8 :hash-function #'sb!c::globaldb-sxhashoid)
+ :hash-bits 8 :hash-function #'globaldb-sxhashoid)
  ((lambda-form equal))
  (let (#!+(or sb-eval sb-fasteval)
  (*evaluator-mode* :interpret))

src/code/target-sxhash.lisp

@@ -527,7 +527,7 @@
 ;;; More work here equates to less work in the global hashtable.
 ;;; To wit: (eq (sxhash '(foo a b c bar)) (sxhash '(foo a b c d))) => T
 ;;; but the corresponding globaldb-sxhashoids differ.
-(defun sb!c::globaldb-sxhashoid (name)
+(defun globaldb-sxhashoid (name)
  (locally
  (declare (optimize (safety 0))) ; after the argc check
  ;; TRAVERSE will walk across more cons cells than RECURSE will descend.

src/cold/defun-load-or-cload-xcompiler.lisp

@@ -63,7 +63,7 @@
  (do-all-symbols (s)
  (when (get s :sb-xc-globaldb-info)
  (remf (symbol-plist s) :sb-xc-globaldb-info)))
- (fill (symbol-value 'sb!c::*info-types*) nil)
+ (fill (symbol-value 'sb!impl::*info-types*) nil)
  (clrhash (symbol-value 'sb!kernel::*forward-referenced-layouts*))
  (setf (symbol-value 'sb!kernel:*type-system-initialized*) nil)
  (makunbound 'sb!c::*backend-primitive-type-names*)

src/compiler/early-globaldb.lisp

@@ -10,10 +10,7 @@
 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
 ;;;; files for more information.
 
-;;; Given the presence of docstrings and source locations,
-;;; this logic arguably belongs to the runtime kernel, not the compiler,
-;;; but such nuance isn't hugely important.
-(in-package "SB!C")
+(in-package "SB!IMPL")
 
 ;;; Similar to FUNCTION, but the result type is "exactly" specified:
 ;;; if it is an object type, then the function returns exactly one
@@ -255,6 +252,7 @@
 ;;;; functions and VOPs. To save space and allow for quick set
 ;;;; operations, we represent the attributes as bits in a fixnum.
 
+(in-package "SB!C")
 (deftype attributes () 'fixnum)
 
 ;;; Given a list of attribute names and an alist that translates them

src/compiler/generic/genesis.lisp

@@ -1956,7 +1956,7 @@ core and return a descriptor to it."
  (setf (gethash symbol hashtable)
  (packed-info-insert
  (gethash symbol hashtable +nil-packed-infos+)
- sb!c::+no-auxilliary-key+ num cold-classoid-cell)))
+ sb!impl::+no-auxilliary-key+ num cold-classoid-cell)))
  *classoid-cells*))
  hashtable)
 

src/compiler/globaldb.lisp

@@ -32,7 +32,7 @@
 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
 ;;;; files for more information.
 
-(in-package "SB!C")
+(in-package "SB!IMPL")
 
 #-no-ansi-print-object
 (defmethod print-object ((x meta-info) stream)
@@ -345,7 +345,7 @@
 
 ;;; This specifies whether this function may be expanded inline. If
 ;;; null, we don't care.
-(define-info-type (:function :inlinep) :type-spec inlinep)
+(define-info-type (:function :inlinep) :type-spec sb!c::inlinep)
 
 ;;; Track how many times IR2 converted a call to this function as a full call
 ;;; that was not in the scope of a local or global notinline declaration.
@@ -380,7 +380,7 @@
 
 ;;; If a function is "known" to the compiler, then this is a FUN-INFO
 ;;; structure containing the info used to special-case compilation.
-(define-info-type (:function :info) :type-spec (or fun-info null))
+(define-info-type (:function :info) :type-spec (or sb!c::fun-info null))
 
 ;;; This is a type specifier <t> such that if an argument X to the function
 ;;; does not satisfy (TYPEP x <t>) then the function definitely returns NIL.
@@ -423,7 +423,7 @@
 (define-info-type (:variable :macro-expansion) :type-spec t)
 
 (define-info-type (:variable :alien-info)
- :type-spec (or heap-alien-info null))
+ :type-spec (or null sb!alien-internals:heap-alien-info))
 
 (define-info-type (:variable :documentation) :type-spec (or string null))
 
@@ -546,10 +546,14 @@
  :type-spec (member :primitive :defined :unknown)
  :default :unknown)
 (define-info-type (:alien-type :translator) :type-spec (or function null))
-(define-info-type (:alien-type :definition) :type-spec (or alien-type null))
-(define-info-type (:alien-type :struct) :type-spec (or alien-type null))
-(define-info-type (:alien-type :union) :type-spec (or alien-type null))
-(define-info-type (:alien-type :enum) :type-spec (or alien-type null))
+(define-info-type (:alien-type :definition)
+ :type-spec (or null sb!alien-internals:alien-type))
+(define-info-type (:alien-type :struct)
+ :type-spec (or null sb!alien-internals:alien-type))
+(define-info-type (:alien-type :union)
+ :type-spec (or null sb!alien-internals:alien-type))
+(define-info-type (:alien-type :enum)
+ :type-spec (or null sb!alien-internals:alien-type))
 
 ;;;; ":SETF" subsection - Data pertaining to expansion of the omnipotent macro.
 (define-info-type (:setf :documentation) :type-spec (or string null))

src/compiler/info-vector.lisp

@@ -7,7 +7,7 @@
 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
 ;;;; files for more information.
 
-(in-package "SB!C")
+(in-package "SB!IMPL")
 
 ;;;; This file implements abstract types which map globaldb Info-Number/Name
 ;;;; pairs to data values. The database itself is defined in 'globaldb'.
@@ -1188,7 +1188,7 @@ This is interpreted as
  (when (and (consp name)
  (memq (car name) '(sb!pcl::slow-method sb!pcl::fast-method))
  (some #'consp (car (last name))))
- (let ((i (aref sb!c::*info-types* info-number)))
+ (let ((i (aref *info-types* info-number)))
  (warn "Globaldb storing info for ~S~% ~S ~S~% -> ~S"
  name (meta-info-category i) (meta-info-kind i) new-value)))
 

tests/compiler.impure.lisp

@@ -1546,7 +1546,7 @@
  (return nil))
  (t t)))))
 (test-util:with-test (:name :identify-suspect-vops)
- (sb-c::call-with-each-globaldb-name
+ (sb-int:call-with-each-globaldb-name
  (lambda (name)
  ;; LEGAL-FUN-NAME-P test is necessary, since (INFO :FUNCTION :TYPE)
  ;; has a defaulting expression that involves calling FDEFINITION.

tests/info.before-xc.lisp

@@ -24,7 +24,7 @@
 (assert (boundp 'sb!vm:vector-data-offset))
 (assert (integerp (symbol-value 'sb!vm:vector-data-offset)))
 
-(in-package "SB!C")
+(in-package "SB!IMPL")
 
 (let ((foo-iv (packed-info-insert +nil-packed-infos+ +no-auxilliary-key+
  5 "hi 5"))

tests/info.impure.lisp

@@ -54,22 +54,22 @@
  (assert-error (funcall (compile nil `(lambda (x) (fdefinition x))) 0)
  type-error))
 
-(in-package "SB-C")
+(in-package "SB-IMPL")
 
 (test-util:with-test (:name :globaldb-sxhashoid-discrimination)
  (assert (not (eql (globaldb-sxhashoid '(a b c d e))
  (globaldb-sxhashoid '(a b c d mumble))))))
 
 (test-util:with-test (:name :bug-458015)
  ;; Make sure layouts have sane source-locations
- (sb-c::call-with-each-globaldb-name
+ (sb-int:call-with-each-globaldb-name
  (lambda (info-name)
  (when (and (symbolp info-name) (info :type :kind info-name))
  (let* ((classoid (find-classoid info-name nil))
  (layout (and classoid (classoid-layout classoid)))
  (srcloc (and layout (sb-kernel::layout-source-location layout))))
  (when (and layout)
- (assert (or (definition-source-location-p srcloc)
+ (assert (or (sb-c::definition-source-location-p srcloc)
  (null srcloc)))))))))
 
 (test-util:with-test (:name :find-classoid-signal-error)
@@ -481,7 +481,7 @@
  (random-result (make-array (length names) :initial-element nil))
  (n-created 0)
  (highest-type-num
- (position-if #'identity sb-c::*info-types*
+ (position-if #'identity *info-types*
  :end sb-int:+fdefn-info-num+ :from-end t)))
  (loop for name across names
  for i from 0
@@ -499,8 +499,8 @@
  (random-value (random most-positive-fixnum)))
  (push (cons random-type random-value)
  (aref random-result random-name-index))
- (sb-c::set-info-value (aref names random-name-index)
- random-type random-value))))
+ (sb-int:set-info-value (aref names random-name-index)
+  random-type random-value))))
  (values n-created fdefn-result random-result)))
 
 (test-util:with-test (:name :get-info-value-initializing
@@ -551,8 +551,7 @@
  (when (some (lambda (output)
  (assoc type-num (aref output name-index)))
  random-results)
- (let ((actual (sb-c::get-info-value (aref work name-index)
- type-num)))
+ (let ((actual (get-info-value (aref work name-index) type-num)))
  (unless (some (lambda (output)
  (some (lambda (cell)
  (and (eq (car cell) type-num)
@@ -588,8 +587,7 @@
  (let* ((index (random n))
  (name (aref names index)))
  (atomic-incf (aref counts index))
- ;; should probably be SB-INT:
- (sb-c::atomic-set-info-value
+ (sb-int:atomic-set-info-value
  :variable :macro-expansion name
  (lambda (old old-p)
  (if old-p (1+ old) 1))))