-;;;; 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.
(in-package "SB!VM")
\f
+;;; 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.
: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)))
;;; 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)))
(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)
#!-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)
(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
-;;;; 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.
\f
;;;; 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
;; 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
(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)
;;; 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)
(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)
#!-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)
(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)
;;; 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"
projects / sbcl.git / commitdiff