From: Nathan Froyd Date: Sun, 27 Sep 2009 01:18:47 +0000 (+0000) Subject: 1.0.31.22: improved SAP-{REF,SET}-* for x86-64 X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;ds=inline;h=7be799a096f8be64365dfd5b566f667f9ea0314a;p=sbcl.git 1.0.31.22: improved SAP-{REF,SET}-* for x86-64 - Don't go through RAX in reffers; zero- or sign-extend the memory referenced into the result register directly. Specialized array references already do this. - Don't go through RAX in setters; use the appropriately-sized low part of the value register directly. --- diff --git a/src/compiler/x86-64/sap.lisp b/src/compiler/x86-64/sap.lisp index 02aba44..b255b07 100644 --- a/src/compiler/x86-64/sap.lisp +++ b/src/compiler/x86-64/sap.lisp @@ -158,13 +158,12 @@ (macrolet ((def-system-ref-and-set (ref-name set-name + ref-insn sc type - size - &optional signed) + size) (let ((ref-name-c (symbolicate ref-name "-C")) - (set-name-c (symbolicate set-name "-C")) - (temp-sc (symbolicate size "-REG"))) + (set-name-c (symbolicate set-name "-C"))) `(progn (define-vop (,ref-name) (:translate ,ref-name) @@ -172,19 +171,11 @@ (:args (sap :scs (sap-reg)) (offset :scs (signed-reg))) (:arg-types system-area-pointer signed-num) - ,@(unless (eq size :qword) - `((:temporary (:sc ,temp-sc - :from (:eval 0) - :to (:eval 1)) - temp))) (:results (result :scs (,sc))) (:result-types ,type) (:generator 5 - (inst mov ,(if (eq size :qword) 'result 'temp) - (make-ea ,size :base sap :index offset)) - ,@(unless (eq size :qword) - `((inst ,(if signed 'movsx 'movzx) - result temp))))) + (inst ,ref-insn result + (make-ea ,size :base sap :index offset)))) (define-vop (,ref-name-c) (:translate ,ref-name) (:policy :fast-safe) @@ -192,90 +183,56 @@ (:arg-types system-area-pointer (:constant (signed-byte 32))) (:info offset) - ,@(unless (eq size :qword) - `((:temporary (:sc ,temp-sc - :from (:eval 0) - :to (:eval 1)) - temp))) (:results (result :scs (,sc))) (:result-types ,type) (:generator 4 - (inst mov ,(if (eq size :qword) 'result 'temp) - (make-ea ,size :base sap :disp offset)) - ,@(unless (eq size :qword) - `((inst ,(if signed 'movsx 'movzx) - result temp))))) + (inst ,ref-insn result + (make-ea ,size :base sap :disp offset)))) (define-vop (,set-name) (:translate ,set-name) (:policy :fast-safe) (:args (sap :scs (sap-reg) :to (:eval 0)) (offset :scs (signed-reg) :to (:eval 0)) - (value :scs (,sc) - :target ,(if (eq size :qword) - 'result - 'temp))) + (value :scs (,sc) :target result)) (:arg-types system-area-pointer signed-num ,type) - ,@(unless (eq size :qword) - `((:temporary (:sc ,temp-sc :offset rax-offset - :from (:argument 2) :to (:result 0) - :target result) - temp))) (:results (result :scs (,sc))) (:result-types ,type) (:generator 5 - ,@(unless (eq size :qword) - `((move rax-tn value))) - (inst mov (make-ea ,size - :base sap - :index offset) - ,(if (eq size :qword) 'value 'temp)) - (move result - ,(if (eq size :qword) 'value 'rax-tn)))) + (inst mov (make-ea ,size :base sap :index offset) + (reg-in-size value ,size)) + (move result value))) (define-vop (,set-name-c) (:translate ,set-name) (:policy :fast-safe) (:args (sap :scs (sap-reg) :to (:eval 0)) - (value :scs (,sc) - :target ,(if (eq size :qword) - 'result - 'temp))) + (value :scs (,sc) :target result)) (:arg-types system-area-pointer (:constant (signed-byte 32)) ,type) (:info offset) - ,@(unless (eq size :qword) - `((:temporary (:sc ,temp-sc :offset rax-offset - :from (:argument 2) :to (:result 0) - :target result) - temp))) (:results (result :scs (,sc))) (:result-types ,type) (:generator 4 - ,@(unless (eq size :qword) - `((move rax-tn value))) - (inst mov - (make-ea ,size :base sap :disp offset) - ,(if (eq size :qword) 'value 'temp)) - (move result ,(if (eq size :qword) - 'value - 'rax-tn)))))))) + (inst mov (make-ea ,size :base sap :disp offset) + (reg-in-size value ,size)) + (move result value))))))) - (def-system-ref-and-set sap-ref-8 %set-sap-ref-8 - unsigned-reg positive-fixnum :byte nil) - (def-system-ref-and-set signed-sap-ref-8 %set-signed-sap-ref-8 - signed-reg tagged-num :byte t) - (def-system-ref-and-set sap-ref-16 %set-sap-ref-16 - unsigned-reg positive-fixnum :word nil) - (def-system-ref-and-set signed-sap-ref-16 %set-signed-sap-ref-16 - signed-reg tagged-num :word t) - (def-system-ref-and-set sap-ref-32 %set-sap-ref-32 - unsigned-reg unsigned-num :dword nil) - (def-system-ref-and-set signed-sap-ref-32 %set-signed-sap-ref-32 - signed-reg signed-num :dword t) - (def-system-ref-and-set sap-ref-64 %set-sap-ref-64 - unsigned-reg unsigned-num :qword nil) - (def-system-ref-and-set signed-sap-ref-64 %set-signed-sap-ref-64 - signed-reg signed-num :qword t) - (def-system-ref-and-set sap-ref-sap %set-sap-ref-sap + (def-system-ref-and-set sap-ref-8 %set-sap-ref-8 movzx + unsigned-reg positive-fixnum :byte) + (def-system-ref-and-set signed-sap-ref-8 %set-signed-sap-ref-8 movsx + signed-reg tagged-num :byte) + (def-system-ref-and-set sap-ref-16 %set-sap-ref-16 movzx + unsigned-reg positive-fixnum :word) + (def-system-ref-and-set signed-sap-ref-16 %set-signed-sap-ref-16 movsx + signed-reg tagged-num :word) + (def-system-ref-and-set sap-ref-32 %set-sap-ref-32 movzxd + unsigned-reg unsigned-num :dword) + (def-system-ref-and-set signed-sap-ref-32 %set-signed-sap-ref-32 movsxd + signed-reg signed-num :dword) + (def-system-ref-and-set sap-ref-64 %set-sap-ref-64 mov + unsigned-reg unsigned-num :qword) + (def-system-ref-and-set signed-sap-ref-64 %set-signed-sap-ref-64 mov + signed-reg signed-num :qword) + (def-system-ref-and-set sap-ref-sap %set-sap-ref-sap mov sap-reg system-area-pointer :qword)) ;;;; SAP-REF-DOUBLE diff --git a/src/compiler/x86-64/vm.lisp b/src/compiler/x86-64/vm.lisp index ce60198..63af4f9 100644 --- a/src/compiler/x86-64/vm.lisp +++ b/src/compiler/x86-64/vm.lisp @@ -19,8 +19,8 @@ (eval-when (:compile-toplevel :load-toplevel :execute) (defvar *byte-register-names* (make-array 32 :initial-element nil)) - (defvar *word-register-names* (make-array 16 :initial-element nil)) - (defvar *dword-register-names* (make-array 16 :initial-element nil)) + (defvar *word-register-names* (make-array 32 :initial-element nil)) + (defvar *dword-register-names* (make-array 32 :initial-element nil)) (defvar *qword-register-names* (make-array 32 :initial-element nil)) (defvar *float-register-names* (make-array 16 :initial-element nil))) @@ -82,7 +82,16 @@ (defreg bp 10 :word) (defreg si 12 :word) (defreg di 14 :word) - (defregset *word-regs* ax cx dx bx si di) + (defreg r8w 16 :word) + (defreg r9w 18 :word) + (defreg r10w 20 :word) + (defreg r11w 22 :word) + (defreg r12w 24 :word) + (defreg r13w 26 :word) + (defreg r14w 28 :word) + (defreg r15w 30 :word) + (defregset *word-regs* ax cx dx bx si di r8w r9w r10w + #+nil r11w #+nil r12w r13w r14w r15w) ;; double word registers (defreg eax 0 :dword) @@ -93,7 +102,16 @@ (defreg ebp 10 :dword) (defreg esi 12 :dword) (defreg edi 14 :dword) - (defregset *dword-regs* eax ecx edx ebx esi edi) + (defreg r8d 16 :dword) + (defreg r9d 18 :dword) + (defreg r10d 20 :dword) + (defreg r11d 22 :dword) + (defreg r12d 24 :dword) + (defreg r13d 26 :dword) + (defreg r14d 28 :dword) + (defreg r15d 30 :dword) + (defregset *dword-regs* eax ecx edx ebx esi edi r8d r9d r10d + #+nil r11d #+nil r12w r13d r14d r15d) ;; quadword registers (defreg rax 0 :qword) @@ -397,14 +415,26 @@ (def-misc-reg-tns unsigned-reg rax rbx rcx rdx rbp rsp rdi rsi r8 r9 r10 r11 r12 r13 r14 r15) - (def-misc-reg-tns dword-reg eax ebx ecx edx ebp esp edi esi) - (def-misc-reg-tns word-reg ax bx cx dx bp sp di si) + (def-misc-reg-tns dword-reg eax ebx ecx edx ebp esp edi esi + r8d r9d r10d r11d r12d r13d r14d r15d) + (def-misc-reg-tns word-reg ax bx cx dx bp sp di si + r8w r9w r10w r11w r12w r13w r14w r15w) (def-misc-reg-tns byte-reg al cl dl bl sil dil r8b r9b r10b r11b r12b r13b r14b r15b) (def-misc-reg-tns single-reg float0 float1 float2 float3 float4 float5 float6 float7 float8 float9 float10 float11 float12 float13 float14 float15)) +(defun reg-in-size (tn size) + (make-random-tn :kind :normal + :sc (sc-or-lose + (ecase size + (:byte 'byte-reg) + (:word 'word-reg) + (:dword 'dword-reg) + (:qword 'unsigned-reg))) + :offset (tn-offset tn))) + ;; A register that's never used by the code generator, and can therefore ;; be used as an assembly temporary in cases where a VOP :TEMPORARY can't ;; be used. diff --git a/version.lisp-expr b/version.lisp-expr index 0edc72d..a2b2aa3 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"1.0.31.21" +"1.0.31.22"