X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86%2Fchar.lisp;h=023067891ea3fe92e590cfa4cdd814f1cce1a863;hb=d306e2d23b38487488eb93881dad836e439e0c77;hp=15a53a44df9a8f23f1698d164354c563a050eda2;hpb=3c65762b927af861c9c8bc416e4cbac9a14ec0c3;p=sbcl.git diff --git a/src/compiler/x86/char.lisp b/src/compiler/x86/char.lisp index 15a53a4..0230678 100644 --- a/src/compiler/x86/char.lisp +++ b/src/compiler/x86/char.lisp @@ -14,127 +14,189 @@ ;;;; moves and coercions ;;; Move a tagged char to an untagged representation. -(define-vop (move-to-base-char) +#!+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) - (:results (y :scs (base-char-reg base-char-stack))) + :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-base-char :move - (any-reg control-stack) (base-char-reg base-char-stack)) +(define-move-vop move-to-character :move + (any-reg #!-sb-unicode control-stack) + (character-reg #!-sb-unicode character-stack)) ;;; Move an untagged char to a tagged representation. -(define-vop (move-from-base-char) - (:args (x :scs (base-char-reg base-char-stack) :target ah)) +#!+sb-unicode +(define-vop (move-from-character) + (:args (x :scs (character-reg) :target y)) + (:results (y :scs (any-reg descriptor-reg))) + (:note "character tagging") + (:generator 1 + (move y x) + (inst shl y 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 base-char-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-base-char :move - (base-char-reg base-char-stack) (any-reg descriptor-reg control-stack)) +(define-move-vop move-from-character :move + (character-reg #!-sb-unicode character-stack) + (any-reg descriptor-reg #!-sb-unicode control-stack)) -;;; Move untagged base-char values. -(define-vop (base-char-move) +;;; Move untagged character values. +(define-vop (character-move) (:args (x :target y - :scs (base-char-reg) - :load-if (not (location= x y)))) - (:results (y :scs (base-char-reg base-char-stack) - :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)))) (:note "character move") (:effects) (:affected) (:generator 0 (move y x))) -(define-move-vop base-char-move :move - (base-char-reg) (base-char-reg base-char-stack)) +(define-move-vop character-move :move + (character-reg) (character-reg character-stack)) -;;; Move untagged base-char arguments/return-values. -(define-vop (move-base-char-argument) +;;; Move untagged character arguments/return-values. +(define-vop (move-character-arg) (:args (x :target y - :scs (base-char-reg)) - (fp :scs (any-reg) - :load-if (not (sc-is y base-char-reg)))) + :scs (character-reg)) + (fp :scs (any-reg) + :load-if (not (sc-is y character-reg)))) (:results (y)) (:note "character arg move") (:generator 0 (sc-case y - (base-char-reg + (character-reg (move y x)) - (base-char-stack + (character-stack + #!-sb-unicode (inst mov - (make-ea :byte :base fp :disp (- (* (1+ (tn-offset y)) 4))) - x))))) -(define-move-vop move-base-char-argument :move-argument - (any-reg base-char-reg) (base-char-reg)) + ;; XXX: If the sb-unicode case needs to handle c-call, + ;; why does the non-unicode case not need to? + (make-ea :byte :base fp :disp (frame-byte-offset (tn-offset y))) + x) + #!+sb-unicode + (if (= (tn-offset fp) esp-offset) + (storew x fp (tn-offset y)) ; c-call + (storew x fp (frame-word-offset (tn-offset y)))))))) +(define-move-vop move-character-arg :move-arg + (any-reg character-reg) (character-reg)) -;;; Use standard MOVE-ARGUMENT + coercion to move an untagged base-char +;;; Use standard MOVE-ARG + coercion to move an untagged character ;;; to a descriptor passing location. -(define-move-vop move-argument :move-argument - (base-char-reg) (any-reg descriptor-reg)) +(define-move-vop move-arg :move-arg + (character-reg) (any-reg descriptor-reg)) ;;;; other operations (define-vop (char-code) (:translate char-code) (:policy :fast-safe) - (:args (ch :scs (base-char-reg base-char-stack))) - (:arg-types base-char) + (: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) (:generator 1 - (inst movzx res ch))) + #!-sb-unicode + (inst movzx res ch) + #!+sb-unicode + (move res ch))) +#!+sb-unicode +(define-vop (code-char) + (:translate code-char) + (:policy :fast-safe) + (:args (code :scs (unsigned-reg unsigned-stack) :target res)) + (:arg-types positive-fixnum) + (:results (res :scs (character-reg))) + (:result-types character) + (:generator 1 + (move 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) - (:results (res :scs (base-char-reg))) - (:result-types base-char) + :from (:argument 0) :to (:result 0)) + eax) + (:results (res :scs (character-reg))) + (:result-types character) (:generator 1 (move eax code) (move res al-tn))) -;;; comparison of BASE-CHARs -(define-vop (base-char-compare) - (:args (x :scs (base-char-reg base-char-stack)) - (y :scs (base-char-reg) - :load-if (not (and (sc-is x base-char-reg) - (sc-is y base-char-stack))))) - (:arg-types base-char base-char) - (:conditional) - (:info target not-p) +;;; 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))))) + (:arg-types character character) (:policy :fast-safe) (:note "inline comparison") - (:variant-vars condition not-condition) (:generator 3 - (inst cmp x y) - (inst jmp (if not-p not-condition condition) target))) + (inst cmp x y))) + +(define-vop (fast-char=/character character-compare) + (:translate char=) + (:conditional :e)) + +(define-vop (fast-char/character character-compare) + (:translate char>) + (:conditional :a)) + +(define-vop (character-compare/c) + (:args (x :scs (character-reg character-stack))) + (:arg-types character (:constant character)) + (:info y) + (:policy :fast-safe) + (:note "inline constant comparison") + (:generator 2 + (inst cmp x (sb!xc:char-code y)))) -(define-vop (fast-char=/base-char base-char-compare) +(define-vop (fast-char=/character/c character-compare/c) (:translate char=) - (:variant :e :ne)) + (:conditional :e)) -(define-vop (fast-char/base-char base-char-compare) +(define-vop (fast-char>/character/c character-compare/c) (:translate char>) - (:variant :a :na)) + (:conditional :a))