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

[Git][cmucl/cmucl][issue-156-take-2-nan-comparison] Add deftransform for >= and <= for integers.
by Raymond Toy (＠rtoy) 11 Mar '23

11 Mar '23

Raymond Toy pushed to branch issue-156-take-2-nan-comparison at cmucl / cmucl Commits: 7ae79da6 by Raymond Toy at 2023-03-10T18:37:11-08:00 Add deftransform for >= and <= for integers. See the comments in the code for this change. I'm not sure this is what we want, but the testsuite passes now when it was previously failing. The failure had something to do with utf-16-be external format and there were warnings about `(>= foo 0)` having to use `generic->=` because the first type was `unsigned-byte`. This doesn't happen anymore. - - - - - 1 changed file: - src/compiler/srctran.lisp Changes: ===================================== src/compiler/srctran.lisp ===================================== @@ -3537,6 +3537,29 @@ (deftransform > ((x y) (real real) * :when :both) (ir1-transform-< y x x y '<)) + +#+x86 +(progn + ;; When x and y are integers, we want to transform <= to > and >= to + ;; <. But we don't want to do this for floats because it messes up + ;; comparisons with NaN. + ;; + ;; I'm not sure about this. The transformation is right, but + ;; perhaps what we really need is an ir-transform-<= to determine x + ;; <= y is definitely true or false, like for ir1-transform-<. + ;; + ;; For now this allows the testsuite to pass. Perhaps there's a bug + ;; in generic->=? + (deftransform <= ((x y) (integer integer) * :when :both) + ;; (<= x y) is the same as (not (> x y)) + `(not (> x y))) + + + (deftransform >= ((x y) (integer integer) * :when :both) + ;; (>= x y) is the same as (not (< x y)) + `(not (< x y)))) + + ;; Like IR1-TRANSFORM-< but for CHAR<. This is needed so that the ;; vops for base-char comparison with a constant gets used when the ;; first arg is the constant. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/7ae79da601d4a56ba939417… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/7ae79da601d4a56ba939417… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-156-take-2-nan-comparison] Split the <= and >= macros from the others
by Raymond Toy (＠rtoy) 10 Mar '23

10 Mar '23

