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
   9 ;;; Push some values onto the stack, returning the start and number of values
  10 ;;; pushed as results.  It is assumed that the Vals are wired to the standard
  11 ;;; argument locations.  Nvals is the number of values to push.
  12 ;;;
  13 ;;; The generator cost is pseudo-random.  We could get it right by defining a
  14 ;;; bogus SC that reflects the costs of the memory-to-memory moves for each
  15 ;;; operand, but this seems unworthwhile.
  16 ;;;
  17 (define-vop (push-values)
  18   (:args
  19    (vals :more t))
  20   (:results (start :scs (any-reg) :from :load)
  21             (count :scs (any-reg)))
  22   (:info nvals)
  23   (:temporary (:scs (descriptor-reg)) temp)
  24   (:generator 20
  25     (move csp-tn start)
  26     (inst addi (* nvals n-word-bytes) csp-tn csp-tn)
  27     (do ((val vals (tn-ref-across val))
  28          (i 0 (1+ i)))
  29         ((null val))
  30       (let ((tn (tn-ref-tn val)))
  31         (sc-case tn
  32           (descriptor-reg
  33            (storew tn start i))
  34           (control-stack
  35            (load-stack-tn temp tn)
  36            (storew temp start i)))))
  37     (inst li (fixnumize nvals) count)))
  38
  39
  40 ;;; Push a list of values on the stack, returning Start and Count as used in
  41 ;;; unknown values continuations.
  42 ;;;
  43 (define-vop (values-list)
  44   (:args (arg :scs (descriptor-reg) :target list))
  45   (:arg-types list)
  46   (:policy :fast-safe)
  47   (:results (start :scs (any-reg))
  48             (count :scs (any-reg)))
  49   (:temporary (:scs (descriptor-reg) :type list :from (:argument 0)) list)
  50   (:temporary (:scs (descriptor-reg)) temp)
  51   (:temporary (:scs (non-descriptor-reg) :type random) ndescr)
  52   (:vop-var vop)
  53   (:save-p :compute-only)
  54   (:generator 0
  55     (move arg list)
  56     (inst comb := list null-tn done)
  57     (move csp-tn start)
  58
  59     LOOP
  60     (loadw temp list cons-car-slot list-pointer-lowtag)
  61     (loadw list list cons-cdr-slot list-pointer-lowtag)
  62     (inst addi n-word-bytes csp-tn csp-tn)
  63     (storew temp csp-tn -1)
  64     (inst extru list 31 n-lowtag-bits ndescr)
  65     (inst comib := list-pointer-lowtag ndescr loop)
  66     (inst comb := list null-tn done :nullify t)
  67     (error-call vop bogus-arg-to-values-list-error list)
  68
  69     DONE
  70     (inst sub csp-tn start count)))
  71
  72
  73 ;;; Copy the more arg block to the top of the stack so we can use them
  74 ;;; as function arguments.
  75 ;;;
  76 (define-vop (%more-arg-values)
  77   (:args (context :scs (descriptor-reg any-reg) :target src)
  78          (skip :scs (any-reg zero immediate))
  79          (num :scs (any-reg) :target count))
  80   (:temporary (:sc any-reg :from (:argument 0)) src)
  81   (:temporary (:sc any-reg :from (:argument 1)) dst end)
  82   (:temporary (:sc descriptor-reg :from (:argument 1)) temp)
  83   (:results (start :scs (any-reg))
  84             (count :scs (any-reg)))
  85   (:generator 20
  86     (sc-case skip
  87       (zero
  88        (move context src))
  89       (immediate
  90        (inst addi (* (tn-value skip) n-word-bytes) context src))
  91       (any-reg
  92        (inst add skip context src)))
  93     (move num count)
  94     (inst comb := num zero-tn done)
  95     (inst move csp-tn start)
  96     (inst move csp-tn dst)
  97     (inst add csp-tn count csp-tn)
  98     (inst addi (- n-word-bytes) csp-tn end)
  99     LOOP
 100     (inst ldwm 4 src temp)
 101     (inst comb :< dst end loop)
 102     (inst stwm temp 4 dst)
 103     DONE))