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

Do more bootstrap symbol shake-out

Browse source
This commit is contained in:
Douglas Katzman 2022-10-01 02:07:58 -04:00
parent 52c9a79107
commit 9255dbbc30
2 changed files with 20 additions and 13 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -159,7 +159,7 @@
nil)
;; Todo: perform one pass, then a full GC, then a final pass to confirm
;; it worked. It should be an error if any uninternable symbols remain,
;; but at present there are about 9 symbols with referrers.
;; but at present there are about 7 symbols with referrers.
(with-package-iterator (iter (list-all-packages) :internal :external)
(loop (multiple-value-bind (winp symbol accessibility package) (iter)
(declare (ignore accessibility))

31
src/code/early-raw-slots.lisp
View file

@ -96,20 +96,14 @@
;; By making this a cold-init function, it is possible to use raw slots
;; in cold toplevel forms.
(defun !raw-slot-data-init ()
(macrolet ((make-raw-slot-data (&rest args &key accessor-name &allow-other-keys)
(declare (ignorable accessor-name))
#+sb-xc-host
`(!make-raw-slot-data ,@args)
#-sb-xc-host
(let ((access (cadr accessor-name)))
(macrolet ((make-raw-slot-data (&rest args)
#+sb-xc-host `(!make-raw-slot-data ,@args)
#-sb-xc-host ; unwrap the QUOTE from the args (this is a macro)
(let ((access (cadr (getf args :accessor-name)))
(type (cadr (getf args :raw-type))))
`(!make-raw-slot-data
:accessor-fun #',access
:comparator
;; Not a symbol, because there aren't any so-named functions.
(named-lambda ,(string (symbolicate access "="))
(index x y)
(declare (optimize speed (safety 0)))
(= (,access x index) (,access y index)))
:comparator #',(symbolicate "RAW-" type "SLOT=")
;; Ignore the :ACCESSOR-NAME initarg
,@args :allow-other-keys t))))
(let ((double-float-alignment
@ -163,6 +157,19 @@
:n-words #+x86 6 #+sparc 8))))))
#+sb-xc-host (!raw-slot-data-init)
#-sb-xc-host
(macrolet ((define-rs= ()
;; Expand by using the host's vector of RSD instances
`(progn
,@(loop for rsd across *raw-slot-data*
collect
(let ((type (raw-slot-data-raw-type rsd))
(reader (raw-slot-data-accessor-name rsd)))
`(defun ,(symbolicate "RAW-" type "SLOT=") (index x y)
(declare (optimize speed (safety 0)))
(= (,reader x index) (,reader y index))))))))
(define-rs=))
#+sb-xc
(declaim (type (simple-vector #.(length *raw-slot-data*)) *raw-slot-data*))