Remove more strange idioms for symbol pruning

[Continuing with theme from change bbaae542da]

Of the tricks employed to prevent compile-time-only junk from remaining in
the pristine core, the (EVAL-WHEN (:COMPILE-TOPLEVEL) (SB!XC:DEFMACRO ...))
pattern is particularly unnecessary in as much as it presents an obstacle
to understanding. The tree-shaker will remove unused macros more cleanly.
Moreover, seeing symbols not get dropped as expected by the tree-shaker
shows where we had created a dangling reference to a deleted macro.
(See comment at end of src/code/bignum for example)

Also note that many macros don't need the leading #\! any more,
which eliminates yet another bit of weirdness.

make-target-2.sh

@@ -64,7 +64,16 @@ echo //checking for leftover cold-init symbols
                       (search "!" (string obj)))
              (push obj l)))
          :all)
-        (format t "Found ~D:~%~S~%" (length l) l))
+        (format t "Found ~D:~%~S~%" (length l) l)
+        (sb-int:awhen
+          (mapcan (quote apropos-list)
+           (quote ("DEFINE-INFO-TYPE" "LVAR-TYPE-USING"
+                   "COPY-LIST-MACRO" "TWO-ARG-+/-"
+                   "SUBTRACT-BIGNUM-LOOP" "BIGNUM-REPLACE" "WITH-BIGNUM-BUFFERS"
+                   "GCD-ASSERT" "MODULARLY" "BIGNUM-NEGATE-LOOP"
+                   "SHIFT-RIGHT-UNALIGNED"
+                   "STRING-LESS-GREATER-EQUAL-TESTS")))
+         (format t "~&Leftover from [disabled?] tree-shaker:~%~S~%" sb-int:it)))
     (abort ()
       :report "Abort building SBCL."
       (sb-ext:exit :code 1)))' --quit

src/code/bignum.lisp

@@ -325,12 +325,10 @@
 
 ;;;; subtraction
 
