src/compiler/ppc/char.lisp

   1 ;;;; the PPC VM definition of character operations
   2
   3 ;;;; This software is part of the SBCL system. See the README file for
   4 ;;;; more information.
   5 ;;;;
   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.
  11
  12 (in-package "SB-VM")
  13 \f
  14 ;;;; Moves and coercions:
  15
  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")
  21   (:generator 1
  22     (inst srwi y x n-widetag-bits)))
  23 (define-move-vop move-to-character :move
  24   (any-reg descriptor-reg) (character-reg))
  25
  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")
  31   (:generator 1
  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))
  36
  37 ;;; Move untagged character values.
  38 (define-vop (character-move)
  39   (:args (x :target y
  40             :scs (character-reg)
  41             :load-if (not (location= x y))))
  42   (:results (y :scs (character-reg)
  43                :load-if (not (location= x y))))
  44   (:note "character move")
  45   (:generator 0
  46     (move y x)))
  47 (define-move-vop character-move :move
  48   (character-reg) (character-reg))
  49
  50 ;;; Move untagged character arguments/return-values.
  51 (define-vop (move-character-arg)
  52   (:args (x :target y
  53             :scs (character-reg))
  54          (fp :scs (any-reg)
  55              :load-if (not (sc-is y character-reg))))
  56   (:results (y))
  57   (:note "character arg move")
  58   (:generator 0
  59     (sc-case y
  60       (character-reg
  61        (move y x))
  62       (character-stack
  63        (storew x fp (tn-offset y))))))
  64 (define-move-vop move-character-arg :move-arg
  65   (any-reg character-reg) (character-reg))
  66
  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))
  71 \f
  72 ;;;; Other operations:
  73
  74 (define-vop (char-code)
  75   (:translate char-code)
  76   (:policy :fast-safe)
  77   (:args (ch :scs (character-reg) :target res))
  78   (:arg-types character)
  79   (:results (res :scs (any-reg)))
  80   (:result-types positive-fixnum)
  81   (:generator 1
  82     (inst slwi res ch n-fixnum-tag-bits)))
  83
  84 (define-vop (code-char)
  85   (:translate code-char)
  86   (:policy :fast-safe)
  87   (:args (code :scs (any-reg) :target res))
  88   (:arg-types positive-fixnum)
  89   (:results (res :scs (character-reg)))
  90   (:result-types character)
  91   (:generator 1
  92     (inst srwi res code n-fixnum-tag-bits)))
  93 \f
  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)
  99   (:conditional)
 100   (:info target not-p)
 101   (:policy :fast-safe)
 102   (:note "inline comparison")
 103   (:variant-vars condition not-condition)
 104   (:generator 3
 105     (inst cmplw x y)
 106     (inst b? (if not-p not-condition condition) target)))
 107
 108 (define-vop (fast-char=/character character-compare)
 109   (:translate char=)
 110   (:variant :eq :ne))
 111
 112 (define-vop (fast-char</character character-compare)
 113   (:translate char<)
 114   (:variant :lt :ge))
 115
 116 (define-vop (fast-char>/character character-compare)
 117   (:translate char>)
 118   (:variant :gt :le))
 119
 120 (define-vop (character-compare/c)
 121   (:args (x :scs (character-reg)))
 122   (:arg-types character (:constant (character-set ((0 . #xFFFF)))))
 123   (:conditional)
 124   (:info target not-p y)
 125   (:policy :fast-safe)
 126   (:note "inline comparison")
 127   (:variant-vars condition not-condition)
 128   (:generator 2
 129     (inst cmplwi x (char-code y))
 130     (inst b? (if not-p not-condition condition) target)))
 131
 132 (define-vop (fast-char=/character/c character-compare/c)
 133   (:translate char=)
 134   (:variant :eq :ne))
 135
 136 (define-vop (fast-char</character/c character-compare/c)
 137   (:translate char<)
 138   (:variant :lt :ge))
 139
 140 (define-vop (fast-char>/character/c character-compare/c)
 141   (:translate char>)
 142   (:variant :gt :le))