- cmucl-cvs - mailman3.common-lisp.net

[Git][cmucl/cmucl][issue-456-more-accurate-complex-div] 3 commits: Add comments and remove debugging.
by Raymond Toy (＠rtoy) 11 Dec '25

11 Dec '25

Raymond Toy pushed to branch issue-456-more-accurate-complex-div at cmucl / cmucl Commits: 22b67f1e by Raymond Toy at 2025-12-10T17:48:16-08:00 Add comments and remove debugging. Add comments to cdiv-double-float based on the text of the paper and also add some derivations to make it a bit easier to follow what's going on. Remove the debugging prints too. - - - - - 7f08a0de by Raymond Toy at 2025-12-10T18:19:38-08:00 Fix round-off error for z/z not returning 1. In the ansi tests, there's a test case for (/ z z) for many random complex numbers z. This is expected to return #c(1 0), but we weren't. This is caused by the cdiv-double-float algorithm computing tt = 1/(c + d*r) and then multiplying by tt in various places. However, this causes an extra rounding operation. Instead, modify the code to use tt = (c + d*r) and divide by tt instead of multiply. This gets rid of the extra rounding. - - - - - 1aa7c11f by Raymond Toy at 2025-12-10T19:31:06-08:00 Update tests. Test 8 now has full accuracy, but test 11 from Maxima only has 52 bits. Add a test from the failed ansi-test that was testing (/ z z) being exactly 1. Fix typo in complex-division.single. - - - - - 2 changed files: - src/code/numbers.lisp - tests/float.lisp Changes: ===================================== src/code/numbers.lisp ===================================== @@ -605,42 +605,85 @@ (labels ((internal-compreal (a b c d r tt) (declare (double-float a b c d r tt)) + ;; Compute the real part of the complex division + ;; (a+ib)/(c+id), assuming |c| <= |d|. r = d/c and tt = 1/(c+d*r). + ;; + ;; The realpart is (a*c+b*d)/(c^2+d^2). + ;; + ;; c^2+d^2 = c*(c+d*(d/c)) = c*(c+d*r) + ;; + ;; Then + ;; + ;; (a*c+b*d)/(c^2+d^2) = (a*c+b*d)/(c*(c+d*r)) + ;; = (a + b*d/c)/(c+d*r) + ;; = (a + b*r)/(c + d*r). + ;; + ;; Thus tt = (c + d*r). + #+nil + (progn + (format t "a,b,c,d = ~A ~A ~A ~A~%" a b c d) + (format t " r, tt = ~A ~A~%" r tt)) (cond ((/= r 0) (let ((br (* b r))) + #+nil + (format t "br = ~A~%" br) (if (/= br 0) - (* (+ a br) tt) - (+ (* a tt) - (* (* b tt) + (/ (+ a br) tt) + ;; b*r underflows. Instead, compute + ;; + ;; (a + b*r)*tt = a*tt + b*tt*r + ;; = a*tt + (b*tt)*r + ;; (a + b*r)/tt = a/tt + b/tt*r + ;; = a*tt + (b*tt)*r + (+ (/ a tt) + (* (/ b tt) r))))) (t - (* (+ a (* d (/ b c))) + ;; r = 0 so d is very tiny compared to c. + ;; + ;; (a + b*r)/tt = (a + b*(d/c))/tt + #+nil + (progn + (format t "r = 0~%") + (format t "a*tt = ~A~%" (* a tt))) + (/ (+ a (* d (/ b c))) tt)))) (robust-subinternal (a b c d) (declare (double-float a b c d)) (let* ((r (/ d c)) - (tt (/ (+ c (* d r))))) + (tt (+ c (* d r)))) + ;; e is the real part and f is the imaginary part. We + ;; can use internal-compreal for the imaginary part by + ;; noticing that the imaginary part of (a+i*b)/(c+i*d) is + ;; the same as the real part of (b-i*a)/(c+i*d). (let ((e (internal-compreal a b c d r tt)) (f (internal-compreal b (- a) c d r tt))) - #+nil(format t "subint: e f = ~A ~A~%" e f) (values e f)))) (robust-internal (x y) (declare (type (complex double-float) x y)) - #+nil(format t "x = ~A, y = ~A~%" x y) (let ((a (realpart x)) (b (imagpart x)) (c (realpart y)) (d (imagpart y))) (cond ((<= (abs d) (abs c)) + ;; |d| <= |c|, so we can use robust-subinternal to + ;; perform the division. (multiple-value-bind (e f) (robust-subinternal a b c d) - #+nil(format t "1: e f = ~A ~A~%" e f) (complex e f))) (t + ;; |d| > |c|. So, instead compute + ;; + ;; (b + i*a)/(d + i*c) = ((b*d+a*c) + (a*d-b*c)*i)/(d^2+c^2) + ;; + ;; Compare this to (a+i*b)/(c+i*d) and we see that + ;; realpart of the former is the same, but the + ;; imagpart of the former is the negative of the + ;; desired division. (multiple-value-bind (e f) (robust-subinternal b a d c) - #+nil(format t "2: e f = ~A ~A~%" e f) (complex e (- f)))))))) (let* ((a (realpart x)) (b (imagpart x)) @@ -648,19 +691,23 @@ (d (imagpart y)) (ab (max (abs a) (abs b))) (cd (max (abs c) (abs d))) - (b 2d0) + (bb 2d0) (s 1d0) - (be (/ b (* eps eps)))) + (be (/ bb (* eps eps)))) + ;; If a or b is big, scale down a and b. (when (>= ab (/ ov 2)) (setf x (/ x 2) s (* s 2))) + ;; If c or d is big, scale down c and d. (when (>= cd (/ ov 2)) (setf y (/ y 2) s (/ s 2))) - (when (<= ab (* un (/ b eps))) + ;; If a or b is tiny, scale up a and b. + (when (<= ab (* un (/ bb eps))) (setf x (* x be) s (/ s be))) - (when (<= cd (* un (/ b eps))) + ;; If c or d is tiny, scale up c and d. + (when (<= cd (* un (/ bb eps))) (setf y (* y be) s (* s be))) (* s ===================================== tests/float.lisp ===================================== @@ -388,7 +388,7 @@ (list (complex (scale-float 1d0 -1074) (scale-float 1d0 -1074)) (complex (scale-float 1d0 -1073) (scale-float 1d0 -1074)) (complex 0.6d0 0.2d0) - 52 least-positive-double-float) + 53 least-positive-double-float) ;; 9 (list (complex (scale-float 1d0 1015) (scale-float 1d0 -989)) (complex (scale-float 1d0 1023) (scale-float 1d0 1023)) @@ -399,11 +399,18 @@ (complex (scale-float 1d0 -343) (scale-float 1d0 -798)) (complex 1.02951151789360578d-84 6.97145987515076231d-220) 53 least-positive-double-float) + ;; 11 ;; From Maxima (list #c(5.43d-10 1.13d-100) #c(1.2d-311 5.7d-312) #c(3.691993880674614517999740937026568563794896024143749539711267954d301 -1.753697093319947872394996242210428954266103103602859195409591583d301) + 52 least-positive-double-float) + ;; 12 + ;; Found by ansi tests. z/z should be exactly 1. + (list #c(1.565640716292489d19 0.0d0) + #c(1.565640716292489d19 0.0d0) + #c(1d0 0) 53 least-positive-double-float) )) @@ -494,10 +501,10 @@ (define-test complex-division.single (:tag :issues) - (let ((x #c(1 2)) - (y (complex (expt 2 127) (expt 2 127))) - (expected (coerce (/ x y) - '(complex single-float)))) + (let* ((x #c(1 2)) + (y (complex (expt 2 127) (expt 2 127))) + (expected (coerce (/ x y) + '(complex single-float)))) ;; A naive implementation of complex division would cause an ;; overflow in computing the denominator. (assert-equal expected View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/bb5c9e106d89594a1bc302… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/bb5c9e106d89594a1bc302… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-456-more-accurate-complex-div] Clean up removing old code.
by Raymond Toy (＠rtoy) 10 Dec '25

