X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86%2Finsts.lisp;h=e31279537f1c83f7b335a3af488401021a21ebbf;hb=2f492b2a39b1361e1dd97d5243bc47238b98ca8f;hp=1f4c432843e23dbbf06ea4bbd146b327bfffb1c1;hpb=0f234877047c56ca945fe54e9e77a9cc2c8141cb;p=sbcl.git diff --git a/src/compiler/x86/insts.lisp b/src/compiler/x86/insts.lisp index 1f4c432..e312795 100644 --- 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)) @@ -728,7 +732,7 @@ (emit-mod-reg-r/m-byte segment #b11 reg (reg-tn-encoding thing))) (stack ;; Convert stack tns into an index off of EBP. - (let ((disp (- (* (1+ (tn-offset thing)) n-word-bytes)))) + (let ((disp (frame-byte-offset (tn-offset thing)))) (cond ((<= -128 disp 127) (emit-mod-reg-r/m-byte segment #b01 reg #b101) (emit-byte segment disp)) @@ -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)) ;;;; 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,10 +1111,26 @@ (emit-ea segment dst (reg-tn-encoding src))))) +(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 + (bug "GS emitted as a separate instruction!"))) ;;;; flag control instructions @@ -1163,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 @@ -1208,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. @@ -1383,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) @@ -1557,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) @@ -2044,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"))) ;;;; miscellaneous hackery @@ -2708,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)))