src/compiler/hppa/char.lisp

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