10 Dec '25

Raymond Toy pushed to branch issue-456-more-accurate-complex-div at cmucl / cmucl Commits: bb5c9e10 by Raymond Toy at 2025-12-10T15:31:47-08:00 Clean up removing old code. - - - - - 2 changed files: - src/code/numbers.lisp - src/compiler/float-tran.lisp Changes: ===================================== src/code/numbers.lisp ===================================== @@ -593,180 +593,18 @@ (build-ratio x y) (build-ratio (truncate x gcd) (truncate y gcd)))))) - -#+nil -(defun two-arg-/ (x y) - (number-dispatch ((x number) (y number)) - (float-contagion / x y (ratio integer)) - - ((complex complex) - (let* ((rx (realpart x)) - (ix (imagpart x)) - (ry (realpart y)) - (iy (imagpart y))) - (if (> (abs ry) (abs iy)) - (let* ((r (/ iy ry)) - (dn (+ ry (* r iy)))) - (canonical-complex (/ (+ rx (* ix r)) dn) - (/ (- ix (* rx r)) dn))) - (let* ((r (/ ry iy)) - (dn (+ iy (* r ry)))) - (canonical-complex (/ (+ (* rx r) ix) dn) - (/ (- (* ix r) rx) dn)))))) - (((foreach integer ratio single-float double-float) complex) - (let* ((ry (realpart y)) - (iy (imagpart y))) - (if (> (abs ry) (abs iy)) - (let* ((r (/ iy ry)) - (dn (* ry (+ 1 (* r r))))) - (canonical-complex (/ x dn) - (/ (- (* x r)) dn))) - (let* ((r (/ ry iy)) - (dn (* iy (+ 1 (* r r))))) - (canonical-complex (/ (* x r) dn) - (/ (- x) dn)))))) - ((complex (or rational float)) - (canonical-complex (/ (realpart x) y) - (/ (imagpart x) y))) - - ((ratio ratio) - (let* ((nx (numerator x)) - (dx (denominator x)) - (ny (numerator y)) - (dy (denominator y)) - (g1 (gcd nx ny)) - (g2 (gcd dx dy))) - (build-ratio (* (maybe-truncate nx g1) (maybe-truncate dy g2)) - (* (maybe-truncate dx g2) (maybe-truncate ny g1))))) - - ((integer integer) - (integer-/-integer x y)) - - ((integer ratio) - (if (zerop x) - 0 - (let* ((ny (numerator y)) - (dy (denominator y)) - (gcd (gcd x ny))) - (build-ratio (* (maybe-truncate x gcd) dy) - (maybe-truncate ny gcd))))) - - ((ratio integer) - (let* ((nx (numerator x)) - (gcd (gcd nx y))) - (build-ratio (maybe-truncate nx gcd) - (* (maybe-truncate y gcd) (denominator x))))))) - -;; An implementation of Baudin and Smith's robust complex division. -;; This is a pretty straightforward translation of the original in -;; https://arxiv.org/pdf/1210.4539. -#+nil -(eval-when (:compile-toplevel :load-toplevel :execute) -(macrolet - ((frob (type max-float min-float eps-float) - (let ((name (symbolicate "CDIV-" type))) - `(progn - (let ((ov ,max-float) - (un ,min-float) - (eps ,eps-float)) - (defun ,name (x y) - (declare (type (complex ,type) x y)) - (labels - ((internal-compreal (a b c d r tt) - (declare (double-float a b c d r tt)) - ;; Iteration 1: compare r against DBL_MIN instead of 0 - (cond ((/= r 0) - (let ((br (* b r))) - (if (/= br 0) - (* (+ a br) tt) - (+ (* a tt) - (* (* b tt) - r))))) - (t - (* (+ a (* d (/ b c))) - tt)))) - - (robust-subinternal (a b c d) - (declare (double-float a b c d)) - (let* ((r (/ d c)) - (tt (/ (+ c (* d r))))) - (let ((e (internal-compreal a b c d r tt)) - (f (internal-compreal b (- a) c d r tt))) - #+nil(format t "subint: e f = ~A ~A~%" e f) - (values e - f)))) - - (robust-internal (x y) - (declare (type (complex ,type) x y)) - #+nil(format t "x = ~A, y = ~A~%" x y) - (let ((a (realpart x)) - (b (imagpart x)) - (c (realpart y)) - (d (imagpart y))) - (cond - ((<= (abs d) (abs c)) - (multiple-value-bind (e f) - (robust-subinternal a b c d) - #+nil(format t "1: e f = ~A ~A~%" e f) - (complex e f))) - (t - (multiple-value-bind (e f) - (robust-subinternal b a d c) - #+nil(format t "2: e f = ~A ~A~%" e f) - (complex e (- f)))))))) - (let* ((a (realpart x)) - (b (imagpart x)) - (c (realpart y)) - (d (imagpart y)) - (ab (max (abs a) (abs b))) - (cd (max (abs c) (abs d))) - (b 2d0) - (s 1d0) - (be (/ b (* eps eps)))) - (when (>= ab (/ ov 2)) - (setf x (/ x 2) - s (* s 2))) - (when (>= cd (/ ov 2)) - (setf y (/ y 2) - s (/ s 2))) - (when (<= ab (* un (/ b eps))) - (setf x (* x be) - s (/ s be))) - (when (<= cd (* un (/ b eps))) - (setf y (* y be) - s (* s be))) - ;; Iteration 2 - #+nil - (when (< cd eps) - (setf x (/ x eps)) - (setf y (/ y eps))) - - ;; Iteration 4 - #+nil - (when (> cd (/ ov 2)) - (setf x (/ x 2) - y (/ y 2))) - - (* s - (robust-internal x y)))))))))) - ;; The eps value for double-float is determined by looking at the - ;; value of %eps in Scilab. - (frob double-float most-positive-double-float least-positive-normalized-double-float - (scale-float 1d0 -52)) - ;; The eps value here is a guess. - (frob single-float most-positive-single-float least-positive-normalized-single-float - (scale-float 1f0 -22))) -) - +;; An implementation of Baudin and Smith's robust complex division for +;; double-floats. This is a pretty straightforward translation of the +;; original in https://arxiv.org/pdf/1210.4539. (let ((ov most-positive-double-float) (un least-positive-normalized-double-float) + ;; This is the value of Scilab's %eps variable. (eps (scale-float 1d0 -52))) (defun cdiv-double-float (x y) (declare (type (complex double-float) x y)) (labels ((internal-compreal (a b c d r tt) (declare (double-float a b c d r tt)) - ;; Iteration 1: compare r against DBL_MIN instead of 0 (cond ((/= r 0) (let ((br (* b r))) (if (/= br 0) @@ -777,7 +615,6 @@ (t (* (+ a (* d (/ b c))) tt)))) - (robust-subinternal (a b c d) (declare (double-float a b c d)) (let* ((r (/ d c)) @@ -787,7 +624,6 @@ #+nil(format t "subint: e f = ~A ~A~%" e f) (values e f)))) - (robust-internal (x y) (declare (type (complex double-float) x y)) #+nil(format t "x = ~A, y = ~A~%" x y) @@ -827,21 +663,11 @@ (when (<= cd (* un (/ b eps))) (setf y (* y be) s (* s be))) - ;; Iteration 2 - #+nil - (when (< cd eps) - (setf x (/ x eps)) - (setf y (/ y eps))) - - ;; Iteration 4 - #+nil - (when (> cd (/ ov 2)) - (setf x (/ x 2) - y (/ y 2))) - (* s (robust-internal x y)))))) +;; Smith's algorithm for complex division for (complex single-float). +;; We convert the parts to double-floats before computing the result. (defun cdiv-single-float (x y) (declare (type (complex single-float) x y)) (let ((a (float (realpart x) 1d0)) @@ -877,12 +703,15 @@ (cdiv-single-float (coerce x '(complex single-float)) y)) - (((foreach integer ratio single-float double-float (complex rational) (complex single-float)) + (((foreach integer ratio single-float double-float (complex rational) + (complex single-float)) (complex double-float)) (cdiv-double-float (coerce x '(complex double-float)) y)) (((complex double-double-float) - (foreach (complex rational) (complex single-float) (complex double-float) (complex double-double-float))) + (foreach (complex rational) (complex single-float) (complex double-float) + (complex double-double-float))) + ;; We should do something better for double-double floats. (let ((a (realpart x)) (b (imagpart x)) (c (realpart y)) @@ -935,6 +764,8 @@ (/ (- x) dn)))))) (((complex rational) (complex rational)) + ;; We probably don't need to do Smith's algorithm for rationals. + ;; A naive implementation of coplex division has no issues. (let ((a (realpart x)) (b (imagpart x)) (c (realpart y)) @@ -952,7 +783,8 @@ (f (/ (- b (* a r)) denom))) (canonical-complex e f)))))) - (((foreach (complex rational) (complex single-float) (complex double-float) (complex double-double-float)) + (((foreach (complex rational) (complex single-float) (complex double-float) + (complex double-double-float)) (or rational float)) (canonical-complex (/ (realpart x) y) (/ (imagpart x) y))) @@ -962,108 +794,6 @@ (cdiv-double-float (coerce x '(complex double-float)) (coerce y '(complex double-float)))) - #+nil - (((foreach integer ratio single-float double-float) complex) - (let* ((ry (realpart y)) - (iy (imagpart y))) - (if (> (abs ry) (abs iy)) - (let* ((r (/ iy ry)) - (dn (* ry (+ 1 (* r r))))) - (canonical-complex (/ x dn) - (/ (- (* x r)) dn))) - (let* ((r (/ ry iy)) - (dn (* iy (+ 1 (* r r))))) - (canonical-complex (/ (* x r) dn) - (/ (- x) dn)))))) - #+nil - ((complex (or rational float)) - (canonical-complex (/ (realpart x) y) - (/ (imagpart x) y))) - - ((ratio ratio) - (let* ((nx (numerator x)) - (dx (denominator x)) - (ny (numerator y)) - (dy (denominator y)) - (g1 (gcd nx ny)) - (g2 (gcd dx dy))) - (build-ratio (* (maybe-truncate nx g1) (maybe-truncate dy g2)) - (* (maybe-truncate dx g2) (maybe-truncate ny g1))))) - - ((integer integer) - (integer-/-integer x y)) - - ((integer ratio) - (if (zerop x) - 0 - (let* ((ny (numerator y)) - (dy (denominator y)) - (gcd (gcd x ny))) - (build-ratio (* (maybe-truncate x gcd) dy) - (maybe-truncate ny gcd))))) - - ((ratio integer) - (let* ((nx (numerator x)) - (gcd (gcd nx y))) - (build-ratio (maybe-truncate nx gcd) - (* (maybe-truncate y gcd) (denominator x))))))) - - -#+nil -(defun two-arg-/ (x y) - (number-dispatch ((x number) (y number)) - (float-contagion / x y (ratio integer)) - - (((complex double-float) (complex double-float)) - (cdiv-double-float x y)) - (((complex double-float) (complex single-float)) - (cdiv-double-float x (coerce y '(complex double-float)))) - - (((complex single-float) (complex double-float)) - (cdiv-double-float (coerce y '(complex double-float)) - y)) - (((complex single-float) (complex single-float)) - (cdiv-single-float x y)) - - #+nil - (((foreach (complex single-float) (complex double-float)) - (complex double-float)) - (cdiv-double-float (complex (float (realpart x) 1d0) - (float (imagpart x) 1d0)) - y)) - (((foreach (complex rational) (complex double-double-float)) - (foreach (complex rational) (complex double-double-float))) - (let* ((rx (realpart x)) - (ix (imagpart x)) - (ry (realpart y)) - (iy (imagpart y))) - (if (> (abs ry) (abs iy)) - (let* ((r (/ iy ry)) - (dn (+ ry (* r iy)))) - (canonical-complex (/ (+ rx (* ix r)) dn) - (/ (- ix (* rx r)) dn))) - (let* ((r (/ ry iy)) - (dn (+ iy (* r ry)))) - (canonical-complex (/ (+ (* rx r) ix) dn) - (/ (- (* ix r) rx) dn)))))) - (((foreach integer ratio single-float double-float) - (foreach (complex rational) (complex double-double-float))) - (let* ((ry (realpart y)) - (iy (imagpart y))) - (if (> (abs ry) (abs iy)) - (let* ((r (/ iy ry)) - (dn (* ry (+ 1 (* r r))))) - (canonical-complex (/ x dn) - (/ (- (* x r)) dn))) - (let* ((r (/ ry iy)) - (dn (* iy (+ 1 (* r r))))) - (canonical-complex (/ (* x r) dn) - (/ (- x) dn)))))) - (((foreach (complex rational) (complex double-double-float)) - (or rational float)) - (canonical-complex (/ (realpart x) y) - (/ (imagpart x) y))) - ((ratio ratio) (let* ((nx (numerator x)) (dx (denominator x)) @@ -1092,7 +822,6 @@ (build-ratio (maybe-truncate nx gcd) (* (maybe-truncate y gcd) (denominator x))))))) - (defun %negate (n) (number-dispatch ((n number)) (((foreach fixnum single-float double-float #+long-float long-float)) ===================================== src/compiler/float-tran.lisp ===================================== @@ -1804,119 +1804,6 @@ #+double-double (frob double-double-float)) -#+(and nil sse2 complex-fp-vops) -(macrolet - ((frob (type one) - `(deftransform / ((x y) (,type ,type) * - :policy (> speed space)) - ;; Divide a complex by a complex - - ;; Here's how we do a complex division - ;; - ;; Compute (xr + i*xi)/(yr + i*yi) - ;; - ;; Assume |yi| < |yr|. Then - ;; - ;; (xr + i*xi) (xr + i*xi) - ;; ----------- = ----------------- - ;; (yr + i*yi) yr*(1 + i*(yi/yr)) - ;; - ;; (xr + i*xi)*(1 - i*(yi/yr)) - ;; = --------------------------- - ;; yr*(1 + (yi/yr)^2) - ;; - ;; (xr + i*xi)*(1 - i*(yi/yr)) - ;; = --------------------------- - ;; yr + (yi/yr)*yi - ;; - ;; This allows us to use a fast complex multiply followed by - ;; a real division. - '(let* ((ry (realpart y)) - (iy (imagpart y))) - (if (> (abs ry) (abs iy)) - (let* ((r (/ iy ry)) - (dn (+ ry (* r iy)))) - (/ (* x (complex ,one r)) - dn)) - (let* ((r (/ ry iy)) - (dn (+ iy (* r ry)))) - (/ (* x (complex r ,(- one))) - dn))))))) - (frob (complex single-float) 1f0) - (frob (complex double-float) 1d0)) - -#+(and nil sse2 complex-fp-vops) -(macrolet - ((frob (type one) - `(deftransform / ((x y) (,type ,type) * - :policy (> speed space)) - ;; Divide a complex by a complex - - ;; Here's how we do a complex division - ;; - ;; Compute (xr + i*xi)/(yr + i*yi) - ;; - ;; Assume |xi| < |xr| and |yi| < |yr|. Then - ;; - ;; (xr + i*xi) xr*(1 + i*(xi/xr)) - ;; ----------- = ----------------- - ;; (yr + i*yi) yr*(1 + i*(yi/yr)) - ;; - ;; xr*(1+i(xi/xr))*(1-i*(yi/yr)) - ;; = ----------------------------- - ;; yr*(1+(yi/yr)^2) - ;; - ;; xr*(1+i(xi/xr))*(1-i*(yi/yr)) - ;; = ----------------------------- - ;; yr + (yi/yr)*yi - ;; - ;; This allows us to use a fast complex multiply followed by - ;; a real division. - '(let* ((rx (realpart x)) - (ix (imagpart x)) - (ry (realpart y)) - (iy (imagpart y))) - (if (>= (abs rx) (abs ix)) - (if (>= (abs ry) (abs iy)) - ;; |xr| >= |xi| and |yr| >= |yi| - ;; - ;; xr*(1+i*(xi/xr))*(1-i*(yi/yr)) - ;; w = ------------------------------ - ;; yr + (yi/yr)*yi - ;; - ;; (1+i*p)*(1-i*q) = 1+p*q + i*(p-q) - (let* ((x-div (/ ix rx)) - (y-div (/ iy ry)) - (dn (+ ry (* y-div iy))) - (factor (/ xr dn))) - (* factor - (complex (1+ (* x-div y-div)) - (- x-div y-div)))) - ;; |xr| >= |xi| and |yr| < |yi| - ;; - ;; xr*(1+i*(xi/xr))*(yr/yi-i) - ;; w = ------------------------------ - ;; yi*((yr/yi)^2+1) - ;; - ;; xr*(1+i*(xi/xr))*(yr/yi-i) - ;; w = ------------------------------ - ;; (yr/yi)*yi + yi - ;; - ;; (1+i*p)*(q-i) = p+q + i*(p*q-1) - (let* ((x-div (/ ix rx)) - (y-div (/ ry iy)) - (dn (+ yi (* y-div iy))) - (factor (/ xr dn))) - (* factor - (complex (+ x-div y-div) - (1- (* x-div y-div)))))) - (let* ((r (/ ry iy)) - (dn (+ iy (* r ry)))) - (/ (* x (complex r ,(- one))) - dn))))))) - (frob (complex single-float) 1f0) - (frob (complex double-float) 1d0)) - (macrolet ((frob (type name) `(deftransform / ((x y) ((complex ,type) (complex ,type)) *) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/bb5c9e106d89594a1bc3020… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/bb5c9e106d89594a1bc3020… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-456-more-accurate-complex-div] 3 commits: Move cdiv functions from float-tran to numbers
by Raymond Toy (＠rtoy) 10 Dec '25

