sbcl-devel — Development discussions.

[Sbcl-devel] Function for user macro to indicate source form

[Qiantan H. <qt...@st...>]

Hi there,

When working to improve ITERATE's interaction with debugger source tracking, I find that I need to tell the compiler the mapping between subforms in ITER's output (produced by a code walker) and the subforms in the original source. I hacked a solution using the internal SB-C::*SOURCE-PATHS* which indeed works according to my test, but of course I'd like to refrain from using internal variables. I suggest adding (to source-location.lisp) and exporting the following public function:

(defun note-source-form (form source-form)
  "Indicate that FORM is expanded from SOURCE-FORM.

This allows more accurate source location tracking.

NOTE: This interface is experimental and subject to change."
  (when (and (boundp '*source-paths*)
             (source-form-has-path-p form))
    (let ((path (get-source-path source-form)))
      (when path
        (setf (gethash form *source-paths*) path)))))

Best,
Qiantan

Re: [Sbcl-devel] [Sbcl-commits] master: Use OS-specific C files as intended for sb_GetTID

[Sebastien M. <se...@ka...>]

Douglas Katzman <do...@go...> writes:

> Thanks. I think it's fixed now, but if not can you send a patch?

yes, HEAD build fine now.

thanks.
-- 
Sebastien Marie

Re: [Sbcl-devel] [PATCH] Comment cleanup

[Douglas K. <do...@go...>]

applied, thanks

Re: [Sbcl-devel] [Sbcl-commits] master: Use OS-specific C files as intended for sb_GetTID

[Douglas K. <do...@go...>]

Thanks. I think it's fixed now, but if not can you send a patch?

[Sbcl-devel] [PATCH] Comment cleanup

[Philipp M. <ph...@ma...>]

Re: [Sbcl-devel] [Sbcl-commits] master: Use OS-specific C files as intended for sb_GetTID

[Sebastien M. <se...@ka...>]

Hi,

This commit breaks all BSDs (except FreeBSD). Found while building on OpenBSD.

Comments inside.

snuglas via Sbcl-commits <sbc...@li...> writes:

> The branch "master" has been updated in SBCL:
>        via  d297265cc8108f43fc94577b0d07116fb2bc5b65 (commit)
>       from  902efbd3a781f38fa5f709181011cdfe1f7e1716 (commit)
>
> - Log -----------------------------------------------------------------
> commit d297265cc8108f43fc94577b0d07116fb2bc5b65
> Author: Douglas Katzman <do...@go...>
> Date:   Sat Jul 26 12:09:29 2025 -0400
>
>     Use OS-specific C files as intended for sb_GetTID
>     
>     It started out for Linux only and never should have acquired
>     a myriad of definitions all stuffed in to one place
> ---
>  src/runtime/bsd-os.c    | 20 ++++++++++++++++++++
>  src/runtime/darwin-os.c |  2 ++
>  src/runtime/haiku-os.c  |  3 +++
>  src/runtime/linux-os.c  |  3 +++
>  src/runtime/sunos-os.c  |  2 ++
>  src/runtime/thread.c    | 43 ++++---------------------------------------
>  src/runtime/thread.h    |  2 +-
>  src/runtime/win32-os.c  |  2 ++
>  8 files changed, 37 insertions(+), 40 deletions(-)
>
> diff --git a/src/runtime/bsd-os.c b/src/runtime/bsd-os.c
> index 02b54e579..716d948b0 100644
> --- a/src/runtime/bsd-os.c
> +++ b/src/runtime/bsd-os.c
> @@ -385,6 +385,26 @@ static void freebsd_init()
>  #endif
>  }
>  
> +#if defined __DragonFly__
> +#include <sys/lwp.h>
> +lwpid_t sb_GetTID() { return lwp_gettid(); }
> +#elif defined __FreeBSD__
> +#include <sys/thr.h>
> +int sb_GetTID()
> +{
> +    long id;
> +    thr_self(&id);
> +    // man thr_self(2) says: the thread identifier is an integer in the range
> +    // from PID_MAX + 2 (100001) to INT_MAX. So casting to int is safe.
> +    return (int)id;
> +}
> +#elif defined __OpenBSD__
> +int sb_GetTID()
> +{
> +    return getthrid();
> +}
> +#endif
> +

this chunk is added inside a LIST_FEATURE_FREEBSD block, so only FreeBSD
see it.

moving it outside the #ifdef is enough to unbreak OpenBSD (and I assume
NetBSD, and DragonFlyBSD)

>  #ifdef LISP_FEATURE_SB_FUTEX
>  int
>  futex_wait(int *lock_word, int oldval, long sec, unsigned long usec)

Regards.
-- 
Sebastien Marie

Re: [Sbcl-devel] [Sbcl-commits] master: Change session-threads to a lockfree list

[Douglas K. <do...@go...>]

I thought lockfree lists worked everywhere, but apparently not. This is
reverted and the test that failed at the prior change is disabled; it's not
a great test

Re: [Sbcl-devel] [Sbcl-commits] master: Change session-threads to a lockfree list

[Stas B. <sta...@gm...>]

And where it succeeds in building:
// Running /home/runner/work/sbcl/sbcl/tests/packed-varints.pure.lisp
in COMPILE evaluator mode
::: Running :BIGNUM-UNPACKER-NO-CONSING
::: UNEXPECTED-FAILURE :BIGNUM-UNPACKER-NO-CONSING due to SB-INT:BUG:
        "  failed AVER: (THREAD-P THREAD)

