From: Nathan Froyd Date: Tue, 10 Apr 2007 01:20:24 +0000 (+0000) Subject: 1.0.4.53: Apply Lutz Euler's improved character VOPs patch X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=fb2d70782a537348895f6a04f257d1f1fcc7942d;p=sbcl.git 1.0.4.53: Apply Lutz Euler's improved character VOPs patch --- diff --git a/src/compiler/x86-64/char.lisp b/src/compiler/x86-64/char.lisp index 68657ac..3b2307e 100644 --- a/src/compiler/x86-64/char.lisp +++ b/src/compiler/x86-64/char.lisp @@ -1,4 +1,4 @@ -;;;; x86 definition of character operations +;;;; x86-64 definition of character operations ;;;; This software is part of the SBCL system. See the README file for ;;;; more information. @@ -11,6 +11,11 @@ (in-package "SB!VM") +;;; Space optimization: As the upper 32 bits of (tagged or untagged) +;;; characters are always zero many operations can be done on 32-bit +;;; registers. This often leads to smaller encodings as the REX prefix +;;; is then only needed if registers R8 - R15 are used. + ;;;; moves and coercions ;;; Move a tagged char to an untagged representation. @@ -22,8 +27,9 @@ :load-if (not (location= x y)))) (:note "character untagging") (:generator 1 - (move y x) - (inst shr y n-widetag-bits))) + (let ((y-dword (make-dword-tn y))) + (move y-dword (make-dword-tn x)) + (inst shr y-dword n-widetag-bits)))) #!-sb-unicode (define-vop (move-to-character) (:args (x :scs (any-reg control-stack))) @@ -44,12 +50,15 @@ ;;; Move an untagged char to a tagged representation. #!+sb-unicode (define-vop (move-from-character) - (:args (x :scs (character-reg))) + (:args (x :scs (character-reg) :target y)) (:results (y :scs (any-reg descriptor-reg))) (:note "character tagging") (:generator 1 - (inst imul y x (ash 1 n-widetag-bits)) - (inst or y character-widetag))) + (let ((y-dword (make-dword-tn y))) + (unless (location= x y) + (inst mov y-dword (make-dword-tn x))) + (inst shl y-dword n-widetag-bits) + (inst or y-dword character-widetag)))) #!-sb-unicode (define-vop (move-from-character) (:args (x :scs (character-reg character-stack))) @@ -117,7 +126,8 @@ (define-vop (char-code) (:translate char-code) (:policy :fast-safe) - (:args (ch :scs (character-reg character-stack))) + (:args #!-sb-unicode (ch :scs (character-reg character-stack)) + #!+sb-unicode (ch :scs (character-reg character-stack) :target res)) (:arg-types character) (:results (res :scs (unsigned-reg))) (:result-types positive-fixnum) @@ -125,18 +135,18 @@ #!-sb-unicode (inst movzx res ch) #!+sb-unicode - (inst mov res ch))) + (move res ch))) #!+sb-unicode (define-vop (code-char) (:translate code-char) (:policy :fast-safe) - (:args (code :scs (unsigned-reg unsigned-stack))) + (:args (code :scs (unsigned-reg unsigned-stack) :target res)) (:arg-types positive-fixnum) (:results (res :scs (character-reg))) (:result-types character) (:generator 1 - (inst mov res code))) + (move res code))) #!-sb-unicode (define-vop (code-char) (:translate code-char) diff --git a/src/compiler/x86-64/move.lisp b/src/compiler/x86-64/move.lisp index a5de78c..1a5279c 100644 --- a/src/compiler/x86-64/move.lisp +++ b/src/compiler/x86-64/move.lisp @@ -11,6 +11,19 @@ (in-package "SB!VM") +(defun make-byte-tn (tn) + (aver (sc-is tn any-reg descriptor-reg unsigned-reg signed-reg)) + (make-random-tn :kind :normal + :sc (sc-or-lose 'byte-reg) + :offset (tn-offset tn))) + +(defun make-dword-tn (tn) + (aver (sc-is tn any-reg descriptor-reg character-reg + unsigned-reg signed-reg)) + (make-random-tn :kind :normal + :sc (sc-or-lose 'dword-reg) + :offset (tn-offset tn))) + (defun zeroize (tn) (let ((offset (tn-offset tn))) ;; Using the 32-bit instruction accomplishes the same thing and is diff --git a/src/compiler/x86-64/type-vops.lisp b/src/compiler/x86-64/type-vops.lisp index a68121f..43b838c 100644 --- a/src/compiler/x86-64/type-vops.lisp +++ b/src/compiler/x86-64/type-vops.lisp @@ -1,4 +1,4 @@ -;;;; type testing and checking VOPs for the x86 VM +;;;; type testing and checking VOPs for the x86-64 VM ;;;; This software is part of the SBCL system. See the README file for ;;;; more information. @@ -13,18 +13,6 @@ ;;;; test generation utilities -(defun make-byte-tn (tn) - (aver (sc-is tn any-reg descriptor-reg unsigned-reg signed-reg)) - (make-random-tn :kind :normal - :sc (sc-or-lose 'byte-reg) - :offset (tn-offset tn))) - -(defun make-dword-tn (tn) - (aver (sc-is tn any-reg descriptor-reg unsigned-reg signed-reg)) - (make-random-tn :kind :normal - :sc (sc-or-lose 'dword-reg) - :offset (tn-offset tn))) - (defun generate-fixnum-test (value) "zero flag set if VALUE is fixnum" (inst test diff --git a/src/compiler/x86-64/vm.lisp b/src/compiler/x86-64/vm.lisp index 76577a6..98d0f9b 100644 --- a/src/compiler/x86-64/vm.lisp +++ b/src/compiler/x86-64/vm.lisp @@ -229,8 +229,8 @@ ;; the non-descriptor stacks ;; XXX alpha backend has :element-size 2 :alignment 2 in these entries - (signed-stack stack) ; (signed-byte 32) - (unsigned-stack stack) ; (unsigned-byte 32) + (signed-stack stack) ; (signed-byte 64) + (unsigned-stack stack) ; (unsigned-byte 64) (character-stack stack) ; non-descriptor characters. (sap-stack stack) ; System area pointers. (single-stack stack) ; single-floats @@ -276,6 +276,8 @@ (character-reg registers :locations #!-sb-unicode #.*byte-regs* #!+sb-unicode #.*qword-regs* + #!+sb-unicode #!+sb-unicode + :element-size 2 #!-sb-unicode #!-sb-unicode :reserve-locations (#.al-offset) :constant-scs (immediate) diff --git a/src/compiler/x86/char.lisp b/src/compiler/x86/char.lisp index d4fcfce..39cb78a 100644 --- a/src/compiler/x86/char.lisp +++ b/src/compiler/x86/char.lisp @@ -44,16 +44,12 @@ ;;; Move an untagged char to a tagged representation. #!+sb-unicode (define-vop (move-from-character) - (:args (x :scs (character-reg))) + (:args (x :scs (character-reg) :target y)) (:results (y :scs (any-reg descriptor-reg))) (:note "character tagging") (:generator 1 - ;; FIXME: is this inefficient? Is there a better way of writing - ;; it? (fixnum tagging is done with LEA). We can't use SHL - ;; because we either scribble over the source register or briefly - ;; have a non-descriptor in a descriptor register, unless we - ;; introduce a temporary. - (inst imul y x (ash 1 n-widetag-bits)) + (move y x) + (inst shl y n-widetag-bits) (inst or y character-widetag))) #!-sb-unicode (define-vop (move-from-character) @@ -124,7 +120,8 @@ (define-vop (char-code) (:translate char-code) (:policy :fast-safe) - (:args (ch :scs (character-reg character-stack))) + (:args #!-sb-unicode (ch :scs (character-reg character-stack)) + #!+sb-unicode (ch :scs (character-reg character-stack) :target res)) (:arg-types character) (:results (res :scs (unsigned-reg))) (:result-types positive-fixnum) @@ -132,18 +129,18 @@ #!-sb-unicode (inst movzx res ch) #!+sb-unicode - (inst mov res ch))) + (move res ch))) #!+sb-unicode (define-vop (code-char) (:translate code-char) (:policy :fast-safe) - (:args (code :scs (unsigned-reg unsigned-stack))) + (:args (code :scs (unsigned-reg unsigned-stack) :target res)) (:arg-types positive-fixnum) (:results (res :scs (character-reg))) (:result-types character) (:generator 1 - (inst mov res code))) + (move res code))) #!-sb-unicode (define-vop (code-char) (:translate code-char) diff --git a/src/compiler/x86/vm.lisp b/src/compiler/x86/vm.lisp index d0a9a41..1b080bc 100644 --- a/src/compiler/x86/vm.lisp +++ b/src/compiler/x86/vm.lisp @@ -232,6 +232,8 @@ (character-reg registers :locations #!-sb-unicode #.*byte-regs* #!+sb-unicode #.*dword-regs* + #!+sb-unicode #!+sb-unicode + :element-size 2 #!-sb-unicode #!-sb-unicode :reserve-locations (#.ah-offset #.al-offset) :constant-scs (immediate) diff --git a/version.lisp-expr b/version.lisp-expr index bdb5493..cf0a988 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.4.52" +"1.0.4.53"