-(eval-when (:compile-toplevel :execute)
-
 ;;; This subtracts b from a plugging result into res. Return-fun is the
 ;;; function to call that fixes up the result returning any useful values, such
 ;;; as the result. This macro may evaluate its arguments more than once.
-(sb!xc:defmacro subtract-bignum-loop (a len-a b len-b res len-res return-fun)
+(defmacro subtract-bignum-loop (a len-a b len-b res len-res return-fun)
   (with-unique-names (borrow a-digit a-sign b-digit b-sign i v k)
     `(let* ((,borrow 1)
             (,a-sign (%sign-digit ,a ,len-a))
@@ -347,8 +345,6 @@
              (setf ,borrow ,k))))
        (,return-fun ,res ,len-res))))
 
-) ;EVAL-WHEN
-
 (defun subtract-bignum (a b)
   (declare (type bignum a b))
   (let* ((len-a (%bignum-length a))
@@ -455,10 +451,7 @@
 
 ;;;; BIGNUM-REPLACE and WITH-BIGNUM-BUFFERS
 
-(eval-when (:compile-toplevel :execute)
-
-(sb!xc:defmacro bignum-replace (dest
-                                src
+(defmacro bignum-replace (dest src
                                 &key
                                 (start1 '0)
                                 end1
@@ -492,7 +485,7 @@
                     (declare (type bignum-index ,i1 ,i2))
                     (%bignum-set ,n-dest ,i1 (%bignum-ref ,n-src ,i2))))))))))
 
-(sb!xc:defmacro with-bignum-buffers (specs &body body)
+(defmacro with-bignum-buffers (specs &body body)
   "WITH-BIGNUM-BUFFERS ({(var size [init])}*) Form*"
   (collect ((binds) (inits))
     (dolist (spec specs)
@@ -505,20 +498,17 @@
     `(let* ,(binds)
        ,@(inits)
        ,@body)))
-
-) ;EVAL-WHEN
 
 ;;;; GCD
 
-(eval-when (:compile-toplevel :load-toplevel :execute)
   ;; The asserts in the GCD implementation are way too expensive to
   ;; check in normal use, and are disabled here.
-  (sb!xc:defmacro gcd-assert (&rest args)
-    (declare (ignore args))
-    #+sb-bignum-assertions `(assert ,@args))
+(defmacro gcd-assert (&rest args)
+  (declare (ignore args))
+  #+sb-bignum-assertions `(assert ,@args))
   ;; We'll be doing a lot of modular arithmetic.
-  (sb!xc:defmacro modularly (form)
-    `(logand all-ones-digit ,form)))
+(defmacro modularly (form)
+  `(logand all-ones-digit ,form))
 
 ;;; I'm not sure why I need this FTYPE declaration.  Compiled by the
 ;;; target compiler, it can deduce the return type fine, but without
@@ -881,11 +871,9 @@
 
 ;;;; negation
 
-(eval-when (:compile-toplevel :execute)
-
 ;;; This negates bignum-len digits of bignum, storing the resulting digits into
 ;;; result (possibly EQ to bignum) and returning whatever end-carry there is.
-(sb!xc:defmacro bignum-negate-loop
+(defmacro bignum-negate-loop
     (bignum bignum-len &optional (result nil resultp))
   (with-unique-names (carry end value last)
     `(let* (,@(if (not resultp) `(,last))
@@ -912,8 +900,6 @@
          (incf i))
        ,(if resultp carry `(values ,carry ,last)))))
 
-) ; EVAL-WHEN
-
 ;;; Fully-normalize is an internal optional. It cause this to always return
 ;;; a bignum, without any extraneous digits, and it never returns a fixnum.
 (defun negate-bignum (x &optional (fully-normalize t))
@@ -946,8 +932,6 @@
 
 ;;;; shifting
 
-(eval-when (:compile-toplevel :execute)
-
 ;;; This macro is used by BIGNUM-ASHIFT-RIGHT, BIGNUM-BUFFER-ASHIFT-RIGHT, and
 ;;; BIGNUM-LDB-BIGNUM-RES. They supply a termination form that references
 ;;; locals established by this form. Source is the source bignum. Start-digit
@@ -960,7 +944,7 @@
 ;;; Given start-pos, 1-31 inclusively, of shift, we form the j'th resulting
 ;;; digit from high bits of the i'th source digit and the start-pos number of
 ;;; bits from the i+1'th source digit.
-(sb!xc:defmacro shift-right-unaligned (source
+(defmacro shift-right-unaligned (source
                                        start-digit
                                        start-pos
                                        res-len-form
@@ -981,8 +965,6 @@
                       (%ashl (%bignum-ref ,source (1+ i))
                              high-bits-in-first-digit))))))
 
-) ; EVAL-WHEN
-
 ;;; First compute the number of whole digits to shift, shifting them by
 ;;; skipping them when we start to pick up bits, and the number of bits to
 ;;; shift the remaining digits into place. If the number of digits is greater
@@ -1979,3 +1961,12 @@
                       (logxor xi
                               (ash xi -7))))))
     result))
+
+;;; NEGATE-BIGNUM-BUFFER-IN-PLACE has an inline expansion that is not expected
+;;; to be used post-build. It references the BIGNUM-NEGATE-LOOP macro,
+;;; which had been deliberately excluded from the target due to a surrounding
+;;; (EVAL-WHEN (:COMPILE-TOPLEVEL :EXECUTE) ...) form.
+(let ((s 'negate-bignum-buffer-in-place))
+  (clear-info :function :inlining-data s)
+  (clear-info :function :inlinep s)
+  (clear-info :source-location :declaration s))

src/code/cold-init.lisp

@@ -40,14 +40,13 @@
 ;;; a SIMPLE-VECTOR set by GENESIS
 (defvar *!load-time-values*)
 
-(eval-when (:compile-toplevel :execute)
   ;; FIXME: Perhaps we should make SHOW-AND-CALL-AND-FMAKUNBOUND, too,
   ;; and use it for most of the cold-init functions. (Just be careful
   ;; not to use it for the COLD-INIT-OR-REINIT functions.)
-  (sb!xc:defmacro show-and-call (name)
+(defmacro show-and-call (name)
     `(progn
        (/primitive-print ,(symbol-name name))
-       (,name))))
+       (,name)))
 
 (defun !encapsulate-stuff-for-cold-init (&aux names)
   (flet ((encapsulate-1 (name handler)

src/code/list.lisp

@@ -424,8 +424,7 @@
 
 ;;;; list copying functions
 
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (sb!xc:defmacro !copy-list-macro (list &key check-proper-list)
+(defmacro copy-list-macro (list &key check-proper-list)
     ;; Unless CHECK-PROPER-LIST is true, the list is copied correctly
     ;; even if the list is not terminated by NIL. The new list is built
     ;; by CDR'ing SPLICE which is always at the tail of the new list.
@@ -438,11 +437,11 @@
                     '((atom orig)
                       (unless (null orig)
                         (rplacd splice orig))))
-              copy))))))
+              copy)))))
 
 (defun copy-list (list)
   "Return a new list which is EQUAL to LIST. LIST may be improper."
-  (!copy-list-macro list))
+  (copy-list-macro list))
 
 (defun copy-alist (alist)
   "Return a new association list which is EQUAL to ALIST."

src/code/numbers.lisp

@@ -395,9 +395,7 @@
   (declare (explicit-check))
   (1- number))
 