Raymond Toy pushed to branch issue-156-take-2-nan-comparison at cmucl / cmucl Commits: 60c39207 by Raymond Toy at 2023-03-10T14:51:32-08:00 Split the <= and >= macros from the others When !129 lands we'll probably need to rework the vops for <= and >=, so let's split these out now, even if they're basically duplicating the code. The < and > vops are going to be replaced, and I have not thought exactly how these will fit with < and > yet. But since <= and >= don't quite fully work, keep them separate. - - - - - 1 changed file: - src/compiler/x86/float-sse2.lisp Changes: ===================================== src/compiler/x86/float-sse2.lisp ===================================== @@ -972,12 +972,42 @@ (inst jmp ,yep target) (emit-label not-lab))))))))) (frob < single comiss :b :nb) - (frob <= single comiss :be :nbe) (frob > single comiss :a :na) - (frob >= single comiss :ae :nae) (frob < double comisd :b :nb) + (frob > double comisd :a :na)) + + + +(macrolet + ((frob (op size inst yep nope) + (let ((ea (ecase size + (single + 'ea-for-sf-desc) + (double + 'ea-for-df-desc))) + (name (symbolicate op "/" size "-FLOAT")) + (sc-type (symbolicate size "-REG")) + (inherit (symbolicate size "-FLOAT-COMPARE"))) + `(define-vop (,name ,inherit) + (:translate ,op) + (:info target not-p) + (:generator 3 + (sc-case y + (,sc-type + (inst ,inst x y)) + (descriptor-reg + (inst ,inst x (,ea y)))) + (cond (not-p + (inst jmp :p target) + (inst jmp ,nope target)) + (t + (let ((not-lab (gen-label))) + (inst jmp :p not-lab) + (inst jmp ,yep target) + (emit-label not-lab))))))))) + (frob <= single comiss :be :nbe) + (frob >= single comiss :ae :nae) (frob <= double comisd :be :nbe) - (frob > double comisd :a :na) (frob >= double comisd :ae :nae)) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/60c3920704106eef2bc45ee… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/60c3920704106eef2bc45ee… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-175-simplify-float-compare-vops] Remove old macros for < and >.
by Raymond Toy (＠rtoy) 10 Mar '23

10 Mar '23

Raymond Toy pushed to branch issue-175-simplify-float-compare-vops at cmucl / cmucl Commits: 1e7d1ddc by Raymond Toy at 2023-03-10T12:09:54-08:00 Remove old macros for < and >. - - - - - 1 changed file: - src/compiler/x86/float-sse2.lisp Changes: ===================================== src/compiler/x86/float-sse2.lisp ===================================== @@ -944,87 +944,6 @@ (frob single ucomiss) (frob double ucomisd)) -#+nil -(macrolet - ((gen-code (swap-args-p sc-type inst ea) - (if swap-args-p - `(sc-case x - (,sc-type - (inst ,inst y x)) - (descriptor-reg - (inst ,inst y (,ea x)))) - `(sc-case y - (,sc-type - (inst ,inst x y)) - (descriptor-reg - (inst ,inst x (,ea y)))))) - (frob (op size inst swap-args-p) - (let ((ea (ecase size - (single - 'ea-for-sf-desc) - (double - 'ea-for-df-desc))) - (name (symbolicate op "/" size "-FLOAT")) - (sc-type (symbolicate size "-REG")) - (inherit (symbolicate size "-FLOAT-COMPARE"))) - `(define-vop (,name ,inherit) - (:translate ,op) - (:info target not-p) - (:generator 3 - (gen-code ,swap-args-p ,sc-type ,inst ,ea) - ;; When a NaN occurs, comis sets ZF, PF, and CF = 1. In - ;; the normal case (not-p false), we want to jump to the - ;; target when x > y. This happens when CF = 0. Hence, - ;; we won't jump to the target when there's a NaN, as - ;; desired. - ;; - ;; For the not-p case, we want to jump to target when x - ;; <= y. This means CF = 1 or ZF = 1. But NaN sets - ;; these bits too, so we jump to the target for NaN or x - ;; <= y, as desired. - (inst jmp (if (not not-p) :a :be) target)))))) - (frob > single comiss nil) - (frob > double comisd nil)) - -#+nil -(macrolet - ((gen-code (swap-args-p sc-type inst ea) - (if swap-args-p - `(sc-case x - (,sc-type - (inst ,inst y x)) - (descriptor-reg - (inst ,inst y (,ea x)))) - `(sc-case y - (,sc-type - (inst ,inst x y)) - (descriptor-reg - (inst ,inst x (,ea y)))))) - (frob (op size inst swap-args-p) - (let ((ea (ecase size - (single - 'ea-for-sf-desc) - (double - 'ea-for-df-desc))) - (name (symbolicate op "/" size "-FLOAT")) - (sc-type (symbolicate size "-REG")) - (inherit (symbolicate size "-FLOAT-COMPARE"))) - `(define-vop (,name ,inherit) - (:args (x :scs (,sc-type descriptor-reg)) - (y :scs (,sc-type))) - (:translate ,op) - (:info target not-p) - (:temporary (:sc ,sc-type) load-x) - (:generator 3 - ;; Note: x < y is the same as y > x. We reverse the - ;; args to reduce the number of jump instructions - ;; needed. Then the logic for the branches is the same - ;; as for the case y > x above. - (gen-code ,swap-args-p ,sc-type ,inst ,ea) - (inst jmp (if (not not-p) :a :be) target)))))) - (frob < single comiss t) - (frob < double comisd t)) - (macrolet ((gen-code (op sc-type inst ea) ;; When the operation is >, the second arg (y) can be a View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/1e7d1ddcf57f37b66262f21… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/1e7d1ddcf57f37b66262f21… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-175-simplify-float-compare-vops] 3 commits: First cut at using a common macro for both > and <.
by Raymond Toy (＠rtoy) 10 Mar '23

10 Mar '23

