1.0.9.52: copy propagation interfering with local calls
[sbcl.git] / 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))