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