1.0.24.12: adding and fixing the HPUX/HPPA build target

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

diff --git a/src/compiler/x86-64/insts.lisp b/src/compiler/x86-64/insts.lisp
index 3f0c6f0..ec48990 100644 (file)
--- a/src/compiler/x86-64/insts.lisp
+++ b/src/compiler/x86-64/insts.lisp
@@ -542,6 +542,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))))
+
 ;;; A one-byte instruction with a #x66 prefix, used to indicate an
 ;;; operand size of :word.
 (sb!disassem:define-instruction-format (x66-byte 16
@@ -1810,11 +1814,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)
      (maybe-emit-rex-for-ea segment dst src)
@@ -1823,11 +1828,6 @@
      (emit-ea segment dst (reg-tn-encoding src)))))
 
 \f
-
-(define-instruction fs-segment-prefix (segment)
-  (:emitter
-   (emit-byte segment #x64)))
-
 ;;;; flag control instructions
 
 ;;; CLC -- Clear Carry Flag.
@@ -1956,9 +1956,11 @@
       (rex-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))
@@ -2137,11 +2139,12 @@
    (maybe-emit-rex-prefix segment :qword nil nil nil)
    (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)
      (maybe-emit-rex-for-ea segment dst src)
@@ -2767,10 +2770,20 @@
   (:emitter
    (emit-byte segment #b10011011)))
 
+(defun emit-prefix (segment name)
+  (declare (ignorable segment))
+  (ecase name
+    ((nil))
+    (:lock
+     #!+sb-thread
+     (emit-byte segment #xf0))))
+
+;;; 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
 
@@ -2967,3 +2980,17 @@
    (emit-byte segment #x0f)
    (emit-byte segment #xae)
    (emit-ea segment dst 3)))
+
+;;;; 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)))