common-lisp/sbcl.sbcl
1
0
Fork 0
mirror of git://git.code.sf.net/p/sbcl/sbcl synced 2026-09-10 07:26:40 -04:00
Code Issues Actions 8 Packages Projects Releases Wiki Activity

Fix (/ real complex) float contagion

Browse source
This commit is contained in:
Stas Boukarev 2026-02-13 01:24:27 +03:00
parent d44029f2dd
commit f96e614006
4 changed files with 16 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
src/compiler/float-tran.lisp
View file

@ -1457,12 +1457,12 @@
(if (vop-existsp :translate sb-vm::swap-complex) (if (vop-existsp :translate sb-vm::swap-complex)
(let ((real (csubtypep (lvar-type x) (specifier-type 'real)))) (let ((real (csubtypep (lvar-type x) (specifier-type 'real))))
`(let* (,@(if real `(let* (,@(if real
'((x (coerce x ',type)))) '((x (coerce x 'float))))
(cs ,(if real (cs ,(if real
'(complex ,(coerce 0 type) (%negate x)) '(complex 0 (%negate x))
'(conjugate (sb-vm::swap-complex x)))) '(conjugate (sb-vm::swap-complex x))))
,@(if real ,@(if real
'((x (complex x ,(coerce 0 type))))) '((x (complex x 0))))
(ry (realpart y)) (ry (realpart y))
(iy (imagpart y))) (iy (imagpart y)))
(if (> (abs ry) (abs iy)) (if (> (abs ry) (abs iy))

8
tests/arith-2.pure.lisp
View file

@ -2412,7 +2412,13 @@
(/ (- a) (- b))) (/ (- a) (- b)))
((#c(0.0 3.0) #c(0.0 3.0)) ((#c(0.0 3.0) #c(0.0 3.0))
(/ (opaque-identity (- #c(0.0 3.0))) (/ (opaque-identity (- #c(0.0 3.0)))
(opaque-identity (- #c(0.0 3.0))))))) (opaque-identity (- #c(0.0 3.0))))))
(checked-compile-and-assert
()
`(lambda (n)
(declare (double-float n))
(/ n #C(1.0 2.0)))
((5d0) #C(1.0d0 -2.0d0))))
(with-test (:name :truncate+/+complex) (with-test (:name :truncate+/+complex)
(checked-compile-and-assert (checked-compile-and-assert

6
tests/parallel-exec.lisp
View file

@ -1,6 +1,10 @@
(pop *posix-argv*) (pop *posix-argv*)
(require :sb-posix) (require :sb-posix)
#-sparc (push :test-sprof *features*)
(if (find "--no-sprof" *posix-argv* :test #'equal)
(setf *posix-argv* (remove "--no-sprof" *posix-argv* :test #'equal))
#-sparc (push :test-sprof *features*))
#+test-sprof (require :sb-sprof) #+test-sprof (require :sb-sprof)
;; (push :tlsf-stress *features*) ;; (push :tlsf-stress *features*)

2
tools-for-build/wxs.lisp
View file

@ -260,7 +260,7 @@
"Type" "string" "Type" "string"
"Value" "" "Value" ""
"KeyPath" "yes"))))) "KeyPath" "yes")))))
("Directory" ("Id" #+x86 "ProgramFilesFolder" ("Directory" ("Id" #+x86 "ProgramFilesFolder"
#+64-bit "ProgramFiles64Folder" #+64-bit "ProgramFiles64Folder"
"Name" "PFiles") "Name" "PFiles")
("Directory" ("Id" "BaseFolder" ("Directory" ("Id" "BaseFolder"