Menu
▾
▴
[Sbcl-commits] master: Delete unused macro DSTATE-GET-PROP
|
From: Douglas K. <sn...@us...> - 2017-11-14 04:01:17
|
The branch "master" has been updated in SBCL:
via dfb4c2e5b1a981b50518c12f1ce511dc16921e5d (commit)
from 5a3e8299f3bca5fdc3946a874ad855d05309f224 (commit)
- Log -----------------------------------------------------------------
commit dfb4c2e5b1a981b50518c12f1ce511dc16921e5d
Author: Douglas Katzman <do...@go...>
Date: Mon Nov 13 22:51:21 2017 -0500
Delete unused macro DSTATE-GET-PROP
Move some target-only code to target-insts
---
package-data-list.lisp-expr | 4 +--
src/compiler/disassem.lisp | 24 ------------------
src/compiler/target-disassem.lisp | 16 ++++++++++++
src/compiler/x86-64/insts.lisp | 47 +++++------------------------------
src/compiler/x86-64/target-insts.lisp | 41 +++++++++++++++++++++++++++---
src/compiler/x86/insts.lisp | 28 ++-------------------
src/compiler/x86/target-insts.lisp | 26 +++++++++++++++++--
7 files changed, 87 insertions(+), 99 deletions(-)
diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index be27ead..aaf218d 100644
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -518,8 +518,8 @@ like *STACK-TOP-HINT* and unsupported stuff like *TRACED-FUN-LIST*."
"DISASSEMBLE-FUN" "DISASSEMBLE-MEMORY"
"DISASSEMBLE-SEGMENT" "DISASSEMBLE-SEGMENTS"
"DSTATE-BYTE-ORDER"
- "DSTATE-GET-INST-PROP"
- "DSTATE-GET-PROP" "DSTATE-PUT-INST-PROP"
+ "DSTATE-GETPROP"
+ "DSTATE-SETPROP"
"DSTATE-SEGMENT-SAP"
"FIND-INST"
"GET-CODE-SEGMENTS" "GET-FUN-SEGMENTS"
diff --git a/src/compiler/disassem.lisp b/src/compiler/disassem.lisp
index 86a7cdd..bebd99e 100644
--- a/src/compiler/disassem.lisp
+++ b/src/compiler/disassem.lisp
@@ -1096,30 +1096,6 @@
(the address (+ (seg-virtual-location (dstate-segment dstate))
(dstate-next-offs dstate))))
-;;; Get the value of the property called NAME in DSTATE. Also SETF'able.
-;;;
-;;; KLUDGE: The associated run-time machinery for this is in
-;;; target-disassem.lisp (much later). This is here just to make sure
-;;; it's defined before it's used. -- WHN ca. 19990701
-(defmacro dstate-get-prop (dstate name)
- `(getf (dstate-properties ,dstate) ,name))
-
-;;; Put PROPERTY into the set of instruction properties in DSTATE.
-;;; PROPERTY can be a fixnum or symbol, but any given backend
-;;; must exclusively use one or the other property representation.
-(defun dstate-put-inst-prop (dstate property)
- (if (fixnump property)
- (setf (dstate-inst-properties dstate)
- (logior (or (dstate-inst-properties dstate) 0) property))
- (push property (dstate-inst-properties dstate))))
-
-;;; Return non-NIL if PROPERTY is in the set of instruction properties in
-;;; DSTATE. As with -PUT-INST-PROP, we can have a bitmask or a plist.
-(defun dstate-get-inst-prop (dstate property)
- (if (fixnump property)
- (logtest (or (dstate-inst-properties dstate) 0) property)
- (memq property (dstate-inst-properties dstate))))
-
(declaim (ftype function read-suffix))
(defun read-signed-suffix (length dstate)
(declare (type (member 8 16 32 64) length)
diff --git a/src/compiler/target-disassem.lisp b/src/compiler/target-disassem.lisp
index 4cf3ecd..00e2749 100644
--- a/src/compiler/target-disassem.lisp
+++ b/src/compiler/target-disassem.lisp
@@ -1001,6 +1001,22 @@
:alignment alignment
:byte-order sb!c:*backend-byte-order*)))
+;;; Put PROPERTY into the set of instruction properties in DSTATE.
+;;; PROPERTY can be a fixnum or symbol, but any given backend
+;;; must exclusively use one or the other property representation.
+(defun dstate-setprop (dstate property)
+ (if (fixnump property)
+ (setf (dstate-inst-properties dstate)
+ (logior (or (dstate-inst-properties dstate) 0) property))
+ (push property (dstate-inst-properties dstate))))
+
+;;; Return non-NIL if PROPERTY is in the set of instruction properties in
+;;; DSTATE. As with -PUT-INST-PROP, we can have a bitmask or a plist.
+(defun dstate-getprop (dstate property)
+ (if (fixnump property)
+ (logtest (or (dstate-inst-properties dstate) 0) property)
+ (memq property (dstate-inst-properties dstate))))
+
(defun add-fun-header-hooks (segment)
(declare (type segment segment))
(dotimes (i (or (awhen (seg-code segment) (code-n-entries it)) 0))
diff --git a/src/compiler/x86-64/insts.lisp b/src/compiler/x86-64/insts.lisp
index 1c44e17..4ce76ea 100644
--- a/src/compiler/x86-64/insts.lisp
+++ b/src/compiler/x86-64/insts.lisp
@@ -72,40 +72,6 @@
(defconstant +rex-x+ #b0010)
(defconstant +rex-b+ #b0001)
-;;; Return the operand size depending on the prefixes and width bit as
-;;; stored in DSTATE.
-(defun inst-operand-size (dstate)
- (declare (type disassem-state dstate))
- (cond ((dstate-get-inst-prop dstate +operand-size-8+) :byte)
- ((dstate-get-inst-prop dstate +rex-w+) :qword)
- ((dstate-get-inst-prop dstate +operand-size-16+) :word)
- (t +default-operand-size+)))
-
-;;; The same as INST-OPERAND-SIZE, but for those instructions (e.g.
-;;; PUSH, JMP) that have a default operand size of :qword. It can only
-;;; be overwritten to :word.
-(defun inst-operand-size-default-qword (dstate)
- (declare (type disassem-state dstate))
- (if (dstate-get-inst-prop dstate +operand-size-16+) :word :qword))
-
-;;; This prefilter is used solely for its side effect, namely to put
-;;; the property OPERAND-SIZE-8 into the DSTATE if VALUE is 0.
-(defun prefilter-width (dstate value)
- (declare (type bit value) (type disassem-state dstate))
- (when (zerop value)
- (dstate-put-inst-prop dstate +operand-size-8+))
- value)
-
-;;; A register field that can be extended by REX.R.
-(defun prefilter-reg-r (dstate value)
- (declare (type reg value) (type disassem-state dstate))
- (if (dstate-get-inst-prop dstate +rex-r+) (+ value 8) value))
-
-;;; A register field that can be extended by REX.B.
-(defun prefilter-reg-b (dstate value)
- (declare (type reg value) (type disassem-state dstate))
- (if (dstate-get-inst-prop dstate +rex-b+) (+ value 8) value))
-
(defun width-bits (width)
(ecase width
(:byte 8)
@@ -119,17 +85,16 @@
;;; Used to capture the lower four bits of the REX prefix all at once ...
(define-arg-type wrxb
:prefilter (lambda (dstate value)
- (dstate-put-inst-prop dstate (logior +rex+ (logand value #b1111)))
+ (dstate-setprop dstate (logior +rex+ (logand value #b1111)))
value))
;;; ... or individually (not needed for REX.R and REX.X).
;;; They are always used together, so only the first one sets the REX property.
(define-arg-type rex-w
:prefilter (lambda (dstate value)
- (dstate-put-inst-prop dstate
- (logior +rex+ (if (plusp value) +rex-w+ 0)))))
+ (dstate-setprop dstate (logior +rex+ (if (plusp value) +rex-w+ 0)))))
(define-arg-type rex-b
:prefilter (lambda (dstate value)
- (dstate-put-inst-prop dstate (if (plusp value) +rex-b+ 0))))
+ (dstate-setprop dstate (if (plusp value) +rex-b+ 0))))
(define-arg-type width
:prefilter #'prefilter-width
@@ -142,7 +107,7 @@
(define-arg-type x66
:prefilter (lambda (dstate junk)
(declare (ignore junk))
- (dstate-put-inst-prop dstate +operand-size-16+)))
+ (dstate-setprop dstate +operand-size-16+)))
;;; Find the Lisp object, if any, called by a "CALL rel32offs"
;;; instruction format and add it as an end-of-line comment,
@@ -190,7 +155,7 @@
;;; The exception is that opcode group 0xB8 .. 0xBF allows a :qword immediate.
(define-arg-type signed-imm-data
:prefilter (lambda (dstate &aux (width (inst-operand-size dstate)))
- (when (and (not (dstate-get-inst-prop dstate +allow-qword-imm+))
+ (when (and (not (dstate-getprop dstate +allow-qword-imm+))
(eq width :qword))
(setf width :dword))
(read-signed-suffix (width-bits width) dstate))
@@ -1493,7 +1458,7 @@
(define-instruction mov (segment dst src)
;; immediate to register
(:printer reg ((op #b1011 :prefilter (lambda (dstate value)
- (dstate-put-inst-prop dstate +allow-qword-imm+)
+ (dstate-setprop dstate +allow-qword-imm+)
value))
(imm nil :type 'signed-imm-data/asm-routine))
'(:name :tab reg ", " imm))
diff --git a/src/compiler/x86-64/target-insts.lisp b/src/compiler/x86-64/target-insts.lisp
index 712cc8a..99d67bf 100644
--- a/src/compiler/x86-64/target-insts.lisp
+++ b/src/compiler/x86-64/target-insts.lisp
@@ -15,6 +15,40 @@
(in-package "SB!X86-64-ASM")
+;;; Return the operand size depending on the prefixes and width bit as
+;;; stored in DSTATE.
+(defun inst-operand-size (dstate)
+ (declare (type disassem-state dstate))
+ (cond ((dstate-getprop dstate +operand-size-8+) :byte)
+ ((dstate-getprop dstate +rex-w+) :qword)
+ ((dstate-getprop dstate +operand-size-16+) :word)
+ (t +default-operand-size+)))
+
+;;; The same as INST-OPERAND-SIZE, but for those instructions (e.g.
+;;; PUSH, JMP) that have a default operand size of :qword. It can only
+;;; be overwritten to :word.
+(defun inst-operand-size-default-qword (dstate)
+ (declare (type disassem-state dstate))
+ (if (dstate-getprop dstate +operand-size-16+) :word :qword))
+
+;;; This prefilter is used solely for its side effect, namely to put
+;;; the property OPERAND-SIZE-8 into the DSTATE if VALUE is 0.
+(defun prefilter-width (dstate value)
+ (declare (type bit value) (type disassem-state dstate))
+ (when (zerop value)
+ (dstate-setprop dstate +operand-size-8+))
+ value)
+
+;;; A register field that can be extended by REX.R.
+(defun prefilter-reg-r (dstate value)
+ (declare (type reg value) (type disassem-state dstate))
+ (if (dstate-getprop dstate +rex-r+) (+ value 8) value))
+
+;;; A register field that can be extended by REX.B.
+(defun prefilter-reg-b (dstate value)
+ (declare (type reg value) (type disassem-state dstate))
+ (if (dstate-getprop dstate +rex-b+) (+ value 8) value))
+
(defstruct (machine-ea (:include sb!disassem::filtered-arg)
(:copier nil)
(:predicate nil)
@@ -31,7 +65,7 @@
(type disassem-state dstate))
(princ (if (and (eq width :byte)
(<= 4 value 7)
- (not (dstate-get-inst-prop dstate +rex+)))
+ (not (dstate-getprop dstate +rex+)))
(aref #("AH" "CH" "DH" "BH") (- value 4))
(aref (ecase width
(:byte sb!vm::+byte-register-names+)
@@ -59,7 +93,7 @@
;; Avoid use of INST-OPERAND-SIZE because it's wrong for this type of operand.
(defun print-d/q-word-reg (value stream dstate)
(print-reg-with-width value
- (if (dstate-get-inst-prop dstate +rex-w+) :qword :dword)
+ (if (dstate-getprop dstate +rex-w+) :qword :dword)
stream
dstate))
@@ -148,8 +182,7 @@
(#b01 (read-signed-suffix 8 dstate))
(#b10 (read-signed-suffix 32 dstate))))
(extend (bit-name reg)
- (logior (if (dstate-get-inst-prop dstate bit-name) 8 0)
- reg)))
+ (logior (if (dstate-getprop dstate bit-name) 8 0) reg)))
(declare (inline extend))
(let ((full-reg (extend +rex-b+ r/m)))
(cond ((= mod #b11) full-reg) ; register direct mode
diff --git a/src/compiler/x86/insts.lisp b/src/compiler/x86/insts.lisp
index 4c57578..8749f03 100644
--- a/src/compiler/x86/insts.lisp
+++ b/src/compiler/x86/insts.lisp
@@ -46,20 +46,6 @@
;;; instruction, must be set by prefilters, and contain a single bit of
;;; data each (presence/absence).
-;;; Return the operand size based on the prefixes and width bit from
-;;; the dstate.
-(defun inst-operand-size (dstate)
- (declare (type disassem-state dstate))
- (cond ((dstate-get-inst-prop dstate 'operand-size-8) :byte)
- ((dstate-get-inst-prop dstate 'operand-size-16) :word)
- (t +default-operand-size+)))
-
-;;; Return the operand size for a "word-sized" operand based on the
-;;; prefixes from the dstate.
-(defun inst-word-operand-size (dstate)
- (declare (type disassem-state dstate))
- (if (dstate-get-inst-prop dstate 'operand-size-16) :word :dword))
-
;;; Returns either an integer, meaning a register, or a list of
;;; (BASE-REG OFFSET INDEX-REG INDEX-SCALE), where any component
;;; may be missing or nil to indicate that it's not used or has the
@@ -103,16 +89,6 @@
(t ; (= mod #b10)
(list r/m (read-signed-suffix 32 dstate)))))
-
-;;; This is a sort of bogus prefilter that just stores the info globally for
-;;; other people to use; it probably never gets printed.
-(defun prefilter-width (dstate value)
- (declare (type bit value)
- (type disassem-state dstate))
- (when (zerop value)
- (dstate-put-inst-prop dstate 'operand-size-8))
- value)
-
(defun width-bits (width)
(ecase width
(:byte 8)
@@ -223,14 +199,14 @@
(define-arg-type x66
:prefilter (lambda (dstate junk)
(declare (ignore junk))
- (dstate-put-inst-prop dstate 'operand-size-16)))
+ (dstate-setprop dstate 'operand-size-16)))
;;; Used to capture the effect of the #x64 and #x65 segment override
;;; prefixes.
(define-arg-type seg
:prefilter (lambda (dstate value)
(declare (type bit value))
- (dstate-put-inst-prop
+ (dstate-setprop
dstate (elt '(fs-segment-prefix gs-segment-prefix) value))))
(defconstant-eqx +conditions+
diff --git a/src/compiler/x86/target-insts.lisp b/src/compiler/x86/target-insts.lisp
index 1bec5a5..c2f4b4f 100644
--- a/src/compiler/x86/target-insts.lisp
+++ b/src/compiler/x86/target-insts.lisp
@@ -15,6 +15,28 @@
(in-package "SB!X86-ASM")
+;;; Return the operand size based on the prefixes and width bit from
+;;; the dstate.
+(defun inst-operand-size (dstate)
+ (declare (type disassem-state dstate))
+ (cond ((dstate-getprop dstate 'operand-size-8) :byte)
+ ((dstate-getprop dstate 'operand-size-16) :word)
+ (t +default-operand-size+)))
+
+;;; Return the operand size for a "word-sized" operand based on the
+;;; prefixes from the dstate.
+(defun inst-word-operand-size (dstate)
+ (declare (type disassem-state dstate))
+ (if (dstate-getprop dstate 'operand-size-16) :word :dword))
+
+;;; This is a sort of bogus prefilter that just stores the info globally for
+;;; other people to use; it probably never gets printed.
+(defun prefilter-width (dstate value)
+ (declare (type bit value) (type disassem-state dstate))
+ (when (zerop value)
+ (dstate-setprop dstate 'operand-size-8))
+ value)
+
(defun print-reg-with-width (value width stream dstate)
(declare (ignore dstate))
(princ (aref (ecase width
@@ -97,9 +119,9 @@
(princ16 value stream))
(defun maybe-print-segment-override (stream dstate)
- (cond ((dstate-get-inst-prop dstate 'fs-segment-prefix)
+ (cond ((dstate-getprop dstate 'fs-segment-prefix)
(princ "FS:" stream))
- ((dstate-get-inst-prop dstate 'gs-segment-prefix)
+ ((dstate-getprop dstate 'gs-segment-prefix)
(princ "GS:" stream))))
(defun print-mem-access (value stream print-size-p dstate)
-----------------------------------------------------------------------
hooks/post-receive
--
SBCL
|