1.0.21.34: fix build on x86/x86-64 lutex platforms

[sbcl.git] / src / compiler / x86 / insts.lisp

diff --git a/src/compiler/x86/insts.lisp b/src/compiler/x86/insts.lisp
index 132224e..e312795 100644 (file)
--- a/src/compiler/x86/insts.lisp
+++ b/src/compiler/x86/insts.lisp
@@ -378,6 +378,10 @@
   (accum :type 'accum)
   (imm))
 
+(sb!disassem:define-instruction-format (two-bytes 16
+                                        :default-printer '(:name))
+  (op :fields (list (byte 8 0) (byte 8 8))))
+
 ;;; Same as simple, but with direction bit
 (sb!disassem:define-instruction-format (simple-dir 8 :include 'simple)
   (op :field (byte 6 2))
@@ -896,10 +900,27 @@
      (emit-word segment value))
     (:dword
      (emit-dword segment value))))
+
+(defun toggle-word-width (chunk inst stream dstate)
+  (declare (ignore chunk inst stream))
+  (let ((word-width (or (sb!disassem:dstate-get-prop dstate 'word-width)
+                        +default-operand-size+)))
+    (setf (sb!disassem:dstate-get-prop dstate 'word-width)
+          (ecase word-width
+            (:word :dword)
+            (:dword :word)))))
+
+;;; This is a "prefix" instruction, which means that it modifies the
+;;; following instruction in some way without having an actual
+;;; mnemonic of its own.
+(define-instruction operand-size-prefix (segment)
+  (:printer byte ((op +operand-size-prefix-byte+))
+            nil                         ; don't actually print it
+            :control #'toggle-word-width))
 \f
 ;;;; general data transfer
 
-(define-instruction mov (segment dst src)
+(define-instruction mov (segment dst src &optional prefix)
   ;; immediate to register
   (:printer reg ((op #b1011) (imm nil :type 'imm-data))
             '(:name :tab reg ", " imm))
@@ -912,6 +933,7 @@
   (:printer reg/mem-imm ((op '(#b1100011 #b000))))
 
   (:emitter
+   (emit-prefix segment prefix)
    (let ((size (matching-operand-size dst src)))
      (maybe-emit-operand-size-prefix segment size)
      (cond ((register-p dst)
@@ -983,7 +1005,7 @@
   (:printer ext-reg-reg/mem ((op #b1011011) (reg nil :type 'word-reg)))
   (:emitter (emit-move-with-extension segment dst src #b10110110)))
 
-(define-instruction push (segment src)
+(define-instruction push (segment src &optional prefix)
   ;; register
   (:printer reg-no-width ((op #b01010)))
   ;; register/memory
@@ -996,6 +1018,7 @@
   ;; ### segment registers?
 
   (:emitter
+   (emit-prefix segment prefix)
    (cond ((integerp src)
           (cond ((<= -128 src 127)
                  (emit-byte segment #b01101010)
@@ -1075,11 +1098,12 @@
    (emit-byte segment #b10001101)
    (emit-ea segment src (reg-tn-encoding dst))))
 
-(define-instruction cmpxchg (segment dst src)
+(define-instruction cmpxchg (segment dst src &optional prefix)
   ;; Register/Memory with Register.
   (:printer ext-reg-reg/mem ((op #b1011000)) '(:name :tab reg/mem ", " reg))
   (:emitter
    (aver (register-p src))
+   (emit-prefix segment prefix)
    (let ((size (matching-operand-size src dst)))
      (maybe-emit-operand-size-prefix segment size)
      (emit-byte segment #b00001111)
@@ -1087,16 +1111,26 @@
      (emit-ea segment dst (reg-tn-encoding src)))))
 
 \f
+(defun emit-prefix (segment name)
+  (ecase name
+    ((nil))
+    (:lock
+     #!+sb-thread
+     (emit-byte segment #xf0))
+    (:fs
+     (emit-byte segment #x64))
+    (:gs
+     (emit-byte segment #x65))))
 
 (define-instruction fs-segment-prefix (segment)
   (:printer byte ((op #b01100100)))
   (:emitter
-   (emit-byte segment #x64)))
+   (bug "FS emitted as a separate instruction!")))
 
 (define-instruction gs-segment-prefix (segment)
   (:printer byte ((op #b01100101)))
   (:emitter
-   (emit-byte segment #x65)))
+   (bug "GS emitted as a separate instruction!")))
 
 ;;;; flag control instructions
 
@@ -1169,7 +1203,7 @@
 ;;;; arithmetic
 
 (defun emit-random-arith-inst (name segment dst src opcode
-                                    &optional allow-constants)
+                               &optional allow-constants)
   (let ((size (matching-operand-size dst src)))
     (maybe-emit-operand-size-prefix segment size)
     (cond
@@ -1214,25 +1248,31 @@
       (reg-reg/mem-dir ((op ,(dpb subop (byte 3 1) #b000000))))))
   )
 
-(define-instruction add (segment dst src)
+(define-instruction add (segment dst src &optional prefix)
   (:printer-list (arith-inst-printer-list #b000))
-  (:emitter (emit-random-arith-inst "ADD" segment dst src #b000)))
+  (:emitter
+   (emit-prefix segment prefix)
+   (emit-random-arith-inst "ADD" segment dst src #b000)))
 
 (define-instruction adc (segment dst src)
   (:printer-list (arith-inst-printer-list #b010))
   (:emitter (emit-random-arith-inst "ADC" segment dst src #b010)))
 
-(define-instruction sub (segment dst src)
+(define-instruction sub (segment dst src &optional prefix)
   (:printer-list (arith-inst-printer-list #b101))
-  (:emitter (emit-random-arith-inst "SUB" segment dst src #b101)))
+  (:emitter
+   (emit-prefix segment prefix)
+   (emit-random-arith-inst "SUB" segment dst src #b101)))
 
 (define-instruction sbb (segment dst src)
   (:printer-list (arith-inst-printer-list #b011))
   (:emitter (emit-random-arith-inst "SBB" segment dst src #b011)))
 
-(define-instruction cmp (segment dst src)
+(define-instruction cmp (segment dst src &optional prefix)
   (:printer-list (arith-inst-printer-list #b111))
-  (:emitter (emit-random-arith-inst "CMP" segment dst src #b111 t)))
+  (:emitter
+   (emit-prefix segment prefix)
+   (emit-random-arith-inst "CMP" segment dst src #b111 t)))
 
 (define-instruction inc (segment dst)
   ;; Register.
@@ -1389,11 +1429,12 @@
    (maybe-emit-operand-size-prefix segment :dword)
    (emit-byte segment #b10011001)))
 
-(define-instruction xadd (segment dst src)
+(define-instruction xadd (segment dst src &optional prefix)
   ;; Register/Memory with Register.
   (:printer ext-reg-reg/mem ((op #b1100000)) '(:name :tab reg/mem ", " reg))
   (:emitter
    (aver (register-p src))
+   (emit-prefix segment prefix)
    (let ((size (matching-operand-size src dst)))
      (maybe-emit-operand-size-prefix segment size)
      (emit-byte segment #b00001111)
@@ -1563,16 +1604,18 @@
     (t
      (inst test x y))))
 
-(define-instruction or (segment dst src)
+(define-instruction or (segment dst src &optional prefix)
   (:printer-list
    (arith-inst-printer-list #b001))
   (:emitter
+   (emit-prefix segment prefix)
    (emit-random-arith-inst "OR" segment dst src #b001)))
 
-(define-instruction xor (segment dst src)
+(define-instruction xor (segment dst src &optional prefix)
   (:printer-list
    (arith-inst-printer-list #b110))
   (:emitter
+   (emit-prefix segment prefix)
    (emit-random-arith-inst "XOR" segment dst src #b110)))
 
 (define-instruction not (segment dst)
@@ -2050,10 +2093,12 @@
   (:emitter
    (emit-byte segment #b10011011)))
 
+;;; FIXME: It would be better to make the disassembler understand the prefix as part
+;;; of the instructions...
 (define-instruction lock (segment)
   (:printer byte ((op #b11110000)))
   (:emitter
-   (emit-byte segment #b11110000)))
+   (bug "LOCK prefix used as a standalone instruction")))
 \f
 ;;;; miscellaneous hackery
 
@@ -2714,3 +2759,17 @@
   (:emitter
    (emit-byte segment #b11011001)
    (emit-byte segment #b11101101)))
+
+;;;; Miscellany
+
+(define-instruction cpuid (segment)
+  (:printer two-bytes ((op '(#b00001111 #b10100010))))
+  (:emitter
+   (emit-byte segment #b00001111)
+   (emit-byte segment #b10100010)))
+
+(define-instruction rdtsc (segment)
+  (:printer two-bytes ((op '(#b00001111 #b00110001))))
+  (:emitter
+   (emit-byte segment #b00001111)
+   (emit-byte segment #b00110001)))