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

[Git][cmucl/cmucl] Pushed new branch issue-143-ansi-compliance-failure-listen-extra-argument
by Jon Boone (＠jboone) 30 Apr '23

30 Apr '23

Jon Boone pushed new branch issue-143-ansi-compliance-failure-listen-extra-argument at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/issue-143-ansi-compliance… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-193-nil-unspecific-equivalent] Treat NIL, :NEWEST, and :UNSPECIFIC as equivalent for :version
by Raymond Toy (＠rtoy) 30 Apr '23

30 Apr '23

Raymond Toy pushed to branch issue-193-nil-unspecific-equivalent at cmucl / cmucl Commits: c487a6cf by Raymond Toy at 2023-04-29T18:53:42-07:00 Treat NIL, :NEWEST, and :UNSPECIFIC as equivalent for :version Add tests for this too. - - - - - 2 changed files: - src/code/pathname.lisp - tests/issues.lisp Changes: ===================================== src/code/pathname.lisp ===================================== @@ -505,11 +505,13 @@ (eq that :unspecific))))))) ;; Compare the version component. We treat NIL to be EQUAL to -;; :NEWEST. +;; :NEWEST or :UNSPECIFIC. (defun compare-version-component (this that) (or (eql this that) - (and (null this) (eq that :newest)) - (and (null that) (eq this :newest)))) + (if (and (member this '(nil :newest :unspecific) :test #'eq) + (member that '(nil :newest :unspecific) :test #'eq)) + t + nil))) ;;;; Pathname functions. ===================================== tests/issues.lisp ===================================== @@ -962,3 +962,18 @@ (make-pathname :type nil))) (assert-true (equal (make-pathname :type nil) (make-pathname :type :unspecific)))) + +(define-test issue.192.version + (assert-true (equal (make-pathname :version :newest) + (make-pathname :version nil))) + (assert-true (equal (make-pathname :version nil) + (make-pathname :version :newest))) + (assert-true (equal (make-pathname :version :unspecific) + (make-pathname :version nil))) + (assert-true (equal (make-pathname :version nil) + (make-pathname :version :unspecific))) + (assert-true (equal (make-pathname :version :unspecific) + (make-pathname :version :newest))) + (assert-true (equal (make-pathname :version :newest) + (make-pathname :version :unspecific))) +) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/c487a6cf06ef73aaa361fe0… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/c487a6cf06ef73aaa361fe0… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-193-nil-unspecific-equivalent] Add tests for nil being equivalent to :unspecific
by Raymond Toy (＠rtoy) 29 Apr '23

29 Apr '23

