X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86-64%2Finsts.lisp;h=ae0f2b8caaa8bce05cfa1c90ff267eb62e2faabc;hb=71d9292d4c2627c4d76b763443be759f95423c2c;hp=614071106707fade9d608d8cbd5b65ccdbacbb6f;hpb=b66385e2031fc2cac17dd129df0af400beb48a22;p=sbcl.git diff --git a/src/compiler/x86-64/insts.lisp b/src/compiler/x86-64/insts.lisp index 6140711..ae0f2b8 100644 --- 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 @@ -1052,6 +1056,14 @@ :default-printer '(:name :tab code)) (op :field (byte 8 0)) (code :field (byte 8 8))) + +;;; Two byte instruction with an immediate byte argument. +;;; +(sb!disassem:define-instruction-format (word-imm 24 + :default-printer '(:name :tab code)) + (op :field (byte 16 0)) + (code :field (byte 8 16))) + ;;;; primitive emitters @@ -1222,7 +1234,7 @@ (emit-mod-reg-r/m-byte segment #b11 reg (reg-tn-encoding thing))) (stack ;; Convert stack tns into an index off RBP. - (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)) @@ -1802,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) @@ -1815,11 +1828,6 @@ (emit-ea segment dst (reg-tn-encoding src))))) - -(define-instruction fs-segment-prefix (segment) - (:emitter - (emit-byte segment #x64))) - ;;;; flag control instructions ;;; CLC -- Clear Carry Flag. @@ -1948,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)) @@ -2129,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) @@ -2389,7 +2400,7 @@ (define-instruction rep (segment) (:emitter - (emit-byte segment #b11110010))) + (emit-byte segment #b11110011))) (define-instruction repe (segment) (:printer byte ((op #b11110011))) @@ -2495,8 +2506,8 @@ (- (label-position where) (+ posn 4)))))) (fixup - (emit-byte segment #b11101000) - (emit-relative-fixup segment where)) + ;; There is no CALL rel64... + (error "Cannot CALL a fixup: ~S" where)) (t (maybe-emit-rex-for-ea segment where nil :operand-size :do-not-set) (emit-byte segment #b11111111) @@ -2567,23 +2578,18 @@ (emit-byte segment #b11111111) (emit-ea segment where #b100))))) -(define-instruction jmp-short (segment label) - (:emitter - (emit-byte segment #b11101011) - (emit-byte-displacement-backpatch segment label))) - (define-instruction ret (segment &optional stack-delta) (:printer byte ((op #b11000011))) (:printer byte ((op #b11000010) (imm nil :type 'imm-word-16)) '(:name :tab imm)) (:emitter - (cond (stack-delta + (cond ((and stack-delta (not (zerop stack-delta))) (emit-byte segment #b11000010) (emit-word segment stack-delta)) (t (emit-byte segment #b11000011))))) -(define-instruction jecxz (segment target) +(define-instruction jrcxz (segment target) (:printer short-jump ((op #b0011))) (:emitter (emit-byte segment #b11100011) @@ -2695,7 +2701,8 @@ ;; Lisp (with (DESCRIBE 'BYTE-IMM-CODE)) than to definitively deduce ;; from first principles whether it's defined in some way that genesis ;; can't grok. - (case (byte-imm-code chunk dstate) + (case #!-darwin (byte-imm-code chunk dstate) + #!+darwin (word-imm-code chunk dstate) (#.error-trap (nt "error trap") (sb!disassem:handle-break-args #'snarf-error-junk stream dstate)) @@ -2717,10 +2724,17 @@ (define-instruction break (segment code) (:declare (type (unsigned-byte 8) code)) - (:printer byte-imm ((op #b11001100)) '(:name :tab code) - :control #'break-control) - (:emitter - (emit-byte segment #b11001100) + #!-darwin (:printer byte-imm ((op #b11001100)) '(:name :tab code) + :control #'break-control) + #!+darwin (:printer word-imm ((op #b0000101100001111)) '(:name :tab code) + :control #'break-control) + (:emitter + #!-darwin (emit-byte segment #b11001100) + ;; On darwin, trap handling via SIGTRAP is unreliable, therefore we + ;; throw a sigill with 0x0b0f instead and check for this in the + ;; SIGILL handler and pass it on to the sigtrap handler if + ;; appropriate + #!+darwin (emit-word segment #b0000101100001111) (emit-byte segment code))) (define-instruction int (segment number) @@ -2756,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"))) ;;;; miscellaneous hackery @@ -2956,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)))