Re: master: Remove the :no-constructor-defun defstruct option
Stas Boukarev <[email protected]>
| Newsgroups | gmane.lisp.steel-bank.cvs,gmane.lisp.steel-bank.devel |
|---|---|
| Message-ID | <CAF63=11rNjCtoDhFmZ16gpBOgo9aaswMJBNY+8rbJ0-3kSD6qA@mail.gmail.com> |
I get
#<weak pointer: SB-IMPL::!ALLOCATE-PATHNAME> is not a string designator.
0: (STRING #<weak pointer: SB-IMPL::!ALLOCATE-PATHNAME>)
1: ((LAMBDA (SB-IMPL::X) :IN SB-IMPL::SHAKE-PACKAGES) (#<weak pointer:
SB-IMPL::!ALLOCATE-PATHNAME> "!ALLOCATE-PATHNAME" 0 (SB-KERNEL::HOST
SB-IMPL::DEVICE SB-IMPL::DIR+HASH SB-IMPL::NAME TYPE
SB-IMPL::VERSION)))
2: ((FLET SB-IMPL::VISIT-CTORS :IN SB-IMPL::SHAKE-PACKAGES) #<FUNCTION
(LAMBDA (SB-IMPL::X) :IN SB-IMPL::SHAKE-PACKAGES) {B800DDECEB}>)
3: (SB-IMPL::SHAKE-PACKAGES #<FUNCTION (LAMBDA (SYMBOL ACCESSIBILITY)
:IN "SYS:make-target-2-load.lisp") {12050B022B}> :PRINT NIL :VERBOSE
NIL :QUERY NIL)
And does that inline every constructor now?
And what about the assessors?
On Sun, Dec 28, 2025 at 7:36 PM snuglas via Sbcl-commits
<[email protected]> wrote:
>
> The branch "master" has been updated in SBCL:
> via d23d8006bae9470fa95b61f29c37796305c4fbb5 (commit)
> from ff428d11cd64eb000fe0e034966b4dd811c43bda (commit)
>
> - Log -----------------------------------------------------------------
> commit d23d8006bae9470fa95b61f29c37796305c4fbb5
> Author: Douglas Katzman <[email protected]>
> Date: Sun Dec 28 11:34:57 2025 -0500
>
> Remove the :no-constructor-defun defstruct option
>
> Weaken function names in defstruct-descriptions before tree-shaking
> and restore them after. This deletes more constructors than the option.
> ---
> make-target-2-load.lisp | 18 ++++++------------
> src/code/defstruct.lisp | 6 ++----
> src/code/shaketree.lisp | 17 ++++++++++++++++-
> src/compiler/disassem.lisp | 3 +--
> src/compiler/early-c.lisp | 6 ++----
> src/compiler/knownfun.lisp | 3 +--
> src/compiler/node.lisp | 27 +++++++++------------------
> src/compiler/target-dstate.lisp | 6 ++----
> xperfecthash63.lisp-expr | 9 +++++++++
> 9 files changed, 48 insertions(+), 47 deletions(-)
>
> diff --git a/make-target-2-load.lisp b/make-target-2-load.lisp
> index 7c662fb3a..08e6ea269 100644
> --- a/make-target-2-load.lisp
> +++ b/make-target-2-load.lisp
> @@ -142,20 +142,13 @@
> ;; So loop over all structure classoids and clobber any
> ;; symbol that should be uninternable.
> (maphash (lambda (classoid layout)
> - (when (structure-classoid-p classoid)
> - (let ((dd (layout-%info layout)))
> - (setf (dd-constructors dd)
> - (delete-if (lambda (x)
> - (and (consp x) (uninternable-p (car x))))
> - (dd-constructors dd))))))
> + (declare (ignore classoid))
> + (binding* ((dd (layout-info layout) :exit-if-null))
> + (setf (dd-constructors dd)
> + (delete-if (lambda (x) (and (consp x) (uninternable-p (car x))))
> + (dd-constructors dd)))))
> (classoid-subclasses (find-classoid t)))
>
> - (loop for type in '(pathname ;; PATHNAME is not a structure-classoid
> - sb-c:storage-class
> - sb-c:storage-base)
> - do
> - (setf (sb-kernel:dd-constructors (sb-kernel:find-defstruct-description type))
> - 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 7 symbols with referrers.
> @@ -416,6 +409,7 @@ Please check that all strings which were not recognizable to the compiler
> (dolist (sym list ht) (setf (gethash sym ht) t)))
> '(sb-alien::alien-callback-p sb-alien::alien-lambda ; the API uses internals, really?
> sb-c::tab sb-c::scramble ; for perfecthash
> + sb-c::make-transform ; cl-protobufs uses this
> sb-impl::%default-comma-constructor
> sb-kernel::%%make-random-state
> sb-lockless::+hash-nbits+ sb-lockless::%make-so-set-node ; for tests
> diff --git a/src/code/defstruct.lisp b/src/code/defstruct.lisp
> index 387157ca4..71889dce5 100644
> --- a/src/code/defstruct.lisp
> +++ b/src/code/defstruct.lisp
> @@ -365,13 +365,12 @@
> (*dsd-source-form* nil)
> ((inherits comparators) (parse-defstruct dd options slot-descriptions))
> (constructor-definitions
> - (unless (find :no-constructor-defun options)
> (mapcar (lambda (ctor)
> `(sb-c:xdefun ,(car ctor)
> :constructor
> nil
> ,@(structure-ctor-lambda-parts dd (cdr ctor))))
> - (dd-constructors dd))))
> + (dd-constructors dd)))
> (print-method
> (when (dd-print-option dd)
> (let* ((x (make-symbol "OBJECT"))
> @@ -729,7 +728,6 @@ requires exactly~;accepts at most~] one argument" keyword syntax-group)
> (:pure
> (setf (dd-flags dd) (logior (logandc2 (dd-flags dd) +dd-pure+)
> (if arg +dd-pure+ 0))))
> - (:no-constructor-defun)
> (t
> (error "unknown DEFSTRUCT option:~% ~S" option)))
> seen-options))
> @@ -747,7 +745,7 @@ requires exactly~;accepts at most~] one argument" keyword syntax-group)
> (parse-1-dd-option
> (cond ((consp option) option)
> ((member option
> - '(:conc-name :constructor :copier :predicate :no-constructor-defun))
> + '(:conc-name :constructor :copier :predicate))
> (list option))
> (t
> ;; FIXME: ugly message (defstruct (s :include) a)
> diff --git a/src/code/shaketree.lisp b/src/code/shaketree.lisp
> index cdee5ad3e..c117fb9a9 100644
> --- a/src/code/shaketree.lisp
> +++ b/src/code/shaketree.lisp
> @@ -25,7 +25,22 @@
> (weaken (package-external-symbols package) :external)
> package)
> list))))
> - (gc :gen 7)
> +
> + (flet ((visit-ctors (xform)
> + (maphash (lambda (classoid layout)
> + (declare (ignore classoid))
> + (binding* ((dd (layout-info layout) :exit-if-null))
> + (setf (dd-constructors dd) (mapcan xform (dd-constructors dd)))))
> + (classoid-subclasses (find-classoid t)))))
> + ;; Weaken references from a defstruct-descriptions to its constructors.
> + ;; No global def needed if every call site was inlined
> + (visit-ctors (lambda (x) `((,(make-weak-pointer (car x)) ,(string (car x)) . ,(cdr x)))))
> + (gc :gen 7)
> + ;; Unweaken dd constructor references ASAP because the compiler is in a fragile state.
> + ;; If FUN-NAME-INLINE-EXPANSION were to be called, it might fail an AVER.
> + (visit-ctors (lambda (x &aux (wpv (weak-pointer-value (car x))))
> + (if wpv `((,wpv . ,(cddr x)))))))
> +
> (when query
> (sb-ext:search-roots query :criterion :static))
> (let ((n-dropped 0))
> diff --git a/src/compiler/disassem.lisp b/src/compiler/disassem.lisp
> index 0950148f0..28337d548 100644
> --- a/src/compiler/disassem.lisp
> +++ b/src/compiler/disassem.lisp
> @@ -167,8 +167,7 @@
> (defstruct (instruction-format (:conc-name format-)
> (:constructor make-inst-format
> (name length default-printer args))
> - (:copier nil)
> - #-sb-xc-host :no-constructor-defun)
> + (:copier nil))
> (name nil :read-only t)
> (args nil :type list :read-only t)
>
> diff --git a/src/compiler/early-c.lisp b/src/compiler/early-c.lisp
> index 90545a2fa..897da3b44 100644
> --- a/src/compiler/early-c.lisp
> +++ b/src/compiler/early-c.lisp
> @@ -40,14 +40,12 @@
>
> (defstruct (dxable-args (:constructor make-dxable-args (list))
> (:predicate nil)
> - (:copier nil)
> - #-sb-xc-host :no-constructor-defun)
> + (:copier nil))
> (list nil :read-only t))
> (defstruct (inlining-data (:include dxable-args)
> (:constructor make-inlining-data (expansion list))
> (:predicate nil)
> - (:copier nil)
> - #-sb-xc-host :no-constructor-defun)
> + (:copier nil))
> (expansion nil :read-only t))
> (declaim (freeze-type dxable-args))
>
> diff --git a/src/compiler/knownfun.lisp b/src/compiler/knownfun.lisp
> index 9ecd50a84..ce45a6c4c 100644
> --- a/src/compiler/knownfun.lisp
> +++ b/src/compiler/knownfun.lisp
> @@ -20,8 +20,7 @@
>
> ;;; an IR1 transform
> (defstruct (transform (:copier nil)
> - (:predicate nil)
> - #-sb-xc-host :no-constructor-defun)
> + (:predicate nil))
> ;; the function type which enables this transform.
> ;;
> ;; (Note that declaring this :TYPE FUN-TYPE probably wouldn't
> diff --git a/src/compiler/node.lisp b/src/compiler/node.lisp
> index ff59468d0..3f9985f11 100644
> --- a/src/compiler/node.lisp
> +++ b/src/compiler/node.lisp
> @@ -556,8 +556,7 @@
> (:constructor make-component
> (head tail &aux (last-block tail)
> (outer-loop
> - (make-loop :outer head (list tail)))))
> - #-sb-xc-host :no-constructor-defun)
> + (make-loop :outer head (list tail))))))
> ;; space where this component will be allocated in
> ;; :auto won't make any codegen optimizations pertinent to immobile space,
> ;; but will place the code there given sufficient available space.
> @@ -713,8 +712,7 @@
>
> ;;; The ENVIRONMENT structure represents the result of environment analysis.
> (defstruct (environment (:copier nil)
> - (:constructor make-environment (lambda))
> - #-sb-xc-host :no-constructor-defun)
> + (:constructor make-environment (lambda)))
> ;; the function that allocates this environment
> (lambda (missing-arg) :type clambda :read-only t)
> ;; a list of all the LAMBDA-VARs and NLX-INFOs needed from enclosing
> @@ -764,8 +762,7 @@
> ;;; ENVIRONMENT-NLX-INFO.
> (defstruct (nlx-info
> (:copier nil)
> - (:constructor make-nlx-info (cleanup block))
> - #-sb-xc-host :no-constructor-defun)
> + (:constructor make-nlx-info (cleanup block)))
> ;; the cleanup associated with this exit. In a catch or
> ;; unwind-protect, this is the :CATCH or :UNWIND-PROTECT cleanup,
> ;; and not the cleanup for the escape block. The CLEANUP-KIND of
> @@ -1331,8 +1328,7 @@
> (defstruct (optional-dispatch
> (:include functional) (:copier nil)
> (:constructor make-optional-dispatch
> - (arglist allowp keyp %source-name %debug-name source-path))
> - #-sb-xc-host :no-constructor-defun)
> + (arglist allowp keyp %source-name %debug-name source-path)))
> ;; the original parsed argument list, for anyone who cares
> (arglist nil :type list)
> ;; true if &ALLOW-OTHER-KEYS was supplied
> @@ -1566,8 +1562,7 @@
>
> (defstruct (jump-table (:include multiple-successors-node)
> (:constructor make-jump-table (index))
> - (:copier nil)
> - #-sb-xc-host :no-constructor-defun)
> + (:copier nil))
> (index (missing-arg) :type lvar)
> (targets nil :type list))
>
> @@ -1580,8 +1575,7 @@
> (:conc-name set-)
> (:predicate set-p)
> (:constructor make-set (var value))
> - (:copier nil)
> - #-sb-xc-host :no-constructor-defun)
> + (:copier nil))
> ;; descriptor for the variable set
> (var (missing-arg) :type basic-var)
> ;; LVAR for the value form
> @@ -1661,8 +1655,7 @@
> ;;; receiving forms.
> (defstruct (mv-combination (:include basic-combination)
> (:constructor make-mv-combination (fun))
> - (:copier nil)
> - #-sb-xc-host :no-constructor-defun))
> + (:copier nil)))
> (defprinter (mv-combination)
> (fun :prin1 (lvar-uses fun))
> (args :prin1 (mapcar #'lvar-uses args)))
> @@ -1686,8 +1679,7 @@
> (:conc-name return-)
> (:predicate return-p)
> (:constructor make-return (result lambda))
> - (:copier nil)
> - #-sb-xc-host :no-constructor-defun)
> + (:copier nil))
> ;; the lambda we are returning from. Null temporarily during
> ;; ir1tran.
> (lambda nil :type (or clambda null))
> @@ -1708,8 +1700,7 @@
> (defstruct (cast (:include valued-node)
> (:copier nil)
> (:constructor %make-cast
> - (asserted-type type-to-check value derived-type context))
> - #-sb-xc-host :no-constructor-defun)
> + (asserted-type type-to-check value derived-type context)))
> (asserted-type (missing-arg) :type ctype)
> (type-to-check (missing-arg) :type ctype)
> ;; an indication of what we have proven about how this type
> diff --git a/src/compiler/target-dstate.lisp b/src/compiler/target-dstate.lisp
> index ec3e7f2af..7b6e34db3 100644
> --- a/src/compiler/target-dstate.lisp
> +++ b/src/compiler/target-dstate.lisp
> @@ -12,8 +12,7 @@
> (in-package "SB-DISASSEM")
>
> (defstruct (storage-info (:copier nil)
> - (:predicate nil)
> - #-sb-xc-host :no-constructor-defun)
> + (:predicate nil))
> (groups nil :type list :read-only t) ; alist of (name . location-group)
> (debug-vars #() :type vector :read-only t))
>
> @@ -56,8 +55,7 @@
> (defstruct (disassem-state (:conc-name dstate-)
> (:constructor %make-dstate
> (alignment argument-column fun-hooks))
> - (:copier nil)
> - #-sb-xc-host :no-constructor-defun)
> + (:copier nil))
> ;; to avoid buffer overrun at segment end, we might need to copy bytes
> ;; here first because we access memory in chunks larger than 1 byte.
> (scratch-buf 0 :type sb-vm:word)
> diff --git a/xperfecthash63.lisp-expr b/xperfecthash63.lisp-expr
> index 5a6aff44c..d28874f57 100644
> --- a/xperfecthash63.lisp-expr
> +++ b/xperfecthash63.lisp-expr
> @@ -1675,5 +1675,14 @@
> (let ((b (& val #xf)))
> (let ((a (>> val 28)))
> (^ a (aref tab b))))))")
> +(#(359CB801 5DAB18D0 625827B9 7D5DAB1C BF38ADF8 C2B3EDA3 C7436840 D2821F1C E391E233 EBD01872 F1F25102)
> + "(:PURE :INITIAL-OFFSET :NAMED :TYPE :PRINT-OBJECT :PRINT-FUNCTION :INCLUDE :PREDICATE :COPIER :CONSTRUCTOR :CONC-NAME)"
> + "((let ((tab #a((8) (unsigned-byte 8) 0 5 8 11 4 1 0 5)))
> + (let ((b (& (>> val 4) #x7)))
> + (let ((a (>> (<< val 5) 29)))
> + (^ a (aref tab b))))))")
> +(#(359CB801 5DAB18D0 D2821F1C E391E233)
> + "(:CONC-NAME :CONSTRUCTOR :COPIER :PREDICATE)"
> + "((& (>> val 15) 3))")
> )
> ;; EOF
>
> -----------------------------------------------------------------------
>
>
> hooks/post-receive
> --
> SBCL
>
>
> _______________________________________________
> Sbcl-commits mailing list
> [email protected]
> https://lists.sourceforge.net/lists/listinfo/sbcl-commits
_______________________________________________
Sbcl-commits mailing list
[email protected]
https://lists.sourceforge.net/lists/listinfo/sbcl-commits