Raymond Toy pushed to branch issue-175-simplify-float-compare-vops at cmucl / cmucl Commits: 225335b5 by Raymond Toy at 2023-03-10T11:42:37-08:00 First cut at using a common macro for both > and <. This works, but I think it should be cleaned up a bit. - - - - - 1ef34feb by Raymond Toy at 2023-03-10T12:05:04-08:00 Refactor comparison vops into one macro to handle them all. Previously we had two macros: one for < and one for >. They are very similar so we combine them into one macro to handle both operations. - - - - - 552d91f3 by Raymond Toy at 2023-03-10T12:06:57-08:00 Remove unused swap-args-p arg to frob We can determine whether we want to swap or not from the operation, so we don't need this arg to frob anymore. - - - - - 1 changed file: - src/compiler/x86/float-sse2.lisp Changes: ===================================== src/compiler/x86/float-sse2.lisp ===================================== @@ -944,8 +944,21 @@ (frob single ucomiss) (frob double ucomisd)) +#+nil (macrolet - ((frob (op size inst) + ((gen-code (swap-args-p sc-type inst ea) + (if swap-args-p + `(sc-case x + (,sc-type + (inst ,inst y x)) + (descriptor-reg + (inst ,inst y (,ea x)))) + `(sc-case y + (,sc-type + (inst ,inst x y)) + (descriptor-reg + (inst ,inst x (,ea y)))))) + (frob (op size inst swap-args-p) (let ((ea (ecase size (single 'ea-for-sf-desc) @@ -958,11 +971,7 @@ (:translate ,op) (:info target not-p) (:generator 3 - (sc-case y - (,sc-type - (inst ,inst x y)) - (descriptor-reg - (inst ,inst x (,ea y)))) + (gen-code ,swap-args-p ,sc-type ,inst ,ea) ;; When a NaN occurs, comis sets ZF, PF, and CF = 1. In ;; the normal case (not-p false), we want to jump to the ;; target when x > y. This happens when CF = 0. Hence, @@ -974,11 +983,24 @@ ;; these bits too, so we jump to the target for NaN or x ;; <= y, as desired. (inst jmp (if (not not-p) :a :be) target)))))) - (frob > single comiss) - (frob > double comisd)) + (frob > single comiss nil) + (frob > double comisd nil)) +#+nil (macrolet - ((frob (op size inst) + ((gen-code (swap-args-p sc-type inst ea) + (if swap-args-p + `(sc-case x + (,sc-type + (inst ,inst y x)) + (descriptor-reg + (inst ,inst y (,ea x)))) + `(sc-case y + (,sc-type + (inst ,inst x y)) + (descriptor-reg + (inst ,inst x (,ea y)))))) + (frob (op size inst swap-args-p) (let ((ea (ecase size (single 'ea-for-sf-desc) @@ -998,12 +1020,69 @@ ;; args to reduce the number of jump instructions ;; needed. Then the logic for the branches is the same ;; as for the case y > x above. - (sc-case x - (,sc-type - (inst ,inst y x)) - (descriptor-reg - (inst ,inst y (,ea x)))) + (gen-code ,swap-args-p ,sc-type ,inst ,ea) + (inst jmp (if (not not-p) :a :be) target)))))) + (frob < single comiss t) + (frob < double comisd t)) + +(macrolet + ((gen-code (op sc-type inst ea) + ;; When the operation is >, the second arg (y) can be a + ;; register or a descriptor. When the operation is <, the args + ;; are swapped and we want to allow x to be a register or + ;; descriptor. + (if (eq op '<) + `(sc-case x + (,sc-type + (inst ,inst y x)) + (descriptor-reg + (inst ,inst y (,ea x)))) + `(sc-case y + (,sc-type + (inst ,inst x y)) + (descriptor-reg + (inst ,inst x (,ea y)))))) + (frob (op size inst) + (let ((ea (ecase size + (single + 'ea-for-sf-desc) + (double + 'ea-for-df-desc))) + (name (symbolicate op "/" size "-FLOAT")) + (sc-type (symbolicate size "-REG")) + (inherit (symbolicate size "-FLOAT-COMPARE"))) + `(define-vop (,name ,inherit) + ;; When the operation is <, we want to rewrite x < y to y + ;; > x. In that case, we want to allow x to be in a + ;; descriptor. For >, y is allowed to be a descriptor. + ,@(when (eq op '<) + `((:args (x :scs (,sc-type descriptor-reg)) + (y :scs (,sc-type))))) + (:translate ,op) + (:info target not-p) + (:generator 3 + ;; Note: x < y is the same as y > x. We reverse the + ;; args to reduce the number of jump instructions + ;; needed. + (gen-code ,op ,sc-type ,inst ,ea) + ;; Consider the case of x > y. + ;; + ;; When a NaN occurs, comis sets ZF, PF, and CF = 1. In + ;; the normal case (not-p false), we want to jump to the + ;; target when x > y. This happens when CF = 0. Hence, + ;; we won't jump to the target when there's a NaN, as + ;; desired. + ;; + ;; For the not-p case, we want to jump to target when x + ;; <= y. This means CF = 1 or ZF = 1. But NaN sets + ;; these bits too, so we jump to the target for NaN or x + ;; <= y, as desired. + ;; + ;; For the case of x < y, we can use the equivalent y > + ;; x. Thus if we swap the args, the same logic applies. (inst jmp (if (not not-p) :a :be) target)))))) + (frob > single comiss) + (frob > double comisd) (frob < single comiss) (frob < double comisd)) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/5ad9f2d825f2e986e04fa2… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/5ad9f2d825f2e986e04fa2… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-175-simplify-float-compare-vops] Remove unused mover arg from the macro for < comparisons
by Raymond Toy (＠rtoy) 10 Mar '23