On Sun, Jul 27, 2025 at 8:02 AM Stas Boukarev <sta...@gm...> wrote:
>
> arm and x86:
> //entering make-target-2.sh
> //doing warm init - compilation phase
> This is SBCL 2.5.7.5-0e58e978b, an implementation of ANSI Common Lisp.
> More information about SBCL is available at <http://www.sbcl.org/>.
>
> SBCL is free software, provided as is, with absolutely no warranty.
> It is mostly in the public domain; some portions are provided under
> BSD-style licenses.  See the CREDITS and COPYING files in the
> distribution for more information.
> Initial page table:
>      | Immobile Objects |
>  Gen layout symbol   code  Boxed   Cons    Raw   Code  SmMix  Mixed
> LgRaw LgCode  LgMix Waste%       Alloc        Trig   Dirty GCs Mem-age
>   6      0      0      0      0    375      0   2798      0   2346
>  0      0      0    0.3    22528528     2000000    2798   0  0.0000
> Tot      0      0      0      0    375      0   2798      0   2346
>  0      0      0    0.3    22528528 [4.2% of 536870912 max]
> COLD-INIT... Internal error #1 "An attempt was made to use an
> undefined FDEFINITION." at 0x1100824
>     SC: 0, Offset: 0 $1=   0xd7b9843f: other pointer
> fatal error encountered in SBCL pid 3970 tid 3970:
> internal error too early in init, can't recover
>
>    0: fp=0xd77f2ec0 pc=0x1100824 {code_serialno=0}
>    1: fp=0xd77f2f00 pc=0xd8cff3bf Warning: lisp package array is not
> initialized for C
> <??? type 0>::MAKE-ORDERED-LIST
>    2: fp=0xd77f2f14 pc=0xd8e34c5e <??? type 0>::MAKE-SESSION
>    3: fp=0xd77f2f20 pc=0xd8e34fb9 <??? type 0>::NEW-SESSION
>    4: fp=0xd77f2f30 pc=0xd8e22cab <??? type 0>::INIT-MAIN-THREAD
>    5: fp=0xd77f2f80 pc=0xd90164e3 <??? type 0>::!COLD-INIT
>
>
> On Sun, Jul 27, 2025 at 7:56 AM snuglas via Sbcl-commits
> <sbc...@li...> wrote:
> >
> > The branch "master" has been updated in SBCL:
> >        via  0e58e978b196dd72696eafbe7793d7f7bc1452ea (commit)
> >       from  3e20eb9c5f18787f7407aab883ed869f6008065f (commit)
> >
> > - Log -----------------------------------------------------------------
> > commit 0e58e978b196dd72696eafbe7793d7f7bc1452ea
> > Author: Douglas Katzman <do...@go...>
> > Date:   Sun Jul 27 03:24:22 2025 +0000
> >
> >     Change session-threads to a lockfree list
> >
> >     Use the session lock only for mediating access to the REPL.
> >
> >     Also maybe get the make-thread test asserting absence of conservative
> >     pinning to pass again.
> > ---
> >  src/code/target-lflist.lisp |   4 +-
> >  src/code/target-thread.lisp | 183 +++++++++++++++++++++-----------------------
> >  src/cold/exports.lisp       |   1 +
> >  tests/make-thread.pure.lisp |  25 ++++--
> >  tests/session.impure.lisp   |   6 +-
> >  5 files changed, 111 insertions(+), 108 deletions(-)
> >
> > diff --git a/src/code/target-lflist.lisp b/src/code/target-lflist.lisp
> > index 6e5da5044..3c1db1541 100644
> > --- a/src/code/target-lflist.lisp
> > +++ b/src/code/target-lflist.lisp
> > @@ -17,9 +17,9 @@
> >
> >  (in-package "SB-LOCKLESS")
> >
> > -(export '(make-ordered-list lfl-insert lfl-delete lfl-find
> > +(export '(lfl-find
> >            lfl-insert*/t lfl-delete*/t lfl-find*/t
> > -          do-lockfree-list lfl-keys make-marked-ref))
> > +          do-lockfree-list make-marked-ref))
> >
> >  ;;; The changes to GC to support this code were as follows:
> >  ;;;
> > diff --git a/src/code/target-thread.lisp b/src/code/target-thread.lisp
> > index c997ddfb6..f79e05c5f 100644
> > --- a/src/code/target-thread.lisp
> > +++ b/src/code/target-thread.lisp
> > @@ -1467,19 +1467,27 @@ on this semaphore, then N of them is woken up."
> >
> >  ;;;; Job control, independent listeners
> >
> > -(defstruct (session (:copier nil))
> > -  ;; New threads are atomically pushed into NEW-ENROLLEES without acquiring the
> > -  ;; session lock. Any operation on the session that transfers ownership of the
> > -  ;; foreground must move the enrollees into THREADS while holding the lock.
> > -  (new-enrollees)
> > -  (lock (make-mutex :name "session lock"))
> > -  ;; If we wanted to get fancy, these next 2 lists might become lockfree linked lists
> > -  ;; so that it would be possible for threads to exit without acquiring the lock.
> > -  ;; It might be tricky (i.e. too much trouble) to figure out how to reimplement
> > -  ;; the various operations on a session though.
> > -  (threads nil)
> > -  (interactive-threads nil)
> > -  (interactive-threads-queue (make-waitqueue :name "session")))
> > +(defstruct (session (:copier nil)
> > +                    (:constructor make-session (interactive-threads)))
> > +  ;; A thread can enter into and leave from the session without using a mutex
> > +  ;; except when leaving as the foreground thread
> > +  (threads (sb-lockless:make-ordered-list
> > +            :sort (lambda (a b)
> > +                    ;; Sort order is arbitrary, but if threads are allocated at increasing
> > +                    ;; addresses, then new threads go to the front of the list by defining <
> > +                    ;; "backwards" which can require slightly less work to insert.
> > +                    (> (thread-primitive-thread a) (thread-primitive-thread b)))
> > +            :test #'eq)
> > +   :read-only t)
> > +  ;; Interactive threads are maintained in an ordinary list, the first element indicating
> > +  ;; which thread owns the foreground.
> > +  ;; This list can contain NILs for threads which left the session
> > +  ;; (Users who read this via the internal symbol may be unpleasantly surprised,
> > +  ;; but why are they doing that when there is an exported accessor?)
> > +  ;; The NILs get culled whenever control over the foreground changes.
> > +  (interactive-threads nil :type list)
> > +  (lock (make-mutex :name "session lock") :read-only t)
> > +  (condvar (make-waitqueue :name "session") :read-only t))
> >  (declaim (sb-ext:freeze-type session))
> >
> >  ;;; The debugger itself tries to acquire the session lock, don't let
> > @@ -1491,43 +1499,27 @@ on this semaphore, then N of them is woken up."
> >  ;;; FIXME: It might be good to have a way to enforce lock ordering invariants
> >  (defmacro with-session-lock ((session) &body body)
> >    `(with-system-mutex ((session-lock ,session) :allow-with-interrupts t)
> > -     (%enroll-new-threads ,session)
> >       ,@body))
> >
> > -;;; Move new enrollees into SESSION-THREADS. The session lock must be held.
> > -;;; The reason this can be lazy is that a thread is never an interactive thread
> > -;;; just by joining a session, so it doesn't involve itself with the waitqueue;
> > -;;; it can't cause a thread waiting on the condition to wake.
> > -;;; i.e. even if a newly created thread were required to obtain the lock to insert
> > -;;; itself into the session, it would not and could not have any effect on any other
> > -;;; thread in the session.
> > -(defun %enroll-new-threads (session)
> > -  (declare (sb-c::tlab :system))
> > -  (loop (let ((thread (sb-ext:atomic-pop (session-new-enrollees session))))
> > -          (cond ((not thread) (return))
> > -                ((thread-alive-p thread)
> > -                 ;; Can it become dead immediately upon insertion into THREADS?
> > -                 ;; No, because to become dead, it must acquire the session lock.
> > -                 (push thread (session-threads session)))))))
> > +
> > +(defun enroll-thread-in-session (thread session)
> > +  (when session
> > +    (sb-vm:without-arena (sb-lockless:lfl-insert (session-threads session) thread t)))
> > +  session)
> >
> >  (defun new-session (thread)
> > -  (make-session :threads (list thread)
> > -                :interactive-threads (list thread)))
> > +  (enroll-thread-in-session thread (make-session (list thread))))
> >
> >  (defun %delete-thread-from-session (thread &aux (session *session*))
> > -  (with-session-lock (session)
> > -    ;; One of two things about THREAD must be true, either:
> > -    ;; - it was transferred from SESSION-NEW-ENROLLEES to SESSION-THREADS
> > -    ;; - it was NOT yet transferred from SESSION-NEW-ENROLLEES.
> > -    ;; There can't be an "in flight" state of having done the atomic-pop from
> > -    ;; SESSION-NEW-ENROLLEES but not the push into THREADS, because anyone manipulating
> > -    ;; the THREADS list must be holding the session lock.
> > -    (let ((was-foreground (eq thread (foreground-thread session))))
> > -      (setf (session-threads session) (delq1 thread (session-threads session))
> > -            (session-interactive-threads session)
> > -            (delq1 thread (session-interactive-threads session)))
> > -      (when was-foreground
> > -        (condition-notify (session-interactive-threads-queue session))))))
> > +  (sb-lockless:lfl-delete (session-threads session) thread)
> > +  ;; If THREAD is not the foreground thread, no locking occurs.
> > +  (if (neq thread (foreground-thread session))
> > +      (nsubstitute nil thread (session-interactive-threads session) :count 1)
> > +      (flet ((deletep (x) (or (null x) (eq x thread)))) ; cull deleted threads
> > +        (with-session-lock (session)
> > +          (setf (session-interactive-threads session)
> > +                (delete-if #'deletep (session-interactive-threads session)))
> > +          (condition-notify (session-condvar session))))))
> >
> >  (defun call-with-new-session (fn)
> >    (%delete-thread-from-session *current-thread*)
> > @@ -1621,7 +1613,7 @@ thread is not the foreground thread."
> >                           (session-threads session)))))
> >      ;; do the kill after dropping the mutex; unwind forms in dying
> >      ;; threads may want to do session things
> > -    (dolist (thread to-kill)
> > +    (dolist (thread (sb-lockless:lfl-keys to-kill))
> >        (unless (eq thread *current-thread*)
> >          ;; terminate the thread but don't be surprised if it has
> >          ;; exited in the meantime
> > @@ -1657,18 +1649,17 @@ SB-THREAD:RELEASE-FOREGROUND has to be called in ~s~%for this thread to enter th
> >       (with-session-lock (session)
> >         (symbol-macrolet
> >             ((interactive-threads (session-interactive-threads session)))
> > +         (setf interactive-threads (delete nil interactive-threads))
> >           (cond
> >             ((null interactive-threads)
> >              (setf was-foreground nil
> >                    interactive-threads (list *current-thread*)))
> > -           ((not (eq (first interactive-threads) *current-thread*))
> > +           ((neq (first interactive-threads) *current-thread*)
> >              (setf was-foreground nil)
> >              (unless (member *current-thread* interactive-threads)
> >                (setf interactive-threads
> >                      (append interactive-threads (list *current-thread*))))
> > -            (condition-wait
> > -             (session-interactive-threads-queue session)
> > -             (session-lock session)))
> > +            (condition-wait (session-condvar session) (session-lock session)))
> >             (t
> >              (unless was-foreground
> >                (format *query-io* "Resuming thread ~A~%" *current-thread*))
> > @@ -1684,22 +1675,27 @@ have the foreground next."
> >      (with-session-lock (session)
> >        (symbol-macrolet
> >            ((interactive-threads (session-interactive-threads session)))
> > -        (setf interactive-threads
> > -              (delete *current-thread* interactive-threads))
> > +        (flet ((deletep (x) (or (null x) (eq x *current-thread*))))
> > +          (setf interactive-threads (delete-if #'deletep interactive-threads)))
> > +        ;; Is it user error if NEXT is not in SESSION-THREADS of this session?
> >          (when (and next (thread-alive-p next))
> > -          (setf interactive-threads
> > -                (list* next (delete next interactive-threads))))
> > -        (condition-notify (session-interactive-threads-queue session))))))
> > +          (setf interactive-threads (list* next (delq1 next interactive-threads))))
> > +        (condition-notify (session-condvar session))))))
> >
> >  (defun interactive-threads (&optional (session *session*))
> >    "Return the interactive threads of SESSION defaulting to the current
> >  session."
> > -  (session-interactive-threads session))
> > +  ;; A thread which left the session when not the foreground gets replaced
> > +  ;; by NIL, which we don't want to expose in the interface.
> > +  (remove nil (session-interactive-threads session)))
> >
> >  (defun foreground-thread (&optional (session *session*))
> >    "Return the foreground thread of SESSION defaulting to the current
> >  session."
> > -  (first (interactive-threads session)))
> > +  ;; naively this is (FIRST (INTERACTIVE-THREADS session)))
> > +  ;; but it's more efficient to avoid the call to REMOVE.
> > +  (declare (optimize speed)) ; inlines into finding the first non-nil item
> > +  (find-if #'identity (session-interactive-threads session)))
> >
> >  #-win32
> >  (defun make-listener-thread (tty-name)
> > @@ -1888,6 +1884,7 @@ session."
> >        ;; They must not participate in shutting other threads down.
> >        (when (and *exit-in-progress* (not (thread-ephemeral-p thread)))
> >          (%exit))
> > +      (when *session* (%delete-thread-from-session thread))
> >        ;; If collecting allocator metrics, transfer them to the global list
> >        ;; so that we can summarize over exited threads.
> >        #+allocator-metrics
> > @@ -1924,11 +1921,6 @@ session."
> >              ;; Operation on the global list must be atomic.
> >              (sb-ext:atomic-push (cons sprof-data thread) *sprof-data*)))
> >          (barrier (:write)))
> > -      ;; After making the thread dead, remove from session. If this were done first,
> > -      ;; we'd just waste time moving the thread into SESSION-THREADS (if it wasn't there)
> > -      ;; only to remove it right away.
> > -      (when *session*
> > -        (%delete-thread-from-session thread))
> >        (cond
> >          ;; If possible, logically remove from *ALL-THREADS* by flipping a bit.
> >          ;; Foreign threads remove themselves. They don't have an exit semaphore,
> > @@ -2078,6 +2070,7 @@ See also: RETURN-FROM-THREAD, ABORT-THREAD."
> >
> >  ;;; System-internal use only
> >  #+sb-thread
> > +(progn
> >  (defun make-system-thread (name function arguments symbol)
> >    (let ((thread (%make-thread name t (make-semaphore :name name))))
> >      (when symbol
> > @@ -2085,41 +2078,38 @@ See also: RETURN-FROM-THREAD, ABORT-THREAD."
> >        (set symbol thread))
> >      (start-thread thread function arguments)))
> >
> > -#+sb-thread
> > +;;; The native thread start procedure calls this function with one arg which is the
> > +;;; pointer to the thread instance without tag bits.
> > +(defun threadstartfun (arg)
> > +  ;; If an error occurs prior to getting the thread into a consistent lisp state,
> > +  ;; there's no chance of debugging anything anyway.
> > +  (declare (optimize (safety 0)))
> > +  (let ((new-thread (%make-lisp-obj (logior (get-lisp-obj-address arg)
> > +                                            sb-vm:instance-pointer-lowtag))))
> > +    ;; Now that this thread is known to GC, NEW-THREAD is either implicitly
> > +    ;; pinned (on conservative gc) or movable. It can hance be deleted from
> > +    ;; *STARTING-THREADS* list which occurs lazily on the next MAKE-THREAD.
> > +    ;; To avoid unnecessary GC work meanwhile, smash the cell in *STARTING-THREADS*
> > +    ;; that points to NEW-THREAD. That cell is pointed to by the startup-info.
> > +    (rplaca (startup-info-thread-cell new-thread) 0)
> > +    (init-thread-local-storage new-thread) ; assign *CURRENT-THREAD*
> > +    ;; Foreign threads don't pass the saved FP modes, so the modes have to be
> > +    ;; restored here and not in RUN.
> > +    #+(or win32 darwin freebsd)
> > +    (setf (sb-vm:floating-point-modes) (startup-info-fp-modes new-thread))
> > +    ;; Join creator's session if there was one
> > +    (enroll-thread-in-session new-thread (startup-info-session new-thread))
> > +    (try-set-os-thread-name (thread-%name new-thread))
> > +    ;; Expose this thread in *ALL-THREADS*.
> > +    ;; Why not set this before calling pthread_create() ? If it fails there should
> > +    ;; be no transient effect on the list of all threads. But it's indeterminate
> > +    ;; whether the creating or created thread will make progress first,
> > +    ;; so they both do this assignment.
> > +    (setf (thread-%visible new-thread) 1))
> > +  (run))
> > +
> >  (defun start-thread (thread function arguments)
> > -  (let* ((trampoline
> > -          (lambda (arg)
> > -            ;; If an error occurs prior to getting the thread into a consistent lisp state,
> > -            ;; there's no chance of debugging anything anyway.
> > -            (declare (optimize (safety 0)))
> > -            (let ((new-thread
> > -                   (%make-lisp-obj (logior (get-lisp-obj-address arg)
> > -                                           sb-vm:instance-pointer-lowtag))))
> > -              ;; Now that this thread is known to GC, NEW-THREAD is either implicitly
> > -              ;; pinned (on conservative gc) or movable. It can hance be deleted from
> > -              ;; *STARTING-THREADS* list which occurs lazily on the next MAKE-THREAD.
> > -              ;; To avoid unnecessary GC work meanwhile, smash the cell in *STARTING-THREADS*
> > -              ;; that points to NEW-THREAD. That cell is pointed to by the startup-info.
> > -              (rplaca (startup-info-thread-cell new-thread) 0)
> > -              (init-thread-local-storage new-thread) ; assign *CURRENT-THREAD*
> > -              ;; Expose this thread in *ALL-THREADS*.
> > -              ;; Why not set this before calling pthread_create() ? If it fails there should
> > -              ;; be no transient effect on the list of all threads. But it's indeterminate
> > -              ;; whether the creating or created thread will make progress first,
> > -              ;; so they both do this assignment.
> > -              (setf (thread-%visible new-thread) 1)
> > -              ;; Foreign threads don't pass the saved FP modes, so the modes have to be
> > -              ;; restored here and not in RUN.
> > -              #+(or win32 darwin freebsd)
> > -              (setf (sb-vm:floating-point-modes) (startup-info-fp-modes new-thread))
> > -              (try-set-os-thread-name (thread-%name new-thread))
> > -              ;; Join creator's session if there was one
> > -              (let ((session (startup-info-session new-thread)))
> > -                (declare (sb-c::tlab :system))
> > -                (when session
> > -                  (sb-ext:atomic-push thread (session-new-enrollees session)))))
> > -            (run)))
> > -         (saved-sigmask (make-array (* sb-unix::sizeof-sigset_t sb-vm:n-byte-bits)
> > +  (let* ((saved-sigmask (make-array (* sb-unix::sizeof-sigset_t sb-vm:n-byte-bits)
> >                                      :element-type 'bit :initial-element 0))
> >           (child-sigmask (make-array (* sb-unix::sizeof-sigset_t sb-vm:n-byte-bits)
> >                                      :element-type 'bit :initial-element 0))
> > @@ -2151,7 +2141,7 @@ See also: RETURN-FROM-THREAD, ABORT-THREAD."
> >                 (cell (locally (declare (sb-c::tlab :system))
> >                         (list thread)))
> >                 (startup-info
> > -                (vector trampoline cell *session* function arguments
> > +                (vector #'threadstartfun cell *session* function arguments
> >                          (if (position 1 child-sigmask) ; if there are any signals masked
> >                              (copy-seq child-sigmask) ; heap-allocate to pass to the new thread
> >                              nil) ; otherwise, don't pass the saved mask
> > @@ -2205,6 +2195,7 @@ See also: RETURN-FROM-THREAD, ABORT-THREAD."
> >      (with-pinned-objects (saved-sigmask)
> >        (sb-unix::pthread-sigmask sb-unix::SIG_SETMASK saved-sigmask nil))
> >      (if created thread (error "Could not create new OS thread."))))
> > +) ; end PROGN
> >
> >  (defun join-thread (thread &key (default nil defaultp) timeout)
> >    "Suspend current thread until THREAD exits. Return the result values
> > diff --git a/src/cold/exports.lisp b/src/cold/exports.lisp
> > index 72dc6f96a..54cbfcc5f 100644
> > --- a/src/cold/exports.lisp
> > +++ b/src/cold/exports.lisp
> > @@ -3624,6 +3624,7 @@ package is deprecated in favour of SB-MOP.")
> >    (:documentation "internal: lockfree lists")
> >    (:use "CL" "SB-INT" "SB-EXT" "SB-SYS" "SB-KERNEL")
> >    (:export "+TAIL+" "%NODE-NEXT" "GET-NEXT"
> > +           "MAKE-ORDERED-LIST" "LFL-INSERT" "LFL-DELETE" "LFL-KEYS"
> >             "MAKE-SO-SET/STRING" "MAKE-SO-SET/FIXNUM" "MAKE-SO-SET/ADDR"
> >             "MAKE-SO-MAP/STRING" "MAKE-SO-MAP/FIXNUM" "MAKE-SO-MAP/ADDR"
> >             "MULTIPLICATIVE-HASH"
> > diff --git a/tests/make-thread.pure.lisp b/tests/make-thread.pure.lisp
> > index 957ca8a62..82d3a201e 100644
> > --- a/tests/make-thread.pure.lisp
> > +++ b/tests/make-thread.pure.lisp
> > @@ -134,6 +134,12 @@
> >     (make-thread (make-a-closure-nontail (make-big-structure :x 0))
> >                  :arguments (list 1 (make-other-big-structure)))))
> >
> > +;;; If the finalizer thread isn't stopped, and there is a lockfree list node pointing
> > +;;; to the it, and such node happens to be in gen0, and was manipulated by LFL-INSERT
> > +;;; when adding a new thread to *SESSION*, then this test could spuriously fail.
> > +;;; Of course that has nothing to do with why it may have failed when session-threads
> > +;;; was just a list, but it doesn't seem important now.
> > +(sb-impl::finalizer-thread-stop)
> >  ;;; Test that reusing memory from an exited thread does not point to junk.
> >  ;;; In fact, assert something stronger: there are no young objects
> >  ;;; between the current SP and end of stack.
> > @@ -146,14 +152,17 @@
> >                             (eq x (sb-kernel:fun-code-header #'actually-get-stack-roots))))
> >                       (tryit :print nil))))
> >      ;; should be not many things pointed to by the stack
> > -    (assert (< (length list) #+x86    38   ; more junk, I don't know why
> > -                             #+x86-64 30   ; less junk, I don't know why
> > -                             #-(or x86 x86-64) 44)) ; even more junk
> > -    ;; Either no objects are in GC generation 0, or all are, depending on
> > -    ;; whether CORE_PAGE_GENERATION has been set to 0 for testing.
> > -    (let ((n-objects-in-g0 (count 0 list :key #'sb-kernel:generation-of)))
> > -      (assert (or (= n-objects-in-g0 0)
> > -                  (= n-objects-in-g0 (length list)))))))
> > +    (assert (< (length list) 44))
> > +    ;; No young object is pointed to by the stack in its freshly born state.
> > +    ;; This test is only sensible if CORE_PAGE_GENERATION has its default value
> > +    ;; of PSEUDO_STATIC_GENERATION
> > +    (when (= (sb-kernel:generation-of #'car) sb-vm:+pseudo-static-generation+)
> > +      (let ((gens (mapcar #'sb-kernel:generation-of list)))
> > +        (when (find 0 gens)
> > +          (format t "Unexpected generation 0 objects:~%")
> > +          (mapc (lambda (x g) (when (eql g 0) (format t "g~d ~s~%" g x)))
> > +                list gens)
> > +          (error "test failed"))))))
> >
> >  ;; lp#1595699
> >  (test-util:with-test (:name :start-thread-in-without-gcing
> > diff --git a/tests/session.impure.lisp b/tests/session.impure.lisp
> > index 23c9ad84b..d47a776a9 100644
> > --- a/tests/session.impure.lisp
> > +++ b/tests/session.impure.lisp
> > @@ -135,6 +135,8 @@
> >      (sb-thread:release-foreground thread)
> >      (get-foreground-quietly)))
> >
> > +(defun session-threads (x) (sb-lockless:lfl-keys (sb-thread::session-threads x)))
> > +
> >  (with-test (:name :new-session)
> >    (let ((old-session sb-thread::*session*))
> >      (sb-thread:with-new-session ()
> > @@ -142,6 +144,6 @@
> >          (assert (not (eq old-session new-session)))
> >          ;; this thread should not be in session-threads of the old session
> >          (assert (not (member sb-thread:*current-thread*
> > -                             (sb-thread::session-threads old-session))))
> > +                             (session-threads old-session))))
> >          (assert (member sb-thread:*current-thread*
> > -                        (sb-thread::session-threads new-session)))))))
> > +                        (session-threads new-session)))))))
> >
> > -----------------------------------------------------------------------
> >
> >
> > hooks/post-receive
> > --
> > SBCL
> >
> >
> > _______________________________________________
> > Sbcl-commits mailing list
> > Sbc...@li...
> > https://lists.sourceforge.net/lists/listinfo/sbcl-commits

Re: [Sbcl-devel] [Sbcl-commits] master: Change session-threads to a lockfree list

[Stas B. <sta...@gm...>]

arm and x86:
//entering make-target-2.sh
//doing warm init - compilation phase
This is SBCL 2.5.7.5-0e58e978b, an implementation of ANSI Common Lisp.
More information about SBCL is available at <http://www.sbcl.org/>.

SBCL is free software, provided as is, with absolutely no warranty.
It is mostly in the public domain; some portions are provided under
BSD-style licenses.  See the CREDITS and COPYING files in the
distribution for more information.
Initial page table:
     | Immobile Objects |
 Gen layout symbol   code  Boxed   Cons    Raw   Code  SmMix  Mixed
LgRaw LgCode  LgMix Waste%       Alloc        Trig   Dirty GCs Mem-age
  6      0      0      0      0    375      0   2798      0   2346
 0      0      0    0.3    22528528     2000000    2798   0  0.0000
Tot      0      0      0      0    375      0   2798      0   2346
 0      0      0    0.3    22528528 [4.2% of 536870912 max]
COLD-INIT... Internal error #1 "An attempt was made to use an
undefined FDEFINITION." at 0x1100824
    SC: 0, Offset: 0 $1=   0xd7b9843f: other pointer
fatal error encountered in SBCL pid 3970 tid 3970:
internal error too early in init, can't recover

   0: fp=0xd77f2ec0 pc=0x1100824 {code_serialno=0}
   1: fp=0xd77f2f00 pc=0xd8cff3bf Warning: lisp package array is not
initialized for C
<??? type 0>::MAKE-ORDERED-LIST
   2: fp=0xd77f2f14 pc=0xd8e34c5e <??? type 0>::MAKE-SESSION
   3: fp=0xd77f2f20 pc=0xd8e34fb9 <??? type 0>::NEW-SESSION
   4: fp=0xd77f2f30 pc=0xd8e22cab <??? type 0>::INIT-MAIN-THREAD
   5: fp=0xd77f2f80 pc=0xd90164e3 <??? type 0>::!COLD-INIT


On Sun, Jul 27, 2025 at 7:56 AM snuglas via Sbcl-commits
<sbc...@li...> wrote:
>
> The branch "master" has been updated in SBCL:
>        via  0e58e978b196dd72696eafbe7793d7f7bc1452ea (commit)
>       from  3e20eb9c5f18787f7407aab883ed869f6008065f (commit)
>
> - Log -----------------------------------------------------------------
> commit 0e58e978b196dd72696eafbe7793d7f7bc1452ea
> Author: Douglas Katzman <do...@go...>
> Date:   Sun Jul 27 03:24:22 2025 +0000
>
>     Change session-threads to a lockfree list
>
>     Use the session lock only for mediating access to the REPL.
>
>     Also maybe get the make-thread test asserting absence of conservative
>     pinning to pass again.
> ---
>  src/code/target-lflist.lisp |   4 +-
>  src/code/target-thread.lisp | 183 +++++++++++++++++++++-----------------------
>  src/cold/exports.lisp       |   1 +
>  tests/make-thread.pure.lisp |  25 ++++--
>  tests/session.impure.lisp   |   6 +-
>  5 files changed, 111 insertions(+), 108 deletions(-)
>
> diff --git a/src/code/target-lflist.lisp b/src/code/target-lflist.lisp
> index 6e5da5044..3c1db1541 100644
> --- a/src/code/target-lflist.lisp
> +++ b/src/code/target-lflist.lisp
> @@ -17,9 +17,9 @@
>
>  (in-package "SB-LOCKLESS")
>
> -(export '(make-ordered-list lfl-insert lfl-delete lfl-find
> +(export '(lfl-find
>            lfl-insert*/t lfl-delete*/t lfl-find*/t
> -          do-lockfree-list lfl-keys make-marked-ref))
> +          do-lockfree-list make-marked-ref))
>
>  ;;; The changes to GC to support this code were as follows:
>  ;;;
> diff --git a/src/code/target-thread.lisp b/src/code/target-thread.lisp
> index c997ddfb6..f79e05c5f 100644
> --- a/src/code/target-thread.lisp
> +++ b/src/code/target-thread.lisp
> @@ -1467,19 +1467,27 @@ on this semaphore, then N of them is woken up."
>
>  ;;;; Job control, independent listeners
>
> -(defstruct (session (:copier nil))
> -  ;; New threads are atomically pushed into NEW-ENROLLEES without acquiring the
> -  ;; session lock. Any operation on the session that transfers ownership of the
> -  ;; foreground must move the enrollees into THREADS while holding the lock.
> -  (new-enrollees)
> -  (lock (make-mutex :name "session lock"))
> -  ;; If we wanted to get fancy, these next 2 lists might become lockfree linked lists
> -  ;; so that it would be possible for threads to exit without acquiring the lock.
> -  ;; It might be tricky (i.e. too much trouble) to figure out how to reimplement
> -  ;; the various operations on a session though.
> -  (threads nil)
> -  (interactive-threads nil)
> -  (interactive-threads-queue (make-waitqueue :name "session")))
> +(defstruct (session (:copier nil)
> +                    (:constructor make-session (interactive-threads)))
> +  ;; A thread can enter into and leave from the session without using a mutex
> +  ;; except when leaving as the foreground thread
> +  (threads (sb-lockless:make-ordered-list
> +            :sort (lambda (a b)
> +                    ;; Sort order is arbitrary, but if threads are allocated at increasing
> +                    ;; addresses, then new threads go to the front of the list by defining <
> +                    ;; "backwards" which can require slightly less work to insert.
> +                    (> (thread-primitive-thread a) (thread-primitive-thread b)))
> +            :test #'eq)
> +   :read-only t)
> +  ;; Interactive threads are maintained in an ordinary list, the first element indicating
> +  ;; which thread owns the foreground.
> +  ;; This list can contain NILs for threads which left the session
> +  ;; (Users who read this via the internal symbol may be unpleasantly surprised,
> +  ;; but why are they doing that when there is an exported accessor?)
> +  ;; The NILs get culled whenever control over the foreground changes.
> +  (interactive-threads nil :type list)
> +  (lock (make-mutex :name "session lock") :read-only t)
> +  (condvar (make-waitqueue :name "session") :read-only t))
>  (declaim (sb-ext:freeze-type session))
>
>  ;;; The debugger itself tries to acquire the session lock, don't let
> @@ -1491,43 +1499,27 @@ on this semaphore, then N of them is woken up."
>  ;;; FIXME: It might be good to have a way to enforce lock ordering invariants
>  (defmacro with-session-lock ((session) &body body)
>    `(with-system-mutex ((session-lock ,session) :allow-with-interrupts t)
> -     (%enroll-new-threads ,session)
>       ,@body))
>
> -;;; Move new enrollees into SESSION-THREADS. The session lock must be held.
> -;;; The reason this can be lazy is that a thread is never an interactive thread
> -;;; just by joining a session, so it doesn't involve itself with the waitqueue;
> -;;; it can't cause a thread waiting on the condition to wake.
> -;;; i.e. even if a newly created thread were required to obtain the lock to insert
> -;;; itself into the session, it would not and could not have any effect on any other
> -;;; thread in the session.
> -(defun %enroll-new-threads (session)
> -  (declare (sb-c::tlab :system))
> -  (loop (let ((thread (sb-ext:atomic-pop (session-new-enrollees session))))
> -          (cond ((not thread) (return))
> -                ((thread-alive-p thread)
> -                 ;; Can it become dead immediately upon insertion into THREADS?
> -                 ;; No, because to become dead, it must acquire the session lock.
> -                 (push thread (session-threads session)))))))
> +
> +(defun enroll-thread-in-session (thread session)
> +  (when session
> +    (sb-vm:without-arena (sb-lockless:lfl-insert (session-threads session) thread t)))
> +  session)
>
>  (defun new-session (thread)
> -  (make-session :threads (list thread)
> -                :interactive-threads (list thread)))
> +  (enroll-thread-in-session thread (make-session (list thread))))
>
>  (defun %delete-thread-from-session (thread &aux (session *session*))
> -  (with-session-lock (session)
> -    ;; One of two things about THREAD must be true, either:
> -    ;; - it was transferred from SESSION-NEW-ENROLLEES to SESSION-THREADS
> -    ;; - it was NOT yet transferred from SESSION-NEW-ENROLLEES.
> -    ;; There can't be an "in flight" state of having done the atomic-pop from
> -    ;; SESSION-NEW-ENROLLEES but not the push into THREADS, because anyone manipulating
> -    ;; the THREADS list must be holding the session lock.
> -    (let ((was-foreground (eq thread (foreground-thread session))))
> -      (setf (session-threads session) (delq1 thread (session-threads session))
> -            (session-interactive-threads session)
> -            (delq1 thread (session-interactive-threads session)))
> -      (when was-foreground
> -        (condition-notify (session-interactive-threads-queue session))))))
> +  (sb-lockless:lfl-delete (session-threads session) thread)
> +  ;; If THREAD is not the foreground thread, no locking occurs.
> +  (if (neq thread (foreground-thread session))
> +      (nsubstitute nil thread (session-interactive-threads session) :count 1)
> +      (flet ((deletep (x) (or (null x) (eq x thread)))) ; cull deleted threads
> +        (with-session-lock (session)
> +          (setf (session-interactive-threads session)
> +                (delete-if #'deletep (session-interactive-threads session)))
> +          (condition-notify (session-condvar session))))))
>
>  (defun call-with-new-session (fn)
>    (%delete-thread-from-session *current-thread*)
> @@ -1621,7 +1613,7 @@ thread is not the foreground thread."
>                           (session-threads session)))))
>      ;; do the kill after dropping the mutex; unwind forms in dying
>      ;; threads may want to do session things
> -    (dolist (thread to-kill)
> +    (dolist (thread (sb-lockless:lfl-keys to-kill))
>        (unless (eq thread *current-thread*)
>          ;; terminate the thread but don't be surprised if it has
>          ;; exited in the meantime
> @@ -1657,18 +1649,17 @@ SB-THREAD:RELEASE-FOREGROUND has to be called in ~s~%for this thread to enter th
>       (with-session-lock (session)
>         (symbol-macrolet
>             ((interactive-threads (session-interactive-threads session)))
> +         (setf interactive-threads (delete nil interactive-threads))
>           (cond
>             ((null interactive-threads)
>              (setf was-foreground nil
>                    interactive-threads (list *current-thread*)))
> -           ((not (eq (first interactive-threads) *current-thread*))
> +           ((neq (first interactive-threads) *current-thread*)
>              (setf was-foreground nil)
>              (unless (member *current-thread* interactive-threads)
>                (setf interactive-threads
>                      (append interactive-threads (list *current-thread*))))
> -            (condition-wait
> -             (session-interactive-threads-queue session)
> -             (session-lock session)))
> +            (condition-wait (session-condvar session) (session-lock session)))
>             (t
>              (unless was-foreground
>                (format *query-io* "Resuming thread ~A~%" *current-thread*))
> @@ -1684,22 +1675,27 @@ have the foreground next."
>      (with-session-lock (session)
>        (symbol-macrolet
>            ((interactive-threads (session-interactive-threads session)))
> -        (setf interactive-threads
> -              (delete *current-thread* interactive-threads))
> +        (flet ((deletep (x) (or (null x) (eq x *current-thread*))))
> +          (setf interactive-threads (delete-if #'deletep interactive-threads)))
> +        ;; Is it user error if NEXT is not in SESSION-THREADS of this session?
>          (when (and next (thread-alive-p next))
> -          (setf interactive-threads
> -                (list* next (delete next interactive-threads))))
> -        (condition-notify (session-interactive-threads-queue session))))))
> +          (setf interactive-threads (list* next (delq1 next interactive-threads))))
> +        (condition-notify (session-condvar session))))))
>
>  (defun interactive-threads (&optional (session *session*))
>    "Return the interactive threads of SESSION defaulting to the current
>  session."
> -  (session-interactive-threads session))
> +  ;; A thread which left the session when not the foreground gets replaced
> +  ;; by NIL, which we don't want to expose in the interface.
> +  (remove nil (session-interactive-threads session)))
>
>  (defun foreground-thread (&optional (session *session*))
>    "Return the foreground thread of SESSION defaulting to the current
>  session."
> -  (first (interactive-threads session)))
> +  ;; naively this is (FIRST (INTERACTIVE-THREADS session)))
> +  ;; but it's more efficient to avoid the call to REMOVE.
> +  (declare (optimize speed)) ; inlines into finding the first non-nil item
> +  (find-if #'identity (session-interactive-threads session)))
>
>  #-win32
>  (defun make-listener-thread (tty-name)
> @@ -1888,6 +1884,7 @@ session."
>        ;; They must not participate in shutting other threads down.
>        (when (and *exit-in-progress* (not (thread-ephemeral-p thread)))
>          (%exit))
> +      (when *session* (%delete-thread-from-session thread))
>        ;; If collecting allocator metrics, transfer them to the global list
>        ;; so that we can summarize over exited threads.
>        #+allocator-metrics
> @@ -1924,11 +1921,6 @@ session."
>              ;; Operation on the global list must be atomic.
>              (sb-ext:atomic-push (cons sprof-data thread) *sprof-data*)))
>          (barrier (:write)))
> -      ;; After making the thread dead, remove from session. If this were done first,
> -      ;; we'd just waste time moving the thread into SESSION-THREADS (if it wasn't there)
> -      ;; only to remove it right away.
> -      (when *session*
> -        (%delete-thread-from-session thread))
>        (cond
>          ;; If possible, logically remove from *ALL-THREADS* by flipping a bit.
>          ;; Foreign threads remove themselves. They don't have an exit semaphore,
> @@ -2078,6 +2070,7 @@ See also: RETURN-FROM-THREAD, ABORT-THREAD."
>
>  ;;; System-internal use only
>  #+sb-thread
> +(progn
>  (defun make-system-thread (name function arguments symbol)
>    (let ((thread (%make-thread name t (make-semaphore :name name))))
>      (when symbol
> @@ -2085,41 +2078,38 @@ See also: RETURN-FROM-THREAD, ABORT-THREAD."
>        (set symbol thread))
>      (start-thread thread function arguments)))
>
> -#+sb-thread
> +;;; The native thread start procedure calls this function with one arg which is the
> +;;; pointer to the thread instance without tag bits.
> +(defun threadstartfun (arg)
> +  ;; If an error occurs prior to getting the thread into a consistent lisp state,
> +  ;; there's no chance of debugging anything anyway.
> +  (declare (optimize (safety 0)))
> +  (let ((new-thread (%make-lisp-obj (logior (get-lisp-obj-address arg)
> +                                            sb-vm:instance-pointer-lowtag))))
> +    ;; Now that this thread is known to GC, NEW-THREAD is either implicitly
> +    ;; pinned (on conservative gc) or movable. It can hance be deleted from
> +    ;; *STARTING-THREADS* list which occurs lazily on the next MAKE-THREAD.
> +    ;; To avoid unnecessary GC work meanwhile, smash the cell in *STARTING-THREADS*
> +    ;; that points to NEW-THREAD. That cell is pointed to by the startup-info.
> +    (rplaca (startup-info-thread-cell new-thread) 0)
> +    (init-thread-local-storage new-thread) ; assign *CURRENT-THREAD*
> +    ;; Foreign threads don't pass the saved FP modes, so the modes have to be
> +    ;; restored here and not in RUN.
> +    #+(or win32 darwin freebsd)
> +    (setf (sb-vm:floating-point-modes) (startup-info-fp-modes new-thread))
> +    ;; Join creator's session if there was one
> +    (enroll-thread-in-session new-thread (startup-info-session new-thread))
> +    (try-set-os-thread-name (thread-%name new-thread))
> +    ;; Expose this thread in *ALL-THREADS*.
> +    ;; Why not set this before calling pthread_create() ? If it fails there should
> +    ;; be no transient effect on the list of all threads. But it's indeterminate
> +    ;; whether the creating or created thread will make progress first,
> +    ;; so they both do this assignment.
> +    (setf (thread-%visible new-thread) 1))
> +  (run))
> +
>  (defun start-thread (thread function arguments)
> -  (let* ((trampoline
> -          (lambda (arg)
> -            ;; If an error occurs prior to getting the thread into a consistent lisp state,
> -            ;; there's no chance of debugging anything anyway.
> -            (declare (optimize (safety 0)))
> -            (let ((new-thread
> -                   (%make-lisp-obj (logior (get-lisp-obj-address arg)
> -                                           sb-vm:instance-pointer-lowtag))))
> -              ;; Now that this thread is known to GC, NEW-THREAD is either implicitly
> -              ;; pinned (on conservative gc) or movable. It can hance be deleted from
> -              ;; *STARTING-THREADS* list which occurs lazily on the next MAKE-THREAD.
> -              ;; To avoid unnecessary GC work meanwhile, smash the cell in *STARTING-THREADS*
> -              ;; that points to NEW-THREAD. That cell is pointed to by the startup-info.
> -              (rplaca (startup-info-thread-cell new-thread) 0)
> -              (init-thread-local-storage new-thread) ; assign *CURRENT-THREAD*
> -              ;; Expose this thread in *ALL-THREADS*.
> -              ;; Why not set this before calling pthread_create() ? If it fails there should
> -              ;; be no transient effect on the list of all threads. But it's indeterminate
> -              ;; whether the creating or created thread will make progress first,
> -              ;; so they both do this assignment.
> -              (setf (thread-%visible new-thread) 1)
> -              ;; Foreign threads don't pass the saved FP modes, so the modes have to be
> -              ;; restored here and not in RUN.
> -              #+(or win32 darwin freebsd)
> -              (setf (sb-vm:floating-point-modes) (startup-info-fp-modes new-thread))
> -              (try-set-os-thread-name (thread-%name new-thread))
> -              ;; Join creator's session if there was one
> -              (let ((session (startup-info-session new-thread)))
> -                (declare (sb-c::tlab :system))
> -                (when session
> -                  (sb-ext:atomic-push thread (session-new-enrollees session)))))
> -            (run)))
> -         (saved-sigmask (make-array (* sb-unix::sizeof-sigset_t sb-vm:n-byte-bits)
> +  (let* ((saved-sigmask (make-array (* sb-unix::sizeof-sigset_t sb-vm:n-byte-bits)
>                                      :element-type 'bit :initial-element 0))
>           (child-sigmask (make-array (* sb-unix::sizeof-sigset_t sb-vm:n-byte-bits)
>                                      :element-type 'bit :initial-element 0))
> @@ -2151,7 +2141,7 @@ See also: RETURN-FROM-THREAD, ABORT-THREAD."
>                 (cell (locally (declare (sb-c::tlab :system))
>                         (list thread)))
>                 (startup-info
> -                (vector trampoline cell *session* function arguments
> +                (vector #'threadstartfun cell *session* function arguments
>                          (if (position 1 child-sigmask) ; if there are any signals masked
>                              (copy-seq child-sigmask) ; heap-allocate to pass to the new thread
>                              nil) ; otherwise, don't pass the saved mask
> @@ -2205,6 +2195,7 @@ See also: RETURN-FROM-THREAD, ABORT-THREAD."
>      (with-pinned-objects (saved-sigmask)
>        (sb-unix::pthread-sigmask sb-unix::SIG_SETMASK saved-sigmask nil))
>      (if created thread (error "Could not create new OS thread."))))
> +) ; end PROGN
>
>  (defun join-thread (thread &key (default nil defaultp) timeout)
>    "Suspend current thread until THREAD exits. Return the result values
> diff --git a/src/cold/exports.lisp b/src/cold/exports.lisp
> index 72dc6f96a..54cbfcc5f 100644
> --- a/src/cold/exports.lisp
> +++ b/src/cold/exports.lisp
> @@ -3624,6 +3624,7 @@ package is deprecated in favour of SB-MOP.")
>    (:documentation "internal: lockfree lists")
>    (:use "CL" "SB-INT" "SB-EXT" "SB-SYS" "SB-KERNEL")
>    (:export "+TAIL+" "%NODE-NEXT" "GET-NEXT"
> +           "MAKE-ORDERED-LIST" "LFL-INSERT" "LFL-DELETE" "LFL-KEYS"
>             "MAKE-SO-SET/STRING" "MAKE-SO-SET/FIXNUM" "MAKE-SO-SET/ADDR"
>             "MAKE-SO-MAP/STRING" "MAKE-SO-MAP/FIXNUM" "MAKE-SO-MAP/ADDR"
>             "MULTIPLICATIVE-HASH"
> diff --git a/tests/make-thread.pure.lisp b/tests/make-thread.pure.lisp
> index 957ca8a62..82d3a201e 100644
> --- a/tests/make-thread.pure.lisp
> +++ b/tests/make-thread.pure.lisp
> @@ -134,6 +134,12 @@
>     (make-thread (make-a-closure-nontail (make-big-structure :x 0))
>                  :arguments (list 1 (make-other-big-structure)))))
>
> +;;; If the finalizer thread isn't stopped, and there is a lockfree list node pointing
> +;;; to the it, and such node happens to be in gen0, and was manipulated by LFL-INSERT
> +;;; when adding a new thread to *SESSION*, then this test could spuriously fail.
> +;;; Of course that has nothing to do with why it may have failed when session-threads
> +;;; was just a list, but it doesn't seem important now.
> +(sb-impl::finalizer-thread-stop)
>  ;;; Test that reusing memory from an exited thread does not point to junk.
>  ;;; In fact, assert something stronger: there are no young objects
>  ;;; between the current SP and end of stack.
> @@ -146,14 +152,17 @@
>                             (eq x (sb-kernel:fun-code-header #'actually-get-stack-roots))))
>                       (tryit :print nil))))
>      ;; should be not many things pointed to by the stack
> -    (assert (< (length list) #+x86    38   ; more junk, I don't know why
> -                             #+x86-64 30   ; less junk, I don't know why
> -                             #-(or x86 x86-64) 44)) ; even more junk
> -    ;; Either no objects are in GC generation 0, or all are, depending on
> -    ;; whether CORE_PAGE_GENERATION has been set to 0 for testing.
> -    (let ((n-objects-in-g0 (count 0 list :key #'sb-kernel:generation-of)))
> -      (assert (or (= n-objects-in-g0 0)
> -                  (= n-objects-in-g0 (length list)))))))
> +    (assert (< (length list) 44))
> +    ;; No young object is pointed to by the stack in its freshly born state.
> +    ;; This test is only sensible if CORE_PAGE_GENERATION has its default value
> +    ;; of PSEUDO_STATIC_GENERATION
> +    (when (= (sb-kernel:generation-of #'car) sb-vm:+pseudo-static-generation+)
> +      (let ((gens (mapcar #'sb-kernel:generation-of list)))
> +        (when (find 0 gens)
> +          (format t "Unexpected generation 0 objects:~%")
> +          (mapc (lambda (x g) (when (eql g 0) (format t "g~d ~s~%" g x)))
> +                list gens)
> +          (error "test failed"))))))
>
>  ;; lp#1595699
>  (test-util:with-test (:name :start-thread-in-without-gcing
> diff --git a/tests/session.impure.lisp b/tests/session.impure.lisp
> index 23c9ad84b..d47a776a9 100644
> --- a/tests/session.impure.lisp
> +++ b/tests/session.impure.lisp
> @@ -135,6 +135,8 @@
>      (sb-thread:release-foreground thread)
>      (get-foreground-quietly)))
>
> +(defun session-threads (x) (sb-lockless:lfl-keys (sb-thread::session-threads x)))
> +
>  (with-test (:name :new-session)
>    (let ((old-session sb-thread::*session*))
>      (sb-thread:with-new-session ()
> @@ -142,6 +144,6 @@
>          (assert (not (eq old-session new-session)))
>          ;; this thread should not be in session-threads of the old session
>          (assert (not (member sb-thread:*current-thread*
> -                             (sb-thread::session-threads old-session))))
> +                             (session-threads old-session))))
>          (assert (member sb-thread:*current-thread*
> -                        (sb-thread::session-threads new-session)))))))
> +                        (session-threads new-session)))))))
>
> -----------------------------------------------------------------------
>
>
> hooks/post-receive
> --
> SBCL
>
>
> _______________________________________________
> Sbcl-commits mailing list
> Sbc...@li...
> https://lists.sourceforge.net/lists/listinfo/sbcl-commits

Re: [Sbcl-devel] [Sbcl-commits] master: Delay adding new thread to *session*

[Douglas K. <do...@go...>]

On Sat, Jul 26, 2025 at 9:25 PM Stas Boukarev <sta...@gm...> wrote:

> It's not OS- or architecture-specific.
>
> I understand that it should not be OS or arch-specific, but all I'm saying
is it passes for me:

::: Running :EXPECTED-GC-ROOTS

::: Success :EXPECTED-GC-ROOTS

Re: [Sbcl-devel] [Sbcl-commits] master: Delay adding new thread to *session*

[Stas B. <sta...@gm...>]

It's not OS- or architecture-specific.

On Sun, Jul 27, 2025 at 4:23 AM Douglas Katzman <do...@go...> wrote:
>
> I suspect we probably don't care about that failure.  I'll need to do a cloud run to hammer on it, since this failure did not occur on linux or macos when developing the change.
>

Re: [Sbcl-devel] [Sbcl-commits] master: Delay adding new thread to *session*

[Douglas K. <do...@go...>]

I suspect we probably don't care about that failure.  I'll need to do a
cloud run to hammer on it, since this failure did not occur on linux or
macos when developing the change.

Re: [Sbcl-devel] [Sbcl-commits] master: Delay adding new thread to *session*

[Stas B. <sta...@gm...>]

I get failures in make-thread.pure.lisp:

::: UNEXPECTED-FAILURE :EXPECTED-GC-ROOTS due to SIMPLE-ERROR:
        "The assertion
         (OR (= N-OBJECTS-IN-G0 0) (= N-OBJECTS-IN-G0 (LENGTH LIST))) failed."

On Sun, Jul 27, 2025 at 3:20 AM snuglas via Sbcl-commits
<sbc...@li...> wrote:
>
> The branch "master" has been updated in SBCL:
>        via  3e20eb9c5f18787f7407aab883ed869f6008065f (commit)
>       from  d297265cc8108f43fc94577b0d07116fb2bc5b65 (commit)
>
> - Log -----------------------------------------------------------------
> commit 3e20eb9c5f18787f7407aab883ed869f6008065f
> Author: Douglas Katzman <do...@go...>
> Date:   Sat Jul 26 22:51:17 2025 +0000
>
>     Delay adding new thread to *session*
>
>     resulting in one less thing to undo if pthread_create() fails
> ---
>  src/code/alien-callback.lisp | 14 ++++++-------
>  src/code/target-thread.lisp  | 50 +++++++++++++++++++++++++-------------------
>  src/code/thread-structs.lisp |  4 ++--
>  3 files changed, 37 insertions(+), 31 deletions(-)
>
> diff --git a/src/code/alien-callback.lisp b/src/code/alien-callback.lisp
> index 824825a8b..d724ec4b8 100644
> --- a/src/code/alien-callback.lisp
> +++ b/src/code/alien-callback.lisp
> @@ -346,13 +346,13 @@ function value."
>  (in-package "SB-THREAD")
>  #+sb-thread
>  (defun enter-foreign-callback (index return arguments)
> -  (let ((thread (init-thread-local-storage (make-foreign-thread))))
> -    (dx-let ((startup-info (vector nil ; trampoline is n/a
> -                                   nil ; cell in *STARTING-THREADS* is n/a
> -                                   #'sb-alien::enter-alien-callback
> -                                   (list index return arguments)
> -                                   nil nil))) ; sigmask + fpu state bits
> +  (dx-let ((startup-info (vector nil ; trampoline is not applicable
> +                                 nil ; cell in *STARTING-THREADS* is not applicable
> +                                 nil ; *SESSION* is not applicable
> +                                 #'sb-alien::enter-alien-callback
> +                                 (list index return arguments)
> +                                 nil nil))) ; sigmask + fpu state bits
> +    (let ((thread (init-thread-local-storage (make-foreign-thread startup-info))))
>        (copy-primitive-thread-fields thread)
> -      (setf (thread-startup-info thread) startup-info)
>        (update-all-threads (thread-primitive-thread thread) thread)
>        (run))))
> diff --git a/src/code/target-thread.lisp b/src/code/target-thread.lisp
> index 4abe335da..c997ddfb6 100644
> --- a/src/code/target-thread.lisp
> +++ b/src/code/target-thread.lisp
> @@ -213,9 +213,10 @@ exited. The offending thread can be accessed using THREAD-ERROR-THREAD."))
>    ;; If NIL or non-base-string, just leave the OS thread name alone
>    #+sb-thread
>    `(with-alien ((sb-set-os-thread-name (function void system-area-pointer) :extern))
> -     (when (simple-base-string-p ,str)
> -       (with-pinned-objects (,str)
> -         (alien-funcall sb-set-os-thread-name (vector-sap ,str))))))
> +     (let ((str ,str))
> +       (when (simple-base-string-p str)
> +         (with-pinned-objects (str)
> +           (alien-funcall sb-set-os-thread-name (vector-sap str)))))))
>
>  (declaim (inline thread-name))
>  (defun thread-name (thread)
> @@ -1872,6 +1873,8 @@ session."
>  ;;; Remove thread from its session, if it has one, and from *all-threads*.
>  ;;; Also clobber the pointer to the primitive thread
>  ;;; which makes THREAD-ALIVE-P return false hereafter.
> +;;; Note that in the case of a native (foreign) thread calling into Lisp,
> +;;; this isn't really "thread exit" - it's just the end of Lisp's execution.
>  (defmacro handle-thread-exit ()
>    '(let* ((thread *current-thread*)
>             ;; use the "funny fixnum" representation
> @@ -1962,12 +1965,19 @@ session."
>          ;; on a condition var. (Good luck trying to make this many threads)
>          (signal-semaphore sem 1000000))))
>
> +;; STARTUP-INFO = #(c-trampoline thread-cell *SESSION* function arglist sigmask fp-modes)
> +;; thread-cell is a cons in *STARTING-THREADS* which informs GC what to pin
> +(defmacro startup-info-thread-cell (th) `(svref (thread-startup-info ,th) 1))
> +(defmacro startup-info-session (th) `(svref (thread-startup-info ,th) 2))
> +(defmacro startup-info-function (th) `(svref (thread-startup-info ,th) 3))
> +(defmacro startup-info-arglist (th) `(svref (thread-startup-info ,th) 4))
> +(defmacro startup-info-sigmask (th) `(svref (thread-startup-info ,th) 5))
> +(defmacro startup-info-fp-modes (th) `(svref (thread-startup-info ,th) 6))
> +
>  (defun run (); All threads other than the initial thread start via this function.
>    (set-thread-control-stack-slots *current-thread*)
> -  (let ((name (thread-%name *current-thread*)))
> -    (try-set-os-thread-name name))
>    (flet ((unmask-signals ()
> -           (let ((mask (svref (thread-startup-info *current-thread*) 4)))
> +           (let ((mask (startup-info-sigmask *current-thread*)))
>                    (if mask
>                        ;; If the original mask (at thread creation time) was provided,
>                        ;; then restore exactly that mask.
> @@ -2015,12 +2025,10 @@ session."
>                                  (unwind-protect
>                                       (catch '%return-from-thread
>                                         (sb-c::inspect-unwinding
> -                                        ;; STARTUP-INFO =
> -                                        ;;   #(c-trampoline starting-thread-cell func args sigmask fp-modes)
>                                          ;; Clobbering STARTUP-INFO prevents garbage retention,
>                                          ;; but is there some significance to using the value 0?
> -                                        (apply (svref (thread-startup-info *current-thread*) 2)
> -                                               (prog1 (svref (thread-startup-info *current-thread*) 3)
> +                                        (apply (startup-info-function *current-thread*)
> +                                               (prog1 (startup-info-arglist *current-thread*)
>                                                   (setf (thread-startup-info *current-thread*) 0)))
>                                          #'sb-di::catch-runaway-unwind))
>                                    (when (and *exit-in-progress*
> @@ -2064,8 +2072,7 @@ See also: RETURN-FROM-THREAD, ABORT-THREAD."
>              (arguments)
>              "Argument passed to ~S, ~S, is an improper list."
>              'make-thread arguments)
> -    (start-thread (sb-vm:without-arena "make-thread"
> -                      (%make-thread name nil (make-semaphore :name name)))
> +    (start-thread (sb-vm:without-arena (%make-thread name nil (make-semaphore :name name)))
>                    (coerce function 'function)
>                    (ensure-list arguments))))
>
> @@ -2093,7 +2100,7 @@ See also: RETURN-FROM-THREAD, ABORT-THREAD."
>                ;; *STARTING-THREADS* list which occurs lazily on the next MAKE-THREAD.
>                ;; To avoid unnecessary GC work meanwhile, smash the cell in *STARTING-THREADS*
>                ;; that points to NEW-THREAD. That cell is pointed to by the startup-info.
> -              (rplaca (svref (thread-startup-info new-thread) 1) 0)
> +              (rplaca (startup-info-thread-cell new-thread) 0)
>                (init-thread-local-storage new-thread) ; assign *CURRENT-THREAD*
>                ;; Expose this thread in *ALL-THREADS*.
>                ;; Why not set this before calling pthread_create() ? If it fails there should
> @@ -2104,8 +2111,13 @@ See also: RETURN-FROM-THREAD, ABORT-THREAD."
>                ;; Foreign threads don't pass the saved FP modes, so the modes have to be
>                ;; restored here and not in RUN.
>                #+(or win32 darwin freebsd)
> -              (setf (sb-vm:floating-point-modes)
> -                    (svref (thread-startup-info *current-thread*) 5)))
> +              (setf (sb-vm:floating-point-modes) (startup-info-fp-modes new-thread))
> +              (try-set-os-thread-name (thread-%name new-thread))
> +              ;; Join creator's session if there was one
> +              (let ((session (startup-info-session new-thread)))
> +                (declare (sb-c::tlab :system))
> +                (when session
> +                  (sb-ext:atomic-push thread (session-new-enrollees session)))))
>              (run)))
>           (saved-sigmask (make-array (* sb-unix::sizeof-sigset_t sb-vm:n-byte-bits)
>                                      :element-type 'bit :initial-element 0))
> @@ -2139,7 +2151,7 @@ See also: RETURN-FROM-THREAD, ABORT-THREAD."
>                 (cell (locally (declare (sb-c::tlab :system))
>                         (list thread)))
>                 (startup-info
> -                (vector trampoline cell function arguments
> +                (vector trampoline cell *session* function arguments
>                          (if (position 1 child-sigmask) ; if there are any signals masked
>                              (copy-seq child-sigmask) ; heap-allocate to pass to the new thread
>                              nil) ; otherwise, don't pass the saved mask
> @@ -2154,9 +2166,6 @@ See also: RETURN-FROM-THREAD, ABORT-THREAD."
>        ;; (LIST-ALL-THREADS) until a POSIX thread is successfully started.
>        (setf (thread-%visible thread) 0)
>        (update-all-threads (sap-int thread-sap) thread)
> -      (when *session*
> -        (locally (declare (sb-c::tlab :system))
> -          (sb-ext:atomic-push thread (session-new-enrollees *session*))))
>        ;; Absence of the startup semaphore notwithstanding, creation is synchronized
>        ;; so that we can prevent new threads from starting, typically in SB-POSIX:FORK
>        ;; or SAVE-LISP-AND-DIE.
> @@ -2192,14 +2201,11 @@ See also: RETURN-FROM-THREAD, ABORT-THREAD."
>              (sb-thread::call-with-system-mutex #'thunk *make-thread-lock*)))
>        (unless created ; Remove side-effects of trying to create
>          (delete-from-all-threads (sap-int thread-sap))
> -        (when *session*
> -          (%delete-thread-from-session thread))
>          (free-thread-struct thread-sap)))
>      (with-pinned-objects (saved-sigmask)
>        (sb-unix::pthread-sigmask sb-unix::SIG_SETMASK saved-sigmask nil))
>      (if created thread (error "Could not create new OS thread."))))
>
> -
>  (defun join-thread (thread &key (default nil defaultp) timeout)
>    "Suspend current thread until THREAD exits. Return the result values
>  of the thread function.
> diff --git a/src/code/thread-structs.lisp b/src/code/thread-structs.lisp
> index d0b1fcde4..58a0979df 100644
> --- a/src/code/thread-structs.lisp
> +++ b/src/code/thread-structs.lisp
> @@ -123,7 +123,7 @@ in future versions."
>    ;; At the beginning of the thread's life, this is a vector of data required
>    ;; to start the user code. At the end, is it pointer to the 'struct thread'
>    ;; so that it can be either freed or reused.
> -  (startup-info 0 :type (or fixnum (simple-vector 6)))
> +  (startup-info 0 :type (or fixnum (simple-vector 7)))
>    ;; Whether this thread should be returned in LIST-ALL-THREADS.
>    ;; This is almost-but-not-quite the same as what formerly
>    ;; might have been known as the %ALIVE-P flag.
> @@ -169,7 +169,7 @@ in future versions."
>  (sb-xc:defstruct (foreign-thread
>                    (:copier nil)
>                    (:include thread (%name "callback"))
> -                  (:constructor make-foreign-thread ())
> +                  (:constructor make-foreign-thread (startup-info))
>                    (:conc-name "THREAD-"))
>    "Type of native threads which are attached to the runtime as Lisp threads
>  temporarily.")
>
> -----------------------------------------------------------------------
>
>
> hooks/post-receive
> --
> SBCL
>
>
> _______________________________________________
> Sbcl-commits mailing list
> Sbc...@li...
> https://lists.sourceforge.net/lists/listinfo/sbcl-commits

Re: [Sbcl-devel] posix io; [Sbcl-bugs] *terminal-io* doesn't buffer its input?

[steve g. <sgo...@gm...>]

On 7/10/25 11:04, Stas Boukarev wrote:
> Fixed, thanks.
> 
> On Thu, Jul 10, 2025 at 6:02 PM Lee Jia Hong <jia...@ou...> wrote:
>>
>> Hi,
>>
>> Is this a buggy behavior? At the terminal, after typing a line and
>> Enter, only the first char is read via `(read-char *terminal-io* ...)`.
>> To illustrate:
>>


some code for effecting filedes on streams.





>>       $ sbcl --no-sysinit --no-userinit --load main.lisp
>>       ...
>>       * (main1)
>>       Hi there
>>       H                 ; cursor stops here, but insert newline again for
>> clarity
>>
>>       one two three
>>       o
>>
>>       1234567890
>>       1
>>
>>       NIL
>>       * (main)        ; using *standard-input/-output*
>>       Hi there
>>       Hi there
>>       one two three
>>       one two three
>>       1234567890
>>       1234567890
>>       NIL
>>
>> I would expect I/O to `*terminal-io*` behaves like *standard-input/-output*.
>>
>> For comparison, running the same code with CCL (v1.13) gives the
>> expected result:
>>
>>       $ ccl -l main.lisp
>>       ? (main1)
>>       Hi there
>>       Hi there
>>       one two three
>>       one two three
>>       1234567890
>>       1234567890
>>       NIL
>>       ? (main)
>>       Hi there
>>       Hi there
>>       one two three
>>       one two three
>>       1234567890
>>       1234567890
>>       NIL
>>
>> ## Context:
>> SBCL version: SBCL 2.5.6
>> Env: Linux x86_64.
>>
>> Content of `main.lisp`:
>>
>>       (defun main (&optional (input *standard-input*) (output
>> *standard-output*))
>>         (loop for ch = (read-char input nil 'eof)
>>               until (eq ch 'eof)
>>               do (princ ch output)
>>                  (finish-output output)))
>>
>>       (defun main1 ()
>>         (main *terminal-io* *terminal-io*))
>>
>>
>>
>> Regards,
>>
>> Jia Hong
>>
>>
>>
>> _______________________________________________
>> Sbcl-bugs mailing list
>> Sbc...@li...
>> https://lists.sourceforge.net/lists/listinfo/sbcl-bugs
> 
> 
> _______________________________________________
> Sbcl-bugs mailing list
> Sbc...@li...
> https://lists.sourceforge.net/lists/listinfo/sbcl-bugs

Re: [Sbcl-devel] [Sbcl-bugs] *terminal-io* doesn't buffer its input?

[steve g. <sgo...@gm...>]

On 7/10/25 11:04, Stas Boukarev wrote:
> Fixed, thanks.
> 
> On Thu, Jul 10, 2025 at 6:02 PM Lee Jia Hong <jia...@ou...> wrote:
>>
>> Hi,
>>
>> Is this a buggy behavior? At the terminal, after typing a line and
>> Enter, only the first char is read via `(read-char *terminal-io* ...)`.
>> To illustrate:
>>


some code for effecting filedes on streams.





>>       $ sbcl --no-sysinit --no-userinit --load main.lisp
>>       ...
>>       * (main1)
>>       Hi there
>>       H                 ; cursor stops here, but insert newline again for
>> clarity
>>
>>       one two three
>>       o
>>
>>       1234567890
>>       1
>>
>>       NIL
>>       * (main)        ; using *standard-input/-output*
>>       Hi there
>>       Hi there
>>       one two three
>>       one two three
>>       1234567890
>>       1234567890
>>       NIL
>>
>> I would expect I/O to `*terminal-io*` behaves like *standard-input/-output*.
>>
>> For comparison, running the same code with CCL (v1.13) gives the
>> expected result:
>>
>>       $ ccl -l main.lisp
>>       ? (main1)
>>       Hi there
>>       Hi there
>>       one two three
>>       one two three
>>       1234567890
>>       1234567890
>>       NIL
>>       ? (main)
>>       Hi there
>>       Hi there
>>       one two three
>>       one two three
>>       1234567890
>>       1234567890
>>       NIL
>>
>> ## Context:
>> SBCL version: SBCL 2.5.6
>> Env: Linux x86_64.
>>
>> Content of `main.lisp`:
>>
>>       (defun main (&optional (input *standard-input*) (output
>> *standard-output*))
>>         (loop for ch = (read-char input nil 'eof)
>>               until (eq ch 'eof)
>>               do (princ ch output)
>>                  (finish-output output)))
>>
>>       (defun main1 ()
>>         (main *terminal-io* *terminal-io*))
>>
>>
>>
>> Regards,
>>
>> Jia Hong
>>
>>
>>
>> _______________________________________________
>> Sbcl-bugs mailing list
>> Sbc...@li...
>> https://lists.sourceforge.net/lists/listinfo/sbcl-bugs
> 
> 
> _______________________________________________
> Sbcl-bugs mailing list
> Sbc...@li...
> https://lists.sourceforge.net/lists/listinfo/sbcl-bugs

Re: [Sbcl-devel] freeze for sbcl-2.5.7

[Douglas K. <do...@go...>]

to answer my own question: this doesn't appear new for the month. The
transform tried to use the nonexistent slot SETF function going back quite
far.
Why is it even allowed to write a slot that is declared read-only though?

>

Re: [Sbcl-devel] freeze for sbcl-2.5.7

[Douglas K. <do...@go...>]

Is the following a regression with respect to anything you or I did to the
slot-value optimizer in the case of writing to a declared read-only slot?
(Because the spec effing sucks of course)
The transform now goes to (funcall #'(setf the-slot) ...) which is a
nonexistent function.  I thought it used to use %instance-set directly but
I could be mistaken.
In any event, there is clearly an observable semantic difference based on
whether the optimizer kicked in.
If it's not a regression for the month, I guess we could leave it.  If it
is, we should most definitely do something.

(defstruct mystruct (a nil :read-only t))
(defun set-ro-slot (z) (setf (slot-value (the mystruct z) 'a) :somevalue))

* (compile-file "foo.lisp")
; in: DEFUN SET-RO-SLOT
;     (SETF (SLOT-VALUE (THE MYSTRUCT Z) 'A) :SOMEVALUE)
;
; caught STYLE-WARNING:
;   undefined function: (COMMON-LISP:SETF COMMON-LISP-USER::MYSTRUCT-A)
;
; compilation unit finished
;   Undefined function:
;     (SETF MYSTRUCT-A)
;   caught 1 STYLE-WARNING condition
* (load "...")
* (set-ro-slot (make-mystruct))

debugger invoked on a UNDEFINED-FUNCTION @B800000C0C in thread
#<THREAD tid=3941849 "main thread" RUNNING {1200B38003}>:
  The function (COMMON-LISP:SETF COMMON-LISP-USER::MYSTRUCT-A) is undefined.

Re: [Sbcl-devel] slot-value optimizations

[Stas B. <sta...@gm...>]

speed 3 can result in worse constraints because of more
variable-elimination, and lvars do not have constraints. Sometimes the
reverse is also true, having variables prevents some type derivation.

On Fri, Jul 25, 2025 at 9:51 PM Douglas Katzman <do...@go...> wrote:
>
> Pursuing this further, I see that different compilation policies leave our lisp image with a very different number of functions named in the pattern of
>  #<STANDARD-GENERIC-FUNCTION (SB-PCL::SLOT-ACCESSOR :GLOBAL {something-something} SB-PCL::WRITER) (2)>
> and the aspect I find counterintuitive is that (speed 3) create more of these.
> I would have guessed that speed 3 puts greater emphasis on obtaining good type information and therefore concluding that SLOT-VALUE is invoked on a structure-object (or even better, a specific type).
> So I'm expecting only calls to structure accessors. Would it be useful to come up with small examples that show the different behavior, or is this basically "yeah, well obviously that's going to happen, no surprise here"
>

Re: [Sbcl-devel] slot-value optimizations

[Douglas K. <do...@go...>]

Pursuing this further, I see that different compilation policies leave our
lisp image with a very different number of functions named in the pattern of
 #<STANDARD-GENERIC-FUNCTION (SB-PCL::SLOT-ACCESSOR :GLOBAL
{something-something} SB-PCL::WRITER) (2)>
and the aspect I find counterintuitive is that (speed 3) create more of
these.
I would have guessed that speed 3 puts greater emphasis on obtaining good
type information and therefore concluding that SLOT-VALUE is invoked on a
structure-object (or even better, a specific type).
So I'm expecting only calls to structure accessors. Would it be useful to
come up with small examples that show the different behavior, or is this
basically "yeah, well obviously that's going to happen, no surprise here"

Re: [Sbcl-devel] [Sbcl-bugs] possible sxhash bug

[Douglas K. <do...@go...>]

Can you provide a self-contained example for the developers to look at ?

[Sbcl-devel] (find-if #'my-test items :from-end t)

[Andreas F. <a.f...@gm...>]

If the user is considered "screwy enough" for "turnabout [to be] fair play", surely it would be polite to issue some kind of warning?

(Not sure if it matters: ccl appears to behave the same as sbcl here, while clisp, abcl, gcl appear to differ.)

git show -b -w 18d4de696b -- seqtran.lisp | grep -A9 'This hack of dealing with non-NIL FROM-END'
+	     ;; This hack of dealing with non-NIL FROM-END for list data
+	     ;; by iterating forward through the list and keeping track of
+	     ;; the last time we found a match might be more screwy than
+	     ;; what the user expects, but it seems to be allowed by the
+	     ;; ANSI standard. (And if the user is screwy enough to ask
+	     ;; for FROM-END behavior on list data, turnabout is fair play.)
+	     ;;
+	     ;; It's also not enormously efficient, calling PREDICATE and
+	     ;; KEY more often than necessary; but all the alternatives
+	     ;; seem to have their own efficiency problems.

Re: [Sbcl-devel] [Sbcl-bugs] possible sxhash bug

[Stas B. <sta...@gm...>]

sort doesn't use sxhash.

On Mon, Jul 21, 2025 at 5:20 PM Dave Brown <dav...@ho...> wrote:
>
> Hi -- I've been experiencing intermittent, but repeatable, crashes when running my search algorithm (:wouldwork) that I think are related to sorting an alist (produced by alexandria from a fixnum hash table).  When I switch from using sort (which I understand uses sxhash) to using merge-sort-list (by Paul Khuong?) the error seems to go away,  but it seems to double the compute time.  Note that the resultant alists are fairly small < 10 items. Here are some basic details & thanks for any insights:
>
> Message:
> CORRUPTION WARNING in SBCL pid 226247400: Memory fault at 0000000006ae9dff (pc=00000010006a16a0 [code 00000010006a1250+0x450 ID 0x43d0], fp=00000000005fee48, sp=00000000005fee10)7400 The integrity of this image is possibly compromised. Continuing with fingers crossed. debugger invoked on a SB-SYS:MEMORY-FAULT-ERROR in thread #<THREAD tid=7400 "main thread" RUNNING {1102A28093}>: Unhandled memory fault at #x6AE9DFF. Type HELP for debugger help, or (SB-EXT:EXIT) to exit from SBCL. restarts (invokable by number or by possibly-abbreviated name): 0: [ABORT] Exit debugger, returning to top level. ((LABELS SB-IMPL::SXHASH-RECURSE :IN SB-IMPL::PERHAPS-TRUNCATED-EQUAL-HASH) #<unavailable argument> #<unavailable argument>) 0] down ((LABELS SB-IMPL::SXHASH-RECURSE :IN SB-IMPL::PERHAPS-TRUNCATED-EQUAL-HASH) ((112107125 . T) (112109125 . T) (118108125 . T) (119109125 . T)) 17)
>
> Possible source:
> (defun idb-to-sorted-alist (idb-hash-table)
>   "Converts an IDB hash table to a sorted alist using Alexandria."
>   (sort (alexandria:hash-table-alist idb-hash-table)
>         #'< :key #'car))  ; Sort by fixnum keys
>
> OS:
> Windows 11 Pro, ver 23H2, build 22631.5624
>
> CPU:
> Intel(R) Core(TM) i9-14900K   3.20 GHz
>
> Memory:
> Corsair, 32 GB (2x16), DDR5-4800
>
> SBCL:
> C:\Windows\System32>sbcl --dynamic-space-size 28000
> This is SBCL 2.5.6, an implementation of ANSI Common Lisp.
>
>
> _______________________________________________
> Sbcl-bugs mailing list
> Sbc...@li...
> https://lists.sourceforge.net/lists/listinfo/sbcl-bugs

[Sbcl-devel] freeze for sbcl-2.5.7

[Christophe R. <cs...@ca...>]

Dear all,

Please could we contemplate what we have achieved this month, without
complacency, and with ruthless focus address regressions and critical
problems while aiming to stabilize rather than destabilize what we
currently have?  I will aim to perform release steps next weekend.

Thank you!

Christophe

Re: [Sbcl-devel] [Sbcl-bugs] Recursive `#.` forms that mismatch a structure slot type can cause infinite recursion in reading

[Stas B. <sta...@gm...>]

Fixed. Thanks.

On Sat, Jul 12, 2025 at 5:31 PM Bohong Huang via Sbcl-bugs
<sbc...@li...> wrote:
>
> Hello SBCL developers,
>
> The following code:
>
>
>     (defstruct a
>       (a nil :type (or a null)))
>
>     (defun recursive-a ()
>       (let ((a (make-a)))
>         (setf (a-a a) a)))
>
>     (read-from-string "#S(A :A (#.(RECURSIVE-A)))")
>
>
> can exhaust the control stack during execution:
>
>
>     Control stack exhausted (no more space for function call frames).
>     This is probably due to heavily nested or infinitely recursive function
>     calls, or a tail call that SBCL cannot or has not optimized away.
>
>     PROCEED WITH CAUTION.
>        [Condition of type SB-KERNEL::CONTROL-STACK-EXHAUSTED]
>
>     Restarts:
>      0: [RETRY] Retry SLY interactive evaluation request.
>      1: [*ABORT] Return to SLY's top level.
>      2: [ABORT] abort thread (#<THREAD tid=5613 "slynk-worker" RUNNING {1201E9DC13}>)
>
>     Backtrace:
>      0: (SB-KERNEL::CONTROL-STACK-EXHAUSTED-ERROR)
>      1: ("foreign function: call_into_lisp_")
>      2: ("foreign function: post_signal_tramp")
>      3: (SB-IMPL::CONTAINS-MARKER #1=#S(A :A #1#))
>      4: ((LABELS SB-IMPL::RECURSE :IN SB-IMPL::SHARP-EQUAL-VISIT) #1=#S(A :A #1#))
>      5: (SB-IMPL::SHARP-EQUAL-VISIT #1=#S(A :A #1#) #<FUNCTION (FLET SB-IMPL::PROCESS :IN SB-IMPL::CONTAINS-MARKER) {1200CD165B}> #<FUNCTION (FLET SB-IMPL::VISIT :IN SB-IMPL::CONTAINS-MARKER) {7F4106A3017B}>)
>      6: (SB-IMPL::CONTAINS-MARKER #1=#S(A :A #1#))
>      7: ((LABELS SB-IMPL::RECURSE :IN SB-IMPL::SHARP-EQUAL-VISIT) #1=#S(A :A #1#))
>      8: (SB-IMPL::SHARP-EQUAL-VISIT #1=#S(A :A #1#) #<FUNCTION (FLET SB-IMPL::PROCESS :IN SB-IMPL::CONTAINS-MARKER) {1200CD165B}> #<FUNCTION (FLET SB-IMPL::VISIT :IN SB-IMPL::CONTAINS-MARKER) {7F4106A3030B}>)
>      9: (SB-IMPL::CONTAINS-MARKER #1=#S(A :A #1#))
>     10: ((LABELS SB-IMPL::RECURSE :IN SB-IMPL::SHARP-EQUAL-VISIT) #1=#S(A :A #1#))
>     11: (SB-IMPL::SHARP-EQUAL-VISIT #1=#S(A :A #1#) #<FUNCTION (FLET SB-IMPL::PROCESS :IN SB-IMPL::CONTAINS-MARKER) {1200CD165B}> #<FUNCTION (FLET SB-IMPL::VISIT :IN SB-IMPL::CONTAINS-MARKER) {7F4106A3049B}>)
>     12: (SB-IMPL::CONTAINS-MARKER #1=#S(A :A #1#))
>
>     ...
>
>     15134: (SB-IMPL::SHARP-EQUAL-VISIT #1=#S(A :A #1#) #<FUNCTION (FLET SB-IMPL::PROCESS :IN SB-IMPL::CONTAINS-MARKER) {1200CD165B}> #<FUNCTION (FLET SB-IMPL::VISIT :IN SB-IMPL::CONTAINS-MARKER) {7F4106C1C92B}>)
>     15135: (SB-IMPL::CONTAINS-MARKER #1=#S(A :A #1#))
>     15136: ((LABELS SB-IMPL::RECURSE :IN SB-IMPL::SHARP-EQUAL-VISIT) #1=#S(A :A #1#))
>     15137: ((LABELS SB-IMPL::RECURSE :IN SB-IMPL::SHARP-EQUAL-VISIT) (#1=#S(A :A #1#)))
>     15138: (SB-IMPL::SHARP-EQUAL-VISIT (#1=#S(A :A #1#)) #<FUNCTION (FLET SB-IMPL::PROCESS :IN SB-IMPL::CONTAINS-MARKER) {1200CD165B}> #<FUNCTION (FLET SB-IMPL::VISIT :IN SB-IMPL::CONTAINS-MARKER) {7F4106C1CB3B}..
>     15139: (SB-IMPL::CONTAINS-MARKER (#1=#S(A :A #1#)))
>     15140: ((LAMBDA (SB-IMPL::C) :IN SB-IMPL::SHARP-S) #<TYPE-ERROR expected-type: (OR A NULL) datum: (#1=#S(A :A #1#))>)
>     15141: (SB-KERNEL::%SIGNAL #<TYPE-ERROR expected-type: (OR A NULL) datum: (#1=#S(A :A #1#))>)
>     15142: (ERROR #<TYPE-ERROR expected-type: (OR A NULL) datum: (#1=#S(A :A #1#))>)
>     15143: (SB-KERNEL:WITH-SIMPLE-CONDITION-RESTARTS ERROR NIL #<TYPE-ERROR expected-type: (OR A NULL) datum: (#1=#S(A :A #1#))>)
>     15144: ((LABELS SB-KERNEL::TRY :IN SB-KERNEL::RESTART-TYPE-ERROR) #<TYPE-ERROR expected-type: (OR A NULL) datum: (#1=#S(A :A #1#))>)
>     15145: (SB-KERNEL::RESTART-TYPE-ERROR (OR A NULL) #<TYPE-ERROR expected-type: (OR A NULL) datum: (#1=#S(A :A #1#))> -60)
>     15146: (SB-KERNEL:INTERNAL-ERROR #.(SB-SYS:INT-SAP #X7F4106C1D040) #<unused argument>)
>     15147: ("foreign function: call_into_lisp_")
>     15148: ("foreign function: funcall2")
>     15149: ("foreign function: interrupt_internal_error")
>     15150: ("foreign function: #x55F1FE926B41")
>     15151: (MAKE-A :A (#1=#S(A :A #1#)))
>     15152: (SB-IMPL::SHARP-S #<SB-IMPL::STRING-INPUT-STREAM {12020A83A3}> #\S NIL)
>     15153: (SB-IMPL::READ-MAYBE-NOTHING #<SB-IMPL::STRING-INPUT-STREAM {12020A83A3}> #\#)
>     15154: (SB-IMPL::%READ-PRESERVING-WHITESPACE #<SB-IMPL::STRING-INPUT-STREAM {12020A83A3}> T (NIL) T)
>     15155: (SB-IMPL::%READ-PRESERVING-WHITESPACE #<SB-IMPL::STRING-INPUT-STREAM {12020A83A3}> T (NIL) NIL)
>     15156: (READ #<SB-IMPL::STRING-INPUT-STREAM {12020A83A3}> T NIL NIL)
>     15157: (SB-IMPL::%READ-FROM-STRING/SAFE "#S(A :A (#.(RECURSIVE-A)))" T NIL 0 NIL NIL)
>     15158: (SB-INT:SIMPLE-EVAL-IN-LEXENV (READ-FROM-STRING "#S(A :A (#.(RECURSIVE-A)))") #<NULL-LEXENV>)
>     15159: (EVAL (READ-FROM-STRING "#S(A :A (#.(RECURSIVE-A)))"))
>
>
> This issue appears to be an issue only in recent versions of SBCL.
> Thank you in advance for taking the time to look into this issue.
>
>
> Best regards,
>
> Bohong Huang
>
>
>
> _______________________________________________
> Sbcl-bugs mailing list
> Sbc...@li...
> https://lists.sourceforge.net/lists/listinfo/sbcl-bugs

Re: [Sbcl-devel] [Sbcl-bugs] SB-KERNEL:%MAKE-DOUBLE-FLOAT undefined in SCALE-FLOAT / space 0

[Stas B. <sta...@gm...>]

Fixed. Thanks.

On Wed, Jul 16, 2025 at 1:46 PM Eric Marsden
<eri...@ri...> wrote:
>
> Hi,
>
> This is from random-integer testing on AMD64.
>
> * (lisp-implementation-version)
> "2.5.6.62-95edde758"
> * (defun baz (a) (declare (optimize (space 0)) (type (member 684016 21) a)) (scale-float 1d0 a))
> ; in: DEFUN BAZ
> ;     (SCALE-FLOAT 1.0d0 A)
> ;
> ; caught STYLE-WARNING:
> ;   Lisp error during constant folding:
> ;   The function SB-KERNEL:%MAKE-DOUBLE-FLOAT is undefined.
> ;
> ; compilation unit finished
> ;   caught 1 STYLE-WARNING condition
> BAZ
> * (baz 21)
> debugger invoked on a UNDEFINED-FUNCTION @B800000C2C in thread
> #<THREAD tid=25129 "main thread" RUNNING {1200BD0003}>:
>    The function SB-KERNEL:%MAKE-DOUBLE-FLOAT is undefined.
>
>
>
>
> _______________________________________________
> Sbcl-bugs mailing list
> Sbc...@li...
> https://lists.sourceforge.net/lists/listinfo/sbcl-bugs