ARM64: miscompilation causes infinite loop

"Scott L. Burson" <[email protected]> Mon, 29 Jun 2026 15:25:22 -0700
Newsgroups gmane.lisp.steel-bank.devel
Message-ID <CAF5LJ4DV9QRLTEknjj9ra=6NqLkLiM=AZE3gfckJGGddYuvgdQ@mail.gmail.com>
--===============6741922108367094788==
Content-Type: multipart/alternative; boundary="0000000000005016fc06556bf167"

--0000000000005016fc06556bf167
Content-Type: text/plain; charset="UTF-8"

The function below runs correctly at safety 1, but at safety 0 on ARM64, it
hangs in an apparent infinite loop.  It runs correctly on x86-64 at safety
0.  The speed setting doesn't seem to matter; I had it at speed 3
originally.  I'm using SBCL 2.6.5 on Mac.

I tried pretty hard to boil this example down into something simpler that
would still repro the bug, but every simplification I tried made it
disappear.

BTW, bugs.launchpad.net is down.

-- Scott

====================
(in-package :cl-user)

(defconstant chunk-bits 4)
(defconstant chunk-size (ash 1 chunk-bits))

(defconstant index-size 58)
(defconstant key-number-size (- (integer-length most-positive-fixnum)
index-size))  ; 4
(defconstant key-number-mask (1- (ash 1 key-number-size)))

(defstruct (tuple-desc
             (:constructor make-tuple-desc (pairs key-set)))
  (pairs nil :type simple-vector)
  (key-set nil))

(defmethod size ((ls list))
  (length ls))

