0.8.3.35:
[sbcl.git] / src / compiler / mips / char.lisp
1 (in-package "SB!VM")
2
3
4 \f
5 ;;;; Moves and coercions:
6
7 ;;; Move a tagged char to an untagged representation.
8 ;;;
9 (define-vop (move-to-base-char)
10   (:args (x :scs (any-reg descriptor-reg)))
11   (:results (y :scs (base-char-reg)))
12   (:generator 1
13     (inst srl y x n-widetag-bits)))
14 ;;;
15 (define-move-vop move-to-base-char :move
16   (any-reg descriptor-reg) (base-char-reg))
17
18
19 ;;; Move an untagged char to a tagged representation.
20 ;;;
21 (define-vop (move-from-base-char)
22   (:args (x :scs (base-char-reg)))
23   (:results (y :scs (any-reg descriptor-reg)))
24   (:generator 1
25     (inst sll y x n-widetag-bits)
26     (inst or y y base-char-widetag)))
27 ;;;
28 (define-move-vop move-from-base-char :move
29   (base-char-reg) (any-reg descriptor-reg))
30
31 ;;; Move untagged base-char values.
32 ;;;
33 (define-vop (base-char-move)
34   (:args (x :target y
35             :scs (base-char-reg)
36             :load-if (not (location= x y))))
37   (:results (y :scs (base-char-reg)
38                :load-if (not (location= x y))))
39   (:effects)
40   (:affected)
41   (:generator 0
42     (move y x)))
43 ;;;
44 (define-move-vop base-char-move :move
45   (base-char-reg) (base-char-reg))
46
47
48 ;;; Move untagged base-char arguments/return-values.
49 ;;;
50 (define-vop (move-base-char-arg)
51   (:args (x :target y
52             :scs (base-char-reg))
53          (fp :scs (any-reg)
54              :load-if (not (sc-is y base-char-reg))))
55   (:results (y))
56   (:generator 0
57     (sc-case y
58       (base-char-reg
59        (move y x))
60       (base-char-stack
61        (storew x fp (tn-offset y))))))
62 ;;;
63 (define-move-vop move-base-char-arg :move-arg
64   (any-reg base-char-reg) (base-char-reg))
65
66
67 ;;; Use standard MOVE-ARGUMENT + coercion to move an untagged base-char
68 ;;; to a descriptor passing location.
69 ;;;
70 (define-move-vop move-arg :move-arg
71   (base-char-reg) (any-reg descriptor-reg))
72
73
74 \f
75 ;;;; Other operations:
76
77 (define-vop (char-code)
78   (:translate char-code)
79   (:policy :fast-safe)
80   (:args (ch :scs (base-char-reg) :target res))
81   (:arg-types base-char)
82   (:results (res :scs (any-reg)))
83   (:result-types positive-fixnum)
84   (:generator 1
85     (inst sll res ch 2)))
86
87 (define-vop (code-char)
88   (:translate code-char)
89   (:policy :fast-safe)
90   (:args (code :scs (any-reg) :target res))
91   (:arg-types positive-fixnum)
92   (:results (res :scs (base-char-reg)))
93   (:result-types base-char)
94   (:generator 1
95     (inst srl res code 2)))
96
97 \f
98 ;;; Comparison of base-chars.
99 ;;;
100 (define-vop (base-char-compare pointer-compare)
101   (:args (x :scs (base-char-reg))
102          (y :scs (base-char-reg)))
103   (:arg-types base-char base-char))
104
105 (define-vop (fast-char=/base-char base-char-compare)
106   (:translate char=)
107   (:variant :eq))
108
109 (define-vop (fast-char</base-char base-char-compare)
110   (:translate char<)
111   (:variant :lt))
112
113 (define-vop (fast-char>/base-char base-char-compare)
114   (:translate char>)
115   (:variant :gt))
116