X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86%2Fchar.lisp;h=f44f3275aab6690b407e20c3447714a3a0da6d34;hb=40e3ba03d0e1b824e4d1ae75d74246b975b70964;hp=9b8d2c00c200122fe0e53495873da63350ec985e;hpb=63817d29028c8551cda23f432a3328acd7fdd62f;p=sbcl.git diff --git a/src/compiler/x86/char.lisp b/src/compiler/x86/char.lisp index 9b8d2c0..f44f327 100644 --- a/src/compiler/x86/char.lisp +++ b/src/compiler/x86/char.lisp @@ -14,45 +14,72 @@ ;;;; moves and coercions ;;; Move a tagged char to an untagged representation. +#!+sb-unicode +(define-vop (move-to-character) + (:args (x :scs (any-reg descriptor-reg) :target y + :load-if (not (location= x y)))) + (:results (y :scs (character-reg) + :load-if (not (location= x y)))) + (:note "character untagging") + (:generator 1 + (move y x) + (inst shr y n-widetag-bits))) +#!-sb-unicode (define-vop (move-to-character) (:args (x :scs (any-reg control-stack) :target al)) (:temporary (:sc byte-reg :offset al-offset - :from (:argument 0) :to (:eval 0)) al) + :from (:argument 0) :to (:eval 0)) al) (:ignore al) (:temporary (:sc byte-reg :offset ah-offset :target y - :from (:argument 0) :to (:result 0)) ah) + :from (:argument 0) :to (:result 0)) ah) (:results (y :scs (character-reg character-stack))) (:note "character untagging") (:generator 1 (move eax-tn x) (move y ah))) (define-move-vop move-to-character :move - (any-reg control-stack) (character-reg character-stack)) + (any-reg #!-sb-unicode control-stack) + (character-reg #!-sb-unicode character-stack)) ;;; Move an untagged char to a tagged representation. +#!+sb-unicode +(define-vop (move-from-character) + (:args (x :scs (character-reg))) + (: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)) + (inst or y character-widetag))) +#!-sb-unicode (define-vop (move-from-character) (:args (x :scs (character-reg character-stack) :target ah)) (:temporary (:sc byte-reg :offset al-offset :target y - :from (:argument 0) :to (:result 0)) al) + :from (:argument 0) :to (:result 0)) al) (:temporary (:sc byte-reg :offset ah-offset - :from (:argument 0) :to (:result 0)) ah) + :from (:argument 0) :to (:result 0)) ah) (:results (y :scs (any-reg descriptor-reg control-stack))) (:note "character tagging") (:generator 1 - (move ah x) ; Maybe move char byte. - (inst mov al character-widetag) ; x86 to type bits - (inst and eax-tn #xffff) ; Remove any junk bits. + (move ah x) ; Maybe move char byte. + (inst mov al character-widetag) ; x86 to type bits + (inst and eax-tn #xffff) ; Remove any junk bits. (move y eax-tn))) (define-move-vop move-from-character :move - (character-reg character-stack) (any-reg descriptor-reg control-stack)) + (character-reg #!-sb-unicode character-stack) + (any-reg descriptor-reg #!-sb-unicode control-stack)) ;;; Move untagged character values. (define-vop (character-move) (:args (x :target y - :scs (character-reg) - :load-if (not (location= x y)))) + :scs (character-reg) + :load-if (not (location= x y)))) (:results (y :scs (character-reg character-stack) - :load-if (not (location= x y)))) + :load-if (not (location= x y)))) (:note "character move") (:effects) (:affected) @@ -64,9 +91,9 @@ ;;; Move untagged character arguments/return-values. (define-vop (move-character-arg) (:args (x :target y - :scs (character-reg)) - (fp :scs (any-reg) - :load-if (not (sc-is y character-reg)))) + :scs (character-reg)) + (fp :scs (any-reg) + :load-if (not (sc-is y character-reg)))) (:results (y)) (:note "character arg move") (:generator 0 @@ -74,9 +101,14 @@ (character-reg (move y x)) (character-stack + #!-sb-unicode (inst mov - (make-ea :byte :base fp :disp (- (* (1+ (tn-offset y)) 4))) - x))))) + (make-ea :byte :base fp :disp (- (* (1+ (tn-offset y)) 4))) + x) + #!+sb-unicode + (if (= (tn-offset fp) esp-offset) + (storew x fp (tn-offset y)) ; c-call + (storew x fp (- (1+ (tn-offset y))))))))) (define-move-vop move-character-arg :move-arg (any-reg character-reg) (character-reg)) @@ -95,16 +127,30 @@ (:results (res :scs (unsigned-reg))) (:result-types positive-fixnum) (:generator 1 - (inst movzx res ch))) + #!-sb-unicode + (inst movzx res ch) + #!+sb-unicode + (inst mov res ch))) +#!+sb-unicode +(define-vop (code-char) + (:translate code-char) + (:policy :fast-safe) + (:args (code :scs (unsigned-reg unsigned-stack))) + (:arg-types positive-fixnum) + (:results (res :scs (character-reg))) + (:result-types character) + (:generator 1 + (inst mov res code))) +#!-sb-unicode (define-vop (code-char) (:translate code-char) (:policy :fast-safe) (:args (code :scs (unsigned-reg unsigned-stack) :target eax)) (:arg-types positive-fixnum) (:temporary (:sc unsigned-reg :offset eax-offset :target res - :from (:argument 0) :to (:result 0)) - eax) + :from (:argument 0) :to (:result 0)) + eax) (:results (res :scs (character-reg))) (:result-types character) (:generator 1 @@ -114,9 +160,9 @@ ;;; comparison of CHARACTERs (define-vop (character-compare) (:args (x :scs (character-reg character-stack)) - (y :scs (character-reg) - :load-if (not (and (sc-is x character-reg) - (sc-is y character-stack))))) + (y :scs (character-reg) + :load-if (not (and (sc-is x character-reg) + (sc-is y character-stack))))) (:arg-types character character) (:conditional) (:info target not-p)