Raymond Toy pushed to branch issue-193-nil-unspecific-equivalent at cmucl / cmucl Commits: dd8b90e0 by Raymond Toy at 2023-04-29T07:33:03-07:00 Add tests for nil being equivalent to :unspecific Handle the device, name, and type components. - - - - - 1 changed file: - tests/issues.lisp Changes: ===================================== tests/issues.lisp ===================================== @@ -944,3 +944,21 @@ (assert-true (typep idf-max-expo 'kernel:double-float-int-exponent)) (assert-true (typep (1- idf-max-expo) 'kernel:double-float-int-exponent)) (assert-false (typep (1+ idf-max-expo) 'kernel:double-float-int-exponent)))) + +(define-test issue.192.device + (assert-true (equal (make-pathname :device :unspecific) + (make-pathname :device nil))) + (assert-true (equal (make-pathname :device nil) + (make-pathname :device :unspecific)))) + +(define-test issue.192.name + (assert-true (equal (make-pathname :name :unspecific) + (make-pathname :name nil))) + (assert-true (equal (make-pathname :name nil) + (make-pathname :name :unspecific)))) + +(define-test issue.192.type + (assert-true (equal (make-pathname :type :unspecific) + (make-pathname :type nil))) + (assert-true (equal (make-pathname :type nil) + (make-pathname :type :unspecific)))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/dd8b90e0244f9c496ce31b2… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/dd8b90e0244f9c496ce31b2… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch issue-193-nil-unspecific-equivalent
by Raymond Toy (＠rtoy) 29 Apr '23

29 Apr '23

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

1 0

[Git][cmucl/cmucl][master] Update release notes for issue #192
by Raymond Toy (＠rtoy) 29 Apr '23

29 Apr '23

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 48aa21e0 by Raymond Toy at 2023-04-28T20:59:32-07:00 Update release notes for issue #192 - - - - - 1 changed file: - src/general-info/release-21e.md Changes: ===================================== src/general-info/release-21e.md ===================================== @@ -84,6 +84,7 @@ public domain. * ~~#173~~ Add pprinter for `define-assembly-routine`. * ~~#176~~ `SHORT-SITE-NAME` and `LONG-SITE-NAME` return `NIL`. * ~~#177~~ Add pprinter for `deftransform` and `defoptimizer`. + * ~~#192~~ Print radix marker in disassemblies and adjust note column to be larger for x86. * 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/48aa21e0b2ff64c1db1688b… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/48aa21e0b2ff64c1db1688b… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Fix #192: Print radix marker in disassemblies; adjust note column
by Raymond Toy (＠rtoy) 29 Apr '23

29 Apr '23

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 784a143b by Raymond Toy at 2023-04-29T03:54:43+00:00 Fix #192: Print radix marker in disassemblies; adjust note column - - - - - ce57a9f2 by Raymond Toy at 2023-04-29T03:55:21+00:00 Merge branch 'issue-192-disassemble-prints-radix-marker' into 'master' Fix #192: Print radix marker in disassemblies; adjust note column Closes #192 See merge request cmucl/cmucl!143 - - - - - 4 changed files: - src/code/exports.lisp - src/code/misc.lisp - src/compiler/disassem.lisp - src/i18n/locale/cmucl.pot Changes: ===================================== src/code/exports.lisp ===================================== @@ -1365,7 +1365,9 @@ (:export "*NOTE-COLUMN*" "*OPCODE-COLUMN-WIDTH*" "ADD-COMMENT-HOOK" "ADD-HOOK" "ADD-NOTE-HOOK" "ARG-VALUE" "CREATE-DSTATE" "DISASSEM-STATE" "DISASSEMBLE" "DISASSEMBLE-CODE-COMPONENT" - "DISASSEMBLE-FUNCTION" "DISASSEMBLE-MEMORY" "DISASSEMBLE-SEGMENT" + "DISASSEMBLE-FUNCTION" "DISASSEMBLE-MEMORY" + "*DISASSEMBLE-PRINT-RADIX*" + "DISASSEMBLE-SEGMENT" "DISASSEMBLE-SEGMENTS" "DSTATE-CODE" "DSTATE-CURPOS" "DSTATE-GET-PROP" "DSTATE-NEXTPOS" "DSTATE-SEGMENT-LENGTH" "DSTATE-SEGMENT-SAP" "DSTATE-SEGMENT-START" "FIELD-TYPE" ===================================== src/code/misc.lisp ===================================== @@ -181,5 +181,7 @@ "Disassemble the machine code associated with OBJECT, which can be a function, a lambda expression, or a symbol with a function definition. If it is not already compiled, the compiler is called to produce something to - disassemble." + disassemble. + + Also see disassem:disassemble for finer control of disassembly." (disassem:disassemble object)) ===================================== src/compiler/disassem.lisp ===================================== @@ -102,7 +102,9 @@ "The width of the column in which instruction-names are printed. NIL means use the default. A value of zero gives the effect of not aligning the arguments at all.") -(defvar *note-column* 45 +(defvar *note-column* + #-x86 45 + #+x86 55 "The column in which end-of-line comments for notes are started.") (defconstant default-opcode-column-width 6) @@ -3316,12 +3318,16 @@ :format-control (intl:gettext "Can't make a compiled function from ~S") :format-arguments (list name))))) +(defvar *disassemble-print-radix* + t + "Default value for :radix argument for disassem:disassemble") + (defun disassemble (object &key (stream *standard-output*) (use-labels t) (backend c:*native-backend*) (base 16) (case :downcase) - (radix *print-radix*)) + (radix *disassemble-print-radix*)) "Disassemble the machine code associated with OBJECT, which can be a function, a lambda expression, or a symbol with a function definition. If it is not already compiled, the compiler is called to produce something to @@ -3336,7 +3342,7 @@ :Radix The disassembler uses the specified base, case, and radix when printing the disassembled code. The default values are 16, - :downcase, and *print-radix*, respectively." + :downcase, and *disassemble-print-radix*, respectively." (declare (type (or function symbol cons) object) (type (or (member t) stream) stream) (type (member t nil) use-labels) ===================================== src/i18n/locale/cmucl.pot ===================================== @@ -5694,7 +5694,9 @@ msgid "" "If\n" " it is not already compiled, the compiler is called to produce something " "to\n" -" disassemble." +" disassemble.\n" +"\n" +" Also see disassem:disassemble for finer control of disassembly." msgstr "" #: src/code/misc-doc.lisp @@ -17387,6 +17389,10 @@ msgstr "" msgid "Can't make a compiled function from ~S" msgstr "" +#: src/compiler/disassem.lisp +msgid "Default value for :radix argument for disassem:disassemble" +msgstr "" + #: src/compiler/disassem.lisp msgid "" "Disassemble the machine code associated with OBJECT, which can be a\n" @@ -17405,7 +17411,7 @@ msgid "" " :Radix\n" " The disassembler uses the specified base, case, and radix when\n" " printing the disassembled code. The default values are 16,\n" -" :downcase, and *print-radix*, respectively." +" :downcase, and *disassemble-print-radix*, respectively." msgstr "" #: src/compiler/disassem.lisp View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/8826d962b0a76b7b0d1cfd… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/8826d962b0a76b7b0d1cfd… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-192-disassemble-prints-radix-marker] Add *disassemble-print-radix* as the default for :radix
by Raymond Toy (＠rtoy) 28 Apr '23

28 Apr '23

Raymond Toy pushed to branch issue-192-disassemble-prints-radix-marker at cmucl / cmucl Commits: c662da73 by Raymond Toy at 2023-04-28T07:20:34-07:00 Add *disassemble-print-radix* as the default for :radix Export this symbol too to make it clear that this is the API and we're allowing users to modify this. Update `disassemble` docstring to mention `disassem:disasemble`. - - - - - 4 changed files: - src/code/exports.lisp - src/code/misc.lisp - src/compiler/disassem.lisp - src/i18n/locale/cmucl.pot Changes: ===================================== src/code/exports.lisp ===================================== @@ -1368,7 +1368,9 @@ (:export "*NOTE-COLUMN*" "*OPCODE-COLUMN-WIDTH*" "ADD-COMMENT-HOOK" "ADD-HOOK" "ADD-NOTE-HOOK" "ARG-VALUE" "CREATE-DSTATE" "DISASSEM-STATE" "DISASSEMBLE" "DISASSEMBLE-CODE-COMPONENT" - "DISASSEMBLE-FUNCTION" "DISASSEMBLE-MEMORY" "DISASSEMBLE-SEGMENT" + "DISASSEMBLE-FUNCTION" "DISASSEMBLE-MEMORY" + "*DISASSEMBLE-PRINT-RADIX*" + "DISASSEMBLE-SEGMENT" "DISASSEMBLE-SEGMENTS" "DSTATE-CODE" "DSTATE-CURPOS" "DSTATE-GET-PROP" "DSTATE-NEXTPOS" "DSTATE-SEGMENT-LENGTH" "DSTATE-SEGMENT-SAP" "DSTATE-SEGMENT-START" "FIELD-TYPE" ===================================== src/code/misc.lisp ===================================== @@ -181,5 +181,7 @@ "Disassemble the machine code associated with OBJECT, which can be a function, a lambda expression, or a symbol with a function definition. If it is not already compiled, the compiler is called to produce something to - disassemble." + disassemble. + + Also see disassem:disassemble for finer control of disassembly." (disassem:disassemble object)) ===================================== src/compiler/disassem.lisp ===================================== @@ -3318,12 +3318,16 @@ :format-control (intl:gettext "Can't make a compiled function from ~S") :format-arguments (list name))))) +(defvar *disassemble-print-radix* + t + "Default value for :radix argument for disassem:disassemble") + (defun disassemble (object &key (stream *standard-output*) (use-labels t) (backend c:*native-backend*) (base 16) (case :downcase) - (radix t)) + (radix *disassemble-print-radix*)) "Disassemble the machine code associated with OBJECT, which can be a function, a lambda expression, or a symbol with a function definition. If it is not already compiled, the compiler is called to produce something to @@ -3338,7 +3342,7 @@ :Radix The disassembler uses the specified base, case, and radix when printing the disassembled code. The default values are 16, - :downcase, and T, respectively." + :downcase, and *disassemble-print-radix*, respectively." (declare (type (or function symbol cons) object) (type (or (member t) stream) stream) (type (member t nil) use-labels) ===================================== src/i18n/locale/cmucl.pot ===================================== @@ -5694,7 +5694,9 @@ msgid "" "If\n" " it is not already compiled, the compiler is called to produce something " "to\n" -" disassemble." +" disassemble.\n" +"\n" +" Also see disassem:disassemble for finer control of disassembly." msgstr "" #: src/code/misc-doc.lisp @@ -17387,6 +17389,10 @@ msgstr "" msgid "Can't make a compiled function from ~S" msgstr "" +#: src/compiler/disassem.lisp +msgid "Default value for :radix argument for disassem:disassemble" +msgstr "" + #: src/compiler/disassem.lisp msgid "" "Disassemble the machine code associated with OBJECT, which can be a\n" @@ -17405,7 +17411,7 @@ msgid "" " :Radix\n" " The disassembler uses the specified base, case, and radix when\n" " printing the disassembled code. The default values are 16,\n" -" :downcase, and T, respectively." +" :downcase, and *disassemble-print-radix*, respectively." msgstr "" #: src/compiler/disassem.lisp View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/c662da73c4ea1e29e947b92… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/c662da73c4ea1e29e947b92… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Fix #185: Use shorter instructions on x86
by Raymond Toy (＠rtoy) 27 Apr '23

27 Apr '23

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 677c3ccf by Raymond Toy at 2023-04-27T22:55:29+00:00 Fix #185: Use shorter instructions on x86 - - - - - 8826d962 by Raymond Toy at 2023-04-27T22:55:39+00:00 Merge branch 'issue-185-x86-shorter-insts' into 'master' Fix #185: Use shorter instructions on x86 Closes #185 See merge request cmucl/cmucl!138 - - - - - 1 changed file: - src/compiler/x86/insts.lisp Changes: ===================================== src/compiler/x86/insts.lisp ===================================== @@ -1254,17 +1254,19 @@ ;;;; Arithmetic +(defun sign-extend (x n) + "Sign extend the N-bit number X" + (if (logbitp (1- n) x) + (logior (ash -1 (1- n)) x) + x)) + (defun emit-random-arith-inst (name segment dst src opcode &optional allow-constants) (let ((size (matching-operand-size dst src))) (maybe-emit-operand-size-prefix segment size) (cond ((integerp src) - (cond ((and (not (eq size :byte)) (<= -128 src 127)) - (emit-byte segment #b10000011) - (emit-ea segment dst opcode allow-constants) - (emit-byte segment src)) - ((accumulator-p dst) + (cond ((accumulator-p dst) (emit-byte segment (dpb opcode (byte 3 3) @@ -1272,6 +1274,10 @@ #b00000100 #b00000101))) (emit-sized-immediate segment size src)) + ((and (not (eq size :byte)) (<= -128 (sign-extend src 32) 127)) + (emit-byte segment #b10000011) + (emit-ea segment dst opcode allow-constants) + (emit-byte segment (ldb (byte 8 0) src))) (t (emit-byte segment (if (eq size :byte) #b10000000 #b10000001)) (emit-ea segment dst opcode allow-constants) @@ -1291,12 +1297,24 @@ (t (error "Bogus operands to ~A" name))))) +(defun arith-logical-constant-control (chunk inst stream dstate) + (declare (ignore inst stream)) + (when (= (ldb (byte 8 0) chunk) #b10000011) + (let ((imm (sign-extend (ldb (byte 8 16) chunk) 8))) + (when (minusp imm) + (disassem:note #'(lambda (stream) + (princ (ldb (byte 32 0) imm) stream)) + dstate))))) + (eval-when (compile eval) - (defun arith-inst-printer-list (subop) - `((accum-imm ((op ,(dpb subop (byte 3 2) #b0000010)))) - (reg/mem-imm ((op (#b1000000 ,subop)))) + (defun arith-inst-printer-list (subop &key control) + `((accum-imm ((op ,(dpb subop (byte 3 2) #b0000010))) + ,@(when control `(:default :control #',control))) + (reg/mem-imm ((op (#b1000000 ,subop))) + ,@(when control `(:default :control #',control))) (reg/mem-imm ((op (#b1000001 ,subop)) - (imm nil :type signed-imm-byte))) + (imm nil :type signed-imm-byte)) + ,@(when control `(:default :control #',control))) (reg-reg/mem-dir ((op ,(dpb subop (byte 3 1) #b000000)))))) ) @@ -1602,7 +1620,7 @@ (define-instruction and (segment dst src) (:printer-list - (arith-inst-printer-list #b100)) + (arith-inst-printer-list #b100 :control 'arith-logical-constant-control)) (:emitter (emit-random-arith-inst "AND" segment dst src #b100))) @@ -1639,13 +1657,13 @@ (define-instruction or (segment dst src) (:printer-list - (arith-inst-printer-list #b001)) + (arith-inst-printer-list #b001 :control 'arith-logical-constant-control)) (:emitter (emit-random-arith-inst "OR" segment dst src #b001))) (define-instruction xor (segment dst src) (:printer-list - (arith-inst-printer-list #b110)) + (arith-inst-printer-list #b110 :control 'arith-logical-constant-control)) (:emitter (emit-random-arith-inst "XOR" segment dst src #b110))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/acb29d8f6a3190744a0427… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/acb29d8f6a3190744a0427… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch issue-192-disassemble-prints-radix-marker
by Raymond Toy (＠rtoy) 27 Apr '23

27 Apr '23

Raymond Toy pushed new branch issue-192-disassemble-prints-radix-marker at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/issue-192-disassemble-pri… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-185-x86-shorter-insts] Simplify test using `sign-extend`.
by Raymond Toy (＠rtoy) 26 Apr '23

26 Apr '23

Raymond Toy pushed to branch issue-185-x86-shorter-insts at cmucl / cmucl Commits: db1e9b11 by Carl S. Shapiro at 2023-04-26T22:59:49+00:00 Simplify test using `sign-extend`. - - - - - 1 changed file: - src/compiler/x86/insts.lisp Changes: ===================================== src/compiler/x86/insts.lisp ===================================== @@ -1274,12 +1274,7 @@ #b00000100 #b00000101))) (emit-sized-immediate segment size src)) - ((and (not (eq size :byte)) - (or (<= -128 src 127) - ;; Check that the top 25 bits are all ones so - ;; that sign-extending an 8-bit value produces - ;; the desired 32-bit value. - (= (ldb (byte 25 7) src) #x1ffffff))) + ((and (not (eq size :byte)) (<= -128 (sign-extend src 32) 127)) (emit-byte segment #b10000011) (emit-ea segment dst opcode allow-constants) (emit-byte segment (ldb (byte 8 0) src))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/db1e9b11dc19a5c3cedea51… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/db1e9b11dc19a5c3cedea51… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0