Remove not-for-public-consumption keywords from *FEATURES*

NEWS

@@ -1,5 +1,10 @@
 ;;;; -*- coding: utf-8; fill-column: 78 -*-
 
+changes relative to sbcl-2.0.0:
+  * minor incompatible change: some symbols have been removed from *FEATURES*
+    based on a determination of which should be impermissible to examine
+    via #+ and #- reader macros in user-written code.
+
 changes in sbcl-2.0.0 relative to sbcl-1.5.9:
   * minor incompatible change: heap relocation now works on Windows.  Since
     this feature now works on all platforms, it is enabled unconditionally and

contrib/asdf-stub.lisp

@@ -45,7 +45,8 @@ sb-ext::(declaim (unmuffle-conditions sb-kernel:redefinition-warning))
     (setf *central-registry* nil)))
 
 (defun build-asdf-contrib (system)
-  (push :sb-building-contrib *features*)
+  (setq *features*
+        (append '(:sb-building-contrib) sb-impl:+internal-features+ *features*))
   (setup-asdf-contrib)
   (let* ((name (string-downcase system))
          (sbcl-pwd (getenv-pathname "SBCL_PWD" :ensure-directory t))

make-target-2-load.lisp

@@ -6,6 +6,46 @@
 (defvar *compile-files-p* nil)
 (load (merge-pathnames "src/cold/warm.lisp" *load-pathname*))
 
+;;; Remove symbols from CL:*FEATURES* that should not be exposed to users.
+(export 'sb-impl::+internal-features+ 'sb-impl)
+(let ((public-features
+        (cons
+         sb-impl::!sbcl-architecture
+         '(:COMMON-LISP :SBCL :ANSI-CL :IEEE-FLOATING-POINT
+           :64-BIT ; choice of word size. 32-bit if absent
+           :BIG-ENDIAN :LITTLE-ENDIAN ; endianness: pick one and only one
+           :BSD :UNIX :LINUX :WIN32 :DARWIN :SUNOS :ANDROID ; OS: pick one or more
+           :MACH-O :ELF ; obj file format: pick zero or one
+           ;; I would argue that this should not be exposed,
+           ;; but I would also anticipate blowblack from removing it.
+           :CHENEYGC :GENCGC ; GC: pick one and only one
+           ;; This really should not exist. For any one architecture, if it supports
+           ;; :linkage-table (which almost all do), then it should support dynamic-core,
+           ;; and we should build with both, which is to say that dynamic-core is not
+           ;; an additional yes/no choice.
+           :SB-DYNAMIC-CORE
+           ;; Features that are also in *features-potentially-affecting-fasl-format*
+           ;; and would probably mess up something if made non-public,
+           ;; though I don't think they should all be public.
+           :SB-SAFEPOINT :SB-SAFEPOINT-STRICTLY
+           :SB-THREAD :SB-UNICODE
+           ;; Things which (I think) at least one person has requested be kept around
+           :SB-LDB
+           ;; Features which are public and "potentially affect" fasl format,
+           ;; though in practice they don't because every build has them.
+           ;; And/or at least one person has requested be kept around.
+           :SB-PACKAGE-LOCKS
+           ;; unsure, I think this is for end-user consumption,
+           ;; though every release of SBCL since eons ago has had local nicknames.
+           :PACKAGE-LOCAL-NICKNAMES
+           ;; Developer mode features. A release build will never have them,
+           ;; hence it makes no difference whether they're public or not.
+           :SB-FLUID :SB-DEVEL))))
+  (defconstant sb-impl:+internal-features+
+    (remove-if (lambda (x) (member x public-features)) *features*))
+  (setq *features* (remove-if-not (lambda (x) (member x public-features))
+                                  *features*)))
+
 ;;; There's a fair amount of machinery which is needed only at cold
 ;;; init time, and should be discarded before freezing the final
 ;;; system. We discard it by uninterning the associated symbols.
@@ -111,22 +151,25 @@
           (format t "Found string ~S~%" (weak-pointer-value wp)))
         (warn "Potential problem with format-control strings.
 Please check that all strings which were not recognizable to the compiler
-(as the first argument to WARN, etc.) are wrapped in SB-FORMAT:TOKENS")
-        ;; This is for display only, I don't check the result.
-        ;; NOTE: this symbol doesn't become external until after fasload.
-        #+gencgc (when (fboundp 'sb-ext::search-roots)
-                   (sb-ext::search-roots wps :criterion :static)))
+(as the first argument to WARN, etc.) are wrapped in SB-FORMAT:TOKENS"))
       wps)))
 
 (progn
   ;; See the giant comment at the bottom of this file
   ;; concerning the need for this GC.
   (gc :full t)
-  (!scan-format-control-strings)
+  (!scan-format-control-strings))
 
