X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86%2Fchar.lisp;h=023067891ea3fe92e590cfa4cdd814f1cce1a863;hb=d306e2d23b38487488eb93881dad836e439e0c77;hp=f44f3275aab6690b407e20c3447714a3a0da6d34;hpb=0d871fd7a98fc4af92a8b942a1154761466ad8c9;p=sbcl.git diff --git a/src/compiler/x86/char.lisp b/src/compiler/x86/char.lisp index f44f327..0230678 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) @@ -103,12 +99,14 @@ (character-stack #!-sb-unicode (inst mov - (make-ea :byte :base fp :disp (- (* (1+ (tn-offset y)) 4))) + ;; 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 (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) @@ -164,47 +163,40 @@ :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))