sbcl-devel — Development discussions.

[Sbcl-devel] User-defined integers: Asking for feedback

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

Hi everybody,

I'd like to ask for feedback regarding that contribution;
furthermore, there are a few rough edges that I need help with.


Summary:

   This patch series provides a column-oriented structure variant
   that's type-safe at compile- and runtime; such objects
   are addressed via immediates with an 8-bit SBCL tag and
   another 8-bit tag to provide multiple such types.

   This reduces memory usage, GC time, and therefore time required
   for safe-lisp-and-die.

The intended use-case is a in-memory database that allocates
lots (>10M) of small structures of a few different types.


The full documentation is available at [1].


* The first patch in the series is concerned with making SBCL accept
another tag for immediate values and to provide a further 8-bit
fan-out of these, so that 256 different immediates with the
chosen tag (5) can be used.

* The second one patch is the one I need some help with.
During XC, prototypes get checked -- but if I give a value of
a different type (eg., a FIXNUM), it croaks, but providing an
immediate with the correct tag breaks in another way.
Please help me get through XC -- I consider this as a blocker
concerning merging the contrib upstream.

* The third patch fixes GC for the first - I kept it separate
because of attribution.

* The fourth patch implements the actual contrib --
code, Makefile, documentation, and tests.

* On my `master` there is another related patch that tries to get
DEFMETHOD working -- any help would be appreciated as well.


This patch set is in use since some time in a project that reads data
from disk, builds an in-memory database, and writes an executable
that is then run in a Kubernetes cluster.
CPU time for the import goes up, of course, but wall clock time
is nearly halved (much less GC at s-l-a-d!) and the (uncompressed)
image is reduced from 20GB to 5.5GB.
Query time doesn't go (noticeably) up, but we're talking ranges of
0.5 to 2msec here anyway.

This is to say that this contrib is stable (at least for my use-case)
and doesn't break performance expectations.
I'm sure there are quite some optimisation opportunities,
and yes, the code still contains a few TODOs.
Any help, ideas, or other feedback is welcome!


Thanks!

Ph.



Ad 1: 
https://github.com/phmarek/sbcl/blob/udef-inttype/contrib/sb-udef-inttype/README.md

Re: [Sbcl-devel] Patch: add sb-ext:note-source-transformation

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

Yes the third example is now fixed.

I think NOTE-SOURCE-TRANSFORMATION is still needed for the second example. Moreover, SBCL's copy detection here is only enabled when debug>1, I assume because it has some computational cost to run. NOTE-SOURCE-TRANSFORMATION on the other hand has virtually no cost and works under any compilation policy.
________________________________
From: Stas Boukarev <sta...@gm...>
Sent: Thursday, August 21, 2025 8:55 PM
To: Qiantan Hong <qt...@st...>
Cc: SBCL Devel-list <sbc...@li...>
Subject: Re: [Sbcl-devel] Patch: add sb-ext:note-source-transformation

The original code handled that. Should be fixed.

On Fri, Aug 22, 2025 at 2:26 AM Qiantan Hong <qt...@st...> wrote:
>
> Thanks! Although the heurstic still won't work for the other example, and it works somewhat reliable only because the copy detection I added to ITERATE. The gist is that macros themselves know how they expand and if we allow them to provide information, we don't need to guess.
>
> An example where copy detection without collaboration from the macro is unreliable:
>
> ;; disable ITER's copy detection, which I added only recently
> ;; and would like to disable if NOTE-SOURCE-TRANSFORMATION
> ;; is available because it's rather costly
> (defun iter::recycle-code (form original-form) form)
>
> (defun test ()
>   (let ((i 0))
>     (iter (repeat 3)
>       (incf i)
>       (when (= i 2) (error "test"))
>       (incf i)
>       (when (= i 2) (error "test")))))
>
> (test)
>
> Debugger incorrectly jump to the first ERROR form.
>
> ________________________________
> From: Stas Boukarev <sta...@gm...>
> Sent: Thursday, August 21, 2025 3:58 PM
> To: Qiantan Hong <qt...@st...>
> Cc: SBCL Devel-list <sbc...@li...>
> Subject: Re: [Sbcl-devel] Patch: add sb-ext:note-source-transformation
>
> I resolved the first one in
> https://github.com/sbcl/sbcl/commit/c97ff0df4425ceef378d6ed27b3b10f201a430b3
>
> On Fri, Aug 22, 2025 at 12:04 AM Qiantan Hong <qt...@st...> wrote:
> >
> > Example of macroexpand-1 issue:
> >
> > (let ((x (make-array 1)))
> >     (iter (repeat 3)
> >       (setf (aref x 3) 2)))
> >
> > ITERATE will MACROEXPAND-1 the SETF form (it MACROEXPAND-1 any macro it sees so it can process potential ITER constructs from the expansion result), and now debugger can only jump to the whole ITER form for that (SETF AREF) error. With NOTE-SOURCE-TRANSFORMATION and my ITERATE patch debugger can jump to the SETF form.
> >
> > Example of subform expanded differently:
> >
> > (iter (repeat 3)
> >     (error (if (first-iteration-p) "test1" "test2")))
> >
> > (FIRST-ITERATION-P) is expanded to a gensym, and debugger again can only jump to the whole ITER form. With NOTE-SOURCE-TRANSFORMATION and my ITERATE patch debugger can jump to the ERROR form.
> > ________________________________
> > From: Stas Boukarev <sta...@gm...>
> > Sent: Thursday, August 21, 2025 1:57 PM
> > To: Qiantan Hong <qt...@st...>
> > Cc: SBCL Devel-list <sbc...@li...>
> > Subject: Re: [Sbcl-devel] Patch: add sb-ext:note-source-transformation
> >
> > On Thu, Aug 21, 2025 at 11:18 PM Qiantan Hong <qt...@st...> wrote:
> > >
> > > Yes, more magic is always desired, but there're case these will not work. E.g. ITERATE might call MACROEXPAND-1 on some input form and return the output (which can be unrecognizable). Or it might expand the subform of some form (e.g. (ordinary-function foo bar (special-construct ...))) differently but do nothing nontrivial to the whole form.
> >
> > Can you provide me example forms?

Re: [Sbcl-devel] Patch: add sb-ext:note-source-transformation

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

The original code handled that. Should be fixed.

On Fri, Aug 22, 2025 at 2:26 AM Qiantan Hong <qt...@st...> wrote:
>
> Thanks! Although the heurstic still won't work for the other example, and it works somewhat reliable only because the copy detection I added to ITERATE. The gist is that macros themselves know how they expand and if we allow them to provide information, we don't need to guess.
>
> An example where copy detection without collaboration from the macro is unreliable:
>
> ;; disable ITER's copy detection, which I added only recently
> ;; and would like to disable if NOTE-SOURCE-TRANSFORMATION
> ;; is available because it's rather costly
> (defun iter::recycle-code (form original-form) form)
>
> (defun test ()
>   (let ((i 0))
>     (iter (repeat 3)
>       (incf i)
>       (when (= i 2) (error "test"))
>       (incf i)
>       (when (= i 2) (error "test")))))
>
> (test)
>
> Debugger incorrectly jump to the first ERROR form.
>
> ________________________________
> From: Stas Boukarev <sta...@gm...>
> Sent: Thursday, August 21, 2025 3:58 PM
> To: Qiantan Hong <qt...@st...>
> Cc: SBCL Devel-list <sbc...@li...>
> Subject: Re: [Sbcl-devel] Patch: add sb-ext:note-source-transformation
>
> I resolved the first one in
> https://github.com/sbcl/sbcl/commit/c97ff0df4425ceef378d6ed27b3b10f201a430b3
>
> On Fri, Aug 22, 2025 at 12:04 AM Qiantan Hong <qt...@st...> wrote:
> >
> > Example of macroexpand-1 issue:
> >
> > (let ((x (make-array 1)))
> >     (iter (repeat 3)
> >       (setf (aref x 3) 2)))
> >
> > ITERATE will MACROEXPAND-1 the SETF form (it MACROEXPAND-1 any macro it sees so it can process potential ITER constructs from the expansion result), and now debugger can only jump to the whole ITER form for that (SETF AREF) error. With NOTE-SOURCE-TRANSFORMATION and my ITERATE patch debugger can jump to the SETF form.
> >
> > Example of subform expanded differently:
> >
> > (iter (repeat 3)
> >     (error (if (first-iteration-p) "test1" "test2")))
> >
> > (FIRST-ITERATION-P) is expanded to a gensym, and debugger again can only jump to the whole ITER form. With NOTE-SOURCE-TRANSFORMATION and my ITERATE patch debugger can jump to the ERROR form.
> > ________________________________
> > From: Stas Boukarev <sta...@gm...>
> > Sent: Thursday, August 21, 2025 1:57 PM
> > To: Qiantan Hong <qt...@st...>
> > Cc: SBCL Devel-list <sbc...@li...>
> > Subject: Re: [Sbcl-devel] Patch: add sb-ext:note-source-transformation
> >
> > On Thu, Aug 21, 2025 at 11:18 PM Qiantan Hong <qt...@st...> wrote:
> > >
> > > Yes, more magic is always desired, but there're case these will not work. E.g. ITERATE might call MACROEXPAND-1 on some input form and return the output (which can be unrecognizable). Or it might expand the subform of some form (e.g. (ordinary-function foo bar (special-construct ...))) differently but do nothing nontrivial to the whole form.
> >
> > Can you provide me example forms?

Re: [Sbcl-devel] Patch: add sb-ext:note-source-transformation

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

Thanks! Although the heurstic still won't work for the other example, and it works somewhat reliable only because the copy detection I added to ITERATE. The gist is that macros themselves know how they expand and if we allow them to provide information, we don't need to guess.

An example where copy detection without collaboration from the macro is unreliable:

;; disable ITER's copy detection, which I added only recently
;; and would like to disable if NOTE-SOURCE-TRANSFORMATION
;; is available because it's rather costly
(defun iter::recycle-code (form original-form) form)

(defun test ()
  (let ((i 0))
    (iter (repeat 3)
      (incf i)
      (when (= i 2) (error "test"))
      (incf i)
      (when (= i 2) (error "test")))))

(test)

Debugger incorrectly jump to the first ERROR form.

________________________________
From: Stas Boukarev <sta...@gm...>
Sent: Thursday, August 21, 2025 3:58 PM
To: Qiantan Hong <qt...@st...>
Cc: SBCL Devel-list <sbc...@li...>
Subject: Re: [Sbcl-devel] Patch: add sb-ext:note-source-transformation

I resolved the first one in
https://github.com/sbcl/sbcl/commit/c97ff0df4425ceef378d6ed27b3b10f201a430b3

On Fri, Aug 22, 2025 at 12:04 AM Qiantan Hong <qt...@st...> wrote:
>
> Example of macroexpand-1 issue:
>
> (let ((x (make-array 1)))
>     (iter (repeat 3)
>       (setf (aref x 3) 2)))
>
> ITERATE will MACROEXPAND-1 the SETF form (it MACROEXPAND-1 any macro it sees so it can process potential ITER constructs from the expansion result), and now debugger can only jump to the whole ITER form for that (SETF AREF) error. With NOTE-SOURCE-TRANSFORMATION and my ITERATE patch debugger can jump to the SETF form.
>
> Example of subform expanded differently:
>
> (iter (repeat 3)
>     (error (if (first-iteration-p) "test1" "test2")))
>
> (FIRST-ITERATION-P) is expanded to a gensym, and debugger again can only jump to the whole ITER form. With NOTE-SOURCE-TRANSFORMATION and my ITERATE patch debugger can jump to the ERROR form.
> ________________________________
> From: Stas Boukarev <sta...@gm...>
> Sent: Thursday, August 21, 2025 1:57 PM
> To: Qiantan Hong <qt...@st...>
> Cc: SBCL Devel-list <sbc...@li...>
> Subject: Re: [Sbcl-devel] Patch: add sb-ext:note-source-transformation
>
> On Thu, Aug 21, 2025 at 11:18 PM Qiantan Hong <qt...@st...> wrote:
> >
> > Yes, more magic is always desired, but there're case these will not work. E.g. ITERATE might call MACROEXPAND-1 on some input form and return the output (which can be unrecognizable). Or it might expand the subform of some form (e.g. (ordinary-function foo bar (special-construct ...))) differently but do nothing nontrivial to the whole form.
>
> Can you provide me example forms?

Re: [Sbcl-devel] Patch: add sb-ext:note-source-transformation

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

I resolved the first one in
https://github.com/sbcl/sbcl/commit/c97ff0df4425ceef378d6ed27b3b10f201a430b3

On Fri, Aug 22, 2025 at 12:04 AM Qiantan Hong <qt...@st...> wrote:
>
> Example of macroexpand-1 issue:
>
> (let ((x (make-array 1)))
>     (iter (repeat 3)
>       (setf (aref x 3) 2)))
>
> ITERATE will MACROEXPAND-1 the SETF form (it MACROEXPAND-1 any macro it sees so it can process potential ITER constructs from the expansion result), and now debugger can only jump to the whole ITER form for that (SETF AREF) error. With NOTE-SOURCE-TRANSFORMATION and my ITERATE patch debugger can jump to the SETF form.
>
> Example of subform expanded differently:
>
> (iter (repeat 3)
>     (error (if (first-iteration-p) "test1" "test2")))
>
> (FIRST-ITERATION-P) is expanded to a gensym, and debugger again can only jump to the whole ITER form. With NOTE-SOURCE-TRANSFORMATION and my ITERATE patch debugger can jump to the ERROR form.
> ________________________________
> From: Stas Boukarev <sta...@gm...>
> Sent: Thursday, August 21, 2025 1:57 PM
> To: Qiantan Hong <qt...@st...>
> Cc: SBCL Devel-list <sbc...@li...>
> Subject: Re: [Sbcl-devel] Patch: add sb-ext:note-source-transformation
>
> On Thu, Aug 21, 2025 at 11:18 PM Qiantan Hong <qt...@st...> wrote:
> >
> > Yes, more magic is always desired, but there're case these will not work. E.g. ITERATE might call MACROEXPAND-1 on some input form and return the output (which can be unrecognizable). Or it might expand the subform of some form (e.g. (ordinary-function foo bar (special-construct ...))) differently but do nothing nontrivial to the whole form.
>
> Can you provide me example forms?