10 Mar '23

Raymond Toy pushed to branch issue-175-simplify-float-compare-vops at cmucl / cmucl Commits: 5ad9f2d8 by Raymond Toy at 2023-03-10T09:25:46-08:00 Remove unused mover arg from the macro for < comparisons We don't need the mover arg anymore since we've changed x to be a descriptor instead of y. - - - - - 1 changed file: - src/compiler/x86/float-sse2.lisp Changes: ===================================== src/compiler/x86/float-sse2.lisp ===================================== @@ -978,7 +978,7 @@ (frob > double comisd)) (macrolet - ((frob (op size inst mover) + ((frob (op size inst) (let ((ea (ecase size (single 'ea-for-sf-desc) @@ -1004,8 +1004,8 @@ (descriptor-reg (inst ,inst y (,ea x)))) (inst jmp (if (not not-p) :a :be) target)))))) - (frob < single comiss movss) - (frob < double comisd movsd)) + (frob < single comiss) + (frob < double comisd)) ;;;; Conversion: View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/5ad9f2d825f2e986e04fa2d… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/5ad9f2d825f2e986e04fa2d… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-175-simplify-float-compare-vops] 2 commits: For float <, allow x to be a descriptor instead of y.
by Raymond Toy (＠rtoy) 10 Mar '23

10 Mar '23

Raymond Toy pushed to branch issue-175-simplify-float-compare-vops at cmucl / cmucl Commits: d10df309 by Raymond Toy at 2023-03-09T13:18:24-08:00 For float <, allow x to be a descriptor instead of y. Since the implementation of x < y reverses args to do y > x, it can be helpful if x can be a descriptor. Make it so. - - - - - e89872a2 by Raymond Toy at 2023-03-10T08:14:14-08:00 Replace cond with simple if The cond expression can be replaced by a much simpler if, which mirrors how the sparc and ppc ports handle the not-p jumps. - - - - - 1 changed file: - src/compiler/x86/float-sse2.lisp Changes: ===================================== src/compiler/x86/float-sse2.lisp ===================================== @@ -963,19 +963,17 @@ (inst ,inst x y)) (descriptor-reg (inst ,inst x (,ea y)))) - (cond (not-p - ;; Instead of x > y, we're doing x <= y and want - ;; to jmp when x <= y. If NaN occurrs we also - ;; want to jump. x <= y means CF = 1 or ZF = 1. - ;; When NaN occurs, ZF, PF, and CF are all set. - ;; Hence, we can just test for x <= y. - (inst jmp :be target)) - (t - ;; If there's NaN, the ZF, PF, and CF bits are - ;; set. We only want to jmp to the target when - ;; x > y. This happens if CF = 0. Hence, we - ;; will not jmp to the target if NaN occurred. - (inst jmp :a target)))))))) + ;; When a NaN occurs, comis sets ZF, PF, and CF = 1. In + ;; the normal case (not-p false), we want to jump to the + ;; target when x > y. This happens when CF = 0. Hence, + ;; we won't jump to the target when there's a NaN, as + ;; desired. + ;; + ;; For the not-p case, we want to jump to target when x + ;; <= y. This means CF = 1 or ZF = 1. But NaN sets + ;; these bits too, so we jump to the target for NaN or x + ;; <= y, as desired. + (inst jmp (if (not not-p) :a :be) target)))))) (frob > single comiss) (frob > double comisd)) @@ -990,29 +988,22 @@ (sc-type (symbolicate size "-REG")) (inherit (symbolicate size "-FLOAT-COMPARE"))) `(define-vop (,name ,inherit) + (:args (x :scs (,sc-type descriptor-reg)) + (y :scs (,sc-type))) (:translate ,op) (:info target not-p) - (:temporary (:sc ,sc-type) load-y) + (:temporary (:sc ,sc-type) load-x) (:generator 3 - (sc-case y + ;; Note: x < y is the same as y > x. We reverse the + ;; args to reduce the number of jump instructions + ;; needed. Then the logic for the branches is the same + ;; as for the case y > x above. + (sc-case x (,sc-type (inst ,inst y x)) (descriptor-reg - (inst ,mover load-y (,ea y)) - (inst ,inst load-y x))) - (cond (not-p - ;; Instead of x < y, we're doing x >= y and want - ;; to jmp when x >= y. But x >=y is the same as - ;; y <= x, so if we swap the args, we can apply - ;; the same logic we use for > not-p case above. - (inst jmp :be target)) - (t - ;; We want to jump when x < y. This is the same - ;; as jumping when y > x. So if we reverse the - ;; args, we can apply the same logic as we did - ;; above for the > vop. - - (inst jmp :a target)))))))) + (inst ,inst y (,ea x)))) + (inst jmp (if (not not-p) :a :be) target)))))) (frob < single comiss movss) (frob < double comisd movsd)) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/9cb12348b64546ee281c5f… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/9cb12348b64546ee281c5f… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-156-take-2-nan-comparison] Fix errors in dd >= and <= implmeentation
by Raymond Toy (＠rtoy) 10 Mar '23

10 Mar '23

Raymond Toy pushed to branch issue-156-take-2-nan-comparison at cmucl / cmucl Commits: 64c9296f by Raymond Toy at 2023-03-09T19:49:21-08:00 Fix errors in dd >= and <= implmeentation For `dd<=`, we accidentally used `dd>` instead of `dd<`. Oops. The deftransforms had swapped the args because of a previous implementation that we changed, but we forgot to revert the swapping. Now `(describe decode-float)` correctly returns ``` (VALUES (OR (SINGLE-FLOAT 0.5 (1.0)) (DOUBLE-FLOAT 0.5d0 (1.0d0)) (DOUBLE-DOUBLE-FLOAT 0.5w0 (1.0w0))) KERNEL:DOUBLE-FLOAT-EXPONENT (OR (SINGLE-FLOAT 1.0 1.0) (SINGLE-FLOAT -1.0 -1.0) (DOUBLE-FLOAT -1.0d0 -1.0d0) (DOUBLE-FLOAT 1.0d0 1.0d0) (DOUBLE-DOUBLE-FLOAT -1.0w0 -1.0w0) (DOUBLE-DOUBLE-FLOAT 1.0w0 1.0w0))) ``` like we used to. - - - - - 1 changed file: - src/compiler/float-tran-dd.lisp Changes: ===================================== src/compiler/float-tran-dd.lisp ===================================== @@ -670,7 +670,7 @@ (declaim (inline dd<=)) (defun dd<= (a0 a1 b0 b1) - (or (dd> a0 a1 b0 b1) + (or (dd< a0 a1 b0 b1) (dd= a0 a1 b0 b1))) (declaim (inline dd>=)) @@ -699,15 +699,15 @@ (kernel:double-double-lo b))) (deftransform <= ((a b) (vm::double-double-float vm::double-double-float) *) - `(dd<= (kernel:double-double-hi b) - (kernel:double-double-lo b) - (kernel:double-double-hi a) - (kernel:double-double-lo a))) + `(dd<= (kernel:double-double-hi a) + (kernel:double-double-lo a) + (kernel:double-double-hi b) + (kernel:double-double-lo b))) (deftransform >= ((a b) (vm::double-double-float vm::double-double-float) *) - `(dd>= (kernel:double-double-hi b) - (kernel:double-double-lo b) - (kernel:double-double-hi a) - (kernel:double-double-lo a))) + `(dd>= (kernel:double-double-hi a) + (kernel:double-double-lo a) + (kernel:double-double-hi b) + (kernel:double-double-lo b))) ) ; end progn View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/64c9296fa3ff2c5a0b8fd5d… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/64c9296fa3ff2c5a0b8fd5d… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] Update release notes with recently closed bugs
by Raymond Toy (＠rtoy) 09 Mar '23

09 Mar '23

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 0038d3d9 by Raymond Toy at 2023-03-09T11:18:21-08:00 Update release notes with recently closed bugs - - - - - 1 changed file: - src/general-info/release-21e.md Changes: ===================================== src/general-info/release-21e.md ===================================== @@ -65,7 +65,17 @@ public domain. * ~~#142~~ `(random 0)` signals incorrect error * ~~#147~~ `stream-line-column` method missing for `fundamental-character-output-stream` * ~~#149~~ Call setlocale(3C) on startup + * ~~#150~~ Add aliases for external format cp949 and euckr + * ~~#151~~ Change `*default-external-format*` to `:utf-8`. * ~~#155~~ Wrap help strings neatly + * ~~#157~~ `(directory "foo/**/")` only returns directories now + * ~~#163~~ Add commandline option `-version` and `--version` to get lisp version + * ~~#165~~ Avoid inserting NIL into simple `LOOP` from `FORMAT` + * ~~#166~~ Fix incorect type declaration for exponent from `integer-decode-float` + * ~~#167~~ Lowe bound for `decode-float-exponent` type was off by one. + * ~~#168~~ Don't use negated forms for jmp instructions when possible + * ~~#169~~ Add pprinter for `define-vop` and `sc-case` + * ~~#173~~ Add pprinter for `define-assembly-routine` * Other changes: * Improvements to the PCL implementation of CLOS: * Changes to building procedure: View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/0038d3d9a489ffcf47bb155… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/0038d3d9a489ffcf47bb155… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-120-software-type-in-c] Just remove some trailing whitespace
by Raymond Toy (＠rtoy) 09 Mar '23

09 Mar '23

Raymond Toy pushed to branch issue-120-software-type-in-c at cmucl / cmucl Commits: d8f99abf by Raymond Toy at 2023-03-09T06:50:32-08:00 Just remove some trailing whitespace - - - - - 1 changed file: - src/lisp/os-common.c Changes: ===================================== src/lisp/os-common.c ===================================== @@ -814,7 +814,7 @@ os_get_locale_codeset() #define UNAME_RELEASE_AND_VERSION #else #undef UNAME_RELEASE_AND_VERSION -#endif +#endif char* os_software_version() @@ -822,7 +822,7 @@ os_software_version() int status; struct utsname uts; char *version = NULL; - + status = uname(&uts); if (status == 0) { int version_length; @@ -836,7 +836,7 @@ os_software_version() } #else version = strdup(uts.version); -#endif +#endif } return version; View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/d8f99abf569c7ae830abeb2… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/d8f99abf569c7ae830abeb2… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Fix #157: (directory "**/") only returns directories
by Raymond Toy (＠rtoy) 09 Mar '23

09 Mar '23

Raymond Toy pushed to branch master at cmucl / cmucl Commits: b3de9354 by Raymond Toy at 2023-03-09T14:46:48+00:00 Fix #157: (directory "**/") only returns directories - - - - - 39e30fad by Raymond Toy at 2023-03-09T14:46:48+00:00 Merge branch 'issue-157-directory-no-magic-wildcarding' into 'master' Fix #157: (directory "**/") only returns directories Closes #157 See merge request cmucl/cmucl!127 - - - - - 2 changed files: - src/code/filesys.lisp - tests/pathname.lisp Changes: ===================================== src/code/filesys.lisp ===================================== @@ -1122,11 +1122,7 @@ optionally keeping some of the most recent old versions." (let ((results nil)) (enumerate-search-list (pathname (merge-pathnames pathname - (make-pathname :name :wild - :type :wild - :version :wild - :defaults *default-pathname-defaults*) - :wild)) + *default-pathname-defaults*)) (enumerate-matches (name pathname nil :follow-links follow-links) (when (or all (let ((slash (position #\/ name :from-end t))) ===================================== tests/pathname.lisp ===================================== @@ -72,4 +72,14 @@ :directory '(:absolute "system2" "module4") :name nil :type nil) (parse-namestring "ASDFTEST:system2;module4;")))) - + + + +(define-test directory.dirs + (let ((files (directory "src/assembly/**/"))) + ;; Verify that we only returned directories + (loop for f in files + for name = (pathname-name f) + and type = (pathname-type f) + do + (assert-true (and (null name) (null type)) f)))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/7a15c46492914989dc85c5… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/7a15c46492914989dc85c5… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0