10 Dec '25

Raymond Toy pushed to branch issue-456-more-accurate-complex-div at cmucl / cmucl Commits: 270c3daf by Raymond Toy at 2025-12-10T10:14:57-08:00 Move cdiv functions from float-tran to numbers Move the cdiv functions from float-tran to numbers because the interpreter needs to use these when dispatching /. The deftransforms are fine with using the version from the KERNEL package. The tests now pass except for one where the precision is 52 bits instead of 53. More cleanup needed. - - - - - e1e1fb47 by Raymond Toy at 2025-12-10T14:58:33-08:00 Clean up implementation and fix contagion issues First, just define `cdiv-double-float` that implements Baudin and Smith for (complex double-float). For (complex single-float), convert to double-float and use Smith's algorithm instead of the more complex Baudin and Smith. Fix up the numeric contagion so we call these two routines appropriately. (This is quite messy!) Update the deftransforms to call kernel::cdiv-double-float and kernel::cdiv-single-float. - - - - - 825f7d96 by Raymond Toy at 2025-12-10T15:19:06-08:00 Fix bug in cdiv-single-float and add/update tests cdiv-single-float needs to convert single-float to double-float so we don't overflow. Update the accuracy of the one test to be 52 instead of 53. The equivalent C code has the same accuracy. Add a test that we don't overflow for division for complex single-float number. Finally, add tests to make sure we got the all the numeric contagion cases covered for division. Quite useful for getting the contagion cases covered. - - - - - 3 changed files: - src/code/numbers.lisp - src/compiler/float-tran.lisp - tests/float.lisp Changes: ===================================== src/code/numbers.lisp ===================================== @@ -594,6 +594,7 @@ (build-ratio (truncate x gcd) (truncate y gcd)))))) +#+nil (defun two-arg-/ (x y) (number-dispatch ((x number) (y number)) (float-contagion / x y (ratio integer)) @@ -656,6 +657,441 @@ (build-ratio (maybe-truncate nx gcd) (* (maybe-truncate y gcd) (denominator x))))))) +;; An implementation of Baudin and Smith's robust complex division. +;; This is a pretty straightforward translation of the original in +;; https://arxiv.org/pdf/1210.4539. +#+nil +(eval-when (:compile-toplevel :load-toplevel :execute) +(macrolet + ((frob (type max-float min-float eps-float) + (let ((name (symbolicate "CDIV-" type))) + `(progn + (let ((ov ,max-float) + (un ,min-float) + (eps ,eps-float)) + (defun ,name (x y) + (declare (type (complex ,type) x y)) + (labels + ((internal-compreal (a b c d r tt) + (declare (double-float a b c d r tt)) + ;; Iteration 1: compare r against DBL_MIN instead of 0 + (cond ((/= r 0) + (let ((br (* b r))) + (if (/= br 0) + (* (+ a br) tt) + (+ (* a tt) + (* (* b tt) + r))))) + (t + (* (+ a (* d (/ b c))) + tt)))) + + (robust-subinternal (a b c d) + (declare (double-float a b c d)) + (let* ((r (/ d c)) + (tt (/ (+ c (* d r))))) + (let ((e (internal-compreal a b c d r tt)) + (f (internal-compreal b (- a) c d r tt))) + #+nil(format t "subint: e f = ~A ~A~%" e f) + (values e + f)))) + + (robust-internal (x y) + (declare (type (complex ,type) x y)) + #+nil(format t "x = ~A, y = ~A~%" x y) + (let ((a (realpart x)) + (b (imagpart x)) + (c (realpart y)) + (d (imagpart y))) + (cond + ((<= (abs d) (abs c)) + (multiple-value-bind (e f) + (robust-subinternal a b c d) + #+nil(format t "1: e f = ~A ~A~%" e f) + (complex e f))) + (t + (multiple-value-bind (e f) + (robust-subinternal b a d c) + #+nil(format t "2: e f = ~A ~A~%" e f) + (complex e (- f)))))))) + (let* ((a (realpart x)) + (b (imagpart x)) + (c (realpart y)) + (d (imagpart y)) + (ab (max (abs a) (abs b))) + (cd (max (abs c) (abs d))) + (b 2d0) + (s 1d0) + (be (/ b (* eps eps)))) + (when (>= ab (/ ov 2)) + (setf x (/ x 2) + s (* s 2))) + (when (>= cd (/ ov 2)) + (setf y (/ y 2) + s (/ s 2))) + (when (<= ab (* un (/ b eps))) + (setf x (* x be) + s (/ s be))) + (when (<= cd (* un (/ b eps))) + (setf y (* y be) + s (* s be))) + ;; Iteration 2 + #+nil + (when (< cd eps) + (setf x (/ x eps)) + (setf y (/ y eps))) + + ;; Iteration 4 + #+nil + (when (> cd (/ ov 2)) + (setf x (/ x 2) + y (/ y 2))) + + (* s + (robust-internal x y)))))))))) + ;; The eps value for double-float is determined by looking at the + ;; value of %eps in Scilab. + (frob double-float most-positive-double-float least-positive-normalized-double-float + (scale-float 1d0 -52)) + ;; The eps value here is a guess. + (frob single-float most-positive-single-float least-positive-normalized-single-float + (scale-float 1f0 -22))) +) + +(let ((ov most-positive-double-float) + (un least-positive-normalized-double-float) + (eps (scale-float 1d0 -52))) + (defun cdiv-double-float (x y) + (declare (type (complex double-float) x y)) + (labels + ((internal-compreal (a b c d r tt) + (declare (double-float a b c d r tt)) + ;; Iteration 1: compare r against DBL_MIN instead of 0 + (cond ((/= r 0) + (let ((br (* b r))) + (if (/= br 0) + (* (+ a br) tt) + (+ (* a tt) + (* (* b tt) + r))))) + (t + (* (+ a (* d (/ b c))) + tt)))) + + (robust-subinternal (a b c d) + (declare (double-float a b c d)) + (let* ((r (/ d c)) + (tt (/ (+ c (* d r))))) + (let ((e (internal-compreal a b c d r tt)) + (f (internal-compreal b (- a) c d r tt))) + #+nil(format t "subint: e f = ~A ~A~%" e f) + (values e + f)))) + + (robust-internal (x y) + (declare (type (complex double-float) x y)) + #+nil(format t "x = ~A, y = ~A~%" x y) + (let ((a (realpart x)) + (b (imagpart x)) + (c (realpart y)) + (d (imagpart y))) + (cond + ((<= (abs d) (abs c)) + (multiple-value-bind (e f) + (robust-subinternal a b c d) + #+nil(format t "1: e f = ~A ~A~%" e f) + (complex e f))) + (t + (multiple-value-bind (e f) + (robust-subinternal b a d c) + #+nil(format t "2: e f = ~A ~A~%" e f) + (complex e (- f)))))))) + (let* ((a (realpart x)) + (b (imagpart x)) + (c (realpart y)) + (d (imagpart y)) + (ab (max (abs a) (abs b))) + (cd (max (abs c) (abs d))) + (b 2d0) + (s 1d0) + (be (/ b (* eps eps)))) + (when (>= ab (/ ov 2)) + (setf x (/ x 2) + s (* s 2))) + (when (>= cd (/ ov 2)) + (setf y (/ y 2) + s (/ s 2))) + (when (<= ab (* un (/ b eps))) + (setf x (* x be) + s (/ s be))) + (when (<= cd (* un (/ b eps))) + (setf y (* y be) + s (* s be))) + ;; Iteration 2 + #+nil + (when (< cd eps) + (setf x (/ x eps)) + (setf y (/ y eps))) + + ;; Iteration 4 + #+nil + (when (> cd (/ ov 2)) + (setf x (/ x 2) + y (/ y 2))) + + (* s + (robust-internal x y)))))) + +(defun cdiv-single-float (x y) + (declare (type (complex single-float) x y)) + (let ((a (float (realpart x) 1d0)) + (b (float (imagpart x) 1d0)) + (c (float (realpart y) 1d0)) + (d (float (imagpart y) 1d0))) + (cond ((< (abs c) (abs d)) + (let* ((r (/ c d)) + (denom (+ (* c r) d)) + (e (float (/ (+ (* a r) b) denom) 1f0)) + (f (float (/ (- (* b r) a) denom) 1f0))) + (complex e f))) + (t + (let* ((r (/ d c)) + (denom (+ c (* d r))) + (e (float (/ (+ a (* b r)) denom) 1f0)) + (f (float (/ (- b (* a r)) denom) 1f0))) + (complex e f)))))) + +(defun two-arg-/ (x y) + (number-dispatch ((x number) (y number)) + (float-contagion / x y (ratio integer)) + + (((complex single-float) + (foreach (complex rational) (complex single-float))) + (cdiv-single-float x (coerce y '(complex single-float)))) + (((complex double-float) + (foreach (complex rational) (complex single-float) (complex double-float))) + (cdiv-double-float x (coerce y '(complex double-float)))) + + (((foreach integer ratio single-float (complex rational)) + (complex single-float)) + (cdiv-single-float (coerce x '(complex single-float)) + y)) + + (((foreach integer ratio single-float double-float (complex rational) (complex single-float)) + (complex double-float)) + (cdiv-double-float (coerce x '(complex double-float)) + y)) + (((complex double-double-float) + (foreach (complex rational) (complex single-float) (complex double-float) (complex double-double-float))) + (let ((a (realpart x)) + (b (imagpart x)) + (c (realpart y)) + (d (imagpart y))) + (cond ((< (abs c) (abs d)) + (let* ((r (/ c d)) + (denom (+ (* c r) d)) + (e (/ (+ (* a r) b) denom)) + (f (/ (- (* b r) a) denom))) + (canonical-complex e f))) + (t + (let* ((r (/ d c)) + (denom (+ c (* d r))) + (e (/ (+ a (* b r)) denom)) + (f (/ (- b (* a r)) denom))) + (canonical-complex e f)))))) + + (((foreach integer ratio single-float double-float double-double-float + (complex rational) (complex single-float) (complex double-float)) + (complex double-double-float)) + (let ((a (realpart x)) + (b (imagpart x)) + (c (realpart y)) + (d (imagpart y))) + (cond ((< (abs c) (abs d)) + (let* ((r (/ c d)) + (denom (+ (* c r) d)) + (e (/ (+ (* a r) b) denom)) + (f (/ (- (* b r) a) denom))) + (canonical-complex e f))) + (t + (let* ((r (/ d c)) + (denom (+ c (* d r))) + (e (/ (+ a (* b r)) denom)) + (f (/ (- b (* a r)) denom))) + (canonical-complex e f)))))) + + (((foreach integer ratio single-float double-float double-double-float) + (complex rational)) + (let* ((ry (realpart y)) + (iy (imagpart y))) + (if (> (abs ry) (abs iy)) + (let* ((r (/ iy ry)) + (dn (* ry (+ 1 (* r r))))) + (canonical-complex (/ x dn) + (/ (- (* x r)) dn))) + (let* ((r (/ ry iy)) + (dn (* iy (+ 1 (* r r))))) + (canonical-complex (/ (* x r) dn) + (/ (- x) dn)))))) + (((complex rational) + (complex rational)) + (let ((a (realpart x)) + (b (imagpart x)) + (c (realpart y)) + (d (imagpart y))) + (cond ((< (abs c) (abs d)) + (let* ((r (/ c d)) + (denom (+ (* c r) d)) + (e (/ (+ (* a r) b) denom)) + (f (/ (- (* b r) a) denom))) + (canonical-complex e f))) + (t + (let* ((r (/ d c)) + (denom (+ c (* d r))) + (e (/ (+ a (* b r)) denom)) + (f (/ (- b (* a r)) denom))) + (canonical-complex e f)))))) + + (((foreach (complex rational) (complex single-float) (complex double-float) (complex double-double-float)) + (or rational float)) + (canonical-complex (/ (realpart x) y) + (/ (imagpart x) y))) + + ((double-float + (complex single-float)) + (cdiv-double-float (coerce x '(complex double-float)) + (coerce y '(complex double-float)))) + + #+nil + (((foreach integer ratio single-float double-float) complex) + (let* ((ry (realpart y)) + (iy (imagpart y))) + (if (> (abs ry) (abs iy)) + (let* ((r (/ iy ry)) + (dn (* ry (+ 1 (* r r))))) + (canonical-complex (/ x dn) + (/ (- (* x r)) dn))) + (let* ((r (/ ry iy)) + (dn (* iy (+ 1 (* r r))))) + (canonical-complex (/ (* x r) dn) + (/ (- x) dn)))))) + #+nil + ((complex (or rational float)) + (canonical-complex (/ (realpart x) y) + (/ (imagpart x) y))) + + ((ratio ratio) + (let* ((nx (numerator x)) + (dx (denominator x)) + (ny (numerator y)) + (dy (denominator y)) + (g1 (gcd nx ny)) + (g2 (gcd dx dy))) + (build-ratio (* (maybe-truncate nx g1) (maybe-truncate dy g2)) + (* (maybe-truncate dx g2) (maybe-truncate ny g1))))) + + ((integer integer) + (integer-/-integer x y)) + + ((integer ratio) + (if (zerop x) + 0 + (let* ((ny (numerator y)) + (dy (denominator y)) + (gcd (gcd x ny))) + (build-ratio (* (maybe-truncate x gcd) dy) + (maybe-truncate ny gcd))))) + + ((ratio integer) + (let* ((nx (numerator x)) + (gcd (gcd nx y))) + (build-ratio (maybe-truncate nx gcd) + (* (maybe-truncate y gcd) (denominator x))))))) + + +#+nil +(defun two-arg-/ (x y) + (number-dispatch ((x number) (y number)) + (float-contagion / x y (ratio integer)) + + (((complex double-float) (complex double-float)) + (cdiv-double-float x y)) + (((complex double-float) (complex single-float)) + (cdiv-double-float x (coerce y '(complex double-float)))) + + (((complex single-float) (complex double-float)) + (cdiv-double-float (coerce y '(complex double-float)) + y)) + (((complex single-float) (complex single-float)) + (cdiv-single-float x y)) + + #+nil + (((foreach (complex single-float) (complex double-float)) + (complex double-float)) + (cdiv-double-float (complex (float (realpart x) 1d0) + (float (imagpart x) 1d0)) + y)) + (((foreach (complex rational) (complex double-double-float)) + (foreach (complex rational) (complex double-double-float))) + (let* ((rx (realpart x)) + (ix (imagpart x)) + (ry (realpart y)) + (iy (imagpart y))) + (if (> (abs ry) (abs iy)) + (let* ((r (/ iy ry)) + (dn (+ ry (* r iy)))) + (canonical-complex (/ (+ rx (* ix r)) dn) + (/ (- ix (* rx r)) dn))) + (let* ((r (/ ry iy)) + (dn (+ iy (* r ry)))) + (canonical-complex (/ (+ (* rx r) ix) dn) + (/ (- (* ix r) rx) dn)))))) + (((foreach integer ratio single-float double-float) + (foreach (complex rational) (complex double-double-float))) + (let* ((ry (realpart y)) + (iy (imagpart y))) + (if (> (abs ry) (abs iy)) + (let* ((r (/ iy ry)) + (dn (* ry (+ 1 (* r r))))) + (canonical-complex (/ x dn) + (/ (- (* x r)) dn))) + (let* ((r (/ ry iy)) + (dn (* iy (+ 1 (* r r))))) + (canonical-complex (/ (* x r) dn) + (/ (- x) dn)))))) + (((foreach (complex rational) (complex double-double-float)) + (or rational float)) + (canonical-complex (/ (realpart x) y) + (/ (imagpart x) y))) + + ((ratio ratio) + (let* ((nx (numerator x)) + (dx (denominator x)) + (ny (numerator y)) + (dy (denominator y)) + (g1 (gcd nx ny)) + (g2 (gcd dx dy))) + (build-ratio (* (maybe-truncate nx g1) (maybe-truncate dy g2)) + (* (maybe-truncate dx g2) (maybe-truncate ny g1))))) + + ((integer integer) + (integer-/-integer x y)) + + ((integer ratio) + (if (zerop x) + 0 + (let* ((ny (numerator y)) + (dy (denominator y)) + (gcd (gcd x ny))) + (build-ratio (* (maybe-truncate x gcd) dy) + (maybe-truncate ny gcd))))) + + ((ratio integer) + (let* ((nx (numerator x)) + (gcd (gcd nx y))) + (build-ratio (maybe-truncate nx gcd) + (* (maybe-truncate y gcd) (denominator x))))))) + (defun %negate (n) (number-dispatch ((n number)) ===================================== src/compiler/float-tran.lisp ===================================== @@ -1917,104 +1917,13 @@ (frob (complex single-float) 1f0) (frob (complex double-float) 1d0)) -;; An implementation of Baudin and Smith's robust complex division. -;; This is a pretty straightforward translation of the original in -;; https://arxiv.org/pdf/1210.4539. (macrolet - ((frob (type max-float min-float eps-float) - (let ((name (symbolicate "CDIV-" type))) - `(progn - (let ((ov ,max-float) - (un ,min-float) - (eps ,eps-float)) - (defun ,name (x y) - (declare (type (complex ,type) x y)) - (labels - ((internal-compreal (a b c d r tt) - (declare (,type a b c d r tt)) - (cond ((zerop r) - (let ((br (* b r))) - (if (/= br 0) - (* (+ a br) tt) - (+ (* a tt) - (* (* b tt) - r))))) - (t - (* (+ a (* d (/ b c))) - tt)))) - - (robust-subinternal (a b c d) - (declare (,type a b c d)) - (let* ((r (/ d c)) - (tt (/ (+ c (* d r))))) - (values (internal-compreal a b c d r tt) - (internal-compreal b (- a) c d r tt)))) - - (robust-internal (x y) - (declare (type (complex ,type) x y)) - (let ((a (realpart x)) - (b (imagpart x)) - (c (realpart y)) - (d (imagpart y))) - (cond - ((<= (abs d) (abs c)) - (multiple-value-bind (e f) - (robust-subinternal a b c d) - (complex e f))) - (t - (multiple-value-bind (e f) - (robust-subinternal b a d c) - (complex e (- f)))))))) - (let* ((a (realpart x)) - (b (imagpart x)) - (c (realpart y)) - (d (imagpart y)) - (ab (max (abs a) (abs b))) - (cd (max (abs c) (abs d))) - (b 2d0) - (s 1d0) - (be (/ b (* eps eps)))) - (when (>= ab (/ ov 2)) - (setf x (/ x 2) - s (* s 2))) - (when (>= cd (/ ov 2)) - (setf y (/ y 2) - s (/ s 2))) - (when (<= ab (* un (/ b eps))) - (setf x (* x be) - s (/ s be))) - (when (<= cd (* un (/ b eps))) - (setf y (* y be) - s (* s be))) - ;; Iteration 2 - #+nil - (when (< cd eps) - (setf x (/ x eps)) - (setf y (/ y eps))) - - ;; Iteration 4 - #+nil - (when (> cd (/ ov 2)) - (setf x (/ x 2) - y (/ y 2))) - - (* s - (robust-internal x y)))))))))) - ;; The eps value for double-float is determined by looking at the - ;; value of %eps in Scilab. - (frob double-float most-positive-double-float least-positive-normalized-double-float - (scale-float 1d0 -52)) - ;; The eps value here is a guess. - (frob single-float most-positive-single-float least-positive-normalized-single-float - (scale-float 1f0 -22))) - -(macrolet - ((frob (type) - (let ((name (symbolicate "CDIV-" type))) + ((frob (type name) `(deftransform / ((x y) ((complex ,type) (complex ,type)) *) - (,name x y))))) - (frob double-float) - (frob single-float)) + (,name x y)))) + (frob double-float kernel::cdiv-double-float) + (frob single-float kernel::cdiv-single-float)) + ;;;; Complex contagion: ===================================== tests/float.lisp ===================================== @@ -388,7 +388,7 @@ (list (complex (scale-float 1d0 -1074) (scale-float 1d0 -1074)) (complex (scale-float 1d0 -1073) (scale-float 1d0 -1074)) (complex 0.6d0 0.2d0) - 53 least-positive-double-float) + 52 least-positive-double-float) ;; 9 (list (complex (scale-float 1d0 1015) (scale-float 1d0 -989)) (complex (scale-float 1d0 1023) (scale-float 1d0 1023)) @@ -456,7 +456,7 @@ (min (real-ulp (realpart diff)) (real-ulp (imagpart diff)))))) -(define-test complex-division +(define-test complex-division.double (:tag :issues) (loop for k from 1 for test in *test-cases* @@ -473,3 +473,35 @@ k x y z z-true diff rel) (assert-true (<= ulp max-ulp) k x y z z-true diff ulp max-ulp))))) + +(define-test complex-division.misc + (:tag :issue) + (let ((num '(1 + 1/2 + 1.0 + 1d0 + #c(1 2) + #c(1.0 2.0) + #c(1d0 2d0) + #c(1w0 2w0)))) + ;; Try all combinations of divisions of different types. This is + ;; primarily to test that we got all the numeric contagion cases + ;; for division in CL:/. + (dolist (x num) + (dolist (y num) + (assert-true (/ x y) + x y))))) + +(define-test complex-division.single + (:tag :issues) + (let ((x #c(1 2)) + (y (complex (expt 2 127) (expt 2 127))) + (expected (coerce (/ x y) + '(complex single-float)))) + ;; A naive implementation of complex division would cause an + ;; overflow in computing the denominator. + (assert-equal expected + (/ (coerce x '(complex single-float)) + (coerce y '(complex single-float))) + x + y))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/e11ed3eb2b57116cf92220… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/e11ed3eb2b57116cf92220… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch issue-456-more-accurate-complex-div
by Raymond Toy (＠rtoy) 10 Dec '25