Re: [Sbcl-devel] Patch: add sb-ext:note-source-transformation

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

Example of macroexpand-1 issue:

(let ((x (make-array 1)))
    (iter (repeat 3)
      (setf (aref x 3) 2)))

ITERATE will MACROEXPAND-1 the SETF form (it MACROEXPAND-1 any macro it sees so it can process potential ITER constructs from the expansion result), and now debugger can only jump to the whole ITER form for that (SETF AREF) error. With NOTE-SOURCE-TRANSFORMATION and my ITERATE patch debugger can jump to the SETF form.

Example of subform expanded differently:

(iter (repeat 3)
    (error (if (first-iteration-p) "test1" "test2")))

(FIRST-ITERATION-P) is expanded to a gensym, and debugger again can only jump to the whole ITER form. With NOTE-SOURCE-TRANSFORMATION and my ITERATE patch debugger can jump to the ERROR form.
________________________________
From: Stas Boukarev <sta...@gm...>
Sent: Thursday, August 21, 2025 1:57 PM
To: Qiantan Hong <qt...@st...>
Cc: SBCL Devel-list <sbc...@li...>
Subject: Re: [Sbcl-devel] Patch: add sb-ext:note-source-transformation

On Thu, Aug 21, 2025 at 11:18 PM Qiantan Hong <qt...@st...> wrote:
>
> Yes, more magic is always desired, but there're case these will not work. E.g. ITERATE might call MACROEXPAND-1 on some input form and return the output (which can be unrecognizable). Or it might expand the subform of some form (e.g. (ordinary-function foo bar (special-construct ...))) differently but do nothing nontrivial to the whole form.

Can you provide me example forms?

Re: [Sbcl-devel] Patch: add sb-ext:note-source-transformation

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

On Thu, Aug 21, 2025 at 11:18 PM Qiantan Hong <qt...@st...> wrote:
>
> Yes, more magic is always desired, but there're case these will not work. E.g. ITERATE might call MACROEXPAND-1 on some input form and return the output (which can be unrecognizable). Or it might expand the subform of some form (e.g. (ordinary-function foo bar (special-construct ...))) differently but do nothing nontrivial to the whole form.

Can you provide me example forms?

Re: [Sbcl-devel] Patch: add sb-ext:note-source-transformation

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

Yes, more magic is always desired, but there're case these will not work. E.g. ITERATE might call MACROEXPAND-1 on some input form and return the output (which can be unrecognizable). Or it might expand the subform of some form (e.g. (ordinary-function foo bar (special-construct ...))) differently but do nothing nontrivial to the whole form. In fact in a previous patch to ITERATE I already try to detect copied form and recycle them to return EQed form instead, so this will have all the effect of detecting copied form. The result is better than nothing but still fragile. Debugger source works for simple function call but many thing doesn't work.

Useful functionality will get used. I contribute to ITERATE and if this gets merge I will get it to use it, and on my local branch everything works perfectly - so much better than our previous copy detection hack. I know a few more people considering this useful, plus the same functionality alreayd exists in Clozure CL, and hopefully this can be adopted to more implementations over time. We will work on a trivial-* portability library.
________________________________
From: Stas Boukarev <sta...@gm...>
Sent: Thursday, August 21, 2025 4:29 AM
To: Qiantan Hong <qt...@st...>
Cc: SBCL Devel-list <sbc...@li...>
Subject: Re: [Sbcl-devel] Patch: add sb-ext:note-source-transformation

The problem with new functionality is that someone has to use it. And
also it's not portable (even to older versions of SBCL itself). I
would like more magic to happen to find source locations
automatically.
E.g. https://github.com/sbcl/sbcl/commit/110cd9a4de1321abf12298cd299247b7c9f1bfef
is a move towards that, perhaps, something more clever is needed.

On Thu, Aug 21, 2025 at 12:18 PM Qiantan Hong <qt...@st...> wrote:
>
> Hi there,
>
> The added function allows user macro to indicate correspondence between subforms before and after macro-expansion. This is particularly useful for code-walking macro (like ITERATE), and if used, allows more accurate source tracking when debugging runtime errors.
>
> Can someone help review this? Thanks!
>
> BTW if someone feel the need for tests, can you give guidance on where to put the tests? I couldn't find existing test for runtime error source tracking.
>
> Best,
> Qiantan_______________________________________________
> Sbcl-devel mailing list
> Sbc...@li...
> https://lists.sourceforge.net/lists/listinfo/sbcl-devel

Re: [Sbcl-devel] [Sbcl-commits] master: Make sb-aprof output understandable if foreign threads start and stop rapidly

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

On darwin, aprof.impure fails with:
::: UNEXPECTED-FAILURE :APROF-INSTANCE
due to SB-KERNEL::UNDEFINED-ALIEN-VARIABLE-ERROR:
"Attempt to access an undefined alien variable."

