src/compiler/ppc/values.lisp

   1 ;;;
   2 ;;; Written by Rob MacLachlan
   3 ;;;
   4 ;;; Converted for SPARC by William Lott.
   5 ;;;
   6
   7 (in-package "SB!VM")
   8
   9 (define-vop (reset-stack-pointer)
  10   (:args (ptr :scs (any-reg)))
  11   (:generator 1
  12     (move csp-tn ptr)))
  13
  14 (define-vop (%%pop-dx)
  15   (:args (ptr :scs (any-reg)))
  16   (:ignore ptr)
  17   (:generator 1
  18     (bug "VOP %%POP-DX is not implemented.")))
  19
  20 (define-vop (%%nip-dx)
  21   (:args (last-nipped-ptr :scs (any-reg) :target dest)
  22          (last-preserved-ptr :scs (any-reg) :target src)
  23          (moved-ptrs :scs (any-reg) :more t))
  24   (:results (r-moved-ptrs :scs (any-reg) :more t))
  25   (:temporary (:sc any-reg) src)
  26   (:temporary (:sc any-reg) dest)
  27   (:temporary (:sc non-descriptor-reg) temp)
  28   (:ignore r-moved-ptrs
  29            last-nipped-ptr last-preserved-ptr moved-ptrs
  30            src dest temp)
  31   (:generator 1
  32     (bug "VOP %%NIP-DX is not implemented.")))
  33
  34 ;;; sparc version translated to ppc by David Steuber with help from #lisp.
  35 (define-vop (%%nip-values)
  36   (:args (last-nipped-ptr :scs (any-reg) :target dest)
  37          (last-preserved-ptr :scs (any-reg) :target src)
  38          (moved-ptrs :scs (any-reg) :more t))
  39   (:results (r-moved-ptrs :scs (any-reg) :more t))
  40   (:temporary (:sc any-reg) src)
  41   (:temporary (:sc any-reg) dest)
  42   (:temporary (:sc non-descriptor-reg) temp)
  43   (:ignore r-moved-ptrs)
  44   (:generator 1
  45     (inst mr dest last-nipped-ptr)
  46     (inst mr src last-preserved-ptr)
  47     (inst cmplw csp-tn src)
  48     (inst ble DONE)
  49     LOOP
  50     (loadw temp src)
  51     (inst addi dest dest n-word-bytes)
  52     (inst addi src src n-word-bytes)
  53     (storew temp dest -1)
  54     (inst cmplw csp-tn src)
  55     (inst bgt LOOP)
  56     DONE
  57     (inst mr csp-tn dest)
  58     (inst sub src src dest)
  59     (loop for moved = moved-ptrs then (tn-ref-across moved)
  60           while moved
  61           do (sc-case (tn-ref-tn moved)
  62                ((descriptor-reg any-reg)
  63                 (inst sub (tn-ref-tn moved) (tn-ref-tn moved) src))
  64                ((control-stack)
  65                 (load-stack-tn temp (tn-ref-tn moved))
  66                 (inst sub temp temp src)
  67                 (store-stack-tn (tn-ref-tn moved) temp))))))
  68
  69
  70 ;;; Push some values onto the stack, returning the start and number of values
  71 ;;; pushed as results.  It is assumed that the Vals are wired to the standard
  72 ;;; argument locations.  Nvals is the number of values to push.
  73 ;;;
  74 ;;; The generator cost is pseudo-random.  We could get it right by defining a
  75 ;;; bogus SC that reflects the costs of the memory-to-memory moves for each
  76 ;;; operand, but this seems unworthwhile.
  77 ;;;
  78 (define-vop (push-values)
  79   (:args (vals :more t))
  80   (:results (start :scs (any-reg) :from :load)
  81             (count :scs (any-reg)))
  82   (:info nvals)
  83   (:temporary (:scs (descriptor-reg)) temp)
  84   (:generator 20
  85     (inst mr start csp-tn)
  86     (inst addi csp-tn csp-tn (* nvals n-word-bytes))
  87     (do ((val vals (tn-ref-across val))
  88          (i 0 (1+ i)))
  89         ((null val))
  90       (let ((tn (tn-ref-tn val)))
  91         (sc-case tn
  92           (descriptor-reg
  93            (storew tn start i))
  94           (control-stack
  95            (load-stack-tn temp tn)
  96            (storew temp start i)))))
  97     (inst lr count (fixnumize nvals))))
  98
  99 ;;; Push a list of values on the stack, returning Start and Count as used in
 100 ;;; unknown values continuations.
 101 ;;;
 102 (define-vop (values-list)
 103   (:args (arg :scs (descriptor-reg) :target list))
 104   (:arg-types list)
 105   (:policy :fast-safe)
 106   (:results (start :scs (any-reg))
 107             (count :scs (any-reg)))
 108   (:temporary (:scs (descriptor-reg) :type list :from (:argument 0)) list)
 109   (:temporary (:scs (descriptor-reg)) temp)
 110   (:temporary (:scs (non-descriptor-reg)) ndescr)
 111   (:vop-var vop)
 112   (:save-p :compute-only)
 113   (:generator 0
 114     (let ((loop (gen-label))
 115           (done (gen-label)))
 116
 117       (move list arg)
 118       (move start csp-tn)
 119
 120       (emit-label loop)
 121       (inst cmpw list null-tn)
 122       (loadw temp list cons-car-slot list-pointer-lowtag)
 123       (inst beq done)
 124       (loadw list list cons-cdr-slot list-pointer-lowtag)
 125       (inst addi csp-tn csp-tn n-word-bytes)
 126       (storew temp csp-tn -1)
 127       (test-type list loop nil (list-pointer-lowtag) :temp ndescr)
 128       (error-call vop bogus-arg-to-values-list-error list)
 129
 130       (emit-label done)
 131       (inst sub count csp-tn start))))
 132
 133
 134 ;;; Copy the more arg block to the top of the stack so we can use them
 135 ;;; as function arguments.
 136 ;;;
 137 (define-vop (%more-arg-values)
 138   (:args (context :scs (descriptor-reg any-reg) :target src)
 139          (skip :scs (any-reg zero immediate))
 140          (num :scs (any-reg) :target count))
 141   (:arg-types * positive-fixnum positive-fixnum)
 142   (:temporary (:sc any-reg :from (:argument 0)) src)
 143   (:temporary (:sc any-reg :from (:argument 2)) dst)
 144   (:temporary (:sc descriptor-reg :from (:argument 1)) temp)
 145   (:temporary (:sc any-reg) i)
 146   (:results (start :scs (any-reg))
 147             (count :scs (any-reg)))
 148   (:generator 20
 149     (sc-case skip
 150       (zero
 151        (inst mr src context))
 152       (immediate
 153        (inst addi src context (* (tn-value skip) n-word-bytes)))
 154       (any-reg
 155        (inst add src context skip)))
 156     (inst mr. count num)
 157     (inst mr start csp-tn)
 158     (inst beq done)
 159     (inst mr dst csp-tn)
 160     (inst add csp-tn csp-tn count)
 161     (inst mr i count)
 162     LOOP
 163     (inst cmpwi i 4)
 164     (inst subi i i 4)
 165     (inst lwzx temp src i)
 166     (inst stwx temp dst i)
 167     (inst bne loop)
 168     DONE))