-(eval-when (:compile-toplevel)
-
-(sb!xc:defmacro two-arg-+/- (name op big-op)
+(defmacro two-arg-+/- (name op big-op)
   `(defun ,name (x y)
      (number-dispatch ((x number) (y number))
        (bignum-cross-fixnum ,op ,big-op)
@@ -439,8 +437,6 @@
                                 (nd (if (eql t2 1) t3 (* t2 t3))))
                            (if (eql nd 1) nn (%make-ratio nn nd))))))))))))
 
-) ; EVAL-WHEN
-
 (two-arg-+/- two-arg-+ + add-bignums)
 (two-arg-+/- two-arg-- - subtract-bignum)
 

src/code/seq.lisp

@@ -552,7 +552,7 @@
     (the extended-sequence (values (sb!sequence:copy-seq sequence)))))
 
 (defun list-copy-seq* (sequence)
-  (!copy-list-macro sequence :check-proper-list t))
+  (copy-list-macro sequence :check-proper-list t))
 
 ;;;; FILL
 

src/code/string.lisp

@@ -9,8 +9,7 @@
 
 (in-package "SB!IMPL")
 
-(eval-when (:compile-toplevel)
-  (sb!xc:defmacro %string (x) `(if (stringp ,x) ,x (string ,x))))
+(defmacro %string (x) `(if (stringp ,x) ,x (string ,x)))
 
 (defun string (x)
   "Coerces X into a string. If X is a string, X is returned. If X is a
@@ -35,11 +34,10 @@
 (defun %check-vector-sequence-bounds (vector start end)
   (%check-vector-sequence-bounds vector start end))
 
-(eval-when (:compile-toplevel)
 ;;; WITH-ONE-STRING is used to set up some string hacking things. The
 ;;; keywords are parsed, and the string is hacked into a
 ;;; simple-string.
-(sb!xc:defmacro with-one-string ((string start end) &body forms)
+(defmacro with-one-string ((string start end) &body forms)
   `(let ((,string (%string ,string)))
      (with-array-data ((,string ,string)
                        (,start ,start)
@@ -48,8 +46,8 @@
        ,@forms)))
 ;;; WITH-TWO-STRINGS is used to set up string comparison operations. The
 ;;; keywords are parsed, and the strings are hacked into SIMPLE-STRINGs.
-(sb!xc:defmacro with-two-strings (string1 string2 start1 end1 cum-offset-1
-                                  start2 end2 &rest forms)
+(defmacro with-two-strings (string1 string2 start1 end1 cum-offset-1
+                            start2 end2 &rest forms)
   `(let ((,string1 (%string ,string1))
          (,string2 (%string ,string2)))
      (with-array-data ((,string1 ,string1 :offset-var ,cum-offset-1)
@@ -62,7 +60,7 @@
                          :check-fill-pointer t)
          ,@forms))))
 
-(sb!xc:defmacro with-two-arg-strings (string1 string2 start1 end1 cum-offset-1
+(defmacro with-two-arg-strings (string1 string2 start1 end1 cum-offset-1
                                       start2 end2 &rest forms)
   `(let ((,string1 (%string ,string1))
          (,string2 (%string ,string2)))
@@ -76,8 +74,6 @@
                          :check-fill-pointer t)
          ,@forms))))
 
-) ; EVAL-WHEN
-
 (defun char (string index)
   "Given a string and a non-negative integer index less than the length of
   the string, returns the character object representing the character at
@@ -187,11 +183,9 @@
                                           string2 start2 end2)))
       (if comparison (- (the fixnum comparison) offset1)))))
 
-(eval-when (:compile-toplevel :execute)
-
 ;;; LESSP is true if the desired expansion is for STRING<* or STRING<=*.
 ;;; EQUALP is true if the desired expansion is for STRING<=* or STRING>=*.
-(sb!xc:defmacro string<>=*-body (lessp equalp)
+(defmacro string<>=*-body (lessp equalp)
   (let ((offset1 (gensym)))
     `(with-two-strings string1 string2 start1 end1 ,offset1 start2 end2
        (let ((index (%sp-string-compare string1 start1 end1
@@ -212,7 +206,6 @@
                     (- (the fixnum index) ,offset1))
                    (t nil))
              ,(if equalp `(- (the fixnum end1) ,offset1) nil))))))