10 Dec '25

Raymond Toy pushed new branch issue-456-more-accurate-complex-div at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/issue-456-more-accurate-c… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Fix #455: Allow manual pipeline runs
by Raymond Toy (＠rtoy) 05 Dec '25

05 Dec '25

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 25cd44a2 by Raymond Toy at 2025-12-04T17:57:49-08:00 Fix #455: Allow manual pipeline runs - - - - - ae1bdde7 by Raymond Toy at 2025-12-04T17:57:50-08:00 Merge branch 'issue-455-manual-pipeline-run' into 'master' Fix #455: Allow manual pipeline runs Closes #455 See merge request cmucl/cmucl!334 - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -133,6 +133,7 @@ linux:install: - if: $CI_PIPELINE_SOURCE == "push" - if: $CI_PIPELINE_SOURCE == "merge_request_event" - if: $CI_PIPELINE_SOURCE == "branch" + - if: $CI_PIPELINE_SOURCE == "web" linux:build: <<: *build_configuration @@ -148,6 +149,7 @@ linux:build: - if: $CI_PIPELINE_SOURCE == "schedule" - if: $CI_PIPELINE_SOURCE == "push" - if: $CI_PIPELINE_SOURCE == "merge_request_event" + - if: $CI_PIPELINE_SOURCE == "web" linux:cross-build: stage: build View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/16c334b0116235288a7ea7… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/16c334b0116235288a7ea7… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch issue-455-manual-pipeline-run
by Raymond Toy (＠rtoy) 05 Dec '25