(defun tuple-make-reorder-map (old-desc new-desc)
  (declare (optimize (speed 1) (safety 0)))
  (let* ((old-pairs (tuple-desc-pairs old-desc))
         (new-size (the fixnum (size (tuple-desc-key-set new-desc))))
         (new-pairs (tuple-desc-pairs new-desc))
         (new-nchunks (ceiling new-size chunk-size))
         (key-by-idx (make-array new-size))
         (result nil))
    ;; Initialize `key-by-idx' to contain, for each index within the tuple,
the corresponding key number.
    (dotimes (i new-size)
      (let ((pr (the fixnum (svref new-pairs (+ i new-size)))))
        (setf (svref key-by-idx (ash pr (- key-number-size)))
              (logand pr key-number-mask))))
    (dotimes (ichunk new-nchunks)
      (let ((chunk (make-array (min chunk-size (- new-size (* ichunk
chunk-size)))))
            (changed? nil))
        (dotimes (i (length chunk))
          (let* ((new-idx (+ (* ichunk chunk-size) i))
                 (old-size (the fixnum (size (tuple-desc-key-set
old-desc))))
                 (new-key (the fixnum (svref key-by-idx new-idx)))
                 ;; Since the second half of the pair vector is in key
order, we can do binary
                 ;; search to find the pair.
                 (old-pr (do ((lo old-size)
                              (hi (1- (* 2 old-size))))
                             ((< hi lo) nil)
                           (declare (fixnum lo hi))
                           (let* ((mid (floor (+ lo hi) 2))
                                  (old-pr (the fixnum (svref old-pairs
mid)))
                                  (old-key (logand old-pr key-number-mask)))
                             (cond ((< old-key new-key)
                                    (setq lo (1+ mid)))
                                   ((> old-key new-key)
                                    (setq hi (1- mid)))
                                   (t
                                    (return old-pr))))))
                 (old-idx (and old-pr (ash old-pr (- key-number-size)))))
            (unless (eql old-idx new-idx)
              (setq changed? t))
            (setf (svref chunk i) old-idx)))
        (push (and changed? chunk) result)))
    (nreverse result)))

;;; Test case: (tuple-make-reorder-map (make-tuple-desc #(0 0 #x01 #x13)
'(a b)) (make-tuple-desc #(0 0 0 #x01 #x13 #x25) '(a b c)))

--0000000000005016fc06556bf167
Content-Type: text/html; charset="UTF-8"
Content-Transfer-Encoding: quoted-printable

<div dir=3D"ltr"><div>The function below runs correctly at safety 1, but at=
 safety 0 on ARM64, it hangs in an apparent infinite loop.=C2=A0 It runs co=
rrectly on x86-64 at safety 0.=C2=A0 The speed setting doesn&#39;t seem to =
matter; I had it at speed 3 originally.=C2=A0 I&#39;m using SBCL 2.6.5 on M=
ac.</div><div><br></div><div>I tried pretty hard to boil this example down =
into something simpler that would still repro the bug, but every simplifica=
tion I tried made it disappear.</div><div><br></div><div>BTW, <a href=3D"ht=
tp://bugs.launchpad.net">bugs.launchpad.net</a> is down.</div><div><br></di=
v><div>-- Scott</div><div><br></div><div>=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D</div><div>(in-package :cl-user)<br><br>(defcons=
tant chunk-bits 4)<br>(defconstant chunk-size (ash 1 chunk-bits))<br><br>(d=
efconstant index-size 58)<br>(defconstant key-number-size (- (integer-lengt=
h most-positive-fixnum) index-size)) =C2=A0; 4<br>(defconstant key-number-m=
ask (1- (ash 1 key-number-size)))<br><br>(defstruct (tuple-desc<br>=C2=A0 =
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(:constructor make-tuple-desc (pai=
rs key-set)))<br>=C2=A0 (pairs nil :type simple-vector)<br>=C2=A0 (key-set =
nil))<br><br>(defmethod size ((ls list))<br>=C2=A0 (length ls))<br><br>(def=
un tuple-make-reorder-map (old-desc new-desc)<br>=C2=A0 (declare (optimize =
(speed 1) (safety 0)))<br>=C2=A0 (let* ((old-pairs (tuple-desc-pairs old-de=
sc))<br>=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(new-size (the fixnum (size (tupl=
e-desc-key-set new-desc))))<br>=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(new-pairs=
 (tuple-desc-pairs new-desc))<br>=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(new-nch=
unks (ceiling new-size chunk-size))<br>=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(k=
ey-by-idx (make-array new-size))<br>=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(resu=
lt nil))<br>=C2=A0 =C2=A0 ;; Initialize `key-by-idx&#39; to contain, for ea=
ch index within the tuple, the corresponding key number.<br>=C2=A0 =C2=A0 (=
dotimes (i new-size)<br>=C2=A0 =C2=A0 =C2=A0 (let ((pr (the fixnum (svref n=
ew-pairs (+ i new-size)))))<br>=C2=A0 =C2=A0 =C2=A0 =C2=A0 (setf (svref key=
-by-idx (ash pr (- key-number-size)))<br>=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0=
 =C2=A0 =C2=A0 (logand pr key-number-mask))))<br>=C2=A0 =C2=A0 (dotimes (ic=
hunk new-nchunks)<br>=C2=A0 =C2=A0 =C2=A0 (let ((chunk (make-array (min chu=
nk-size (- new-size (* ichunk chunk-size)))))<br>=C2=A0 =C2=A0 =C2=A0 =C2=
=A0 =C2=A0 =C2=A0 (changed? nil))<br>=C2=A0 =C2=A0 =C2=A0 =C2=A0 (dotimes (=
i (length chunk))<br>=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (let* ((new-idx (+ =
(* ichunk chunk-size) i))<br>=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=
=A0 =C2=A0 =C2=A0(old-size (the fixnum (size (tuple-desc-key-set old-desc))=
))<br>=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(new-ke=
y (the fixnum (svref key-by-idx new-idx)))<br>=C2=A0 =C2=A0 =C2=A0 =C2=A0 =
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0;; Since the second half of the pair vect=
or is in key order, we can do binary<br>=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =
=C2=A0 =C2=A0 =C2=A0 =C2=A0;; search to find the pair.<br>=C2=A0 =C2=A0 =C2=
=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(old-pr (do ((lo old-size)<br>=
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=
=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (hi (1- (* 2 old-size))))<br>=C2=A0 =C2=A0 =
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=
=A0 =C2=A0 =C2=A0((&lt; hi lo) nil)<br>=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(declare (fix=
num lo hi))<br>=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=
=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(let* ((mid (floor (+ lo hi) 2))<br>=
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=
=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (old-pr (the fixnum (svref ol=
d-pairs mid)))<br>=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (old-key (lo=
gand old-pr key-number-mask)))<br>=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0=
 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(cond ((&lt;=
 old-key new-key)<br>=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=
=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (=
setq lo (1+ mid)))<br>=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=
=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0((=
&gt; old-key new-key)<br>=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=
=A0 (setq hi (1- mid)))<br>=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0=
 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=
=A0(t<br>=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=
=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (return old-pr)=
)))))<br>=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(old=
-idx (and old-pr (ash old-pr (- key-number-size)))))<br>=C2=A0 =C2=A0 =C2=
=A0 =C2=A0 =C2=A0 =C2=A0 (unless (eql old-idx new-idx)<br>=C2=A0 =C2=A0 =C2=
=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (setq changed? t))<br>=C2=A0 =C2=A0 =C2=A0 =
=C2=A0 =C2=A0 =C2=A0 (setf (svref chunk i) old-idx)))<br>=C2=A0 =C2=A0 =C2=
=A0 =C2=A0 (push (and changed? chunk) result)))<br>=C2=A0 =C2=A0 (nreverse =
result)))<br><br></div><div>;;; Test case:=C2=A0(tuple-make-reorder-map (ma=
ke-tuple-desc #(0 0 #x01 #x13) &#39;(a b)) (make-tuple-desc #(0 0 0 #x01 #x=
13 #x25) &#39;(a b c)))</div></div>

--0000000000005016fc06556bf167--


--===============6741922108367094788==
Content-Type: text/plain; charset="us-ascii"
MIME-Version: 1.0
Content-Transfer-Encoding: 7bit
Content-Disposition: inline


--===============6741922108367094788==
Content-Type: text/plain; charset="us-ascii"
MIME-Version: 1.0
Content-Transfer-Encoding: 7bit
Content-Disposition: inline

_______________________________________________
Sbcl-devel mailing list
[email protected]
https://lists.sourceforge.net/lists/listinfo/sbcl-devel

--===============6741922108367094788==--