diff --git a/compiler/ppc/move.lisp b/compiler/ppc/move.lisp index 30df3e00051c4a83d621af8a3916d94e2f520fd4..468c9a1b14169b87ff5d2b889965b019bd013918 100644 --- a/compiler/ppc/move.lisp +++ b/compiler/ppc/move.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman (FAHLMAN@CMUC). ;;; ********************************************************************** ;;; -;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/move.lisp,v 1.3 2004/07/25 18:15:52 pmai Exp $ +;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/move.lisp,v 1.4 2004/08/08 11:18:07 rtoy Exp $ ;;; ;;; This file contains the SPARC VM definition of operand loading/saving and ;;; the Move VOP. @@ -239,6 +239,7 @@ ;;; Check for fixnum, and possibly allocate one or two word bignum result. Use ;;; a worst-case cost to make sure people know they may be number consing. ;;; +#+nil (define-vop (move-from-unsigned) (:args (arg :scs (signed-reg unsigned-reg) :target x)) (:results (y :scs (any-reg descriptor-reg))) @@ -267,6 +268,33 @@ (storew temp y 0 other-pointer-type) (storew x y bignum-digits-offset other-pointer-type)) (emit-label done)))) + +(define-vop (move-from-unsigned) + (:args (arg :scs (signed-reg unsigned-reg) :target x)) + (:results (y :scs (any-reg descriptor-reg))) + (:temporary (:scs (non-descriptor-reg) :from (:argument 0)) x temp) + (:temporary (:sc non-descriptor-reg :offset nl3-offset) pa-flag) + (:note "unsigned word to integer coercion") + (:generator 20 + (move x arg) + (let ((done (gen-label)) + (one-word (gen-label)) + (initial-alloc (pad-data-block (+ 2 bignum-digits-offset)))) + (inst srawi. temp x 29) + (inst slwi y x 2) + (inst beq done) + + ;; We always allocate 2 words even if we don't need it. (The + ;; copying GC will take care of freeing the unused extra word.) + (with-fixed-allocation + (y pa-flag temp bignum-type (+ 2 bignum-digits-offset)) + (inst cmpwi x 0) + (inst li temp (logior (ash 1 type-bits) bignum-type)) + (inst bge one-word) + (inst li temp (logior (ash 2 type-bits) bignum-type)) + (emit-label one-word) + (storew x y bignum-digits-offset other-pointer-type)) + (emit-label done)))) ;;; (define-move-vop move-from-unsigned :move (unsigned-reg) (descriptor-reg))