05 Dec '25

Raymond Toy pushed new branch issue-455-manual-pipeline-run at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/issue-455-manual-pipeline… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] Undo previous change that deleted a blank line
by Raymond Toy (＠rtoy) 04 Dec '25

04 Dec '25

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 16c334b0 by Raymond Toy at 2025-12-04T15:46:41-08:00 Undo previous change that deleted a blank line Dummy commit to get CI to run to test out concurrent builds. (concurrent=2). - - - - - 1 changed file: - BUILDING.md Changes: ===================================== BUILDING.md ===================================== @@ -704,3 +704,4 @@ In particular steps 3, 4, and 5 can be combined into one by using the -c, -r, and -l options for cross-build-world.sh. The -c option cleans out the targe and cross directories; -r does step 4; and -l does step 5. + View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/16c334b0116235288a7ea7f… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/16c334b0116235288a7ea7f… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] Dummy commit to run pipeline
by Raymond Toy (＠rtoy) 04 Dec '25

04 Dec '25

Raymond Toy pushed to branch master at cmucl / cmucl Commits: b04aaec6 by Raymond Toy at 2025-12-03T18:30:46-08:00 Dummy commit to run pipeline Just removed an extra line at the end of the file. - - - - - 1 changed file: - BUILDING.md Changes: ===================================== BUILDING.md ===================================== @@ -704,4 +704,3 @@ In particular steps 3, 4, and 5 can be combined into one by using the -c, -r, and -l options for cross-build-world.sh. The -c option cleans out the targe and cross directories; -r does step 4; and -l does step 5. - View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/b04aaec6114f62c3ba38009… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/b04aaec6114f62c3ba38009… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-454-signal-error-for-bad-pathname-parts] 2 commits: Signal error not cerror for make-pathname errors
by Raymond Toy (＠rtoy) 15 Nov '25

