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

[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

[Git][cmucl/cmucl][master] 2 commits: Fix #131: Move unix-uname to contrib/unix
by Raymond Toy (＠rtoy) 26 Apr '23

26 Apr '23

Raymond Toy pushed to branch master at cmucl / cmucl Commits: c2a99381 by Raymond Toy at 2023-04-26T21:38:42+00:00 Fix #131: Move unix-uname to contrib/unix - - - - - acb29d8f by Raymond Toy at 2023-04-26T21:38:42+00:00 Merge branch 'issue-131-move-unix-uname' into 'master' Fix #131: Move unix-uname to contrib/unix Closes #131 See merge request cmucl/cmucl!142 - - - - - 5 changed files: - src/code/exports.lisp - src/code/unix.lisp - src/contrib/unix/unix-glibc2.lisp - src/contrib/unix/unix.lisp - src/i18n/locale/cmucl-unix.pot Changes: ===================================== src/code/exports.lisp ===================================== @@ -249,9 +249,6 @@ "OPEN-DIR" "READ-DIR" - ;; linux-os, sunos-os. - "UNIX-UNAME" - ;; filesys.lisp "UNIX-GETPWUID" @@ -411,7 +408,7 @@ "TIOCSETP" "TTY-IUCLC" "TTY-OCRNL" "TTY-OFDEL" "TTY-OFILL" "TTY-OLCUC" "TTY-ONLRET" "TTY-ONOCR" - "TTY-XCASE" "UNIX-DUP2" "UNIX-GETITIMER" "UNIX-PID" "UNIX-UNAME" + "TTY-XCASE" "UNIX-DUP2" "UNIX-GETITIMER" "UNIX-PID" "UTSNAME" ) #+solaris ===================================== src/code/unix.lisp ===================================== @@ -2724,27 +2724,6 @@ (machine (array char 65)) (domainname (array char 65)))) -(defun unix-uname () - _N"Unix-uname returns information from the uname(2) system call. - The return values are - - Name of the operating system - Name of this node within some implementation-defined network, if any - Release level of this operating system - Version level of this operating system release - Name of the hardware type on which the system is running" - (with-alien ((names (struct utsname))) - (syscall* (#-(or freebsd (and x86 solaris)) "uname" - #+(and x86 solaris) "nuname" ; See /usr/include/sys/utsname.h - #+freebsd "__xuname" #+freebsd int - (* (struct utsname))) - (values (cast (slot names 'sysname) c-string) - (cast (slot names 'nodename) c-string) - (cast (slot names 'release) c-string) - (cast (slot names 'version) c-string) - (cast (slot names 'machine) c-string)) - #+freebsd 256 - (addr names)))) ;;; For asdf. Well, only getenv, but might as well make it symmetric. ===================================== src/contrib/unix/unix-glibc2.lisp ===================================== @@ -1908,5 +1908,26 @@ in at a time in poll.") :until (zerop (sap-int (alien-sap member))) :collect (string (cast member c-call:c-string)))))))) +(defun unix-uname () + _N"Unix-uname returns information from the uname(2) system call. + The return values are + + Name of the operating system + Name of this node within some implementation-defined network, if any + Release level of this operating system + Version level of this operating system release + Name of the hardware type on which the system is running" + (with-alien ((names (struct utsname))) + (syscall* (#-(or freebsd (and x86 solaris)) "uname" + #+(and x86 solaris) "nuname" ; See /usr/include/sys/utsname.h + #+freebsd "__xuname" #+freebsd int + (* (struct utsname))) + (values (cast (slot names 'sysname) c-string) + (cast (slot names 'nodename) c-string) + (cast (slot names 'release) c-string) + (cast (slot names 'version) c-string) + (cast (slot names 'machine) c-string)) + #+freebsd 256 + (addr names)))) ;; EOF ===================================== src/contrib/unix/unix.lisp ===================================== @@ -929,4 +929,25 @@ _N"Unix-getpagesize returns the number of bytes in a system page." (int-syscall ("getpagesize"))) +(defun unix-uname () + _N"Unix-uname returns information from the uname(2) system call. + The return values are + + Name of the operating system + Name of this node within some implementation-defined network, if any + Release level of this operating system + Version level of this operating system release + Name of the hardware type on which the system is running" + (with-alien ((names (struct utsname))) + (syscall* (#-(or freebsd (and x86 solaris)) "uname" + #+(and x86 solaris) "nuname" ; See /usr/include/sys/utsname.h + #+freebsd "__xuname" #+freebsd int + (* (struct utsname))) + (values (cast (slot names 'sysname) c-string) + (cast (slot names 'nodename) c-string) + (cast (slot names 'release) c-string) + (cast (slot names 'version) c-string) + (cast (slot names 'machine) c-string)) + #+freebsd 256 + (addr names)))) ;; EOF ===================================== src/i18n/locale/cmucl-unix.pot ===================================== @@ -1370,18 +1370,6 @@ msgid "" " and its children." msgstr "" -#: src/code/unix.lisp -msgid "" -"Unix-uname returns information from the uname(2) system call.\n" -" The return values are\n" -"\n" -" Name of the operating system\n" -" Name of this node within some implementation-defined network, if any\n" -" Release level of this operating system\n" -" Version level of this operating system release\n" -" Name of the hardware type on which the system is running" -msgstr "" - #: src/code/unix.lisp msgid "" "Get the value of the environment variable named Name. If no such\n" View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/90a5e5690f8baa91a3484f… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/90a5e5690f8baa91a3484f… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch issue-131-move-unix-uname
by Raymond Toy (＠rtoy) 26 Apr '23

26 Apr '23

Raymond Toy pushed new branch issue-131-move-unix-uname at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/issue-131-move-unix-uname 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 testing for signed-imm-byte data using sign-extend function.,
by Raymond Toy (＠rtoy) 25 Apr '23

25 Apr '23

Raymond Toy pushed to branch issue-185-x86-shorter-insts at cmucl / cmucl Commits: 54ba7245 by Carl S. Shapiro at 2023-04-25T23:53:54+00:00 Simplify testing for signed-imm-byte data using sign-extend function., - - - - - 1 changed file: - src/compiler/x86/insts.lisp Changes: ===================================== src/compiler/x86/insts.lisp ===================================== @@ -1304,19 +1304,12 @@ (defun arith-logical-constant-control (chunk inst stream dstate) (declare (ignore inst stream)) - (let ((opcode (ldb (byte 8 0) chunk)) - (signed-imm-data (ldb (byte 8 16) chunk))) - ;; See emit-random-arith-inst for the case where we use an 8-bit - ;; signed immediate value in the instruction. We print a note - ;; only if we have a 8-bit immediate and the 8-bit value is - ;; negative (MSB is 1). - (when (and (= opcode #b10000011) - (logbitp 7 signed-imm-data)) - (disassem:note #'(lambda (stream) - (princ (ldb (byte 32 0) - (sign-extend signed-imm-data 8)) - stream)) - dstate)))) + (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 &key control) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/54ba7245abe655147e6dfe0… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/54ba7245abe655147e6dfe0… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0