2 ;;; Written by Rob MacLachlan
3 ;;; Converted for the MIPS R2000 by Christopher Hoover.
4 ;;; And then to the SPARC by William Lott.
10 ;;;; Moves and coercions:
12 ;;; Move a tagged char to an untagged representation.
14 (define-vop (move-to-base-char)
15 (:args (x :scs (any-reg descriptor-reg)))
16 (:results (y :scs (base-char-reg)))
17 (:note "character untagging")
19 (inst srwi y x sb!vm:n-widetag-bits)))
21 (define-move-vop move-to-base-char :move
22 (any-reg descriptor-reg) (base-char-reg))
25 ;;; Move an untagged char to a tagged representation.
27 (define-vop (move-from-base-char)
28 (:args (x :scs (base-char-reg)))
29 (:results (y :scs (any-reg descriptor-reg)))
30 (:note "character tagging")
32 (inst slwi y x sb!vm:n-widetag-bits)
33 (inst ori y y sb!vm:base-char-widetag)))
35 (define-move-vop move-from-base-char :move
36 (base-char-reg) (any-reg descriptor-reg))
38 ;;; Move untagged base-char values.
40 (define-vop (base-char-move)
43 :load-if (not (location= x y))))
44 (:results (y :scs (base-char-reg)
45 :load-if (not (location= x y))))
46 (:note "character move")
52 (define-move-vop base-char-move :move
53 (base-char-reg) (base-char-reg))
56 ;;; Move untagged base-char arguments/return-values.
58 (define-vop (move-base-char-arg)
62 :load-if (not (sc-is y base-char-reg))))
64 (:note "character arg move")
70 (storew x fp (tn-offset y))))))
72 (define-move-vop move-base-char-arg :move-arg
73 (any-reg base-char-reg) (base-char-reg))
76 ;;; Use standard MOVE-ARG + coercion to move an untagged base-char
77 ;;; to a descriptor passing location.
79 (define-move-vop move-arg :move-arg
80 (base-char-reg) (any-reg descriptor-reg))
84 ;;;; Other operations:
86 (define-vop (char-code)
87 (:translate char-code)
89 (:args (ch :scs (base-char-reg) :target res))
90 (:arg-types base-char)
91 (:results (res :scs (any-reg)))
92 (:result-types positive-fixnum)
94 (inst slwi res ch 2)))
96 (define-vop (code-char)
97 (:translate code-char)
99 (:args (code :scs (any-reg) :target res))
100 (:arg-types positive-fixnum)
101 (:results (res :scs (base-char-reg)))
102 (:result-types base-char)
104 (inst srwi res code 2)))
107 ;;; Comparison of base-chars.
109 (define-vop (base-char-compare)
110 (:args (x :scs (base-char-reg))
111 (y :scs (base-char-reg)))
112 (:arg-types base-char base-char)
116 (:note "inline comparison")
117 (:variant-vars condition not-condition)
120 (inst b? (if not-p not-condition condition) target)))
122 (define-vop (fast-char=/base-char base-char-compare)
126 (define-vop (fast-char</base-char base-char-compare)
130 (define-vop (fast-char>/base-char base-char-compare)