15 Nov '25

Raymond Toy pushed to branch issue-454-signal-error-for-bad-pathname-parts at cmucl / cmucl Commits: 9e279ba7 by Raymond Toy at 2025-11-15T07:20:05-08:00 Signal error not cerror for make-pathname errors - - - - - b2c51c98 by Raymond Toy at 2025-11-15T07:20:39-08:00 Add tests for make-pathname errors - - - - - 2 changed files: - src/code/pathname.lisp - tests/pathname.lisp Changes: ===================================== src/code/pathname.lisp ===================================== @@ -843,8 +843,11 @@ a host-structure or string." (flet ((check-component-validity (name name-or-type) (when (stringp name) (when (eq host (%pathname-host *default-pathname-defaults*)) - (when (or (find #\/ name :test #'char=) - (find #\nul name :test #'char=)) + (when (find-if #'(lambda (c) + ;; Illegal characters are a slash or NUL. + (or (char= c #\/) + (char= c #\nul))) + name) (cerror _"Continue anyway" _"Pathname component ~A cannot contain a slash or nul character: ~S" name-or-type name)))))) ===================================== tests/pathname.lisp ===================================== @@ -142,3 +142,28 @@ "/*.*") :truenamep nil :follow-links nil))) (assert-equal dir-tilde dir-home)))) + +(define-test issue.454.illegal-pathname-chars + (:tag :issues) + ;; A slash (Unix directory separater) is not allowed. + (assert-error 'simple-error + (make-pathname :name "a/b")) + (assert-error 'simple-error + (make-pathname :type "a/b")) + (assert-error 'simple-error + (make-pathname :directory '(:relative "a/b"))) + ;; ASCII NUL characters are not allowed in Unix pathnames. + (let ((string-with-nul (concatenate 'string "a" (string #\nul) "b"))) + (assert-error 'simple-error + (make-pathname :name string-with-nul)) + (assert-error 'simple-error + (make-pathname :type string-with-nul)) + (assert-error 'simple-error + (make-pathname :directory (list :relative string-with-nul))))) + +(define-test issue.454.illegal-pathname-dot + (:tag :issues) + (assert-error 'simple-error + (make-pathname :name ".")) + (assert-error 'simple-error + (make-pathname :name ".."))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/5f887812a73484d110a880… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/5f887812a73484d110a880… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch issue-454-signal-error-for-bad-pathname-parts
by Raymond Toy (＠rtoy) 14 Nov '25

14 Nov '25

Raymond Toy pushed new branch issue-454-signal-error-for-bad-pathname-parts at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/issue-454-signal-error-fo… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0