1 ;;;; the HPPA 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 (:note "character untagging")
19 (:args (x :scs (any-reg descriptor-reg)))
20 (:results (y :scs (character-reg)))
22 (inst srl x n-widetag-bits y)))
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 (:note "character tagging")
29 (:args (x :scs (character-reg)))
30 (:results (y :scs (any-reg descriptor-reg)))
32 (inst sll x n-widetag-bits y)
33 (inst addi character-widetag y y)))
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)
39 (:note "character move")
42 :load-if (not (location= x y))))
43 (:results (y :scs (character-reg)
44 :load-if (not (location= x y))))
49 (define-move-vop character-move :move
50 (character-reg) (character-reg))
52 ;;; Move untagged character args/return-values.
53 (define-vop (move-character-arg)
54 (:note "character arg move")
58 :load-if (not (sc-is y character-reg))))
65 (storew x fp (tn-offset y))))))
66 (define-move-vop move-character-arg :move-arg
67 (any-reg character-reg) (character-reg))
69 ;;; Use standard MOVE-ARG + coercion to move an untagged character to
70 ;;; a descriptor passing location.
71 (define-move-vop move-arg :move-arg
72 (character-reg) (any-reg descriptor-reg))
74 ;;;; Other operations:
75 (define-vop (char-code)
76 (:translate char-code)
78 (:args (ch :scs (character-reg) :target res))
79 (:arg-types character)
80 (:results (res :scs (any-reg)))
81 (:result-types positive-fixnum)
85 (define-vop (code-char)
86 (:translate code-char)
88 (:args (code :scs (any-reg) :target res))
89 (:arg-types positive-fixnum)
90 (:results (res :scs (character-reg)))
91 (:result-types character)
93 (inst srl code 2 res)))
95 ;;; Comparison of characters.
96 (define-vop (character-compare)
97 (:args (x :scs (character-reg))
98 (y :scs (character-reg)))
99 (:arg-types character character)
103 (:note "inline comparison")
106 (inst bc cond not-p x y 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)