X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86%2Fchar.lisp;h=023067891ea3fe92e590cfa4cdd814f1cce1a863;hb=d6f9676ae94419cb5544c45821a8d31adbc1fbe8;hp=c0ee1444127d3413ca4eb76a956f326a1093c1da;hpb=bf27595fb567015495b7131707cc85af361567fe;p=sbcl.git diff --git a/src/compiler/x86/char.lisp b/src/compiler/x86/char.lisp index c0ee144..0230678 100644 --- a/src/compiler/x86/char.lisp +++ b/src/compiler/x86/char.lisp @@ -28,10 +28,10 @@ (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 @@ -44,30 +44,26 @@ ;;; 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) (: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 #!-sb-unicode character-stack) @@ -76,10 +72,10 @@ ;;; 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) @@ -91,9 +87,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 @@ -103,12 +99,14 @@ (character-stack #!-sb-unicode (inst mov - (make-ea :byte :base fp :disp (- (* (1+ (tn-offset y)) 4))) - x) + ;; 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 (- (1+ (tn-offset y))))))))) + (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)) @@ -122,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) @@ -130,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) @@ -149,8 +148,8 @@ (: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 @@ -160,51 +159,44 @@ ;;; 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) (: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=) - (:variant :e :ne)) + (:conditional :e)) (define-vop (fast-char/character character-compare) (:translate char>) - (:variant :a :na)) + (:conditional :a)) (define-vop (character-compare/c) (:args (x :scs (character-reg character-stack))) (:arg-types character (:constant character)) - (:conditional) - (:info target not-p y) + (:info y) (:policy :fast-safe) (:note "inline constant comparison") - (:variant-vars condition not-condition) (:generator 2 - (inst cmp x (sb!xc:char-code y)) - (inst jmp (if not-p not-condition condition) target))) + (inst cmp x (sb!xc:char-code y)))) (define-vop (fast-char=/character/c character-compare/c) (:translate char=) - (:variant :e :ne)) + (:conditional :e)) (define-vop (fast-char/character/c character-compare/c) (:translate char>) - (:variant :a :na)) + (:conditional :a))