1 ;;;; the PPC VM 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 descriptor-reg
)))
19 (:results
(y :scs
(character-reg)))
20 (:note
"character untagging")
22 (inst srwi y x n-widetag-bits
)))
23 (define-move-vop move-to-character
:move
24 (any-reg descriptor-reg
) (character-reg))
26 ;;; Move an untagged char to a tagged representation.
27 (define-vop (move-from-character)
28 (:args
(x :scs
(character-reg)))
29 (:results
(y :scs
(any-reg descriptor-reg
)))
30 (:note
"character tagging")
32 (inst slwi y x n-widetag-bits
)
33 (inst ori y y character-widetag
)))
34 (define-move-vop move-from-character
:move
35 (character-reg) (any-reg descriptor-reg
))
37 ;;; Move untagged character values.
38 (define-vop (character-move)
41 :load-if
(not (location= x y
))))
42 (:results
(y :scs
(character-reg)
43 :load-if
(not (location= x y
))))
44 (:note
"character move")
47 (define-move-vop character-move
:move
48 (character-reg) (character-reg))
50 ;;; Move untagged character arguments/return-values.
51 (define-vop (move-character-arg)
55 :load-if
(not (sc-is y character-reg
))))
57 (:note
"character arg move")
63 (storew x fp
(tn-offset y
))))))
64 (define-move-vop move-character-arg
:move-arg
65 (any-reg character-reg
) (character-reg))
67 ;;; Use standard MOVE-ARG + coercion to move an untagged character
68 ;;; to a descriptor passing location.
69 (define-move-vop move-arg
:move-arg
70 (character-reg) (any-reg descriptor-reg
))
72 ;;;; Other operations:
74 (define-vop (char-code)
75 (:translate char-code
)
77 (:args
(ch :scs
(character-reg) :target res
))
78 (:arg-types character
)
79 (:results
(res :scs
(any-reg)))
80 (:result-types positive-fixnum
)
82 (inst slwi res ch n-fixnum-tag-bits
)))
84 (define-vop (code-char)
85 (:translate code-char
)
87 (:args
(code :scs
(any-reg) :target res
))
88 (:arg-types positive-fixnum
)
89 (:results
(res :scs
(character-reg)))
90 (:result-types character
)
92 (inst srwi res code n-fixnum-tag-bits
)))
94 ;;; Comparison of characters.
95 (define-vop (character-compare)
96 (:args
(x :scs
(character-reg))
97 (y :scs
(character-reg)))
98 (:arg-types character character
)
102 (:note
"inline comparison")
103 (:variant-vars condition not-condition
)
106 (inst b?
(if not-p not-condition condition
) target
)))
108 (define-vop (fast-char=/character character-compare
)
112 (define-vop (fast-char</character character-compare
)
116 (define-vop (fast-char>/character character-compare
)
120 (define-vop (character-compare/c
)
121 (:args
(x :scs
(character-reg)))
122 (:arg-types character
(:constant
(character-set ((0 .
#xFFFF
)))))
124 (:info target not-p y
)
126 (:note
"inline comparison")
127 (:variant-vars condition not-condition
)
129 (inst cmplwi x
(char-code y
))
130 (inst b?
(if not-p not-condition condition
) target
)))
132 (define-vop (fast-char=/character
/c character-compare
/c
)
136 (define-vop (fast-char</character
/c character-compare
/c
)
140 (define-vop (fast-char>/character
/c character-compare
/c
)