On Thu, Aug 21, 2025 at 7:29 PM snuglas via Sbcl-commits
<sbc...@li...> wrote:
>
> The branch "master" has been updated in SBCL:
>        via  f91c424fcfe1993743ec08de35ef46f89e7f82c6 (commit)
>       from  c3bcc6f886743ccb8a3f7377e5649200e84f7b57 (commit)
>
> - Log -----------------------------------------------------------------
> commit f91c424fcfe1993743ec08de35ef46f89e7f82c6
> Author: Douglas Katzman <do...@go...>
> Date:   Thu Aug 21 16:22:32 2025 +0000
>
>     Make sb-aprof output understandable if foreign threads start and stop rapidly
>
>     Without an extra line of output it was impossible to see that 99% of consing
>     in the fcb-threads test is fictitious and merely accounts for unusable space
>     (due to the patch in rev f4ff026a) which helps GC run enough not to crash.
> ---
>  src/code/aprof.lisp           | 11 +++++++++--
>  src/runtime/alloc.c           |  5 +++++
>  src/runtime/thread.c          |  7 +++++++
>  tests/fcb-threads.impure.lisp | 25 ++++++++++++++++++++++++-
>  4 files changed, 45 insertions(+), 3 deletions(-)
>
> diff --git a/src/code/aprof.lisp b/src/code/aprof.lisp
> index 6352fb13b..fda96c65e 100644
> --- a/src/code/aprof.lisp
> +++ b/src/code/aprof.lisp
> @@ -85,6 +85,8 @@
>
>  (define-alien-variable alloc-profile-buffer system-area-pointer)
>  (defun aprof-reset ()
> +  (setf (extern-alien "close_region_nfillers" int) 0)
> +  (setf (extern-alien "close_region_tot_bytes_wasted" unsigned) 0)
>    (let ((buffer alloc-profile-buffer))
>      (unless (= (sap-int buffer) 0)
>        (alien-funcall (extern-alien "memset" (function void system-area-pointer int size-t))
> @@ -605,10 +607,15 @@
>           (dstate (sb-disassem:make-dstate nil))
>           (collection (make-hash-table :test 'equal)))
>      (when stream
> -      (format stream "~&~d (of ~d max) profile entries consumed~2%"
> -              n-hit metadata-len))
> +      (format stream "~&~d (of ~d max) profile entries consumed, ~D GCs done~2%"
> +              n-hit metadata-len (extern-alien "n_gcs_done" int)))
>      (loop
>       (when (>= index n-counters)
> +       ;; Add an item accounting for waste caused by closing regions on unfull pages
> +       (let ((count (extern-alien "close_region_nfillers" int))
> +             (total-bytes (extern-alien "close_region_tot_bytes_wasted" unsigned)))
> +         (push (make-alloc total-bytes count 'sb-vm::filler 0)
> +               (gethash 'sb-vm::filler collection)))
>         (return collection))
>       (let ((count (sap-ref-word sap (* index 8))))
>         (multiple-value-bind (code pc-offset total-bytes)
> diff --git a/src/runtime/alloc.c b/src/runtime/alloc.c
> index 005176722..45b635a72 100644
> --- a/src/runtime/alloc.c
> +++ b/src/runtime/alloc.c
> @@ -128,6 +128,9 @@ CRITICAL_SECTION code_allocator_lock; // threads are mandatory for win32
>  pthread_mutex_t code_allocator_lock = PTHREAD_MUTEX_INITIALIZER;
>  #endif
>
> +int close_region_nfillers;
> +uword_t close_region_tot_bytes_wasted;
> +
>  typedef struct { struct alloc_region* r; int type; } close_region_arg;
>  void sync_close_regions(int block_signals, int options,
>                          close_region_arg* a, int count)
> @@ -163,6 +166,8 @@ void sync_close_regions(int block_signals, int options,
>              // fillers may not be needed. This anticipates non-zero-filed pages though.
>              deposit_filler(freeptr, new_end);
>              a[i].r->free_pointer = new_end;
> +            close_region_nfillers++;
> +            close_region_tot_bytes_wasted += new_end - freeptr;
>          }
>  #endif
>          ensure_region_closed(a[i].r, a[i].type);
> diff --git a/src/runtime/thread.c b/src/runtime/thread.c
> index 38ddd5296..61dd3bbc8 100644
> --- a/src/runtime/thread.c
> +++ b/src/runtime/thread.c
> @@ -515,7 +515,14 @@ unregister_thread(struct thread *th,
>          th->remset = 0;
>      }
>  #endif
> +    /* Here's a thought: if this structure was for a native thread doing call-in
> +     * and so we're about to toss this into the recycle bin, what if we didn't
> +     * consume the remainder of all open regions but instead just kept them?
> +     * A subsequent call-in which reuses this structure could own the same open
> +     * regions if no GC ran in the meantime. If GC does need to run,
> +     * it should close TLABs of all thread structures in the recycle bin */
>      gc_close_thread_regions(th, LOCK_PAGE_TABLE|CONSUME_REMAINDER);
> +
>  #ifdef LISP_FEATURE_SB_SAFEPOINT
>      if (scribble)
>        pop_gcing_safety(&scribble->safety);
> diff --git a/tests/fcb-threads.impure.lisp b/tests/fcb-threads.impure.lisp
> index 195070b80..d287352f3 100644
> --- a/tests/fcb-threads.impure.lisp
> +++ b/tests/fcb-threads.impure.lisp
> @@ -46,7 +46,30 @@
>  (defun trivial-call-test (n)
>    (with-alien ((testfun (function int system-area-pointer int) :extern "minimal_perftest"))
>      (alien-funcall testfun (alien-sap (alien-callable-function 'perftestcb)) n)))
> -(time (trivial-call-test 200000))
> +
> +
> +;;; When compiled with APROF, the truly astounding amount of space taken up not by objects
> +;;; but just closing the open regions in unregister_thread becomes evident:
> +#|
> +10 (of 150000 max) profile entries consumed, 367 GCs done
> +       %        Bytes        Count    Function
> + -------  -----------    ---------    --------
> +  99.7    19590256480       600000    SB-VM::FILLER - SB-VM::FILLER
> +   0.1       28800144       600003    SB-THREAD::AVLNODE - SB-THREAD::AVLNODE
> +   0.1       28800000       200000    SB-THREAD::MAKE-FOREIGN-THREAD - SB-THREAD:FOREIGN-THREAD
> +  00.0        6400000       200000    SB-THREAD:MAKE-MUTEX - SB-THREAD:MUTEX
> +  00.0        3200000       200000    SB-THREAD::SYS-TLAB-LIST
> +  00.0           5840          365    (FLET "WITHOUT-GCING-BODY-" :IN SB-KERNEL:SUB-GC) - LIST
> +  00.0             16            1    SB-THREAD::%ENROLL-NEW-THREADS - LIST
> + =======  ===========
> + 100.0    19657462480
> +|#
> +;;; Something is very off about these numbers though. If there are 20,000 thread creation/
> +;;; destructions, and each thread wastes all of its 4 TLABs, that should be 132KiB per thread,
> +;;; for roughly 2.6GB of waste in total. How are we seing nearly 8x that?
> +(if (> (sb-c:policy sb-c::*policy* sb-c:instrument-consing) 0)
> +    (sb-aprof:aprof-run #'trivial-call-test :arguments '(200000))
> +    (time (trivial-call-test 200000)))
>
>  ;;;;
>  (defglobal *counter* 0)
>
> -----------------------------------------------------------------------
>
>
> hooks/post-receive
> --
> SBCL
>
>
> _______________________________________________
> Sbcl-commits mailing list
> Sbc...@li...
> https://lists.sourceforge.net/lists/listinfo/sbcl-commits

Re: [Sbcl-devel] Patch: add sb-ext:note-source-transformation

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

The problem with new functionality is that someone has to use it. And
also it's not portable (even to older versions of SBCL itself). I
would like more magic to happen to find source locations
automatically.
E.g. https://github.com/sbcl/sbcl/commit/110cd9a4de1321abf12298cd299247b7c9f1bfef
is a move towards that, perhaps, something more clever is needed.

On Thu, Aug 21, 2025 at 12:18 PM Qiantan Hong <qt...@st...> wrote:
>
> Hi there,
>
> The added function allows user macro to indicate correspondence between subforms before and after macro-expansion. This is particularly useful for code-walking macro (like ITERATE), and if used, allows more accurate source tracking when debugging runtime errors.
>
> Can someone help review this? Thanks!
>
> BTW if someone feel the need for tests, can you give guidance on where to put the tests? I couldn't find existing test for runtime error source tracking.
>
> Best,
> Qiantan_______________________________________________
> Sbcl-devel mailing list
> Sbc...@li...
> https://lists.sourceforge.net/lists/listinfo/sbcl-devel

[Sbcl-devel] Patch: add sb-ext:note-source-transformation

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

Hi there,

The added function allows user macro to indicate correspondence between subforms before and after macro-expansion. This is particularly useful for code-walking macro (like ITERATE), and if used, allows more accurate source tracking when debugging runtime errors.

Can someone help review this? Thanks!

BTW if someone feel the need for tests, can you give guidance on where to put the tests? I couldn't find existing test for runtime error source tracking.

Best,
Qiantan

Re: [Sbcl-devel] Solaris SPARC build failing on Solaris 11.3

[Chun T. (binghe) <bin...@gm...>]

Hi Chris,

I was able to rebuild SBCL (any version) on Solaris 10 & 11 on x86, using
OpenCSW GCC 5.5.0 (preferred) and Oracle Studio compiler 12.5 (both can work but
only one is needed). I think there are at least two issues currently remaining
in SBCL source code:

1) The file make-target-contrib.sh (at least sometime ago) may not be Bourne
Shell-compliant, and if under your PATH environment variable the call of "sh"
does not lead to GNU bash, calling that script may fail. A trivial fix is to
explicitly call "bash" instead.

2) Some C code requires either C99 or special flags when being compiled with the
above mentioned compilers.

The attached patch may help you a bit, unless you meet other SPARC-specific issues.

Regards,

Chun Tian

On 19/08/25 13:58, Chris Hanson wrote:
> I have Solaris 11.3 on a T2000 (SPARC T1, sun4v architecture) and while the SBCL 2.0.4 binary on the downloads page appears to work fine, I can’t seem to build either 2.0.4 or any newer version using it and the GCC installed from the Solaris pkg system, I always get dropped to the debugger early on.
> 
> I’d be a bit out of my depth if I tried to debug it, but on the off chance it’s helpful background information, does anyone remember what version of Solaris and (I assume) GCC was used to compile the 2.0.4 binary?
> 
>   — Chris
> 
> Sent from my iPhone
> 
> _______________________________________________
> Sbcl-devel mailing list
> Sbc...@li...
> https://lists.sourceforge.net/lists/listinfo/sbcl-devel
> 

[Sbcl-devel] Solaris SPARC build failing on Solaris 11.3

[Chris H. <cmh...@es...>]

I have Solaris 11.3 on a T2000 (SPARC T1, sun4v architecture) and while the SBCL 2.0.4 binary on the downloads page appears to work fine, I can’t seem to build either 2.0.4 or any newer version using it and the GCC installed from the Solaris pkg system, I always get dropped to the debugger early on.

I’d be a bit out of my depth if I tried to debug it, but on the off chance it’s helpful background information, does anyone remember what version of Solaris and (I assume) GCC was used to compile the 2.0.4 binary?

  — Chris

Sent from my iPhone

Re: [Sbcl-devel] Suggested patch to fix high priority bug #1600610 (input and output buffers get out of sync in io streams)

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

launchpad is the best way to ensure things are not lost.

On Sun, Aug 17, 2025 at 12:52 AM Brent Benson <bwb...@gm...> wrote:
>
> I created the attached patch with a fix and unit test for bug #1600610 (input and output buffers get out of sync in io streams). I also put the patch in the bug on Launchpad.
>
> The fix adds calls to finish-fd-stream-output before reading in the input-at-least and input-wrapper/variable-width macros, but only when fd-stream-synchronize-output is true (which is set for bidirectional file streams). This ensures output is flushed before reads without impacting performance of normal input-only or output-only streams.
>
> I'm just making sure this is the right way to submit a fix, rather than submitting a pull request, which I'd be happy to do as well.
>
> Thanks,
> Brent
>
> _______________________________________________
> Sbcl-devel mailing list
> Sbc...@li...
> https://lists.sourceforge.net/lists/listinfo/sbcl-devel

[Sbcl-devel] Suggested patch to fix high priority bug #1600610 (input and output buffers get out of sync in io streams)

[Brent B. <bwb...@gm...>]

I created the attached patch with a fix and unit test for bug #1600610
(input and output buffers get out of sync in io streams). I also put the
patch in the bug on Launchpad.

The fix adds calls to finish-fd-stream-output before reading in the
input-at-least and input-wrapper/variable-width macros, but only when
fd-stream-synchronize-output is true (which is set for bidirectional file
streams). This ensures output is flushed before reads without impacting
performance of normal input-only or output-only streams.

I'm just making sure this is the right way to submit a fix, rather than
submitting a pull request, which I'd be happy to do as well.

Thanks,
Brent

Re: [Sbcl-devel] [Sbcl-commits] master: ldb: add a command to find component_ptr_from_pc.

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

Well, maybe search ought to do that too.

On Fri, Aug 15, 2025 at 9:46 PM Charles Zhang <cha...@ya...> wrote:
>
> Ah, then that’s definitely a quality of life improvement.
>
>
> On Friday, August 15, 2025, 8:46 PM, Charles Zhang via Sbcl-commits <sbc...@li...> wrote:
>
> Its always worked for me to use ‘search’ to find the code object from an interior pointer.
>
> On Friday, August 15, 2025, 8:43 PM, Stas Boukarev <sta...@gm...> wrote:
>
> I see no calls to component_ptr_from_pc there.
>
> On Fri, Aug 15, 2025 at 9:42 PM Charles Zhang <cha...@ya...> wrote:
> >
> > Doesn’t search already do this?
> >
> > On Friday, August 15, 2025, 7:36 PM, stassats via Sbcl-commits <sbc...@li...> wrote:
> >
> > The branch "master" has been updated in SBCL:
> >      via  c525ac98bdc79c3d87821abb8fa45dd60d76adfb (commit)
> >      from  84543e0050dc60b76ed8304abed50105e755d3b0 (commit)
> >
> > - Log -----------------------------------------------------------------
> > commit c525ac98bdc79c3d87821abb8fa45dd60d76adfb
> > Author: Stas Boukarev <sta...@gm...>
> > Date:  Fri Aug 15 20:17:40 2025 +0300
> >
> >    ldb: add a command to find component_ptr_from_pc.
> > ---
> > src/runtime/monitor.c | 14 +++++++++++++-
> > 1 file changed, 13 insertions(+), 1 deletion(-)
> >
> > diff --git a/src/runtime/monitor.c b/src/runtime/monitor.c
> > index c5283ea2c..34cdd1b2e 100644
> > --- a/src/runtime/monitor.c
> > +++ b/src/runtime/monitor.c
> > @@ -279,7 +279,7 @@ void save_gc_crashdump(char *pathname,
> > #endif
> >
> > static cmd call_cmd, dump_cmd, print_cmd, quit_cmd, help_cmd;
> > -static cmd flush_cmd, regs_cmd, exit_cmd;
> > +static cmd flush_cmd, regs_cmd, exit_cmd, print_code;
> > static cmd print_context_cmd, pte_cmd, search_cmd, hashtable_cmd;
> > static cmd backtrace_cmd, threadbt_cmd, catchers_cmd;
> > static cmd threads_cmd, findpath_cmd, layouts_cmd;
> > @@ -484,6 +484,7 @@ static struct cmd {
> >    {"layouts", "Dump LAYOUT instances.", layouts_cmd},
> >    {"print", "Print object at ADDRESS.", print_cmd},
> >    {"p", "(an alias for print)", print_cmd},
> > +    {"code", "Print the code object at ADDRESS.", print_code},
> >    {"pte", "Page table entry for address", pte_cmd},
> >    {"quit", "Quit.", quit_cmd},
> >    {"regs", "Display current Lisp registers.", regs_cmd},
> > @@ -633,6 +634,17 @@ static int print_cmd(char **ptr, iochannel_t io)
> >    return 0;
> > }
> >
> > +static int print_code(char **ptr, iochannel_t io)
> > +{
> > +    lispobj obj;
> > +    if (parse_lispobj(ptr, &obj, io->out)) {
> > +        lispobj * code = component_ptr_from_pc((char *)obj);
> > +        if (code)
> > +            print_to_iochan((lispobj)code | OTHER_POINTER_LOWTAG, io);
> > +    }
> > +    return 0;
> > +}
> > +
> > int verify_lisp_hashtable(__attribute__((unused)) struct hash_table* ht,
> >                          __attribute__((unused)) FILE* file)
> > {
> >
> > -----------------------------------------------------------------------
> >
> >
> > hooks/post-receive
> > --
> > SBCL
> >
> >
> > _______________________________________________
> > Sbcl-commits mailing list
> > Sbc...@li...
> > https://lists.sourceforge.net/lists/listinfo/sbcl-commits
>
> _______________________________________________
> Sbcl-commits mailing list
> Sbc...@li...
> https://lists.sourceforge.net/lists/listinfo/sbcl-commits

Re: [Sbcl-devel] [Sbcl-commits] master: ldb: add a command to find component_ptr_from_pc.

[Charles Z. <cha...@ya...>]

Ah, then that’s definitely a quality of life improvement.



On Friday, August 15, 2025, 8:46 PM, Charles Zhang via Sbcl-commits <sbc...@li...> wrote:

Its always worked for me to use ‘search’ to find the code object from an interior pointer.


On Friday, August 15, 2025, 8:43 PM, Stas Boukarev <sta...@gm...> wrote:

I see no calls to component_ptr_from_pc there.

On Fri, Aug 15, 2025 at 9:42 PM Charles Zhang <cha...@ya...> wrote:
>
> Doesn’t search already do this?
>
> On Friday, August 15, 2025, 7:36 PM, stassats via Sbcl-commits <sbc...@li...> wrote:
>
> The branch "master" has been updated in SBCL:
>      via  c525ac98bdc79c3d87821abb8fa45dd60d76adfb (commit)
>      from  84543e0050dc60b76ed8304abed50105e755d3b0 (commit)
>
> - Log -----------------------------------------------------------------
> commit c525ac98bdc79c3d87821abb8fa45dd60d76adfb
> Author: Stas Boukarev <sta...@gm...>
> Date:  Fri Aug 15 20:17:40 2025 +0300
>
>    ldb: add a command to find component_ptr_from_pc.
> ---
> src/runtime/monitor.c | 14 +++++++++++++-
> 1 file changed, 13 insertions(+), 1 deletion(-)
>
> diff --git a/src/runtime/monitor.c b/src/runtime/monitor.c
> index c5283ea2c..34cdd1b2e 100644
> --- a/src/runtime/monitor.c
> +++ b/src/runtime/monitor.c
> @@ -279,7 +279,7 @@ void save_gc_crashdump(char *pathname,
> #endif
>
> static cmd call_cmd, dump_cmd, print_cmd, quit_cmd, help_cmd;
> -static cmd flush_cmd, regs_cmd, exit_cmd;
> +static cmd flush_cmd, regs_cmd, exit_cmd, print_code;
> static cmd print_context_cmd, pte_cmd, search_cmd, hashtable_cmd;
> static cmd backtrace_cmd, threadbt_cmd, catchers_cmd;
> static cmd threads_cmd, findpath_cmd, layouts_cmd;
> @@ -484,6 +484,7 @@ static struct cmd {
>    {"layouts", "Dump LAYOUT instances.", layouts_cmd},
>    {"print", "Print object at ADDRESS.", print_cmd},
>    {"p", "(an alias for print)", print_cmd},
> +    {"code", "Print the code object at ADDRESS.", print_code},
>    {"pte", "Page table entry for address", pte_cmd},
>    {"quit", "Quit.", quit_cmd},
>    {"regs", "Display current Lisp registers.", regs_cmd},
> @@ -633,6 +634,17 @@ static int print_cmd(char **ptr, iochannel_t io)
>    return 0;
> }
>
> +static int print_code(char **ptr, iochannel_t io)
> +{
> +    lispobj obj;
> +    if (parse_lispobj(ptr, &obj, io->out)) {
> +        lispobj * code = component_ptr_from_pc((char *)obj);
> +        if (code)
> +            print_to_iochan((lispobj)code | OTHER_POINTER_LOWTAG, io);
> +    }
> +    return 0;
> +}
> +
> int verify_lisp_hashtable(__attribute__((unused)) struct hash_table* ht,
>                          __attribute__((unused)) FILE* file)
> {
>
> -----------------------------------------------------------------------
>
>
> hooks/post-receive
> --
> SBCL
>
>
> _______________________________________________
> Sbcl-commits mailing list
> Sbc...@li...
> https://lists.sourceforge.net/lists/listinfo/sbcl-commits



_______________________________________________
Sbcl-commits mailing list
Sbc...@li...
https://lists.sourceforge.net/lists/listinfo/sbcl-commits

Re: [Sbcl-devel] [Sbcl-commits] master: ldb: add a command to find component_ptr_from_pc.

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

ldb> search 0xb80022952c
#xb80022921f

vs

ldb> code 0xb80022952c
          0xb80022921f: other pointer
            header: 0x6c06000035: codeblob
            f[0]: 0xb80022925b: #<ptr to simplefun>
            boxed_size: 0x00000038: 28
            fixups: 0x00020f7e: 67519
            debug_info: 0x1200a375e3: #<ptr to 50000603
COMPILED-DEBUG-INFO instance>
            ???: 0x5003b06f: *INTERRUPTS-ENABLED*
            ???: 0x5003b03f: *ALLOW-WITH-INTERRUPTS*
            ???: 0x5003b09f: *INTERRUPT-PENDING*

On Fri, Aug 15, 2025 at 9:43 PM Stas Boukarev <sta...@gm...> wrote:
>
> I see no calls to component_ptr_from_pc there.
>
> On Fri, Aug 15, 2025 at 9:42 PM Charles Zhang <cha...@ya...> wrote:
> >
> > Doesn’t search already do this?
> >
> > On Friday, August 15, 2025, 7:36 PM, stassats via Sbcl-commits <sbc...@li...> wrote:
> >
> > The branch "master" has been updated in SBCL:
> >       via  c525ac98bdc79c3d87821abb8fa45dd60d76adfb (commit)
> >       from  84543e0050dc60b76ed8304abed50105e755d3b0 (commit)
> >
> > - Log -----------------------------------------------------------------
> > commit c525ac98bdc79c3d87821abb8fa45dd60d76adfb
> > Author: Stas Boukarev <sta...@gm...>
> > Date:  Fri Aug 15 20:17:40 2025 +0300
> >
> >     ldb: add a command to find component_ptr_from_pc.
> > ---
> > src/runtime/monitor.c | 14 +++++++++++++-
> > 1 file changed, 13 insertions(+), 1 deletion(-)
> >
> > diff --git a/src/runtime/monitor.c b/src/runtime/monitor.c
> > index c5283ea2c..34cdd1b2e 100644
> > --- a/src/runtime/monitor.c
> > +++ b/src/runtime/monitor.c
> > @@ -279,7 +279,7 @@ void save_gc_crashdump(char *pathname,
> > #endif
> >
> > static cmd call_cmd, dump_cmd, print_cmd, quit_cmd, help_cmd;
> > -static cmd flush_cmd, regs_cmd, exit_cmd;
> > +static cmd flush_cmd, regs_cmd, exit_cmd, print_code;
> > static cmd print_context_cmd, pte_cmd, search_cmd, hashtable_cmd;
> > static cmd backtrace_cmd, threadbt_cmd, catchers_cmd;
> > static cmd threads_cmd, findpath_cmd, layouts_cmd;
> > @@ -484,6 +484,7 @@ static struct cmd {
> >     {"layouts", "Dump LAYOUT instances.", layouts_cmd},
> >     {"print", "Print object at ADDRESS.", print_cmd},
> >     {"p", "(an alias for print)", print_cmd},
> > +    {"code", "Print the code object at ADDRESS.", print_code},
> >     {"pte", "Page table entry for address", pte_cmd},
> >     {"quit", "Quit.", quit_cmd},
> >     {"regs", "Display current Lisp registers.", regs_cmd},
> > @@ -633,6 +634,17 @@ static int print_cmd(char **ptr, iochannel_t io)
> >     return 0;
> > }
> >
> > +static int print_code(char **ptr, iochannel_t io)
> > +{
> > +    lispobj obj;
> > +    if (parse_lispobj(ptr, &obj, io->out)) {
> > +        lispobj * code = component_ptr_from_pc((char *)obj);
> > +        if (code)
> > +            print_to_iochan((lispobj)code | OTHER_POINTER_LOWTAG, io);
> > +    }
> > +    return 0;
> > +}
> > +
> > int verify_lisp_hashtable(__attribute__((unused)) struct hash_table* ht,
> >                           __attribute__((unused)) FILE* file)
> > {
> >
> > -----------------------------------------------------------------------
> >
> >
> > hooks/post-receive
> > --
> > SBCL
> >
> >
> > _______________________________________________
> > Sbcl-commits mailing list
> > Sbc...@li...
> > https://lists.sourceforge.net/lists/listinfo/sbcl-commits

Re: [Sbcl-devel] [Sbcl-commits] master: ldb: add a command to find component_ptr_from_pc.

[Charles Z. <cha...@ya...>]

Its always worked for me to use ‘search’ to find the code object from an interior pointer.


On Friday, August 15, 2025, 8:43 PM, Stas Boukarev <sta...@gm...> wrote:

I see no calls to component_ptr_from_pc there.

On Fri, Aug 15, 2025 at 9:42 PM Charles Zhang <cha...@ya...> wrote:
>
> Doesn’t search already do this?
>
> On Friday, August 15, 2025, 7:36 PM, stassats via Sbcl-commits <sbc...@li...> wrote:
>
> The branch "master" has been updated in SBCL:
>      via  c525ac98bdc79c3d87821abb8fa45dd60d76adfb (commit)
>      from  84543e0050dc60b76ed8304abed50105e755d3b0 (commit)
>
> - Log -----------------------------------------------------------------
> commit c525ac98bdc79c3d87821abb8fa45dd60d76adfb
> Author: Stas Boukarev <sta...@gm...>
> Date:  Fri Aug 15 20:17:40 2025 +0300
>
>    ldb: add a command to find component_ptr_from_pc.
> ---
> src/runtime/monitor.c | 14 +++++++++++++-
> 1 file changed, 13 insertions(+), 1 deletion(-)
>
> diff --git a/src/runtime/monitor.c b/src/runtime/monitor.c
> index c5283ea2c..34cdd1b2e 100644
> --- a/src/runtime/monitor.c
> +++ b/src/runtime/monitor.c
> @@ -279,7 +279,7 @@ void save_gc_crashdump(char *pathname,
> #endif
>
> static cmd call_cmd, dump_cmd, print_cmd, quit_cmd, help_cmd;
> -static cmd flush_cmd, regs_cmd, exit_cmd;
> +static cmd flush_cmd, regs_cmd, exit_cmd, print_code;
> static cmd print_context_cmd, pte_cmd, search_cmd, hashtable_cmd;
> static cmd backtrace_cmd, threadbt_cmd, catchers_cmd;
> static cmd threads_cmd, findpath_cmd, layouts_cmd;
> @@ -484,6 +484,7 @@ static struct cmd {
>    {"layouts", "Dump LAYOUT instances.", layouts_cmd},
>    {"print", "Print object at ADDRESS.", print_cmd},
>    {"p", "(an alias for print)", print_cmd},
> +    {"code", "Print the code object at ADDRESS.", print_code},
>    {"pte", "Page table entry for address", pte_cmd},
>    {"quit", "Quit.", quit_cmd},
>    {"regs", "Display current Lisp registers.", regs_cmd},
> @@ -633,6 +634,17 @@ static int print_cmd(char **ptr, iochannel_t io)
>    return 0;
> }
>
> +static int print_code(char **ptr, iochannel_t io)
> +{
> +    lispobj obj;
> +    if (parse_lispobj(ptr, &obj, io->out)) {
> +        lispobj * code = component_ptr_from_pc((char *)obj);
> +        if (code)
> +            print_to_iochan((lispobj)code | OTHER_POINTER_LOWTAG, io);
> +    }
> +    return 0;
> +}
> +
> int verify_lisp_hashtable(__attribute__((unused)) struct hash_table* ht,
>                          __attribute__((unused)) FILE* file)
> {
>
> -----------------------------------------------------------------------
>
>
> hooks/post-receive
> --
> SBCL
>
>
> _______________________________________________
> Sbcl-commits mailing list
> Sbc...@li...
> https://lists.sourceforge.net/lists/listinfo/sbcl-commits

Re: [Sbcl-devel] [Sbcl-commits] master: ldb: add a command to find component_ptr_from_pc.

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

I see no calls to component_ptr_from_pc there.

On Fri, Aug 15, 2025 at 9:42 PM Charles Zhang <cha...@ya...> wrote:
>
> Doesn’t search already do this?
>
> On Friday, August 15, 2025, 7:36 PM, stassats via Sbcl-commits <sbc...@li...> wrote:
>
> The branch "master" has been updated in SBCL:
>       via  c525ac98bdc79c3d87821abb8fa45dd60d76adfb (commit)
>       from  84543e0050dc60b76ed8304abed50105e755d3b0 (commit)
>
> - Log -----------------------------------------------------------------
> commit c525ac98bdc79c3d87821abb8fa45dd60d76adfb
> Author: Stas Boukarev <sta...@gm...>
> Date:  Fri Aug 15 20:17:40 2025 +0300
>
>     ldb: add a command to find component_ptr_from_pc.
> ---
> src/runtime/monitor.c | 14 +++++++++++++-
> 1 file changed, 13 insertions(+), 1 deletion(-)
>
> diff --git a/src/runtime/monitor.c b/src/runtime/monitor.c
> index c5283ea2c..34cdd1b2e 100644
> --- a/src/runtime/monitor.c
> +++ b/src/runtime/monitor.c
> @@ -279,7 +279,7 @@ void save_gc_crashdump(char *pathname,
> #endif
>
> static cmd call_cmd, dump_cmd, print_cmd, quit_cmd, help_cmd;
> -static cmd flush_cmd, regs_cmd, exit_cmd;
> +static cmd flush_cmd, regs_cmd, exit_cmd, print_code;
> static cmd print_context_cmd, pte_cmd, search_cmd, hashtable_cmd;
> static cmd backtrace_cmd, threadbt_cmd, catchers_cmd;
> static cmd threads_cmd, findpath_cmd, layouts_cmd;
> @@ -484,6 +484,7 @@ static struct cmd {
>     {"layouts", "Dump LAYOUT instances.", layouts_cmd},
>     {"print", "Print object at ADDRESS.", print_cmd},
>     {"p", "(an alias for print)", print_cmd},
> +    {"code", "Print the code object at ADDRESS.", print_code},
>     {"pte", "Page table entry for address", pte_cmd},
>     {"quit", "Quit.", quit_cmd},
>     {"regs", "Display current Lisp registers.", regs_cmd},
> @@ -633,6 +634,17 @@ static int print_cmd(char **ptr, iochannel_t io)
>     return 0;
> }
>
> +static int print_code(char **ptr, iochannel_t io)
> +{
> +    lispobj obj;
> +    if (parse_lispobj(ptr, &obj, io->out)) {
> +        lispobj * code = component_ptr_from_pc((char *)obj);
> +        if (code)
> +            print_to_iochan((lispobj)code | OTHER_POINTER_LOWTAG, io);
> +    }
> +    return 0;
> +}
> +
> int verify_lisp_hashtable(__attribute__((unused)) struct hash_table* ht,
>                           __attribute__((unused)) FILE* file)
> {
>
> -----------------------------------------------------------------------
>
>
> hooks/post-receive
> --
> SBCL
>
>
> _______________________________________________
> Sbcl-commits mailing list
> Sbc...@li...
> https://lists.sourceforge.net/lists/listinfo/sbcl-commits

Re: [Sbcl-devel] [Sbcl-commits] master: ldb: add a command to find component_ptr_from_pc.

[Charles Z. <cha...@ya...>]

Doesn’t search already do this?

On Friday, August 15, 2025, 7:36 PM, stassats via Sbcl-commits <sbc...@li...> wrote:

The branch "master" has been updated in SBCL:
      via  c525ac98bdc79c3d87821abb8fa45dd60d76adfb (commit)
      from  84543e0050dc60b76ed8304abed50105e755d3b0 (commit)

- Log -----------------------------------------------------------------
commit c525ac98bdc79c3d87821abb8fa45dd60d76adfb
Author: Stas Boukarev <sta...@gm...>
Date:  Fri Aug 15 20:17:40 2025 +0300

    ldb: add a command to find component_ptr_from_pc.
---
 src/runtime/monitor.c | 14 +++++++++++++-
 1 file changed, 13 insertions(+), 1 deletion(-)

diff --git a/src/runtime/monitor.c b/src/runtime/monitor.c
index c5283ea2c..34cdd1b2e 100644
--- a/src/runtime/monitor.c
+++ b/src/runtime/monitor.c
@@ -279,7 +279,7 @@ void save_gc_crashdump(char *pathname,
 #endif
 
 static cmd call_cmd, dump_cmd, print_cmd, quit_cmd, help_cmd;
-static cmd flush_cmd, regs_cmd, exit_cmd;
+static cmd flush_cmd, regs_cmd, exit_cmd, print_code;
 static cmd print_context_cmd, pte_cmd, search_cmd, hashtable_cmd;
 static cmd backtrace_cmd, threadbt_cmd, catchers_cmd;
 static cmd threads_cmd, findpath_cmd, layouts_cmd;
@@ -484,6 +484,7 @@ static struct cmd {
    {"layouts", "Dump LAYOUT instances.", layouts_cmd},
    {"print", "Print object at ADDRESS.", print_cmd},
    {"p", "(an alias for print)", print_cmd},
+    {"code", "Print the code object at ADDRESS.", print_code},
    {"pte", "Page table entry for address", pte_cmd},
    {"quit", "Quit.", quit_cmd},
    {"regs", "Display current Lisp registers.", regs_cmd},
@@ -633,6 +634,17 @@ static int print_cmd(char **ptr, iochannel_t io)
    return 0;
 }
 
+static int print_code(char **ptr, iochannel_t io)
+{
+    lispobj obj;
+    if (parse_lispobj(ptr, &obj, io->out)) {
+        lispobj * code = component_ptr_from_pc((char *)obj);
+        if (code)
+            print_to_iochan((lispobj)code | OTHER_POINTER_LOWTAG, io);
+    }
+    return 0;
+}
+
 int verify_lisp_hashtable(__attribute__((unused)) struct hash_table* ht,
                          __attribute__((unused)) FILE* file)
 {

-----------------------------------------------------------------------


hooks/post-receive
-- 
SBCL


_______________________________________________
Sbcl-commits mailing list
Sbc...@li...
https://lists.sourceforge.net/lists/listinfo/sbcl-commits

Re: [Sbcl-devel] [Sbcl-commits] master: Remove inter-instruction dependency

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

Surely, modern CPUs don't care about that kind of thing.

On Thu, Aug 14, 2025 at 3:09 AM snuglas via Sbcl-commits
<sbc...@li...> wrote:
>
> The branch "master" has been updated in SBCL:
>        via  08cae3d7ff651efa30ebb26db385b6247341bba2 (commit)
>       from  9bfa7d892808dede7ef82517a9282d32e0a270a3 (commit)
>
> - Log -----------------------------------------------------------------
> commit 08cae3d7ff651efa30ebb26db385b6247341bba2
> Author: Douglas Katzman <do...@go...>
> Date:   Wed Aug 13 20:08:52 2025 -0400
>
>     Remove inter-instruction dependency
> ---
>  src/assembly/x86-64/assem-rtns.lisp | 4 ++--
>  1 file changed, 2 insertions(+), 2 deletions(-)
>
> diff --git a/src/assembly/x86-64/assem-rtns.lisp b/src/assembly/x86-64/assem-rtns.lisp
> index 02eb15511..df08161d1 100644
> --- a/src/assembly/x86-64/assem-rtns.lisp
> +++ b/src/assembly/x86-64/assem-rtns.lisp
> @@ -78,8 +78,8 @@
>    ZERO-VALUES
>    (inst lea rbx (ea (* sp->fp-offset n-word-bytes) rbp-tn))
>    (inst mov rdx null-tn)
> -  (inst mov rdi rdx)
> -  (inst mov rsi rdx)
> +  (inst mov rdi null-tn)
> +  (inst mov rsi null-tn)
>    (inst stc)
>    (inst leave)
>    (inst ret)
>
> -----------------------------------------------------------------------
>
>
> hooks/post-receive
> --
> SBCL
>
>
> _______________________________________________
> Sbcl-commits mailing list
> Sbc...@li...
> https://lists.sourceforge.net/lists/listinfo/sbcl-commits

Re: [Sbcl-devel] [Sbcl-commits] master: Don't call lseek for each file-position.

[Richard M K. <kr...@pr...>]

Okay, thanks.

Stas Boukarev writes:
> (file-position fd-stream x) clears the cached value, at the moment.
>
> On Wed, Aug 13, 2025 at 10:24=E2=80=AFPM Richard M Kreuter via Sbcl-devel
> <sbc...@li...> wrote:
> >
> > Hi Stas,
> >
> > Any idea if this change might ever leave a stream's idea of its position
> > different from the fd's offset immediately after
> >
> >   (assert (file-position fd-stream (file-position fd-stream)))
> >
> > succeeds? I can't infer the answer from the diff.
> >
> > Thanks,
> > Richard
> >
> > stassats via Sbcl-commits writes:
> > > The branch "master" has been updated in SBCL:
> > >        via  0dcf58ce89cf14af4d08c3d78cb824056b344df0 (commit)
> > >       from  fb930c0c29af5db4c2984929386b09aba9f0bdfe (commit)
> > >
> > > - Log -----------------------------------------------------------------
> > > commit 0dcf58ce89cf14af4d08c3d78cb824056b344df0
> > > Author: Stas Boukarev <sta...@gm...>
> > > Date:   Wed Aug 13 20:00:40 2025 +0300
> > >
> > >     Don't call lseek for each file-position.
> > >
> > >     Call it only when a new buffer is filled.
> > > ---
> > >  src/code/fd-stream.lisp  | 148 ++++++++++++++++++++++++++++-----------=
> ------
> > > --
> > >  xperfecthash63.lisp-expr |  17 ++++++
> > >  2 files changed, 106 insertions(+), 59 deletions(-)
> > >
> > > diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp
> > > index 87b6c9519..962eab577 100644
> > > --- a/src/code/fd-stream.lisp
> > > +++ b/src/code/fd-stream.lisp
> > > @@ -161,7 +161,13 @@
> > >    ;; fixed width, or function to call with a character
> > >    (char-size 1 :type (or fixnum function))
> > >    (replacement nil :type (or null character string (simple-array (unsi=
> gned-b
> > > yte 8) 1)))
> > > -  (output-bytes #'ill-out :type function))
> > > +  (output-bytes #'ill-out :type function)
> > > +  (file-position -1 :type (or (and unsigned-byte
> > > +                                   #+64-bit index)
> > > +                              ;; -1: uninitialized
> > > +                              ;; -2: don't track
> > > +                              ;; -3: can't be determined
> > > +                              (member -1 -2 -3))))
> > >
> > >  (defun fd-stream-bivalent-p (stream)
> > >    (eq (fd-stream-element-mode stream) :bivalent))
> > > @@ -311,43 +317,47 @@
> > >                 (aver (< head tail))
> > >                 (when (fd-stream-synchronize-output stream)
> > >                   (synchronize-stream-output stream))
> > > +               (when (>=3D (fd-stream-file-position stream) 0)
> > > +                 (setf (fd-stream-file-position stream) -1))
> > >                 (loop
> > > -                 (let ((length (- tail head)))
> > > -                   (multiple-value-bind (count errno)
> > > -                       (sb-unix:unix-write (fd-stream-fd stream) (buff=
> er-sap
> > >  obuf)
> > > -                                           head length)
> > > -                     (flet ((queue-or-wait ()
> > > -                              (if (fd-stream-serve-events stream)
> > > -                                  (return (%queue-and-replace-output-b=
> uffer
> > > stream))
> > > -                                  (or (wait-until-fd-usable (fd-stream=
> -fd st
> > > ream) :output
> > > -                                                            (fd-stream=
> -timeo
> > > ut stream)
> > > -                                                            nil)
> > > -                                      (signal-timeout 'io-timeout
> > > -                                                      :stream stream
> > > -                                                      :direction :outp=
> ut
> > > -                                                      :seconds (fd-str=
> eam-ti
> > > meout stream))))))
> > > -                        (cond ((eql count length)
> > > -                               ;; Complete write -- we can use the sam=
> e buff
> > > er.
> > > -                               (return (reset-buffer obuf)))
> > > -                              (count
> > > -                               ;; Partial write -- update buffer statu=
> s and
> > > -                               ;; queue or wait.
> > > -                               (incf head count)
> > > -                               (setf (buffer-head obuf) head)
> > > -                               (queue-or-wait))
> > > -                              #-win32
> > > -                              ((eql errno sb-unix:ewouldblock)
> > > -                               ;; Blocking, queue or wair.
> > > -                               (queue-or-wait))
> > > -                              ;; if interrupted on win32, just try aga=
> in
> > > -                              #+win32 ((eql errno sb-unix:eintr))
> > > -                              (t
> > > -                               (simple-stream-perror +write-failed+
> > > -                                                     stream errno)))))=
> ))))))
> > > ))
> > > +                (let ((length (- tail head)))
> > > +                  (multiple-value-bind (count errno)
> > > +                      (sb-unix:unix-write (fd-stream-fd stream) (buffe=
> r-sap
> > > obuf)
> > > +                                          head length)
> > > +                    (flet ((queue-or-wait ()
> > > +                             (if (fd-stream-serve-events stream)
> > > +                                 (return (%queue-and-replace-output-bu=
> ffer s
> > > tream))
> > > +                                 (or (wait-until-fd-usable (fd-stream-=
> fd str
> > > eam) :output
> > > +                                                           (fd-stream-=
> timeou
> > > t stream)
> > > +                                                           nil)
> > > +                                     (signal-timeout 'io-timeout
> > > +                                                     :stream stream
> > > +                                                     :direction :outpu=
> t
> > > +                                                     :seconds (fd-stre=
> am-tim
> > > eout stream))))))
> > > +                      (cond ((eql count length)
> > > +                             ;; Complete write -- we can use the same =
> buffer
> > > .
> > > +                             (return (reset-buffer obuf)))
> > > +                            (count
> > > +                             ;; Partial write -- update buffer status =
> and
> > > +                             ;; queue or wait.
> > > +                             (incf head count)
> > > +                             (setf (buffer-head obuf) head)
> > > +                             (queue-or-wait))
> > > +                            #-win32
> > > +                            ((eql errno sb-unix:ewouldblock)
> > > +                             ;; Blocking, queue or wair.
> > > +                             (queue-or-wait))
> > > +                            ;; if interrupted on win32, just try again
> > > +                            #+win32 ((eql errno sb-unix:eintr))
> > > +                            (t
> > > +                             (simple-stream-perror +write-failed+
> > > +                                                   stream errno)))))))=
> ))))))
> > >
> > >  (defun finish-writing-sequence (sequence stream start end)
> > >    (when (fd-stream-synchronize-output stream)
> > >      (synchronize-stream-output stream))
> > > +  (when (>=3D (fd-stream-file-position stream) 0)
> > > +    (setf (fd-stream-file-position stream) -1))
> > >    (loop
> > >     (let ((length (- end start)))
> > >       (multiple-value-bind (count errno)
> > > @@ -404,6 +414,8 @@
> > >    (aver (fd-stream-serve-events stream))
> > >    (when (fd-stream-synchronize-output stream)
> > >      (synchronize-stream-output stream))
> > > +  (when (>=3D (fd-stream-file-position stream) 0)
> > > +    (setf (fd-stream-file-position stream) -1))
> > >    (let (not-first-p)
> > >      (tagbody
> > >       :pop-buffer
> > > @@ -460,6 +472,8 @@
> > >           (let ((length (- end start)))
> > >             (when (fd-stream-synchronize-output stream)
> > >               (synchronize-stream-output stream))
> > > +           (when (>=3D (fd-stream-file-position stream) 0)
> > > +             (setf (fd-stream-file-position stream) -1))
> > >             (multiple-value-bind (count errno)
> > >                 (sb-unix:unix-write (fd-stream-fd stream) thing start l=
> ength)
> > >               (cond ((eql count length)
> > > @@ -1036,6 +1050,8 @@
> > >    (let ((fd (fd-stream-fd stream))
> > >          (errno 0)
> > >          (count 0))
> > > +    (when (>=3D (fd-stream-file-position stream) 0)
> > > +      (setf (fd-stream-file-position stream) -1))
> > >      (tagbody
> > >         #+win32
> > >         (go :main)
> > > @@ -1381,6 +1397,8 @@
> > >                  (eq (fd-stream-fd-type stream) :regular)
> > >                  ;; TODO: handle non-empty initial buffers
> > >                  (=3D (buffer-head ibuf) (buffer-tail ibuf)))
> > > +           (when (>=3D (fd-stream-file-position stream) 0)
> > > +             (setf (fd-stream-file-position stream) -1))
> > >             (prog ((fd (fd-stream-fd stream))
> > >                    (errno 0)
> > >                    (count 0))
> > > @@ -1951,9 +1969,12 @@
> > >              (setf (fd-stream-ibuf fd-stream) nil)
> > >              (release-buffer ibuf))))
> > >
> > > -    ;; FIXME: Why only for output? Why unconditionally?
> > >      (when output-p
> > > -      (setf (fd-stream-output-column fd-stream) 0))
> > > +      ;; FIXME: Why only for output? Why unconditionally?
> > > +      (setf (fd-stream-output-column fd-stream) 0)
> > > +      (when input-p
> > > +        ;; Do not track
> > > +        (setf (fd-stream-file-position fd-stream) -2)))
> > >
> > >      (when input-p
> > >        (flet ((no-input-routine ()
> > > @@ -2321,7 +2342,14 @@
> > >  (defun fd-stream-get-file-position (stream)
> > >    (declare (fd-stream stream))
> > >    (without-interrupts
> > > -    (let ((posn (sb-unix:unix-lseek (fd-stream-fd stream) 0 sb-unix:l_=
> incr))
> > > )
> > > +    (let* ((cached (fd-stream-file-position stream))
> > > +           (posn (cond ((>=3D cached 0)
> > > +                        cached)
> > > +                       ((>=3D cached -2)
> > > +                        (let ((r (sb-unix:unix-lseek (fd-stream-fd str=
> eam) 0
> > >  sb-unix:l_incr)))
> > > +                          (unless (eq cached -2)
> > > +                            (setf (fd-stream-file-position stream) (or=
>  r -3)
> > > ))
> > > +                          r)))))
> > >        (declare (type (or (alien sb-unix:unix-offset) null) posn))
> > >        ;; We used to return NIL for errno=3D=3DESPIPE, and signal an er=
> ror
> > >        ;; in other failure cases. However, CLHS says to return NIL if
> > > @@ -2353,6 +2381,8 @@
> > >    (check-type position-spec
> > >                (or (alien sb-unix:unix-offset) (member nil :start :end)=
> )
> > >                "valid file position designator")
> > > +  (when (>=3D (fd-stream-file-position stream) 0)
> > > +    (setf (fd-stream-file-position stream) -1))
> > >    (tagbody
> > >     :again
> > >       ;; Make sure we don't have any output pending, because if we
> > > @@ -2373,29 +2403,29 @@
> > >         (flush-input-buffer stream)
> > >         ;; Trash cached value for listen, so that we check next time.
> > >         (setf (fd-stream-listen stream) nil)
> > > -         ;; Now move it.
> > > -         (multiple-value-bind (offset origin)
> > > -             (case position-spec
> > > -               (:start
> > > -                (values 0 sb-unix:l_set))
> > > -               (:end
> > > -                (values 0 sb-unix:l_xtnd))
> > > -               (t
> > > -                (values (* position-spec (fd-stream-element-size strea=
> m))
> > > -                        sb-unix:l_set)))
> > > -           (declare (type (alien sb-unix:unix-offset) offset))
> > > -           (let ((posn (sb-unix:unix-lseek (fd-stream-fd stream)
> > > -                                           offset origin)))
> > > -             ;; CLHS says to return true if the file-position was set
> > > -             ;; successfully, and NIL otherwise. We are to signal an e=
> rror
> > > -             ;; only if the given position was out of bounds, and that=
>  is
> > > -             ;; dealt with above. In times past we used to return NIL =
> for
> > > -             ;; errno=3D=3DESPIPE, and signal an error in other cases.
> > > -             ;;
> > > -             ;; FIXME: We are still liable to signal an error if flush=
> ing
> > > -             ;; output fails.
> > > -             (return-from fd-stream-set-file-position
> > > -               (typep posn '(alien sb-unix:unix-offset))))))))
> > > +       ;; Now move it.
> > > +       (multiple-value-bind (offset origin)
> > > +           (case position-spec
> > > +             (:start
> > > +              (values 0 sb-unix:l_set))
> > > +             (:end
> > > +              (values 0 sb-unix:l_xtnd))
> > > +             (t
> > > +              (values (* position-spec (fd-stream-element-size stream)=
> )
> > > +                      sb-unix:l_set)))
> > > +         (declare (type (alien sb-unix:unix-offset) offset))
> > > +         (let ((posn (sb-unix:unix-lseek (fd-stream-fd stream)
> > > +                                         offset origin)))
> > > +           ;; CLHS says to return true if the file-position was set
> > > +           ;; successfully, and NIL otherwise. We are to signal an err=
> or
> > > +           ;; only if the given position was out of bounds, and that i=
> s
> > > +           ;; dealt with above. In times past we used to return NIL fo=
> r
> > > +           ;; errno=3D=3DESPIPE, and signal an error in other cases.
> > > +           ;;
> > > +           ;; FIXME: We are still liable to signal an error if flushin=
> g
> > > +           ;; output fails.
> > > +           (return-from fd-stream-set-file-position
> > > +             (typep posn '(alien sb-unix:unix-offset))))))))
> > >
> > >
> > >  ;;;; creation routines (MAKE-FD-STREAM and OPEN)
> > > diff --git a/xperfecthash63.lisp-expr b/xperfecthash63.lisp-expr
> > > index f5378c33e..9c758f03b 100644
> > > --- a/xperfecthash63.lisp-expr
> > > +++ b/xperfecthash63.lisp-expr
> > > @@ -1574,5 +1574,22 @@
> > >  (#(A49305EF D0241AE7 E55E7F8C EE9A5410)
> > >   "(SB-PCL::%CLASS SB-PCL::%PARAMETER SB-PCL::%VARIABLE-REBINDING SPECI=
> AL)"
> > >   "((& (>> val 8) 3))")
> > > +(#(24D3B50 805A8CE D64C851 207E1321 26568C99 2870F40D 2B465CCD 2CC89B6=
> A 42D8
> > > 3FFB 42E64121 46050970 49C05C00 57C2457C 5A355FA0
> > > +   665871AE 772C8C38 7B50A359 7E89C88A 81BF9BA5 8B32A898 8F463A15 9BD8=
> B4B6 9
> > > D753C32 9E88666C 9EDCE097 9F1704E1 A7EE2BA1
> > > +   AD4575D9 AEDCFD06 B11EF72D B256F00B D088DA49 D64A65E2 DB5C8A6A DDF4=
> 78CA E
> > > 6B647A0 F087745E F5306542 FA4BD0D1 FCFE2013)
> > > + "(:ALLOW-OTHER-KEYS :FILE-POSITION :OUTPUT-BYTES :REPLACEMENT :CHAR-S=
> IZE :E
> > > XTERNAL-FORMAT :PATHNAME :TIMEOUT :HANDLER :OUTPUT-QUEUE :OBUF :EOF-FOR=
> CED-P
> > > :IBUF :INSTEAD :SERVE-EVENTS :LISTEN :OUTPUT-COLUMN :SYNCHRONIZE-OUTPUT=
>  :BUFF
> > > ERING :FD-TYPE :FD :ELEMENT-MODE :ELEMENT-TYPE :ELEMENT-SIZE :DELETE-OR=
> IGINAL
> > >  :ORIGINAL :FILE :NAME :INPUT-CHAR-POS :MISC :SOUT :BOUT :COUT :N-BIN :=
> BIN :I
> > > N :IN-INDEX :CSIZE-BUFFER :CIN-BUFFER :IN-BUFFER)"
> > > + "((let ((tab #a((32) (unsigned-byte 8) 0 49 0 51 0 0 28 0 22 0 31 51 =
> 12 0 1
> > > 9 9 16 0 38 0 9 0 2 9 16 49 13 0 0 0 0 10)))
> > > +  (let ((b (& (>> val 7) #x1f)))
> > > +   (let ((a (>> (<< val 9) 27)))
> > > +    (^ a (aref tab b))))))")
> > > +(#(13913B1 24D3B50 805A8CE D64C851 207E1321 26568C99 2870F40D 2B465CCD=
>  2CC89
> > > B6A 42D83FFB 42E64121 46050970 49C05C00 57C2457C
> > > +   5A355FA0 665871AE 7566B287 772C8C38 7B50A359 7E89C88A 81BF9BA5 8B32=
> A898 8
> > > F463A15 9BD8B4B6 9D753C32 9E88666C 9EDCE097
> > > +   9F1704E1 A00DFCD7 A7EE2BA1 AD4575D9 AEDCFD06 B11EF72D B256F00B B71A=
> FB68 D
> > > 088DA49 D64A65E2 DB5C8A6A DDF478CA E57CFC3F
> > > +   E6B647A0 F087745E F5306542 FA4BD0D1 FCFE2013)
> > > + "(:ALLOW-OTHER-KEYS :FORM-START-CHAR-POS :FORM-START-BYTE-POS :LAST-N=
> EWLINE
> > >  :NEWLINES :OBSERVER :FILE-POSITION :OUTPUT-BYTES :REPLACEMENT :CHAR-SI=
> ZE :EX
> > > TERNAL-FORMAT :PATHNAME :TIMEOUT :HANDLER :OUTPUT-QUEUE :OBUF :EOF-FORC=
> ED-P :
> > > IBUF :INSTEAD :SERVE-EVENTS :LISTEN :OUTPUT-COLUMN :SYNCHRONIZE-OUTPUT =
> :BUFFE
> > > RING :FD-TYPE :FD :ELEMENT-MODE :ELEMENT-TYPE :ELEMENT-SIZE :DELETE-ORI=
> GINAL
> > > :ORIGINAL :FILE :NAME :INPUT-CHAR-POS :MISC :SOUT :BOUT :COUT :N-BIN :B=
> IN :IN
> > >  :IN-INDEX :CSIZE-BUFFER :CIN-BUFFER :IN-BUFFER)"
> > > + "((let ((tab #a((32) (unsigned-byte 8) 51 51 51 0 0 49 0 0 22 12 9 49=
>  10 0
> > > 34 36 50 0 38 0 9 0 0 11 16 0 53 0 0 0 0 10)))
> > > +  (let ((b (& (>> val 7) #x1f)))
> > > +   (let ((a (>> (<< val 9) 27)))
> > > +    (^ a (aref tab b))))))")
> > >  )
> > >  ;; EOF
> > >
> > > -----------------------------------------------------------------------
> > >
> > >
> > > hooks/post-receive
> > > --
> > > SBCL
> > >
> > >
> > > _______________________________________________
> > > Sbcl-commits mailing list
> > > Sbc...@li...
> > > https://lists.sourceforge.net/lists/listinfo/sbcl-commits
> >
> >
> > _______________________________________________
> > Sbcl-devel mailing list
> > Sbc...@li...
> > https://lists.sourceforge.net/lists/listinfo/sbcl-devel

Re: [Sbcl-devel] [Sbcl-commits] master: Don't call lseek for each file-position.

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

(file-position fd-stream x) clears the cached value, at the moment.

On Wed, Aug 13, 2025 at 10:24 PM Richard M Kreuter via Sbcl-devel
<sbc...@li...> wrote:
>
> Hi Stas,
>
> Any idea if this change might ever leave a stream's idea of its position
> different from the fd's offset immediately after
>
>   (assert (file-position fd-stream (file-position fd-stream)))
>
> succeeds? I can't infer the answer from the diff.
>
> Thanks,
> Richard
>
> stassats via Sbcl-commits writes:
> > The branch "master" has been updated in SBCL:
> >        via  0dcf58ce89cf14af4d08c3d78cb824056b344df0 (commit)
> >       from  fb930c0c29af5db4c2984929386b09aba9f0bdfe (commit)
> >
> > - Log -----------------------------------------------------------------
> > commit 0dcf58ce89cf14af4d08c3d78cb824056b344df0
> > Author: Stas Boukarev <sta...@gm...>
> > Date:   Wed Aug 13 20:00:40 2025 +0300
> >
> >     Don't call lseek for each file-position.
> >
> >     Call it only when a new buffer is filled.
> > ---
> >  src/code/fd-stream.lisp  | 148 ++++++++++++++++++++++++++++-----------------
> > --
> >  xperfecthash63.lisp-expr |  17 ++++++
> >  2 files changed, 106 insertions(+), 59 deletions(-)
> >
> > diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp
> > index 87b6c9519..962eab577 100644
> > --- a/src/code/fd-stream.lisp
> > +++ b/src/code/fd-stream.lisp
> > @@ -161,7 +161,13 @@
> >    ;; fixed width, or function to call with a character
> >    (char-size 1 :type (or fixnum function))
> >    (replacement nil :type (or null character string (simple-array (unsigned-b
> > yte 8) 1)))
> > -  (output-bytes #'ill-out :type function))
> > +  (output-bytes #'ill-out :type function)
> > +  (file-position -1 :type (or (and unsigned-byte
> > +                                   #+64-bit index)
> > +                              ;; -1: uninitialized
> > +                              ;; -2: don't track
> > +                              ;; -3: can't be determined
> > +                              (member -1 -2 -3))))
> >
> >  (defun fd-stream-bivalent-p (stream)
> >    (eq (fd-stream-element-mode stream) :bivalent))
> > @@ -311,43 +317,47 @@
> >                 (aver (< head tail))
> >                 (when (fd-stream-synchronize-output stream)
> >                   (synchronize-stream-output stream))
> > +               (when (>= (fd-stream-file-position stream) 0)
> > +                 (setf (fd-stream-file-position stream) -1))
> >                 (loop
> > -                 (let ((length (- tail head)))
> > -                   (multiple-value-bind (count errno)
> > -                       (sb-unix:unix-write (fd-stream-fd stream) (buffer-sap
> >  obuf)
> > -                                           head length)
> > -                     (flet ((queue-or-wait ()
> > -                              (if (fd-stream-serve-events stream)
> > -                                  (return (%queue-and-replace-output-buffer
> > stream))
> > -                                  (or (wait-until-fd-usable (fd-stream-fd st
> > ream) :output
> > -                                                            (fd-stream-timeo
> > ut stream)
> > -                                                            nil)
> > -                                      (signal-timeout 'io-timeout
> > -                                                      :stream stream
> > -                                                      :direction :output
> > -                                                      :seconds (fd-stream-ti
> > meout stream))))))
> > -                        (cond ((eql count length)
> > -                               ;; Complete write -- we can use the same buff
> > er.
> > -                               (return (reset-buffer obuf)))
> > -                              (count
> > -                               ;; Partial write -- update buffer status and
> > -                               ;; queue or wait.
> > -                               (incf head count)
> > -                               (setf (buffer-head obuf) head)
> > -                               (queue-or-wait))
> > -                              #-win32
> > -                              ((eql errno sb-unix:ewouldblock)
> > -                               ;; Blocking, queue or wair.
> > -                               (queue-or-wait))
> > -                              ;; if interrupted on win32, just try again
> > -                              #+win32 ((eql errno sb-unix:eintr))
> > -                              (t
> > -                               (simple-stream-perror +write-failed+
> > -                                                     stream errno)))))))))))
> > ))
> > +                (let ((length (- tail head)))
> > +                  (multiple-value-bind (count errno)
> > +                      (sb-unix:unix-write (fd-stream-fd stream) (buffer-sap
> > obuf)
> > +                                          head length)
> > +                    (flet ((queue-or-wait ()
> > +                             (if (fd-stream-serve-events stream)
> > +                                 (return (%queue-and-replace-output-buffer s
> > tream))
> > +                                 (or (wait-until-fd-usable (fd-stream-fd str
> > eam) :output
> > +                                                           (fd-stream-timeou
> > t stream)
> > +                                                           nil)
> > +                                     (signal-timeout 'io-timeout
> > +                                                     :stream stream
> > +                                                     :direction :output
> > +                                                     :seconds (fd-stream-tim
> > eout stream))))))
> > +                      (cond ((eql count length)
> > +                             ;; Complete write -- we can use the same buffer
> > .
> > +                             (return (reset-buffer obuf)))
> > +                            (count
> > +                             ;; Partial write -- update buffer status and
> > +                             ;; queue or wait.
> > +                             (incf head count)
> > +                             (setf (buffer-head obuf) head)
> > +                             (queue-or-wait))
> > +                            #-win32
> > +                            ((eql errno sb-unix:ewouldblock)
> > +                             ;; Blocking, queue or wair.
> > +                             (queue-or-wait))
> > +                            ;; if interrupted on win32, just try again
> > +                            #+win32 ((eql errno sb-unix:eintr))
> > +                            (t
> > +                             (simple-stream-perror +write-failed+
> > +                                                   stream errno)))))))))))))
> >
> >  (defun finish-writing-sequence (sequence stream start end)
> >    (when (fd-stream-synchronize-output stream)
> >      (synchronize-stream-output stream))
> > +  (when (>= (fd-stream-file-position stream) 0)
> > +    (setf (fd-stream-file-position stream) -1))
> >    (loop
> >     (let ((length (- end start)))
> >       (multiple-value-bind (count errno)
> > @@ -404,6 +414,8 @@
> >    (aver (fd-stream-serve-events stream))
> >    (when (fd-stream-synchronize-output stream)
> >      (synchronize-stream-output stream))
> > +  (when (>= (fd-stream-file-position stream) 0)
> > +    (setf (fd-stream-file-position stream) -1))
> >    (let (not-first-p)
> >      (tagbody
> >       :pop-buffer
> > @@ -460,6 +472,8 @@
> >           (let ((length (- end start)))
> >             (when (fd-stream-synchronize-output stream)
> >               (synchronize-stream-output stream))
> > +           (when (>= (fd-stream-file-position stream) 0)
> > +             (setf (fd-stream-file-position stream) -1))
> >             (multiple-value-bind (count errno)
> >                 (sb-unix:unix-write (fd-stream-fd stream) thing start length)
> >               (cond ((eql count length)
> > @@ -1036,6 +1050,8 @@
> >    (let ((fd (fd-stream-fd stream))
> >          (errno 0)
> >          (count 0))
> > +    (when (>= (fd-stream-file-position stream) 0)
> > +      (setf (fd-stream-file-position stream) -1))
> >      (tagbody
> >         #+win32
> >         (go :main)
> > @@ -1381,6 +1397,8 @@
> >                  (eq (fd-stream-fd-type stream) :regular)
> >                  ;; TODO: handle non-empty initial buffers
> >                  (= (buffer-head ibuf) (buffer-tail ibuf)))
> > +           (when (>= (fd-stream-file-position stream) 0)
> > +             (setf (fd-stream-file-position stream) -1))
> >             (prog ((fd (fd-stream-fd stream))
> >                    (errno 0)
> >                    (count 0))
> > @@ -1951,9 +1969,12 @@
> >              (setf (fd-stream-ibuf fd-stream) nil)
> >              (release-buffer ibuf))))
> >
> > -    ;; FIXME: Why only for output? Why unconditionally?
> >      (when output-p
> > -      (setf (fd-stream-output-column fd-stream) 0))
> > +      ;; FIXME: Why only for output? Why unconditionally?
> > +      (setf (fd-stream-output-column fd-stream) 0)
> > +      (when input-p
> > +        ;; Do not track
> > +        (setf (fd-stream-file-position fd-stream) -2)))
> >
> >      (when input-p
> >        (flet ((no-input-routine ()
> > @@ -2321,7 +2342,14 @@
> >  (defun fd-stream-get-file-position (stream)
> >    (declare (fd-stream stream))
> >    (without-interrupts
> > -    (let ((posn (sb-unix:unix-lseek (fd-stream-fd stream) 0 sb-unix:l_incr))
> > )
> > +    (let* ((cached (fd-stream-file-position stream))
> > +           (posn (cond ((>= cached 0)
> > +                        cached)
> > +                       ((>= cached -2)
> > +                        (let ((r (sb-unix:unix-lseek (fd-stream-fd stream) 0
> >  sb-unix:l_incr)))
> > +                          (unless (eq cached -2)
> > +                            (setf (fd-stream-file-position stream) (or r -3)
> > ))
> > +                          r)))))
> >        (declare (type (or (alien sb-unix:unix-offset) null) posn))
> >        ;; We used to return NIL for errno==ESPIPE, and signal an error
> >        ;; in other failure cases. However, CLHS says to return NIL if
> > @@ -2353,6 +2381,8 @@
> >    (check-type position-spec
> >                (or (alien sb-unix:unix-offset) (member nil :start :end))
> >                "valid file position designator")
> > +  (when (>= (fd-stream-file-position stream) 0)
> > +    (setf (fd-stream-file-position stream) -1))
> >    (tagbody
> >     :again
> >       ;; Make sure we don't have any output pending, because if we
> > @@ -2373,29 +2403,29 @@
> >         (flush-input-buffer stream)
> >         ;; Trash cached value for listen, so that we check next time.
> >         (setf (fd-stream-listen stream) nil)
> > -         ;; Now move it.
> > -         (multiple-value-bind (offset origin)
> > -             (case position-spec
> > -               (:start
> > -                (values 0 sb-unix:l_set))
> > -               (:end
> > -                (values 0 sb-unix:l_xtnd))
> > -               (t
> > -                (values (* position-spec (fd-stream-element-size stream))
> > -                        sb-unix:l_set)))
> > -           (declare (type (alien sb-unix:unix-offset) offset))
> > -           (let ((posn (sb-unix:unix-lseek (fd-stream-fd stream)
> > -                                           offset origin)))
> > -             ;; CLHS says to return true if the file-position was set
> > -             ;; successfully, and NIL otherwise. We are to signal an error
> > -             ;; only if the given position was out of bounds, and that is
> > -             ;; dealt with above. In times past we used to return NIL for
> > -             ;; errno==ESPIPE, and signal an error in other cases.
> > -             ;;
> > -             ;; FIXME: We are still liable to signal an error if flushing
> > -             ;; output fails.
> > -             (return-from fd-stream-set-file-position
> > -               (typep posn '(alien sb-unix:unix-offset))))))))
> > +       ;; Now move it.
> > +       (multiple-value-bind (offset origin)
> > +           (case position-spec
> > +             (:start
> > +              (values 0 sb-unix:l_set))
> > +             (:end
> > +              (values 0 sb-unix:l_xtnd))
> > +             (t
> > +              (values (* position-spec (fd-stream-element-size stream))
> > +                      sb-unix:l_set)))
> > +         (declare (type (alien sb-unix:unix-offset) offset))
> > +         (let ((posn (sb-unix:unix-lseek (fd-stream-fd stream)
> > +                                         offset origin)))
> > +           ;; CLHS says to return true if the file-position was set
> > +           ;; successfully, and NIL otherwise. We are to signal an error
> > +           ;; only if the given position was out of bounds, and that is
> > +           ;; dealt with above. In times past we used to return NIL for
> > +           ;; errno==ESPIPE, and signal an error in other cases.
> > +           ;;
> > +           ;; FIXME: We are still liable to signal an error if flushing
> > +           ;; output fails.
> > +           (return-from fd-stream-set-file-position
> > +             (typep posn '(alien sb-unix:unix-offset))))))))
> >
> >
> >  ;;;; creation routines (MAKE-FD-STREAM and OPEN)
> > diff --git a/xperfecthash63.lisp-expr b/xperfecthash63.lisp-expr
> > index f5378c33e..9c758f03b 100644
> > --- a/xperfecthash63.lisp-expr
> > +++ b/xperfecthash63.lisp-expr
> > @@ -1574,5 +1574,22 @@
> >  (#(A49305EF D0241AE7 E55E7F8C EE9A5410)
> >   "(SB-PCL::%CLASS SB-PCL::%PARAMETER SB-PCL::%VARIABLE-REBINDING SPECIAL)"
> >   "((& (>> val 8) 3))")
> > +(#(24D3B50 805A8CE D64C851 207E1321 26568C99 2870F40D 2B465CCD 2CC89B6A 42D8
> > 3FFB 42E64121 46050970 49C05C00 57C2457C 5A355FA0
> > +   665871AE 772C8C38 7B50A359 7E89C88A 81BF9BA5 8B32A898 8F463A15 9BD8B4B6 9
> > D753C32 9E88666C 9EDCE097 9F1704E1 A7EE2BA1
> > +   AD4575D9 AEDCFD06 B11EF72D B256F00B D088DA49 D64A65E2 DB5C8A6A DDF478CA E
> > 6B647A0 F087745E F5306542 FA4BD0D1 FCFE2013)
> > + "(:ALLOW-OTHER-KEYS :FILE-POSITION :OUTPUT-BYTES :REPLACEMENT :CHAR-SIZE :E
> > XTERNAL-FORMAT :PATHNAME :TIMEOUT :HANDLER :OUTPUT-QUEUE :OBUF :EOF-FORCED-P
> > :IBUF :INSTEAD :SERVE-EVENTS :LISTEN :OUTPUT-COLUMN :SYNCHRONIZE-OUTPUT :BUFF
> > ERING :FD-TYPE :FD :ELEMENT-MODE :ELEMENT-TYPE :ELEMENT-SIZE :DELETE-ORIGINAL
> >  :ORIGINAL :FILE :NAME :INPUT-CHAR-POS :MISC :SOUT :BOUT :COUT :N-BIN :BIN :I
> > N :IN-INDEX :CSIZE-BUFFER :CIN-BUFFER :IN-BUFFER)"
> > + "((let ((tab #a((32) (unsigned-byte 8) 0 49 0 51 0 0 28 0 22 0 31 51 12 0 1
> > 9 9 16 0 38 0 9 0 2 9 16 49 13 0 0 0 0 10)))
> > +  (let ((b (& (>> val 7) #x1f)))
> > +   (let ((a (>> (<< val 9) 27)))
> > +    (^ a (aref tab b))))))")
> > +(#(13913B1 24D3B50 805A8CE D64C851 207E1321 26568C99 2870F40D 2B465CCD 2CC89
> > B6A 42D83FFB 42E64121 46050970 49C05C00 57C2457C
> > +   5A355FA0 665871AE 7566B287 772C8C38 7B50A359 7E89C88A 81BF9BA5 8B32A898 8
> > F463A15 9BD8B4B6 9D753C32 9E88666C 9EDCE097
> > +   9F1704E1 A00DFCD7 A7EE2BA1 AD4575D9 AEDCFD06 B11EF72D B256F00B B71AFB68 D
> > 088DA49 D64A65E2 DB5C8A6A DDF478CA E57CFC3F
> > +   E6B647A0 F087745E F5306542 FA4BD0D1 FCFE2013)
> > + "(:ALLOW-OTHER-KEYS :FORM-START-CHAR-POS :FORM-START-BYTE-POS :LAST-NEWLINE
> >  :NEWLINES :OBSERVER :FILE-POSITION :OUTPUT-BYTES :REPLACEMENT :CHAR-SIZE :EX
> > TERNAL-FORMAT :PATHNAME :TIMEOUT :HANDLER :OUTPUT-QUEUE :OBUF :EOF-FORCED-P :
> > IBUF :INSTEAD :SERVE-EVENTS :LISTEN :OUTPUT-COLUMN :SYNCHRONIZE-OUTPUT :BUFFE
> > RING :FD-TYPE :FD :ELEMENT-MODE :ELEMENT-TYPE :ELEMENT-SIZE :DELETE-ORIGINAL
> > :ORIGINAL :FILE :NAME :INPUT-CHAR-POS :MISC :SOUT :BOUT :COUT :N-BIN :BIN :IN
> >  :IN-INDEX :CSIZE-BUFFER :CIN-BUFFER :IN-BUFFER)"
> > + "((let ((tab #a((32) (unsigned-byte 8) 51 51 51 0 0 49 0 0 22 12 9 49 10 0
> > 34 36 50 0 38 0 9 0 0 11 16 0 53 0 0 0 0 10)))
> > +  (let ((b (& (>> val 7) #x1f)))
> > +   (let ((a (>> (<< val 9) 27)))
> > +    (^ a (aref tab b))))))")
> >  )
> >  ;; EOF
> >
> > -----------------------------------------------------------------------
> >
> >
> > hooks/post-receive
> > --
> > SBCL
> >
> >
> > _______________________________________________
> > Sbcl-commits mailing list
> > Sbc...@li...
> > https://lists.sourceforge.net/lists/listinfo/sbcl-commits
>
>
> _______________________________________________
> Sbcl-devel mailing list
> Sbc...@li...
> https://lists.sourceforge.net/lists/listinfo/sbcl-devel

Re: [Sbcl-devel] [Sbcl-commits] master: Don't call lseek for each file-position.

[Richard M K. <kr...@pr...>]

Hi Stas,

Any idea if this change might ever leave a stream's idea of its position
different from the fd's offset immediately after

  (assert (file-position fd-stream (file-position fd-stream)))

succeeds? I can't infer the answer from the diff.

Thanks,
Richard

stassats via Sbcl-commits writes:
> The branch "master" has been updated in SBCL:
>        via  0dcf58ce89cf14af4d08c3d78cb824056b344df0 (commit)
>       from  fb930c0c29af5db4c2984929386b09aba9f0bdfe (commit)
>
> - Log -----------------------------------------------------------------
> commit 0dcf58ce89cf14af4d08c3d78cb824056b344df0
> Author: Stas Boukarev <sta...@gm...>
> Date:   Wed Aug 13 20:00:40 2025 +0300
>
>     Don't call lseek for each file-position.
>     
>     Call it only when a new buffer is filled.
> ---
>  src/code/fd-stream.lisp  | 148 ++++++++++++++++++++++++++++-----------------
> --
>  xperfecthash63.lisp-expr |  17 ++++++
>  2 files changed, 106 insertions(+), 59 deletions(-)
>
> diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp
> index 87b6c9519..962eab577 100644
> --- a/src/code/fd-stream.lisp
> +++ b/src/code/fd-stream.lisp
> @@ -161,7 +161,13 @@
>    ;; fixed width, or function to call with a character
>    (char-size 1 :type (or fixnum function))
>    (replacement nil :type (or null character string (simple-array (unsigned-b
> yte 8) 1)))
> -  (output-bytes #'ill-out :type function))
> +  (output-bytes #'ill-out :type function)
> +  (file-position -1 :type (or (and unsigned-byte
> +                                   #+64-bit index)
> +                              ;; -1: uninitialized
> +                              ;; -2: don't track
> +                              ;; -3: can't be determined
> +                              (member -1 -2 -3))))
>  
>  (defun fd-stream-bivalent-p (stream)
>    (eq (fd-stream-element-mode stream) :bivalent))
> @@ -311,43 +317,47 @@
>                 (aver (< head tail))
>                 (when (fd-stream-synchronize-output stream)
>                   (synchronize-stream-output stream))
> +               (when (>= (fd-stream-file-position stream) 0)
> +                 (setf (fd-stream-file-position stream) -1))
>                 (loop
> -                 (let ((length (- tail head)))
> -                   (multiple-value-bind (count errno)
> -                       (sb-unix:unix-write (fd-stream-fd stream) (buffer-sap
>  obuf)
> -                                           head length)
> -                     (flet ((queue-or-wait ()
> -                              (if (fd-stream-serve-events stream)
> -                                  (return (%queue-and-replace-output-buffer 
> stream))
> -                                  (or (wait-until-fd-usable (fd-stream-fd st
> ream) :output
> -                                                            (fd-stream-timeo
> ut stream)
> -                                                            nil)
> -                                      (signal-timeout 'io-timeout
> -                                                      :stream stream
> -                                                      :direction :output
> -                                                      :seconds (fd-stream-ti
> meout stream))))))
> -                        (cond ((eql count length)
> -                               ;; Complete write -- we can use the same buff
> er.
> -                               (return (reset-buffer obuf)))
> -                              (count
> -                               ;; Partial write -- update buffer status and
> -                               ;; queue or wait.
> -                               (incf head count)
> -                               (setf (buffer-head obuf) head)
> -                               (queue-or-wait))
> -                              #-win32
> -                              ((eql errno sb-unix:ewouldblock)
> -                               ;; Blocking, queue or wair.
> -                               (queue-or-wait))
> -                              ;; if interrupted on win32, just try again
> -                              #+win32 ((eql errno sb-unix:eintr))
> -                              (t
> -                               (simple-stream-perror +write-failed+
> -                                                     stream errno)))))))))))
> ))
> +                (let ((length (- tail head)))
> +                  (multiple-value-bind (count errno)
> +                      (sb-unix:unix-write (fd-stream-fd stream) (buffer-sap 
> obuf)
> +                                          head length)
> +                    (flet ((queue-or-wait ()
> +                             (if (fd-stream-serve-events stream)
> +                                 (return (%queue-and-replace-output-buffer s
> tream))
> +                                 (or (wait-until-fd-usable (fd-stream-fd str
> eam) :output
> +                                                           (fd-stream-timeou
> t stream)
> +                                                           nil)
> +                                     (signal-timeout 'io-timeout
> +                                                     :stream stream
> +                                                     :direction :output
> +                                                     :seconds (fd-stream-tim
> eout stream))))))
> +                      (cond ((eql count length)
> +                             ;; Complete write -- we can use the same buffer
> .
> +                             (return (reset-buffer obuf)))
> +                            (count
> +                             ;; Partial write -- update buffer status and
> +                             ;; queue or wait.
> +                             (incf head count)
> +                             (setf (buffer-head obuf) head)
> +                             (queue-or-wait))
> +                            #-win32
> +                            ((eql errno sb-unix:ewouldblock)
> +                             ;; Blocking, queue or wair.
> +                             (queue-or-wait))
> +                            ;; if interrupted on win32, just try again
> +                            #+win32 ((eql errno sb-unix:eintr))
> +                            (t
> +                             (simple-stream-perror +write-failed+
> +                                                   stream errno)))))))))))))
>  
>  (defun finish-writing-sequence (sequence stream start end)
>    (when (fd-stream-synchronize-output stream)
>      (synchronize-stream-output stream))
> +  (when (>= (fd-stream-file-position stream) 0)
> +    (setf (fd-stream-file-position stream) -1))
>    (loop
>     (let ((length (- end start)))
>       (multiple-value-bind (count errno)
> @@ -404,6 +414,8 @@
>    (aver (fd-stream-serve-events stream))
>    (when (fd-stream-synchronize-output stream)
>      (synchronize-stream-output stream))
> +  (when (>= (fd-stream-file-position stream) 0)
> +    (setf (fd-stream-file-position stream) -1))
>    (let (not-first-p)
>      (tagbody
>       :pop-buffer
> @@ -460,6 +472,8 @@
>           (let ((length (- end start)))
>             (when (fd-stream-synchronize-output stream)
>               (synchronize-stream-output stream))
> +           (when (>= (fd-stream-file-position stream) 0)
> +             (setf (fd-stream-file-position stream) -1))
>             (multiple-value-bind (count errno)
>                 (sb-unix:unix-write (fd-stream-fd stream) thing start length)
>               (cond ((eql count length)
> @@ -1036,6 +1050,8 @@
>    (let ((fd (fd-stream-fd stream))
>          (errno 0)
>          (count 0))
> +    (when (>= (fd-stream-file-position stream) 0)
> +      (setf (fd-stream-file-position stream) -1))
>      (tagbody
>         #+win32
>         (go :main)
> @@ -1381,6 +1397,8 @@
>                  (eq (fd-stream-fd-type stream) :regular)
>                  ;; TODO: handle non-empty initial buffers
>                  (= (buffer-head ibuf) (buffer-tail ibuf)))
> +           (when (>= (fd-stream-file-position stream) 0)
> +             (setf (fd-stream-file-position stream) -1))
>             (prog ((fd (fd-stream-fd stream))
>                    (errno 0)
>                    (count 0))
> @@ -1951,9 +1969,12 @@
>              (setf (fd-stream-ibuf fd-stream) nil)
>              (release-buffer ibuf))))
>  
> -    ;; FIXME: Why only for output? Why unconditionally?
>      (when output-p
> -      (setf (fd-stream-output-column fd-stream) 0))
> +      ;; FIXME: Why only for output? Why unconditionally?
> +      (setf (fd-stream-output-column fd-stream) 0)
> +      (when input-p
> +        ;; Do not track
> +        (setf (fd-stream-file-position fd-stream) -2)))
>  
>      (when input-p
>        (flet ((no-input-routine ()
> @@ -2321,7 +2342,14 @@
>  (defun fd-stream-get-file-position (stream)
>    (declare (fd-stream stream))
>    (without-interrupts
> -    (let ((posn (sb-unix:unix-lseek (fd-stream-fd stream) 0 sb-unix:l_incr))
> )
> +    (let* ((cached (fd-stream-file-position stream))
> +           (posn (cond ((>= cached 0)
> +                        cached)
> +                       ((>= cached -2)
> +                        (let ((r (sb-unix:unix-lseek (fd-stream-fd stream) 0
>  sb-unix:l_incr)))
> +                          (unless (eq cached -2)
> +                            (setf (fd-stream-file-position stream) (or r -3)
> ))
> +                          r)))))
>        (declare (type (or (alien sb-unix:unix-offset) null) posn))
>        ;; We used to return NIL for errno==ESPIPE, and signal an error
>        ;; in other failure cases. However, CLHS says to return NIL if
> @@ -2353,6 +2381,8 @@
>    (check-type position-spec
>                (or (alien sb-unix:unix-offset) (member nil :start :end))
>                "valid file position designator")
> +  (when (>= (fd-stream-file-position stream) 0)
> +    (setf (fd-stream-file-position stream) -1))
>    (tagbody
>     :again
>       ;; Make sure we don't have any output pending, because if we
> @@ -2373,29 +2403,29 @@
>         (flush-input-buffer stream)
>         ;; Trash cached value for listen, so that we check next time.
>         (setf (fd-stream-listen stream) nil)
> -         ;; Now move it.
> -         (multiple-value-bind (offset origin)
> -             (case position-spec
> -               (:start
> -                (values 0 sb-unix:l_set))
> -               (:end
> -                (values 0 sb-unix:l_xtnd))
> -               (t
> -                (values (* position-spec (fd-stream-element-size stream))
> -                        sb-unix:l_set)))
> -           (declare (type (alien sb-unix:unix-offset) offset))
> -           (let ((posn (sb-unix:unix-lseek (fd-stream-fd stream)
> -                                           offset origin)))
> -             ;; CLHS says to return true if the file-position was set
> -             ;; successfully, and NIL otherwise. We are to signal an error
> -             ;; only if the given position was out of bounds, and that is
> -             ;; dealt with above. In times past we used to return NIL for
> -             ;; errno==ESPIPE, and signal an error in other cases.
> -             ;;
> -             ;; FIXME: We are still liable to signal an error if flushing
> -             ;; output fails.
> -             (return-from fd-stream-set-file-position
> -               (typep posn '(alien sb-unix:unix-offset))))))))
> +       ;; Now move it.
> +       (multiple-value-bind (offset origin)
> +           (case position-spec
> +             (:start
> +              (values 0 sb-unix:l_set))
> +             (:end
> +              (values 0 sb-unix:l_xtnd))
> +             (t
> +              (values (* position-spec (fd-stream-element-size stream))
> +                      sb-unix:l_set)))
> +         (declare (type (alien sb-unix:unix-offset) offset))
> +         (let ((posn (sb-unix:unix-lseek (fd-stream-fd stream)
> +                                         offset origin)))
> +           ;; CLHS says to return true if the file-position was set
> +           ;; successfully, and NIL otherwise. We are to signal an error
> +           ;; only if the given position was out of bounds, and that is
> +           ;; dealt with above. In times past we used to return NIL for
> +           ;; errno==ESPIPE, and signal an error in other cases.
> +           ;;
> +           ;; FIXME: We are still liable to signal an error if flushing
> +           ;; output fails.
> +           (return-from fd-stream-set-file-position
> +             (typep posn '(alien sb-unix:unix-offset))))))))
>  
>  
>  ;;;; creation routines (MAKE-FD-STREAM and OPEN)
> diff --git a/xperfecthash63.lisp-expr b/xperfecthash63.lisp-expr
> index f5378c33e..9c758f03b 100644
> --- a/xperfecthash63.lisp-expr
> +++ b/xperfecthash63.lisp-expr
> @@ -1574,5 +1574,22 @@
>  (#(A49305EF D0241AE7 E55E7F8C EE9A5410)
>   "(SB-PCL::%CLASS SB-PCL::%PARAMETER SB-PCL::%VARIABLE-REBINDING SPECIAL)"
>   "((& (>> val 8) 3))")
> +(#(24D3B50 805A8CE D64C851 207E1321 26568C99 2870F40D 2B465CCD 2CC89B6A 42D8
> 3FFB 42E64121 46050970 49C05C00 57C2457C 5A355FA0
> +   665871AE 772C8C38 7B50A359 7E89C88A 81BF9BA5 8B32A898 8F463A15 9BD8B4B6 9
> D753C32 9E88666C 9EDCE097 9F1704E1 A7EE2BA1
> +   AD4575D9 AEDCFD06 B11EF72D B256F00B D088DA49 D64A65E2 DB5C8A6A DDF478CA E
> 6B647A0 F087745E F5306542 FA4BD0D1 FCFE2013)
> + "(:ALLOW-OTHER-KEYS :FILE-POSITION :OUTPUT-BYTES :REPLACEMENT :CHAR-SIZE :E
> XTERNAL-FORMAT :PATHNAME :TIMEOUT :HANDLER :OUTPUT-QUEUE :OBUF :EOF-FORCED-P 
> :IBUF :INSTEAD :SERVE-EVENTS :LISTEN :OUTPUT-COLUMN :SYNCHRONIZE-OUTPUT :BUFF
> ERING :FD-TYPE :FD :ELEMENT-MODE :ELEMENT-TYPE :ELEMENT-SIZE :DELETE-ORIGINAL
>  :ORIGINAL :FILE :NAME :INPUT-CHAR-POS :MISC :SOUT :BOUT :COUT :N-BIN :BIN :I
> N :IN-INDEX :CSIZE-BUFFER :CIN-BUFFER :IN-BUFFER)"
> + "((let ((tab #a((32) (unsigned-byte 8) 0 49 0 51 0 0 28 0 22 0 31 51 12 0 1
> 9 9 16 0 38 0 9 0 2 9 16 49 13 0 0 0 0 10)))
> +  (let ((b (& (>> val 7) #x1f)))
> +   (let ((a (>> (<< val 9) 27)))
> +    (^ a (aref tab b))))))")
> +(#(13913B1 24D3B50 805A8CE D64C851 207E1321 26568C99 2870F40D 2B465CCD 2CC89
> B6A 42D83FFB 42E64121 46050970 49C05C00 57C2457C
> +   5A355FA0 665871AE 7566B287 772C8C38 7B50A359 7E89C88A 81BF9BA5 8B32A898 8
> F463A15 9BD8B4B6 9D753C32 9E88666C 9EDCE097
> +   9F1704E1 A00DFCD7 A7EE2BA1 AD4575D9 AEDCFD06 B11EF72D B256F00B B71AFB68 D
> 088DA49 D64A65E2 DB5C8A6A DDF478CA E57CFC3F
> +   E6B647A0 F087745E F5306542 FA4BD0D1 FCFE2013)
> + "(:ALLOW-OTHER-KEYS :FORM-START-CHAR-POS :FORM-START-BYTE-POS :LAST-NEWLINE
>  :NEWLINES :OBSERVER :FILE-POSITION :OUTPUT-BYTES :REPLACEMENT :CHAR-SIZE :EX
> TERNAL-FORMAT :PATHNAME :TIMEOUT :HANDLER :OUTPUT-QUEUE :OBUF :EOF-FORCED-P :
> IBUF :INSTEAD :SERVE-EVENTS :LISTEN :OUTPUT-COLUMN :SYNCHRONIZE-OUTPUT :BUFFE
> RING :FD-TYPE :FD :ELEMENT-MODE :ELEMENT-TYPE :ELEMENT-SIZE :DELETE-ORIGINAL 
> :ORIGINAL :FILE :NAME :INPUT-CHAR-POS :MISC :SOUT :BOUT :COUT :N-BIN :BIN :IN
>  :IN-INDEX :CSIZE-BUFFER :CIN-BUFFER :IN-BUFFER)"
> + "((let ((tab #a((32) (unsigned-byte 8) 51 51 51 0 0 49 0 0 22 12 9 49 10 0 
> 34 36 50 0 38 0 9 0 0 11 16 0 53 0 0 0 0 10)))
> +  (let ((b (& (>> val 7) #x1f)))
> +   (let ((a (>> (<< val 9) 27)))
> +    (^ a (aref tab b))))))")
>  )
>  ;; EOF
>
> -----------------------------------------------------------------------
>
>
> hooks/post-receive
> -- 
> SBCL
>
>
> _______________________________________________
> Sbcl-commits mailing list
> Sbc...@li...
> https://lists.sourceforge.net/lists/listinfo/sbcl-commits