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   (:generator 1
  21     (inst srl y x n-widetag-bits)))
  22 (define-move-vop move-to-character :move
  23   (any-reg descriptor-reg) (character-reg))
  24
  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   (:generator 1
  31     (inst sll y x n-widetag-bits)
  32     (inst or y y character-widetag)))
  33 (define-move-vop move-from-character :move
  34   (character-reg) (any-reg descriptor-reg))
  35
  36 ;;; Move untagged character values.
  37 (define-vop (character-move)
  38   (:args (x :target y
  39             :scs (character-reg)
  40             :load-if (not (location= x y))))
  41   (:results (y :scs (character-reg)
  42                :load-if (not (location= x y))))
  43   (:effects)
  44   (:affected)
  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   (:generator 0
  58     (sc-case y
  59       (character-reg
  60        (move y x))
  61       (character-stack
  62        (storew x fp (tn-offset y))))))
  63 (define-move-vop move-character-arg :move-arg
  64   (any-reg character-reg) (character-reg))
  65
  66 ;;; Use standard MOVE-ARG + coercion to move an untagged character to
  67 ;;; a descriptor passing location.
  68 (define-move-vop move-arg :move-arg
  69   (character-reg) (any-reg descriptor-reg))
  70 \f
  71 ;;;; Other operations:
  72 (define-vop (char-code)
  73   (:translate char-code)
  74   (:policy :fast-safe)
  75   (:args (ch :scs (character-reg) :target res))
  76   (:arg-types character)
  77   (:results (res :scs (any-reg)))
  78   (:result-types positive-fixnum)
  79   (:generator 1
  80     (inst sll res ch 2)))
  81
  82 (define-vop (code-char)
  83   (:translate code-char)
  84   (:policy :fast-safe)
  85   (:args (code :scs (any-reg) :target res))
  86   (:arg-types positive-fixnum)
  87   (:results (res :scs (character-reg)))
  88   (:result-types character)
  89   (:generator 1
  90     (inst srl res code 2)))
  91
  92 \f
  93 ;;; Comparison of characters.
  94 ;;;
  95 (define-vop (character-compare pointer-compare)
  96   (:args (x :scs (character-reg))
  97          (y :scs (character-reg)))
  98   (:arg-types character character))
  99
 100 (define-vop (fast-char=/character character-compare)
 101   (:translate char=)
 102   (:variant :eq))
 103
 104 (define-vop (fast-char</character character-compare)
 105   (:translate char<)
 106   (:variant :lt))
 107
 108 (define-vop (fast-char>/character character-compare)
 109   (:translate char>)
 110   (:variant :gt))
 111