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