X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86%2Finsts.lisp;h=aef17c5cb8f2a2fb3e4ff52f0512c4353bc728c7;hb=70c40b1892a606163d0f60ac7b20093724e8e5e5;hp=e5373bd6275f2a0d4fe7a7146e8b91815deb1439;hpb=65bdee4ba534e82c352cff3eec16473daaf285dd;p=sbcl.git

diff --git a/src/compiler/x86/insts.lisp b/src/compiler/x86/insts.lisp
index e5373bd..aef17c5 100644
--- a/src/compiler/x86/insts.lisp
+++ b/src/compiler/x86/insts.lisp
@@ -48,13 +48,11 @@
 ;;; correctly in all cases, so we copy the x86-64 version which at
 ;;; least can handle the code output by the compiler.
 ;;;
-;;; Width information for an instruction is stored as an inst-prop on
-;;; the dstate.  The inst-props are cleared automatically after each
-;;; instruction, must be set by prefilters, and contain a single bit
-;;; of data each (presence/absence).  As such, each instruction that
-;;; can emit an operand-size prefix (x66 prefix) needs to have a set
-;;; of printers declared for both the prefixed and non-prefixed
-;;; encodings.
+;;; Width information for an instruction and whether a segment
+;;; override prefix was seen is stored as an inst-prop on the dstate.
+;;; The inst-props are cleared automatically after each non-prefix
+;;; 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.
@@ -154,6 +152,12 @@
   (declare (ignore dstate))
   (sb!disassem:princ16 value stream))
 
+(defun maybe-print-segment-override (stream dstate)
+  (cond ((sb!disassem:dstate-get-inst-prop dstate 'fs-segment-prefix)
+         (princ "FS:" stream))
+        ((sb!disassem:dstate-get-inst-prop dstate 'gs-segment-prefix)
+         (princ "GS:" stream))))
+
 ;;; 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
@@ -218,6 +222,16 @@
            (type sb!disassem:disassem-state dstate))
   (sb!disassem:dstate-put-inst-prop dstate 'operand-size-16))
 
+;;; This prefilter is used solely for its side effect, namely to put
+;;; one of the properties [FG]S-SEGMENT-PREFIX into the DSTATE.
+;;; Unlike PREFILTER-X66, this prefilter only catches the low bit of
+;;; the prefix byte.
+(defun prefilter-seg (value dstate)
+  (declare (type bit value)
+           (type sb!disassem:disassem-state dstate))
+  (sb!disassem:dstate-put-inst-prop
+   dstate (elt '(fs-segment-prefix gs-segment-prefix) value)))
+
 (defun read-address (value dstate)
   (declare (ignore value))              ; always nil anyway
   (sb!disassem:read-suffix (width-bits *default-address-size*) dstate))
@@ -349,6 +363,11 @@
 (sb!disassem:define-arg-type x66
   :prefilter #'prefilter-x66)
 
+;;; Used to capture the effect of the #x64 and #x65 segment override
+;;; prefixes.
+(sb!disassem:define-arg-type seg
+  :prefilter #'prefilter-seg)
+
 (eval-when (:compile-toplevel :load-toplevel :execute)
 (defparameter *conditions*
   '((:o . 0)
@@ -405,6 +424,10 @@
 (sb!disassem:define-instruction-format (x66 8)
   (x66   :field (byte 8 0) :type 'x66 :value #x66))
 
+(sb!disassem:define-instruction-format (seg 8)
+  (seg   :field (byte 7 1) :value #x32)
+  (fsgs  :field (byte 1 0) :type 'seg))
+
 (sb!disassem:define-instruction-format (simple 8)
   (op    :field (byte 7 1))
   (width :field (byte 1 0) :type 'width)
@@ -965,6 +988,16 @@
     (:gs
      (emit-byte segment #x65))))
 
+(define-instruction fs (segment)
+  (:printer seg ((fsgs #b0)) nil :print-name nil)
+  (:emitter
+   (bug "FS prefix used as a standalone instruction")))
+
+(define-instruction gs (segment)
+  (:printer seg ((fsgs #b1)) nil :print-name nil)
+  (:emitter
+   (bug "GS prefix used as a standalone instruction")))
+
 (define-instruction lock (segment)
   (:printer byte ((op #b11110000)) nil)
   (:emitter
@@ -1186,16 +1219,6 @@
    (emit-byte segment #xf3)
    (emit-byte segment #x90)))
 
-(define-instruction fs-segment-prefix (segment)
-  (:printer byte ((op #b01100100)))
-  (:emitter
-   (bug "FS emitted as a separate instruction!")))
-
-(define-instruction gs-segment-prefix (segment)
-  (:printer byte ((op #b01100101)))
-  (:emitter
-   (bug "GS emitted as a separate instruction!")))
-
 ;;;; flag control instructions
 
 ;;; CLC -- Clear Carry Flag.
@@ -1598,7 +1621,8 @@
 (eval-when (:compile-toplevel :execute)
   (defun double-shift-inst-printer-list (op)
     `((ext-reg-reg/mem ((op ,(logior op #b10)) (width 0)
-                        (imm nil :type signed-imm-byte)))
+                        (imm nil :type signed-imm-byte))
+         (:name :tab reg/mem ", " reg ", " imm))
       (ext-reg-reg/mem ((op ,(logior op #b10)) (width 1))
          (:name :tab reg/mem ", " reg ", " 'cl)))))
 
@@ -2860,8 +2884,8 @@
     (values label (make-ea size
                            :disp (make-fixup nil :code-object label)))))
 
-(defun emit-constant-segment-header (constants optimize)
-  (declare (ignore constants))
+(defun emit-constant-segment-header (segment constants optimize)
+  (declare (ignore segment constants))
   (loop repeat (if optimize 64 16) do (inst byte #x90)))
 
 (defun size-nbyte (size)