1 ;;;; x86 definition of character operations
3 ;;;; This software is part of the SBCL system. See the README file for
6 ;;;; This software is derived from the CMU CL system, which was
7 ;;;; written at Carnegie Mellon University and released into the
8 ;;;; public domain. The software is in the public domain and is
9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
10 ;;;; files for more information.
14 ;;;; moves and coercions
16 ;;; Move a tagged char to an untagged representation.
17 (define-vop (move-to-character)
18 (:args (x :scs (any-reg control-stack) :target al))
19 (:temporary (:sc byte-reg :offset al-offset
20 :from (:argument 0) :to (:eval 0)) al)
22 (:temporary (:sc byte-reg :offset ah-offset :target y
23 :from (:argument 0) :to (:result 0)) ah)
24 (:results (y :scs (character-reg character-stack)))
25 (:note "character untagging")
29 (define-move-vop move-to-character :move
30 (any-reg control-stack) (character-reg character-stack))
32 ;;; Move an untagged char to a tagged representation.
33 (define-vop (move-from-character)
34 (:args (x :scs (character-reg character-stack) :target ah))
35 (:temporary (:sc byte-reg :offset al-offset :target y
36 :from (:argument 0) :to (:result 0)) al)
37 (:temporary (:sc byte-reg :offset ah-offset
38 :from (:argument 0) :to (:result 0)) ah)
39 (:results (y :scs (any-reg descriptor-reg control-stack)))
40 (:note "character tagging")
42 (move ah x) ; Maybe move char byte.
43 (inst mov al character-widetag) ; x86 to type bits
44 (inst and eax-tn #xffff) ; Remove any junk bits.
46 (define-move-vop move-from-character :move
47 (character-reg character-stack) (any-reg descriptor-reg control-stack))
49 ;;; Move untagged character values.
50 (define-vop (character-move)
53 :load-if (not (location= x y))))
54 (:results (y :scs (character-reg character-stack)
55 :load-if (not (location= x y))))
56 (:note "character move")
61 (define-move-vop character-move :move
62 (character-reg) (character-reg character-stack))
64 ;;; Move untagged character arguments/return-values.
65 (define-vop (move-character-arg)
69 :load-if (not (sc-is y character-reg))))
71 (:note "character arg move")
78 (make-ea :byte :base fp :disp (- (* (1+ (tn-offset y)) 4)))
80 (define-move-vop move-character-arg :move-arg
81 (any-reg character-reg) (character-reg))
83 ;;; Use standard MOVE-ARG + coercion to move an untagged character
84 ;;; to a descriptor passing location.
85 (define-move-vop move-arg :move-arg
86 (character-reg) (any-reg descriptor-reg))
90 (define-vop (char-code)
91 (:translate char-code)
93 (:args (ch :scs (character-reg character-stack)))
94 (:arg-types character)
95 (:results (res :scs (unsigned-reg)))
96 (:result-types positive-fixnum)
100 (define-vop (code-char)
101 (:translate code-char)
103 (:args (code :scs (unsigned-reg unsigned-stack) :target eax))
104 (:arg-types positive-fixnum)
105 (:temporary (:sc unsigned-reg :offset eax-offset :target res
106 :from (:argument 0) :to (:result 0))
108 (:results (res :scs (character-reg)))
109 (:result-types character)
114 ;;; comparison of CHARACTERs
115 (define-vop (character-compare)
116 (:args (x :scs (character-reg character-stack))
117 (y :scs (character-reg)
118 :load-if (not (and (sc-is x character-reg)
119 (sc-is y character-stack)))))
120 (:arg-types character character)
124 (:note "inline comparison")
125 (:variant-vars condition not-condition)
128 (inst jmp (if not-p not-condition condition) target)))
130 (define-vop (fast-char=/character character-compare)
134 (define-vop (fast-char</character character-compare)
138 (define-vop (fast-char>/character character-compare)
142 (define-vop (character-compare/c)
143 (:args (x :scs (character-reg character-stack)))
144 (:arg-types character (:constant character))
146 (:info target not-p y)
148 (:note "inline constant comparison")
149 (:variant-vars condition not-condition)
151 (inst cmp x (sb!xc:char-code y))
152 (inst jmp (if not-p not-condition condition) target)))
154 (define-vop (fast-char=/character/c character-compare/c)
158 (define-vop (fast-char</character/c character-compare/c)
162 (define-vop (fast-char>/character/c character-compare/c)