1 ;;;; the sparc implementation of unknown-values VOPs
3 ;;;; This software is part of the SBCL system. See the README file for
6 ;;;; This software is derived from the CMU CL system, which was
7 ;;;; written at Carnegie Mellon University and released into the
8 ;;;; public domain. The software is in the public domain and is
9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
10 ;;;; files for more information.
14 (define-vop (reset-stack-pointer)
15 (:args
(ptr :scs
(any-reg)))
19 (define-vop (%%pop-dx
)
20 (:args
(ptr :scs
(any-reg)))
23 (bug "VOP %%POP-DX is not implemented.")))
25 (define-vop (%%nip-dx
)
26 (:args
(last-nipped-ptr :scs
(any-reg) :target dest
)
27 (last-preserved-ptr :scs
(any-reg) :target src
)
28 (moved-ptrs :scs
(any-reg) :more t
))
29 (:results
(r-moved-ptrs :scs
(any-reg) :more t
))
30 (:temporary
(:sc any-reg
) src
)
31 (:temporary
(:sc any-reg
) dest
)
32 (:temporary
(:sc non-descriptor-reg
) temp
)
34 last-nipped-ptr last-preserved-ptr moved-ptrs
37 (bug "VOP %%NIP-DX is not implemented.")))
39 (define-vop (%%nip-values
)
40 (:args
(last-nipped-ptr :scs
(any-reg) :target dest
)
41 (last-preserved-ptr :scs
(any-reg) :target src
)
42 (moved-ptrs :scs
(any-reg) :more t
))
43 (:results
(r-moved-ptrs :scs
(any-reg) :more t
))
44 (:temporary
(:sc any-reg
) src
)
45 (:temporary
(:sc any-reg
) dest
)
46 (:temporary
(:sc non-descriptor-reg
) temp
)
47 (:ignore r-moved-ptrs
)
49 (inst move dest last-nipped-ptr
)
50 (inst move src last-preserved-ptr
)
53 (inst nop
) ; not strictly necessary
56 (inst add dest dest n-word-bytes
)
57 (inst add src src n-word-bytes
)
63 (inst move csp-tn dest
)
64 (inst sub src src dest
)
65 (loop for moved
= moved-ptrs then
(tn-ref-across moved
)
67 do
(sc-case (tn-ref-tn moved
)
68 ((descriptor-reg any-reg
)
69 (inst sub
(tn-ref-tn moved
) (tn-ref-tn moved
) src
))
71 (load-stack-tn temp
(tn-ref-tn moved
))
72 (inst sub temp temp src
)
73 (store-stack-tn (tn-ref-tn moved
) temp
))))))
75 ;;; Push some values onto the stack, returning the start and number of
76 ;;; values pushed as results. It is assumed that the Vals are wired
77 ;;; to the standard argument locations. Nvals is the number of values
80 ;;; The generator cost is pseudo-random. We could get it right by
81 ;;; defining a bogus SC that reflects the costs of the
82 ;;; memory-to-memory moves for each operand, but this seems
84 (define-vop (push-values)
85 (:args
(vals :more t
))
86 (:results
(start :scs
(any-reg) :from
:load
)
87 (count :scs
(any-reg)))
89 (:temporary
(:scs
(descriptor-reg)) temp
)
91 (inst move start csp-tn
)
92 (inst add csp-tn csp-tn
(* nvals n-word-bytes
))
93 (do ((val vals
(tn-ref-across val
))
96 (let ((tn (tn-ref-tn val
)))
101 (load-stack-tn temp tn
)
102 (storew temp start i
)))))
103 (inst li count
(fixnumize nvals
))))
105 ;;; Push a list of values on the stack, returning Start and Count as
106 ;;; used in unknown values continuations.
107 (define-vop (values-list)
108 (:args
(arg :scs
(descriptor-reg) :target list
))
111 (:results
(start :scs
(any-reg))
112 (count :scs
(any-reg)))
113 (:temporary
(:scs
(descriptor-reg) :type list
:from
(:argument
0)) list
)
114 (:temporary
(:scs
(descriptor-reg)) temp
)
115 (:temporary
(:scs
(non-descriptor-reg)) ndescr
)
117 (:save-p
:compute-only
)
119 (let ((loop (gen-label))
126 (inst cmp list null-tn
)
128 (loadw temp list cons-car-slot list-pointer-lowtag
)
129 (loadw list list cons-cdr-slot list-pointer-lowtag
)
130 (inst add csp-tn csp-tn n-word-bytes
)
131 (storew temp csp-tn -
1)
132 (test-type list loop nil
(list-pointer-lowtag) :temp ndescr
)
133 (error-call vop bogus-arg-to-values-list-error list
)
136 (inst sub count csp-tn start
))))
140 ;;; Copy the more arg block to the top of the stack so we can use them
141 ;;; as function arguments.
142 (define-vop (%more-arg-values
)
143 (:args
(context :scs
(descriptor-reg any-reg
) :target src
)
144 (skip :scs
(any-reg zero immediate
))
145 (num :scs
(any-reg) :target count
))
146 (:arg-types
* positive-fixnum positive-fixnum
)
147 (:temporary
(:sc any-reg
:from
(:argument
0)) src
)
148 (:temporary
(:sc any-reg
:from
(:argument
2)) dst
)
149 (:temporary
(:sc descriptor-reg
:from
(:argument
1)) temp
)
150 (:temporary
(:sc any-reg
) i
)
151 (:results
(start :scs
(any-reg))
152 (count :scs
(any-reg)))
158 (inst add src context
(* (tn-value skip
) n-word-bytes
)))
160 (inst add src context skip
)))
161 (inst orcc count zero-tn num
)
163 (inst move start csp-tn
)
164 (inst move dst csp-tn
)
165 (inst add csp-tn count
)