From 864c91b95c68eef808008fcb65780119e24831b4 Mon Sep 17 00:00:00 2001 From: Juho Snellman Date: Wed, 6 Apr 2005 01:47:35 +0000 Subject: [PATCH] 0.8.21.19: * Merge more x86-64 disassembler improvements from Lutz Euler. (sbcl-devel "Re: Improving the x86-64 disassembler" on 2005-04-05). * Bump compact-info-env-entries-bits to allow purify on images with large amounts of functions (sbcl-devel "purify failure when compact-info-env-entries-bits is too small" on 2005-03-26 by Cyrus Harmon). --- CREDITS | 3 ++ NEWS | 3 ++ src/compiler/globaldb.lisp | 14 ++++++- src/compiler/x86-64/insts.lisp | 85 +++++++++++++++++++++++++++++++--------- version.lisp-expr | 2 +- 5 files changed, 87 insertions(+), 20 deletions(-) diff --git a/CREDITS b/CREDITS index 36d9436..01ce3e1 100644 --- a/CREDITS +++ b/CREDITS @@ -558,6 +558,9 @@ Miles Egan: He creates binary packages of SBCL releases for Red Hat and other (which?) platforms. +Lutz Euler: + He made a large number of improvements to the x86-64 disassembler. + Andreas Fuchs: He provides infrastructure for monitoring build and performance regressions of SBCL. He assisted with the integration of the diff --git a/NEWS b/NEWS index a17a147..af69764 100644 --- a/NEWS +++ b/NEWS @@ -22,6 +22,9 @@ changes in sbcl-0.8.22 relative to sbcl-0.8.21: ** the restarts for recovering from input and output encoding errors only appear when there is in fact such an error to handle. + * increased the maximimum compact environment size to allow + purify on images with large amounts of functions. (thanks to Cyrus Harmon) + * improvements to the x86-64 disassembler. (thanks to Lutz Euler) * fixed some bugs revealed by Paul Dietz' test suite: ** MISC.549 and similar: late transformation of unsafe type assertions into derived types caused unexpected code diff --git a/src/compiler/globaldb.lisp b/src/compiler/globaldb.lisp index c73acaa..221210d 100644 --- a/src/compiler/globaldb.lisp +++ b/src/compiler/globaldb.lisp @@ -476,7 +476,19 @@ ;;;; compact info environments ;;; The upper limit on the size of the ENTRIES vector in a COMPACT-INFO-ENV. -(def!constant compact-info-env-entries-bits 16) +;;; +;;; "Why (U-B 28)?", you might wonder. Originally this was (U-B 16), +;;; presumably to ensure that the arrays of :ELEMENT-TYPE +;;; COMPACT-INFO-ENTRIES-INDEX could use a more space-efficient representation. +;;; It turns out that a environment of of only 65536 entries is insufficient in +;;; the modern world (see message from Cyrus Harmon to sbcl-devel, "Subject: +;;; purify failure when compact-info-env-entries-bits is too small"). Using +;;; (U-B 28) instead of (U-B 29) is to avoid the need for bignum overflow +;;; checks, a probably pointless micro-optimization. Hardcoding the amount of +;;; bits instead of deriving it from SB!VM::N-WORD-BITS is done to allow +;;; use of a more efficient array representation on 64-bit platforms. +;;; -- JES, 2005-04-06 +(def!constant compact-info-env-entries-bits 28) (deftype compact-info-entries-index () `(unsigned-byte ,compact-info-env-entries-bits)) ;;; the type of the values in COMPACT-INFO-ENTRIES-INFO diff --git a/src/compiler/x86-64/insts.lisp b/src/compiler/x86-64/insts.lisp index 17ad57d..f6c36aa 100644 --- a/src/compiler/x86-64/insts.lisp +++ b/src/compiler/x86-64/insts.lisp @@ -495,6 +495,21 @@ (accum :type 'accum) (imm)) +;;; A one-byte instruction with a #x66 prefix, used to indicate an +;;; operand size of :word. +(sb!disassem:define-instruction-format (x66-byte 16 + :default-printer '(:name)) + (x66 :field (byte 8 0) :value #x66) + (op :field (byte 8 8))) + +;;; A one-byte instruction with a REX prefix, used to indicate an +;;; operand size of :qword. REX.W must be 1, the other three bits are +;;; ignored. +(sb!disassem:define-instruction-format (rex-byte 16 + :default-printer '(:name)) + (rex :field (byte 5 3) :value #b01001) + (op :field (byte 8 8))) + (sb!disassem:define-instruction-format (simple 8) (op :field (byte 7 1)) (width :field (byte 1 0) :type 'width) @@ -640,8 +655,6 @@ `(:name :tab ,(swap-if 'dir 'reg/mem ", " 'reg))) - (rex :field (byte 4 4) :value #b0100) - (wrxb :field (byte 4 0) :type 'wrxb) (op :field (byte 6 10)) (dir :field (byte 1 9))) @@ -705,6 +718,13 @@ (reg/mem :type 'reg/mem) ; don't need a size (accum :type 'accum)) +(sb!disassem:define-instruction-format (rex-accum-reg/mem 24 + :include 'rex-reg/mem + :default-printer + '(:name :tab accum ", " reg/mem)) + (reg/mem :type 'reg/mem) ; don't need a size + (accum :type 'accum)) + ;;; Same as reg-reg/mem, but with a prefix of #b00001111 (sb!disassem:define-instruction-format (ext-reg-reg/mem 24 :default-printer @@ -890,6 +910,18 @@ :type 'reg/mem) (reg :field (byte 3 19) :type 'reg)) +(sb!disassem:define-instruction-format (rex-cond-move 32 + :default-printer + '('cmov cc :tab reg ", " reg/mem)) + (rex :field (byte 4 4) :value #b0100) + (wrxb :field (byte 4 0) :type 'wrxb) + (prefix :field (byte 8 8) :value #b00001111) + (op :field (byte 4 20) :value #b0100) + (cc :field (byte 4 16) :type 'condition-code) + (reg/mem :fields (list (byte 2 30) (byte 3 24)) + :type 'reg/mem) + (reg :field (byte 3 27) :type 'reg)) + (sb!disassem:define-instruction-format (enter-format 32 :default-printer '(:name :tab disp @@ -1428,7 +1460,14 @@ ((op #b10110111) (reg/mem nil :type 'sized-word-reg/mem))) (:emitter (emit-move-with-extension segment dst src nil))) +;;; The regular use of MOVSXD is with an operand size of :qword. This +;;; sign-extends the dword source into the qword destination register. +;;; If the operand size is :dword the instruction zero-extends the dword +;;; source into the qword destination register, i.e. it does the same as +;;; a dword MOV into a register. (define-instruction movsxd (segment dst src) + (:printer reg-reg/mem ((op #b0110001) (width 1) + (reg/mem nil :type 'sized-dword-reg/mem))) (:printer rex-reg-reg/mem ((op #b0110001) (width 1) (reg/mem nil :type 'sized-dword-reg/mem))) (:emitter (emit-move-with-extension segment dst src :signed))) @@ -1474,11 +1513,6 @@ (emit-byte segment #b11111111) (emit-ea segment src #b110 t)))))))) -(define-instruction pusha (segment) - (:printer byte ((op #b01100000))) - (:emitter - (emit-byte segment #b01100000))) - (define-instruction pop (segment dst) (:printer reg-no-width-default-qword ((op #b01011))) (:printer rex-reg-no-width-default-qword ((op #b01011))) @@ -1495,11 +1529,6 @@ (emit-byte segment #b10001111) (emit-ea segment dst #b000)))))) -(define-instruction popa (segment) - (:printer byte ((op #b01100001))) - (:emitter - (emit-byte segment #b01100001))) - (define-instruction xchg (segment operand1 operand2) ;; Register with accumulator. (:printer reg-no-width ((op #b10010)) '(:name :tab accum ", " reg)) @@ -1682,8 +1711,8 @@ ;; therefore we force WIDTH to 1. (reg/mem-imm ((op (#b1000001 ,subop)) (width 1) (imm nil :type signed-imm-byte))) - (rex-reg/mem-imm ((op (#b1000001 ,subop)) - (imm nil :type signed-imm-byte))) + (rex-reg/mem-imm ((op (#b1000001 ,subop)) (width 1) + (imm nil :type signed-imm-byte))) (reg-reg/mem-dir ((op ,(dpb subop (byte 3 1) #b000000)))) (rex-reg-reg/mem-dir ((op ,(dpb subop (byte 3 1) #b000000)))))) ) @@ -1743,6 +1772,7 @@ (define-instruction neg (segment dst) (:printer reg/mem ((op '(#b1111011 #b011)))) + (:printer rex-reg/mem ((op '(#b1111011 #b011)))) (:emitter (let ((size (operand-size dst))) (maybe-emit-operand-size-prefix segment size) @@ -1752,6 +1782,7 @@ (define-instruction mul (segment dst src) (:printer accum-reg/mem ((op '(#b1111011 #b100)))) + (:printer rex-accum-reg/mem ((op '(#b1111011 #b100)))) (:emitter (let ((size (matching-operand-size dst src))) (aver (accumulator-p dst)) @@ -1762,6 +1793,7 @@ (define-instruction imul (segment dst &optional src1 src2) (:printer accum-reg/mem ((op '(#b1111011 #b101)))) + (:printer rex-accum-reg/mem ((op '(#b1111011 #b101)))) (:printer ext-reg-reg/mem-no-width ((op #b10101111))) (:printer rex-ext-reg-reg/mem-no-width ((op #b10101111))) (:printer reg-reg/mem ((op #b0110100) (width 1) @@ -1807,6 +1839,7 @@ (define-instruction div (segment dst src) (:printer accum-reg/mem ((op '(#b1111011 #b110)))) + (:printer rex-accum-reg/mem ((op '(#b1111011 #b110)))) (:emitter (let ((size (matching-operand-size dst src))) (aver (accumulator-p dst)) @@ -1817,6 +1850,7 @@ (define-instruction idiv (segment dst src) (:printer accum-reg/mem ((op '(#b1111011 #b111)))) + (:printer rex-accum-reg/mem ((op '(#b1111011 #b111)))) (:emitter (let ((size (matching-operand-size dst src))) (aver (accumulator-p dst)) @@ -1835,18 +1869,28 @@ ;;; CBW -- Convert Byte to Word. AX <- sign_xtnd(AL) (define-instruction cbw (segment) + (:printer x66-byte ((op #b10011000))) (:emitter (maybe-emit-operand-size-prefix segment :word) (emit-byte segment #b10011000))) -;;; CWDE -- Convert Word To Double Word Extened. EAX <- sign_xtnd(AX) +;;; CWDE -- Convert Word To Double Word Extended. EAX <- sign_xtnd(AX) (define-instruction cwde (segment) + (:printer byte ((op #b10011000))) (:emitter (maybe-emit-operand-size-prefix segment :dword) (emit-byte segment #b10011000))) +;;; CDQE -- Convert Word To Double Word Extended. RAX <- sign_xtnd(EAX) +(define-instruction cdqe (segment) + (:printer rex-byte ((op #b10011000))) + (:emitter + (maybe-emit-rex-prefix segment :qword nil nil nil) + (emit-byte segment #b10011000))) + ;;; CWD -- Convert Word to Double Word. DX:AX <- sign_xtnd(AX) (define-instruction cwd (segment) + (:printer x66-byte ((op #b10011001))) (:emitter (maybe-emit-operand-size-prefix segment :word) (emit-byte segment #b10011001))) @@ -1858,8 +1902,9 @@ (maybe-emit-operand-size-prefix segment :dword) (emit-byte segment #b10011001))) -;;; CQO -- Convert Quad or Octaword. RDX:RAX <- sign_xtnd(RAX) +;;; CQO -- Convert Quad Word to Octaword. RDX:RAX <- sign_xtnd(RAX) (define-instruction cqo (segment) + (:printer rex-byte ((op #b10011001))) (:emitter (maybe-emit-rex-prefix segment :qword nil nil nil) (emit-byte segment #b10011001))) @@ -2041,6 +2086,7 @@ (define-instruction not (segment dst) (:printer reg/mem ((op '(#b1111011 #b010)))) + (:printer rex-reg/mem ((op '(#b1111011 #b010)))) (:emitter (let ((size (operand-size dst))) (maybe-emit-operand-size-prefix segment size) @@ -2139,7 +2185,8 @@ ;;;; bit manipulation (define-instruction bsf (segment dst src) - (:printer ext-reg-reg/mem ((op #b1011110) (width 0))) + (:printer ext-reg-reg/mem-no-width ((op #b10111100))) + (:printer rex-ext-reg-reg/mem-no-width ((op #b10111100))) (:emitter (let ((size (matching-operand-size dst src))) (when (eq size :byte) @@ -2151,7 +2198,8 @@ (emit-ea segment src (reg-tn-encoding dst))))) (define-instruction bsr (segment dst src) - (:printer ext-reg-reg/mem ((op #b1011110) (width 1))) + (:printer ext-reg-reg/mem-no-width ((op #b10111101))) + (:printer rex-ext-reg-reg/mem-no-width ((op #b10111101))) (:emitter (let ((size (matching-operand-size dst src))) (when (eq size :byte) @@ -2344,6 +2392,7 @@ ;;;; conditional move (define-instruction cmov (segment cond dst src) (:printer cond-move ()) + (:printer rex-cond-move ()) (:emitter (aver (register-p dst)) (let ((size (matching-operand-size dst src))) diff --git a/version.lisp-expr b/version.lisp-expr index 599e64b..033d273 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.8.21.18" +"0.8.21.19" -- 1.7.10.4