X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86-64%2Finsts.lisp;h=ec48990a2a04a7497632ac9996eb0ee2bd8764a7;hb=dcd86042bba514f5dfc39246de9cdbb030648569;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..ec48990 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 @@ -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) @@ -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,11 +2578,6 @@ (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)) @@ -2583,7 +2589,7 @@ (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)))