psetf and typed structure slots on x8632

[xrme]

From openmcl-devel (https://lists.clozure.com/pipermail/openmcl-devel/2017-April/011640.html)

(lisp-implementation-version)
"Version 1.11-r16635  (WindowsX8632)"

(ql:quickload '3d-vectors)

(let ((vec (3d-vectors::vec 5 0 0)))
  (psetf (3d-vectors::%vx3 vec) 5.0
         (3d-vectors::%vy3 vec) 5.0))

Signal error:
The value 5.0 is not of the expected type STRUCTURE.
[Condition of type TYPE-ERROR]

The sender notes: "The problem seems to be related to psetf. If you remove one of the set pairs, it works fine. If you use setf, it also works fine. 64 bit versions do not have such an issue, LinuxARM32 also passes."

A follow-up message provides a simpler test case

(defstruct vec
  (x 0.0 :type single-float)
  (y 0.0 :type single-float))

(let ((vec (make-vec)))
  (psetf (vec-x vec) 5.0
         (vec-y vec) 5.0))

The follow-up's author notes that the specific trigger combination seems to be psetf with typed structure slots.

---

Want to back this issue? Post a bounty on it! We accept bounties via Bountysource.

[xrme]

Slightly simpler test case:

(defstruct vec
  (x 0.0 :type single-float))

(defun foo ()
  (let ((v (make-vec))
	(x 1.0))
    (let ((y (ccl::typecheck x single-float)))
      (ccl::struct-set v 1 y))))

[phoe]

The failure seems unrelated to the compiler macro in optimizers.lisp or defun struct-set in defstruct.lisp. It seems that the issue is somewhere in the compiled code.

[phoe]

The issue is reproducible on Linux.

nx1-compile-lambda generates different acodes on x32 and x64 - which is natural, since single-floats need to be boxed on 32 bits.

64 bits:

CCL> (let (*nx-current-code-note*)
       (nx1-compile-lambda nil '(lambda ()
         (let ((v (make-vec)))
           (let ((x 1.0))
             (let ((y (ccl::require-type x 'single-float)))
               (ccl::struct-set v 1 y)))))))
#<AFUNC #x302001EBAE2D>
CCL> (afunc-acode *)
#<ACODE lambda-list (NIL NIL NIL NIL (NIL NIL) #<ACODE let* ((#<VAR V #x302001BA9F0D>) (#<ACODE call (#<ACODE immediate (MAKE-VEC)> (NIL NIL) NIL)>) #<ACODE let* (NIL NIL #<ACODE let* ((#<VAR Y #x302001BA93DD>) (#<ACODE typed-form (SINGLE-FLOAT #<ACODE let* ((#<VAR #:G1280 #x302001BA9BFD>) (#<ACODE immediate (1.0)>) #<ACODE if (#<ACODE eq (#<ACODE immediate (:EQ)> #<ACODE fulltag (#<ACODE lexical-reference (#<VAR #:G1280 #x302001BA9BFD>)>)> #<ACODE fixnum (1)>)> #<ACODE lexical-reference (#<VAR #:G1280 #x302001BA9BFD>)> #<ACODE call (#<ACODE immediate (%KERNEL-RESTART)> (NIL (#<ACODE immediate (SINGLE-FLOAT)> #<ACODE lexical-reference (#<VAR #:G1280 #x302001BA9BFD>)> #<ACODE fixnum (157)>)) NIL)>)> 2162688)> NIL)>) #<ACODE struct-set (#<ACODE lexical-reference (#<VAR V #x302001BA9F0D>)> #<ACODE fixnum (1)> #<ACODE lexical-reference (#<VAR Y #x302001BA93DD>)>)> 2162688)> 2162688)> 2162688)> 2162688)>

32 bits:

CCL> (let (*nx-current-code-note*)
       (nx1-compile-lambda nil '(lambda ()
         (let ((v (make-vec)))
           (let ((x 1.0))
             (let ((y (ccl::require-type x 'single-float)))
               (ccl::struct-set v 1 y)))))))
#<AFUNC #x182F58AE>
CCL> (afunc-acode *)
#<ACODE lambda-list (NIL NIL NIL NIL (NIL NIL) #<ACODE let* ((#<VAR V #x182F568E>) (#<ACODE call (#<ACODE immediate (MAKE-VEC)> (NIL NIL) NIL)>) #<ACODE let* (NIL NIL #<ACODE let* ((#<VAR Y #x182F4096>) (#<ACODE typed-form (SINGLE-FLOAT #<ACODE let* ((#<VAR #:G66 #x182F52DE>) (#<ACODE immediate (1.0)>) #<ACODE if (#<ACODE eq (#<ACODE immediate (:EQ)> #<ACODE typecode (#<ACODE lexical-reference (#<VAR #:G66 #x182F52DE>)>)> #<ACODE fixnum (15)>)> #<ACODE lexical-reference (#<VAR #:G66 #x182F52DE>)> #<ACODE call (#<ACODE immediate (%KERNEL-RESTART)> ((#<ACODE fixnum (157)>) (#<ACODE immediate (SINGLE-FLOAT)> #<ACODE lexical-reference (#<VAR #:G66 #x182F52DE>)>)) NIL)>)> 2162688)> NIL)>) #<ACODE struct-set (#<ACODE lexical-reference (#<VAR V #x182F568E>)> #<ACODE fixnum (1)> #<ACODE lexical-reference (#<VAR Y #x182F4096>)>)> 2162688)> 2162688)> 2162688)> 2162688)>

Attaching somewhat formatted and lispified acodes: acode.txt

[phoe]

EDIT: Nevermind - I was going in circles. The information previously posted here was incorrect.