From 73b2555c2deb580cd59b441ba159be1255e73da6 Mon Sep 17 00:00:00 2001 From: Stas Boukarev Date: Sun, 19 May 2024 01:54:45 +0300 Subject: Clear *backend-parsed-vops* Which is used for VOP inheritance, which is not needed in the target. Saves about 600KB --- contrib/sb-introspect/introspect.lisp | 6 ++++-- contrib/sb-introspect/test-driver.lisp | 1 + make-target-2-load.lisp | 30 ++++++++++++++++++------------ src/compiler/arm64/insts.lisp | 6 +++--- tests/arith-2.pure.lisp | 4 ++-- tests/parallel-exec.lisp | 2 +- 6 files changed, 29 insertions(+), 20 deletions(-) diff --git a/contrib/sb-introspect/introspect.lisp b/contrib/sb-introspect/introspect.lisp index 22c027212..58241f3fd 100644 --- a/contrib/sb-introspect/introspect.lisp +++ b/contrib/sb-introspect/introspect.lisp @@ -181,8 +181,10 @@ constant pool." vop (gethash (sb-c::vop-info-name vop) sb-c::*backend-parsed-vops*)) - for name = (sb-c::vop-parse-name vop-parse) - for loc = (sb-c::vop-parse-source-location vop-parse) + for name = (and vop-parse + (sb-c::vop-parse-name vop-parse)) + for loc = (and vop-parse + (sb-c::vop-parse-source-location vop-parse)) when loc collect (let ((source (translate-source-location loc))) (setf (definition-source-description source) diff --git a/contrib/sb-introspect/test-driver.lisp b/contrib/sb-introspect/test-driver.lisp index 2da020a8f..e488b23c7 100644 --- a/contrib/sb-introspect/test-driver.lisp +++ b/contrib/sb-introspect/test-driver.lisp @@ -71,6 +71,7 @@ t) (test-util:with-test (:name definition-source.1 :skipped-on :no-source-locs) + #+sb-devel (assert (consp (find-definition-sources-by-name 'vectorp :vop))) (assert (consp (find-definition-sources-by-name 'check-type :macro)))) diff --git a/make-target-2-load.lisp b/make-target-2-load.lisp index b367f472d..2ea2f7522 100644 --- a/make-target-2-load.lisp +++ b/make-target-2-load.lisp @@ -191,24 +191,27 @@ ;; with non-cold-init lambdas. Though the cold-init function is ;; never called post-build, it is not discarded. Also, I suspect ;; that the following loop should print nothing, but it does: -#| - (sb-vm:map-allocated-objects - (lambda (obj type size) - (declare (ignore size)) - (when (= type sb-vm:code-header-widetag) - (let ((name (sb-c::debug-info-name - (sb-kernel:%code-debug-info obj)))) - (when (and (stringp name) (search "COLD-INIT-FORMS" name)) - (print obj))))) - :dynamic) -|# + #| + (sb-vm:map-allocated-objects ; + (lambda (obj type size) ; + (declare (ignore size)) ; + (when (= type sb-vm:code-header-widetag) ; + (let ((name (sb-c::debug-info-name ; + (sb-kernel:%code-debug-info obj)))) ; + (when (and (stringp name) (search "COLD-INIT-FORMS" name)) ; + (print obj))))) ; + :dynamic) ; + |# (fmakunbound symbol) (unintern symbol package)))))) (sb-int:dohash ((k v) sb-c::*backend-parsed-vops*) (declare (ignore k)) (setf (sb-c::vop-parse-body v) nil)) + ;; Used for inheriting from other VOPs, not needed in the target. + (setf sb-c::*backend-parsed-vops* (make-hash-table)) result) + ;;; Check for potentially bad format-control strings (defun scan-format-control-strings () (labels ((possibly-ungood-package-reference (string) @@ -449,13 +452,16 @@ Please check that all strings which were not recognizable to the compiler (#.(find-package "SB-VM") (or (eq accessibility :external) ;; overapproximate what we need for contribs and tests - (member symbol '(sb-vm::map-referencing-objects + (member symbol `(sb-vm::map-referencing-objects sb-vm::map-stack-references sb-vm::reconstitute-object sb-vm::points-to-arena ;; need this for defining a vop which ;; tests the x86-64 allocation profiler sb-vm::pseudo-atomic + ,@(or #+(or x86 x86-64) '(sb-vm::%vector-cas-pair + sb-vm::%instance-cas-pair + sb-vm::%cons-cas-pair)) ;; Naughty outside-world code uses these. #+x86-64 sb-vm::reg-in-size)) (let ((s (string symbol))) (and (search "THREAD-" s) (search "-SLOT" s))) diff --git a/src/compiler/arm64/insts.lisp b/src/compiler/arm64/insts.lisp index b395fce08..f7dde9c55 100644 --- a/src/compiler/arm64/insts.lisp +++ b/src/compiler/arm64/insts.lisp @@ -3562,9 +3562,9 @@ (or (memq (vop-name vop) safe-vops) (and vop - (memq (car (sb-c::vop-parse-translate - (sb-c::vop-parse-or-lose (vop-name vop)))) - safe-translates)) + (loop for fun in safe-translates + thereis (memq (sb-c::vop-info vop) + (sb-c::fun-info-templates (sb-c::fun-info-or-lose fun))))) (and (not safe-vops) (not safe-translates)))))))) diff --git a/tests/arith-2.pure.lisp b/tests/arith-2.pure.lisp index 2a631b1d7..2db55e51c 100644 --- a/tests/arith-2.pure.lisp +++ b/tests/arith-2.pure.lisp @@ -202,10 +202,10 @@ (let ((res (sb-bignum:%allocate-bignum 2))) (setf (sb-bignum:%bignum-ref res 1) 529 (sb-bignum:%bignum-ref res 0) 9223372036854775807) - (sb-bignum:%bignum-set-length res 1) + (sb-kernel:set-header-data res 1) (unwind-protect (< res d) - (sb-bignum:%bignum-set-length res 2))))) + (sb-kernel:set-header-data res 2))))) ((-9.223372036854776d18) nil) ((9.223372036854776d18) t))) diff --git a/tests/parallel-exec.lisp b/tests/parallel-exec.lisp index 79d87f50f..7e3f20598 100644 --- a/tests/parallel-exec.lisp +++ b/tests/parallel-exec.lisp @@ -138,7 +138,7 @@ (loop (let ((line (read-line f nil))) (unless line (return)) (let ((count (read-from-string line)) - (name (read-from-string line t nil :start 8))) + (name (subseq line 8))) (incf (gethash name aggregate-vop-usage 0) count)))) (when deletep (delete-file f)))))) (dolist (file files) -- cgit v1.2.3-70-g09d2