src/compiler/hppa/values.lisp

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