common-lisp/sbcl.sbcl
1
0
Fork 0
mirror of git://git.code.sf.net/p/sbcl/sbcl synced 2026-09-10 07:26:40 -04:00
Code Issues Actions 8 Packages Projects Releases Wiki Activity

Clear *backend-parsed-vops*

Browse source 
Which is used for VOP inheritance, which is not needed in the target.
Saves about 600KB
This commit is contained in:
Stas Boukarev 2024-05-19 01:54:45 +03:00
parent 1eaa6d4f8e
commit 73b2555c2d
6 changed files with 29 additions and 20 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
contrib/sb-introspect/introspect.lisp
View file

@ -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)

1
contrib/sb-introspect/test-driver.lisp
View file

@ -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))))

30
make-target-2-load.lisp
View file

@ -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)))

6
src/compiler/arm64/insts.lisp
View file

@ -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))))))))

4
tests/arith-2.pure.lisp
View file

@ -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)))

2
tests/parallel-exec.lisp
View file

@ -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)