1 ;;; -*- Package: ALPHA -*-
3 ;;; **********************************************************************
4 ;;; This code was written as part of the CMU Common Lisp project at
5 ;;; Carnegie Mellon University, and has been placed in the public domain.
9 ;;; **********************************************************************
11 ;;; This file contains the implementation of unknown-values VOPs.
13 ;;; Written by Rob MacLachlan
15 ;;; Converted to the Alpha by Sean Hallgren.
21 (define-vop (reset-stack-pointer)
22 (:args (ptr :scs (any-reg)))
27 ;;; Push some values onto the stack, returning the start and number of values
28 ;;; pushed as results. It is assumed that the Vals are wired to the standard
29 ;;; argument locations. Nvals is the number of values to push.
31 ;;; The generator cost is pseudo-random. We could get it right by defining a
32 ;;; bogus SC that reflects the costs of the memory-to-memory moves for each
33 ;;; operand, but this seems unworthwhile.
35 (define-vop (push-values)
39 (start :scs (any-reg))
40 (count :scs (any-reg)))
42 (:temporary (:scs (descriptor-reg)) temp)
43 (:temporary (:scs (descriptor-reg)
48 (move csp-tn start-temp)
49 (inst lda csp-tn (* nvals word-bytes) csp-tn)
50 (do ((val vals (tn-ref-across val))
53 (let ((tn (tn-ref-tn val)))
56 (storew tn start-temp i))
58 (load-stack-tn temp tn)
59 (storew temp start-temp i)))))
60 (move start-temp start)
61 (inst li (fixnumize nvals) count)))
64 ;;; Push a list of values on the stack, returning Start and Count as used in
65 ;;; unknown values continuations.
67 (define-vop (values-list)
68 (:args (arg :scs (descriptor-reg) :target list))
71 (:results (start :scs (any-reg))
72 (count :scs (any-reg)))
73 (:temporary (:scs (descriptor-reg) :type list :from (:argument 0)) list)
74 (:temporary (:scs (non-descriptor-reg)) temp)
75 (:temporary (:scs (non-descriptor-reg)) ndescr)
77 (:save-p :compute-only)
83 (inst cmpeq list null-tn temp)
85 (loadw temp list cons-car-slot list-pointer-type)
86 (loadw list list cons-cdr-slot list-pointer-type)
87 (inst lda csp-tn word-bytes csp-tn)
88 (storew temp csp-tn -1)
89 (inst and list lowtag-mask ndescr)
90 (inst xor ndescr list-pointer-type ndescr)
91 (inst beq ndescr loop)
92 (error-call vop bogus-argument-to-values-list-error list)
95 (inst subq csp-tn start count)))
97 ;;; Copy the more arg block to the top of the stack so we can use them
98 ;;; as function arguments.
100 (define-vop (%more-arg-values)
101 (:args (context :scs (descriptor-reg any-reg) :target src)
102 (skip :scs (any-reg zero immediate))
103 (num :scs (any-reg) :target count))
104 (:arg-types * positive-fixnum positive-fixnum)
105 (:temporary (:sc any-reg :from (:argument 0)) src)
106 (:temporary (:sc any-reg :from (:argument 2)) dst)
107 (:temporary (:sc descriptor-reg :from (:argument 1)) temp)
108 (:temporary (:sc non-descriptor-reg) temp1)
109 (:results (start :scs (any-reg))
110 (count :scs (any-reg)))
116 (inst lda src (* (tn-value skip) word-bytes) context))
118 (inst addq context skip src)))
120 (inst move csp-tn start)
122 (inst move csp-tn dst)
123 (inst addq csp-tn count csp-tn)
125 (inst ldl temp 0 src)
126 (inst addq src 4 src)
127 (inst addq dst 4 dst)
128 (inst stl temp -4 dst)
129 (inst cmpeq dst csp-tn temp1)
130 (inst beq temp1 loop)