-  ;;; Remove docstrings that snuck in, as will happen with
-  ;;; any file compiled in warm load.
-  #-sb-doc
+;;; Either set some more package docstrings, or remove any and all docstrings
+;;; that snuck in (as can happen with any file compiled in warm load)
+;;; depending on presence of the :sb-doc internal feature.
+(if (member :sb-doc sb-impl:+internal-features+)
+  (setf (documentation (find-package "COMMON-LISP") t)
+        "public: home of symbols defined by the ANSI language specification"
+        (documentation (find-package "COMMON-LISP-USER") t)
+        "public: the default package for user code and data"
+        (documentation (find-package "KEYWORD") t)
+        "public: home of keywords")
   (let ((count 0))
     (macrolet ((clear-it (place)
                  `(when ,place
@@ -159,7 +202,9 @@ Please check that all strings which were not recognizable to the compiler
         (clear-it (sb-int:info :random-documentation :stuff s))))
     (when (plusp count)
       (format t "~&Removed ~D doc string~:P" count)))
+)
 
+(progn
   ;; Remove source forms of compiled-to-memory lambda expressions.
   ;; The disassembler is the major culprit for retention of these,
   ;; but there are others and I don't feel like figuring out where from.
@@ -219,7 +264,6 @@ Please check that all strings which were not recognizable to the compiler
   ;; And we can't promise anything across reload, which makes it impossible
   ;; for x86-64 codegen to know which symbols are immediate constants.
   ;; Except that symbols which existed at SBCL build time must be.
-  #+(and immobile-space (not immobile-symbols))
   (do-all-symbols (symbol)
     (when (sb-kernel:immobile-space-obj-p symbol)
       (sb-kernel:set-header-data
@@ -234,17 +278,7 @@ Please check that all strings which were not recognizable to the compiler
                (null (sb-kernel:symbol-info-vector symbol))
                (null (symbol-plist symbol)))
       (setf (sb-kernel:symbol-info symbol) nil)))
-
-  ;; Set doc strings for the standard packages.
-  #+sb-doc
-  (setf (documentation (find-package "COMMON-LISP") t)
-        "public: home of symbols defined by the ANSI language specification"
-        (documentation (find-package "COMMON-LISP-USER") t)
-        "public: the default package for user code and data"
-        (documentation (find-package "KEYWORD") t)
-        "public: home of keywords")
-
-  "done with warm.lisp, about to GC :FULL T")
+)
 
 (sb-ext:gc :full t)
 
@@ -277,19 +311,20 @@ Please check that all strings which were not recognizable to the compiler
 ;;; fasls. Since fasls should be compatible between images originating
 ;;; from the same SBCL build, REPACK-XREF is of no use after the
 ;;; target image has been built.
-#+sb-xref-for-internals (sb-c::repack-xref :verbose 1)
+(when (member :sb-xref-for-internals sb-impl:+internal-features+)
+  (sb-c::repack-xref :verbose 1))
 (fmakunbound 'sb-c::repack-xref)
 
 (progn
   (load (merge-pathnames "src/code/shaketree" *load-pathname*))
   (sb-impl::shake-packages
-   ;; Retain all symbols satisfying this predicate
+   ;; Development mode: retain all symbols with any system-related properties
    #+sb-devel
    (lambda (symbol accessibility)
      (declare (ignore accessibility))
-     ;; Retain all symbols satisfying this predicate
      (or (sb-kernel:symbol-info symbol)
          (and (boundp symbol) (not (keywordp symbol)))))
+   ;; Release mode: retain all symbols satisfying this intricate test
    #-sb-devel
    (lambda (symbol accessibility)
      (case (symbol-package symbol)
@@ -348,8 +383,8 @@ Please check that all strings which were not recognizable to the compiler
   (loop (multiple-value-bind (winp symbol) (iter)
           (if winp (unintern symbol "CL-USER") (return)))))
 
-#+immobile-code (setq sb-c::*compile-to-memory-space* :auto)
-#+sb-fasteval (setq sb-ext:*evaluator-mode* :interpret)
+(setq sb-c:*compile-to-memory-space* :auto)
+(when (find-package "SB-FASTEVAL") (setq sb-ext:*evaluator-mode* :interpret))
 ;; folding doesn't actually do anything unless the backend supports it,
 ;; but the interface exists no matter what.
 (sb-ext:fold-identical-code :aggressive t :preserve-docstrings t)

make-target-2.sh

@@ -61,7 +61,7 @@ echo //doing warm init - load and dump phase
  --lose-on-corruption $SBCL_MAKE_TARGET_2_OPTIONS --no-sysinit --no-userinit \
  --eval "(progn ${devel})" \
  --eval '(sb-fasl::!warm-load "make-target-2-load.lisp")' \
- --eval '(progn #+gencgc(setf (extern-alien "gc_coalesce_string_literals" char) 2))' \
+ --eval '(setf (extern-alien "gc_coalesce_string_literals" char) 2)' \
  --eval '(let ((sb-ext:*invoke-debugger-hook* (prog1 sb-ext:*invoke-debugger-hook* (sb-ext:enable-debugger))))
  (sb-ext:save-lisp-and-die "output/sbcl.core"))'
 

package-data-list.lisp-expr

@@ -254,6 +254,7 @@ of SBCL which maintained the CMU-CL-style split into two packages.)"
 
                "*CODE-SEGMENT*"
                "*COMPILATION*"
+               "*COMPILE-TO-MEMORY-SPACE*"
                "*ELSEWHERE*" "*FREE-FUNS*"
                "*LEXENV*"
                "*SUPPRESS-VALUES-DECLARATION*"

src/code/ntrace.lisp

@@ -670,7 +670,7 @@ functions when called with no arguments."
            (let ((c (fun-code-header
                      ;; Immobile code might use relative fixups which won't work
                      ;; when the code gets copied.
-                     (let ((sb-c::*compile-to-memory-space* :dynamic))
+                     (let ((sb-c:*compile-to-memory-space* :dynamic))
                        (compile nil
                                 `(lambda (&rest args)
                                    ;; The code constants will be overwritten in the copy.

src/code/target-misc.lisp

@@ -27,6 +27,7 @@
                  sb-xc:*features*)
   "a list of symbols that describe features provided by the
    implementation")
+(defconstant !sbcl-architecture #.(sb-cold::target-platform-keyword))
 
 (defun machine-instance ()
   "Return a string giving the name of the local machine."

src/compiler/generic/early-objdef.lisp

@@ -311,10 +311,11 @@
 ;; nonetheless, opportunities for sharing abound.
 (defconstant +vector-shareable-nonstd+ #x200)
 
-;;; This is so that COMPILE-FILE knows that things like :ALLOW-OTHER-KEYS
-;;; can be immediate constants.
+;;; This header bit is set for symbols which were present in the pristine core.
+;;; The backend may emit different code when referencing such symbols.
+;;; For x86-64, symbols with this bit set may be assumed to have been
+;;; allocated in immobile space.
 ;;; Note also that sb-fasteval uses 2 bits of the symbol header.
-#+(and immobile-space (not immobile-symbols))
 (defconstant +initial-core-symbol-bit+ 8) ; bit index, not bit value
 
 #+immobile-space

tests/test-funs.lisp

@@ -37,7 +37,8 @@
         (start-time (get-internal-real-time)))
     (declare (special test-util::*deferred-test-forms*))
     (makunbound 'test-util::*deferred-test-forms*)
-    (load file :external-format :utf-8)
+    (let ((*features* (append *features* sb-impl:+internal-features+)))
+      (load file :external-format :utf-8))
     (when (boundp 'test-util::*deferred-test-forms*)
       ;; Execute all tests that were wrapped in WITH-TEST
       (let ((holder test-util::*deferred-test-forms*))
@@ -64,7 +65,8 @@
   (let ((test-util:*elapsed-times*)
         (start-time (get-internal-real-time)))
     (with-scratch-file (fasl "fasl")
-      (compile-file file :print nil :output-file fasl)
+      (let ((*features* (append *features* sb-impl:+internal-features+)))
+        (compile-file file :print nil :output-file fasl))
       (test-util::record-test-elapsed-time "(compile-file)" start-time)
       (load fasl)
       ;; TODO: as above, execute queued tests if within-file concurrency was enabled.