X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fppc%2Fchar.lisp;h=a7400ab1ef67a2acb653079ba0f58eec587bdaaa;hb=69e6aef5e6fb3bd682c7a2cbf774034d2ea58ee8;hp=308ddb055de16f8c57c4cacf4218f8096c925bbc;hpb=cab2c71bb1bb8a575d9eebdae335e731daa64183;p=sbcl.git diff --git a/src/compiler/ppc/char.lisp b/src/compiler/ppc/char.lisp index 308ddb0..a7400ab 100644 --- a/src/compiler/ppc/char.lisp +++ b/src/compiler/ppc/char.lisp @@ -1,115 +1,103 @@ -;;; -;;; Written by Rob MacLachlan -;;; Converted for the MIPS R2000 by Christopher Hoover. -;;; And then to the SPARC by William Lott. -;;; -(in-package "SB!VM") +;;;; the PPC VM definition of character operations +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; This software is derived from the CMU CL system, which was +;;;; written at Carnegie Mellon University and released into the +;;;; public domain. The software is in the public domain and is +;;;; provided with absolutely no warranty. See the COPYING and CREDITS +;;;; files for more information. +(in-package "SB!VM") ;;;; Moves and coercions: ;;; Move a tagged char to an untagged representation. -;;; -(define-vop (move-to-base-char) +(define-vop (move-to-character) (:args (x :scs (any-reg descriptor-reg))) - (:results (y :scs (base-char-reg))) + (:results (y :scs (character-reg))) (:note "character untagging") (:generator 1 - (inst srwi y x sb!vm:n-widetag-bits))) -;;; -(define-move-vop move-to-base-char :move - (any-reg descriptor-reg) (base-char-reg)) - + (inst srwi y x n-widetag-bits))) +(define-move-vop move-to-character :move + (any-reg descriptor-reg) (character-reg)) ;;; Move an untagged char to a tagged representation. -;;; -(define-vop (move-from-base-char) - (:args (x :scs (base-char-reg))) +(define-vop (move-from-character) + (:args (x :scs (character-reg))) (:results (y :scs (any-reg descriptor-reg))) (:note "character tagging") (:generator 1 - (inst slwi y x sb!vm:n-widetag-bits) - (inst ori y y sb!vm:base-char-widetag))) -;;; -(define-move-vop move-from-base-char :move - (base-char-reg) (any-reg descriptor-reg)) - -;;; Move untagged base-char values. -;;; -(define-vop (base-char-move) + (inst slwi y x n-widetag-bits) + (inst ori y y character-widetag))) +(define-move-vop move-from-character :move + (character-reg) (any-reg descriptor-reg)) + +;;; Move untagged character values. +(define-vop (character-move) (:args (x :target y - :scs (base-char-reg) - :load-if (not (location= x y)))) - (:results (y :scs (base-char-reg) - :load-if (not (location= x y)))) + :scs (character-reg) + :load-if (not (location= x y)))) + (:results (y :scs (character-reg) + :load-if (not (location= x y)))) (:note "character move") (:effects) (:affected) (:generator 0 (move y x))) -;;; -(define-move-vop base-char-move :move - (base-char-reg) (base-char-reg)) - +(define-move-vop character-move :move + (character-reg) (character-reg)) -;;; Move untagged base-char arguments/return-values. -;;; -(define-vop (move-base-char-arg) +;;; Move untagged character arguments/return-values. +(define-vop (move-character-arg) (:args (x :target y - :scs (base-char-reg)) - (fp :scs (any-reg) - :load-if (not (sc-is y base-char-reg)))) + :scs (character-reg)) + (fp :scs (any-reg) + :load-if (not (sc-is y character-reg)))) (:results (y)) (:note "character arg move") (:generator 0 (sc-case y - (base-char-reg + (character-reg (move y x)) - (base-char-stack + (character-stack (storew x fp (tn-offset y)))))) -;;; -(define-move-vop move-base-char-arg :move-arg - (any-reg base-char-reg) (base-char-reg)) - +(define-move-vop move-character-arg :move-arg + (any-reg character-reg) (character-reg)) -;;; Use standard MOVE-ARG + coercion to move an untagged base-char +;;; Use standard MOVE-ARG + coercion to move an untagged character ;;; to a descriptor passing location. -;;; (define-move-vop move-arg :move-arg - (base-char-reg) (any-reg descriptor-reg)) - - + (character-reg) (any-reg descriptor-reg)) ;;;; Other operations: (define-vop (char-code) (:translate char-code) (:policy :fast-safe) - (:args (ch :scs (base-char-reg) :target res)) - (:arg-types base-char) + (:args (ch :scs (character-reg) :target res)) + (:arg-types character) (:results (res :scs (any-reg))) (:result-types positive-fixnum) (:generator 1 - (inst slwi res ch 2))) + (inst slwi res ch n-fixnum-tag-bits))) (define-vop (code-char) (:translate code-char) (:policy :fast-safe) (:args (code :scs (any-reg) :target res)) (:arg-types positive-fixnum) - (:results (res :scs (base-char-reg))) - (:result-types base-char) + (:results (res :scs (character-reg))) + (:result-types character) (:generator 1 - (inst srwi res code 2))) - + (inst srwi res code n-fixnum-tag-bits))) -;;; Comparison of base-chars. -;;; -(define-vop (base-char-compare) - (:args (x :scs (base-char-reg)) - (y :scs (base-char-reg))) - (:arg-types base-char base-char) +;;; Comparison of characters. +(define-vop (character-compare) + (:args (x :scs (character-reg)) + (y :scs (character-reg))) + (:arg-types character character) (:conditional) (:info target not-p) (:policy :fast-safe) @@ -119,15 +107,48 @@ (inst cmplw x y) (inst b? (if not-p not-condition condition) target))) -(define-vop (fast-char=/base-char base-char-compare) +(define-vop (fast-char=/character character-compare) (:translate char=) (:variant :eq :ne)) -(define-vop (fast-char/base-char base-char-compare) +(define-vop (fast-char>/character character-compare) (:translate char>) (:variant :gt :le)) +(define-vop (character-compare/c) + (:args (x :scs (character-reg))) + (:arg-types character + ;; KLUDGE: having a SATISFIES type here is too hairy for + ;; the cross-compiler (running on an arbitrary CL host) + ;; to cope with. Since we know we only have standard + ;; characters in the build anyway, we can restrict the + ;; cross-compiler's arg type to standard char, and all + ;; is well. + #+sb-xc-host + (:constant standard-char) + #-sb-xc-host + (:constant (satisfies inlinable-character-constant-p))) + (:conditional) + (:info target not-p y) + (:policy :fast-safe) + (:note "inline comparison") + (:variant-vars condition not-condition) + (:generator 2 + (inst cmplwi x (sb!xc:char-code y)) + (inst b? (if not-p not-condition condition) target))) + +(define-vop (fast-char=/character/c character-compare/c) + (:translate char=) + (:variant :eq :ne)) + +(define-vop (fast-char/character/c character-compare/c) + (:translate char>) + (:variant :gt :le))