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