-) ; EVAL-WHEN
 
 (defun string<* (string1 string2 start1 end1 start2 end2)
   (declare (fixnum start1 start2))
@@ -292,12 +285,9 @@
 (defun two-arg-string/= (string1 string2)
   (string/=* string1 string2 0 nil 0 nil))
 
-(eval-when (:compile-toplevel :execute)
-
 ;;; STRING-NOT-EQUAL-LOOP is used to generate character comparison loops for
 ;;; STRING-EQUAL and STRING-NOT-EQUAL.
-(sb!xc:defmacro string-not-equal-loop (end
-                                       end-value
+(defmacro string-not-equal-loop (end end-value
                                        &optional (abort-value nil abortp))
   (declare (fixnum end))
   (let ((end-test (if (= end 1)
@@ -319,8 +309,6 @@
                         (schar string2 index2)))
                   (return ,abort-value)))))))
 
-) ; EVAL-WHEN
-
 (defun string-equal (string1 string2 &key (start1 0) end1 (start2 0) end2)
   "Given two strings (string1 and string2), and optional integers start1,
   start2, end1 and end2, compares characters in string1 to characters in
@@ -369,7 +357,7 @@
             (t
              (string-not-equal-loop 2 (- index1 offset1)))))))
 
-(eval-when (:compile-toplevel :execute)
+(eval-when (:compile-toplevel :load-toplevel :execute)
 
 ;;; STRING-LESS-GREATER-EQUAL-TESTS returns a test on the lengths of string1
 ;;; and string2 and a test on the current characters from string1 and string2
@@ -386,8 +374,9 @@
           (values '>= `(not (char-lessp char1 char2)))
           ;; STRING-GREATERP
           (values '> `(char-greaterp char1 char2)))))
+) ; EVAL-WHEN
 
-(sb!xc:defmacro string-less-greater-equal (lessp equalp)
+(defmacro string-less-greater-equal (lessp equalp)
   (multiple-value-bind (length-test character-test)
       (string-less-greater-equal-tests lessp equalp)
     `(with-two-strings string1 string2 start1 end1 offset1 start2 end2
@@ -408,8 +397,6 @@
                    (return (- index1 offset1))
                    (return ()))))))))
 
-) ; EVAL-WHEN
-
 (defun string-lessp* (string1 string2 start1 end1 start2 end2)
   (declare (fixnum start1 start2))
   (string-less-greater-equal t nil))

src/compiler/globaldb.lisp

@@ -124,15 +124,10 @@
 ;;;  :DEFAULT (CONSTANTLY #'<a-function-name>) to adhere to the convention
 ;;; that default objects satisfying FUNCTIONP will always be funcalled.
 ;;;
-(eval-when (:compile-toplevel :execute)
-;; This convoluted idiom creates a macro that disappears from the target,
-;; kind of an alternative to the "!" name convention.
-(#+sb-xc-host defmacro
- #-sb-xc-host sb!xc:defmacro
-    define-info-type ((category kind)
-                       &key (type-spec (missing-arg))
-                            (validate-function)
-                            default)
+(defmacro define-info-type ((category kind)
+                            &key (type-spec (missing-arg))
+                                 (validate-function)
+                                 default)
   (declare (type keyword category kind))
   ;; There was formerly a remark that (COPY-TREE TYPE-SPEC) ensures repeatable
   ;; fasls. That's not true now, probably never was. A compiler is permitted to
@@ -146,7 +141,9 @@
            ;; Rationale for hardcoding here is explained at INFO-VECTOR-FDEFN.
            ,(or (and (eq category :function) (eq kind :definition)
                      +fdefn-info-num+)
-                #+sb-xc (meta-info-number (meta-info category kind))))))
+                #+sb-xc (meta-info-number (meta-info category kind)))))
+;; It's an external symbol of SB-INT so wouldn't be removed automatically
+(push '("SB-INT" define-info-type) sb!impl::*!removable-symbols*)
 
 
 (macrolet ((meta-info-or-lose (category kind)

src/compiler/ir1opt.lisp

@@ -62,10 +62,7 @@
 ;;; The result value is cached in the LVAR-%DERIVED-TYPE slot. If the
 ;;; slot is true, just return that value, otherwise recompute and
 ;;; stash the value there.
-(eval-when (:compile-toplevel :execute)
-  (#+sb-xc-host cl:defmacro
-   #-sb-xc-host sb!xc:defmacro
-        lvar-type-using (lvar accessor)
+(defmacro lvar-type-using (lvar accessor)
      `(let ((uses (lvar-uses ,lvar)))
         (cond ((null uses) *empty-type*)
               ((listp uses)
@@ -76,7 +73,7 @@
                    ((or (null current) (eq res *wild-type*))
                     res)))
               (t
-               (,accessor uses))))))
+               (,accessor uses)))))
 
 (defun %lvar-derived-type (lvar)
   (lvar-type-using lvar node-derived-type))