Re: master: Factor out boilerplate from structure-is-a
Stas Boukarev <[email protected]>
| Newsgroups | gmane.lisp.steel-bank.cvs,gmane.lisp.steel-bank.devel |
|---|---|
| Message-ID | <CAF63=133fUqtfLS2w472h9FXv1bp0xrB8H53UvMdYYj2FDyiag@mail.gmail.com> |
mips:
[ 15/299] src/code/function-names (0.010 sec)
While evaluating the form starting at line 219, column 0
of #P"/home/runner/work/sbcl/sbcl/src/cold/compile-cold-sbcl.lisp":
Unhandled TYPE-ERROR in thread #<HOST-SB-THREAD:THREAD tid=71354 "main
thread" RUNNING
{1200038003}>:
The value
NIL
is not of type
(OR (SIGNED-BYTE 16) SB-C:FIXUP SB-ASSEM:LABEL)
when binding INDEX
Backtrace for: #<HOST-SB-THREAD:THREAD tid=71354 "main thread" RUNNING
{1200038003}>
0: ((LAMBDA (SB-MIPS-ASM::SEGMENT SB-MIPS-ASM::REG SB-MIPS-ASM::BASE
&OPTIONAL INDEX) :IN
"/home/runner/work/sbcl/sbcl/src/compiler/mips/insts.lisp")
#<SB-ASSEM:SEGMENT {12036DB9A3}> #<SB-C:TN t1[NL3] :NORMAL> #<SB-C:TN
t2[A2] :NORMAL> NIL) [external]
1
On Mon, Aug 17, 2026 at 5:19 AM snuglas via Sbcl-commits
<[email protected]> wrote:
>
> The branch "master" has been updated in SBCL:
> via b3b9f0efa2eda1f4d04ab7dfdb7c630bc96dd0df (commit)
> from 65b968f2ac117c7306766ebf7593750e112c1b2a (commit)
>
> - Log -----------------------------------------------------------------
> commit b3b9f0efa2eda1f4d04ab7dfdb7c630bc96dd0df
> Author: Douglas Katzman <[email protected]>
> Date: Sun Aug 16 22:19:14 2026 -0400
>
> Factor out boilerplate from structure-is-a
> ---
> src/compiler/arm/system.lisp | 7 ++-----
> src/compiler/arm64/type-vops.lisp | 7 ++-----
> src/compiler/generic/utils.lisp | 6 ++++++
> src/compiler/loongarch64/system.lisp | 7 ++-----
> src/compiler/mips/system.lisp | 12 ++++--------
> src/compiler/ppc/system.lisp | 7 ++-----
> src/compiler/ppc64/system.lisp | 7 ++-----
> src/compiler/riscv/system.lisp | 7 ++-----
> src/compiler/sparc/system.lisp | 7 ++-----
> src/compiler/x86-64/type-vops.lisp | 7 ++-----
> src/compiler/x86/system.lisp | 6 +-----
> 11 files changed, 27 insertions(+), 53 deletions(-)
>
> diff --git a/src/compiler/arm/system.lisp b/src/compiler/arm/system.lisp
> index e2fcedc86..3047f4518 100644
> --- a/src/compiler/arm/system.lisp
> +++ b/src/compiler/arm/system.lisp
> @@ -78,11 +78,8 @@
> (:info test-layout)
> (:temporary (:sc unsigned-reg) this-id)
> (:generator 4
> - (let ((test-id (layout-id test-layout))
> - (offset (+ (id-bits-offset)
> - (ash (- (layout-depthoid test-layout) 2) 2)
> - (- instance-pointer-lowtag))))
> - (inst ldr this-id (@ x offset))
> + (inst ldr this-id (@ x (layout-id-offset test-layout)))
> + (let ((test-id (layout-id test-layout)))
> ;; 8-bit IDs are permanently assigned, so no fixup ever needed for those.
> (cond ((typep test-id '(and (unsigned-byte 8) (not (eql 0))))
> (inst cmp this-id test-id))
> diff --git a/src/compiler/arm64/type-vops.lisp b/src/compiler/arm64/type-vops.lisp
> index 6e65bec52..d17d67c7b 100644
> --- a/src/compiler/arm64/type-vops.lisp
> +++ b/src/compiler/arm64/type-vops.lisp
> @@ -828,10 +828,7 @@
> nil)
> (t
> (let* ((test-id (layout-id test-layout))
> - (depthoid (layout-depthoid test-layout))
> - (offset (+ (id-bits-offset)
> - (ash (- depthoid 2) 2)
> - (- instance-pointer-lowtag))))
> + (depthoid (layout-depthoid test-layout)))
> (when (and target
> (> depthoid sb-kernel::layout-id-vector-fixed-capacity))
> (inst ldrsw temp
> @@ -843,7 +840,7 @@
> instance-pointer-lowtag)))
> (inst cmp temp (add-sub-immediate (fixnumize depthoid)))
> (inst b :lt (if not-p target done)))
> - (inst ldr (32-bit-reg this-id) (@ layout offset))
> + (inst ldr (32-bit-reg this-id) (@ layout (layout-id-offset test-layout)))
> ;; 8-bit IDs are permanently assigned, so no fixup ever needed for those.
> (cond ((typep test-id '(and (signed-byte 8) (not (eql 0))))
> (if (minusp test-id)
> diff --git a/src/compiler/generic/utils.lisp b/src/compiler/generic/utils.lisp
> index 454caa52a..3e4acfb3a 100644
> --- a/src/compiler/generic/utils.lisp
> +++ b/src/compiler/generic/utils.lisp
> @@ -544,6 +544,12 @@
> (defmacro id-bits-offset () ; FIXME: could this be a constant ?
> (let ((slot (get-dsd-index layout sb-kernel::id-word0)))
> (ash (+ sb-vm:instance-slots-offset slot) sb-vm:word-shift)))
> +(defmacro layout-id-offset (layout)
> + ;; Compute offset at which you can read a layout-id from an unknown layout to see
> + ;; if it matches the ID at the depthoid of LAYOUT.
> + `(+ (id-bits-offset)
> + (ash (- (layout-depthoid ,layout) 2) 2)
> + (- instance-pointer-lowtag))) ; Answer is in bytes relative to tagged ptr
>
> ;; It is both an optimization and a necessity that we use a single-bit test
> ;; for these three layouts in particular, because no layout-id is stored
> diff --git a/src/compiler/loongarch64/system.lisp b/src/compiler/loongarch64/system.lisp
> index e3c9d84d4..55ad453c3 100644
> --- a/src/compiler/loongarch64/system.lisp
> +++ b/src/compiler/loongarch64/system.lisp
> @@ -78,15 +78,12 @@
> (:info target not-p test-layout)
> (:temporary (:sc unsigned-reg) this-id temp)
> (:generator 4
> - (let ((offset (+ (id-bits-offset)
> - (ash (- (layout-depthoid test-layout) 2) 2)
> - (- instance-pointer-lowtag))))
> - (inst ld.w this-id x offset)
> + (inst ld.w this-id x (layout-id-offset test-layout))
> (if (or (typep (layout-id test-layout) '(and (signed-byte 8) (not (eql 0))))
> (not (sb-c::producing-fasl-file)))
> (inst li temp (layout-id test-layout))
> (inst load-layout-id temp test-layout))
> - (inst* (if not-p 'bne 'beq) this-id temp target))))
> + (inst* (if not-p 'bne 'beq) this-id temp target)))
>
> (define-vop (layout-depthoid)
> (:translate layout-depthoid)
> diff --git a/src/compiler/mips/system.lisp b/src/compiler/mips/system.lisp
> index 9898944ab..719c0023c 100644
> --- a/src/compiler/mips/system.lisp
> +++ b/src/compiler/mips/system.lisp
> @@ -77,14 +77,10 @@
> (:info target not-p test-layout)
> (:temporary (:sc unsigned-reg) this-id test-id)
> (:generator 4
> - (let ((label (register-inline-constant :layout-id test-layout))
> - (offset (+ (id-bits-offset)
> - (ash (- (layout-depthoid test-layout) 2) 2)
> - (- instance-pointer-lowtag))))
> - (inst lw test-id sb-vm::code-tn label)
> - (inst lw this-id x offset)
> - (inst* (if not-p 'bne 'beq) this-id test-id target)
> - (inst nop))))
> + (inst lw test-id sb-vm::code-tn (register-inline-constant :layout-id test-layout))
> + (inst lw this-id x (layout-id test-layout))
> + (inst* (if not-p 'bne 'beq) this-id test-id target)
> + (inst nop)))
>
> (define-vop (%other-pointer-widetag)
> (:translate %other-pointer-widetag)
> diff --git a/src/compiler/ppc/system.lisp b/src/compiler/ppc/system.lisp
> index e4ddb8684..173321001 100644
> --- a/src/compiler/ppc/system.lisp
> +++ b/src/compiler/ppc/system.lisp
> @@ -67,11 +67,8 @@
> (:info target not-p test-layout)
> (:temporary (:scs (non-descriptor-reg)) this-id that-id)
> (:generator 4
> - (let ((test-id (layout-id test-layout))
> - (offset (+ (id-bits-offset)
> - (ash (- (layout-depthoid test-layout) 2) 2)
> - (- instance-pointer-lowtag))))
> - (inst lwz this-id x offset)
> + (inst lwz this-id x (layout-id-offset test-layout))
> + (let ((test-id (layout-id test-layout)))
> ;; Always prefer 'cmpwi' if compiling to memory.
> ;; 8-bit IDs are permanently assigned, so no fixup ever needed for those.
> (cond ((or (typep test-id '(and (signed-byte 8) (not (eql 0))))
> diff --git a/src/compiler/ppc64/system.lisp b/src/compiler/ppc64/system.lisp
> index 66fe9e947..d8d591168 100644
> --- a/src/compiler/ppc64/system.lisp
> +++ b/src/compiler/ppc64/system.lisp
> @@ -83,11 +83,8 @@
> (:info target not-p test-layout)
> (:temporary (:scs (non-descriptor-reg)) this-id)
> (:generator 4
> - (let ((test-id (layout-id test-layout))
> - (offset (+ (id-bits-offset)
> - (ash (- (layout-depthoid test-layout) 2) 2)
> - (- instance-pointer-lowtag))))
> - (inst lwa this-id x offset)
> + (inst lwa this-id x (layout-id-offset test-layout))
> + (let ((test-id (layout-id test-layout)))
> ;; Always prefer 'cmpwi' if compiling to memory.
> ;; 8-bit IDs are permanently assigned, so no fixup ever needed for those.
> (cond ((or (typep test-id '(and (signed-byte 8) (not (eql 0))))
> diff --git a/src/compiler/riscv/system.lisp b/src/compiler/riscv/system.lisp
> index 2d1624e92..e48153702 100644
> --- a/src/compiler/riscv/system.lisp
> +++ b/src/compiler/riscv/system.lisp
> @@ -78,15 +78,12 @@
> (:info target not-p test-layout)
> (:temporary (:sc unsigned-reg) this-id temp)
> (:generator 4
> - (let ((offset (+ (id-bits-offset)
> - (ash (- (layout-depthoid test-layout) 2) 2)
> - (- instance-pointer-lowtag))))
> - (inst lw this-id x offset)
> + (inst lw this-id x (layout-id-offset test-layout))
> (if (or (typep (layout-id test-layout) '(and (signed-byte 8) (not (eql 0))))
> (not (sb-c::producing-fasl-file)))
> (inst li temp (layout-id test-layout))
> (inst load-layout-id temp test-layout))
> - (inst* (if not-p 'bne 'beq) this-id temp target))))
> + (inst* (if not-p 'bne 'beq) this-id temp target)))
>
> #+64-bit
> (define-vop (layout-depthoid)
> diff --git a/src/compiler/sparc/system.lisp b/src/compiler/sparc/system.lisp
> index f9fafd34a..68c137e81 100644
> --- a/src/compiler/sparc/system.lisp
> +++ b/src/compiler/sparc/system.lisp
> @@ -70,17 +70,14 @@
> (:info target not-p test-layout)
> (:temporary (:sc unsigned-reg) this-id temp)
> (:generator 4
> - (let ((offset (+ (id-bits-offset)
> - (ash (- (layout-depthoid test-layout) 2) 2)
> - (- instance-pointer-lowtag))))
> - (inst ld this-id x offset)
> + (inst ld this-id x (layout-id-offset test-layout))
> (if (or (typep (layout-id test-layout) '(and (signed-byte 8) (not (eql 0))))
> (not (sb-c::producing-fasl-file)))
> (inst li temp (layout-id test-layout))
> (inst load-layout-id temp test-layout))
> (inst cmp this-id temp)
> (inst b (if not-p :ne :eq) target)
> - (inst nop))))
> + (inst nop)))
>
> (define-vop (%other-pointer-widetag)
> (:translate %other-pointer-widetag)
> diff --git a/src/compiler/x86-64/type-vops.lisp b/src/compiler/x86-64/type-vops.lisp
> index 11cc1c4d3..c01b08a56 100644
> --- a/src/compiler/x86-64/type-vops.lisp
> +++ b/src/compiler/x86-64/type-vops.lisp
> @@ -1260,16 +1260,13 @@
> (inst cmp (emit-constant test-layout) layout))
>
> (t
> - (let* ((depthoid (layout-depthoid test-layout))
> - (offset (+ (id-bits-offset)
> - (ash (- depthoid 2) 2)
> - (- instance-pointer-lowtag))))
> + (let ((depthoid (layout-depthoid test-layout)))
> (when (and target
> (> depthoid sb-kernel::layout-id-vector-fixed-capacity))
> (inst cmp :dword (read-depthoid) (fixnumize depthoid))
> (inst jmp :l (if not-p target done)))
> (inst cmp :dword
> - (ea offset layout)
> + (ea (layout-id-offset test-layout) layout)
> ;; Small layout-ids can only occur for layouts made in genesis.
> ;; Therefore if the compile-time value of the ID is small,
> ;; it is permanently assigned to that type.
> diff --git a/src/compiler/x86/system.lisp b/src/compiler/x86/system.lisp
> index 4a8fb6b20..724670047 100644
> --- a/src/compiler/x86/system.lisp
> +++ b/src/compiler/x86/system.lisp
> @@ -76,11 +76,7 @@
> (:conditional :e)
> (:generator 1
> (inst cmp
> - (make-ea :dword
> - :disp (+ (id-bits-offset)
> - (ash (- (layout-depthoid test) 2) 2)
> - (- instance-pointer-lowtag))
> - :base x)
> + (make-ea :dword :disp (layout-id-offset test) :base x)
> (if (or (typep (layout-id test) '(and (signed-byte 8) (not (eql 0))))
> (not (sb-c::producing-fasl-file)))
> (layout-id test)
>
> -----------------------------------------------------------------------
>
>
> hooks/post-receive
> --
> SBCL
>
>
> _______________________________________________
> Sbcl-commits mailing list
> [email protected]
> https://lists.sourceforge.net/lists/listinfo/sbcl-commits
_______________________________________________
Sbcl-commits mailing list
[email protected]
https://lists.sourceforge.net/lists/listinfo/sbcl-commits