src/compiler/mips/char.lisp

   1 ;;;; the MIPS 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 srl y x n-widetag-bits)))
  23
  24 (define-move-vop move-to-character :move
  25   (any-reg descriptor-reg) (character-reg))
  26
  27 ;;; Move an untagged char to a tagged representation.
  28 (define-vop (move-from-character)
  29   (:args (x :scs (character-reg)))
  30   (:results (y :scs (any-reg descriptor-reg)))
  31   (:note "character tagging")
  32   (:generator 1
  33     (inst sll y x n-widetag-bits)
  34     (inst or y character-widetag)))
  35
  36 (define-move-vop move-from-character :move
  37   (character-reg) (any-reg descriptor-reg))
  38
  39 ;;; Move untagged character values.
  40 (define-vop (character-move)
  41   (:args (x :target y
  42             :scs (character-reg)
  43             :load-if (not (location= x y))))
  44   (:results (y :scs (character-reg)
  45                :load-if (not (location= x y))))
  46   (:note "character move")
  47   (:effects)
  48   (:affected)
  49   (:generator 0
  50     (move y x)))
  51
  52 (define-move-vop character-move :move
  53   (character-reg) (character-reg))
  54
  55 ;;; Move untagged character arguments/return-values.
  56 (define-vop (move-character-arg)
  57   (:args (x :target y
  58             :scs (character-reg))
  59          (fp :scs (any-reg)
  60              :load-if (not (sc-is y character-reg))))
  61   (:results (y))
  62   (:note "character arg move")
  63   (:generator 0
  64     (sc-case y
  65       (character-reg
  66        (move y x))
  67       (character-stack
  68        (storew x fp (tn-offset y))))))
  69
  70 (define-move-vop move-character-arg :move-arg
  71   (any-reg character-reg) (character-reg))
  72
  73 ;;; Use standard MOVE-ARG + coercion to move an untagged character to
  74 ;;; a descriptor passing location.
  75 (define-move-vop move-arg :move-arg
  76   (character-reg) (any-reg descriptor-reg))
  77 \f
  78 ;;;; Other operations:
  79 (define-vop (char-code)
  80   (:translate char-code)
  81   (:policy :fast-safe)
  82   (:args (ch :scs (character-reg) :target res))
  83   (:arg-types character)
  84   (:results (res :scs (any-reg)))
  85   (:result-types positive-fixnum)
  86   (:generator 1
  87     (inst sll res ch n-fixnum-tag-bits)))
  88
  89 (define-vop (code-char)
  90   (:translate code-char)
  91   (:policy :fast-safe)
  92   (:args (code :scs (any-reg) :target res))
  93   (:arg-types positive-fixnum)
  94   (:results (res :scs (character-reg)))
  95   (:result-types character)
  96   (:generator 1
  97     (inst srl res code n-fixnum-tag-bits)))
  98 \f
  99 ;;; Comparison of characters.
 100 (define-vop (character-compare)
 101   (:args (x :scs (character-reg))
 102          (y :scs (character-reg)))
 103   (:arg-types character character)
 104   (:temporary (:scs (non-descriptor-reg)) temp)
 105   (:conditional)
 106   (:info target not-p)
 107   (:policy :fast-safe)
 108   (:note "inline comparison")
 109   (:variant-vars condition)
 110   (:generator 3
 111     (three-way-comparison x y condition :unsigned not-p target temp)))
 112
 113 (define-vop (fast-char=/character character-compare)
 114   (:translate char=)
 115   (:variant :eq))
 116
 117 (define-vop (fast-char</character character-compare)
 118   (:translate char<)
 119   (:variant :lt))
 120
 121 (define-vop (fast-char>/character character-compare)
 122   (:translate char>)
 123   (:variant :gt))
 124