1;;;; the sparc 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 csp-tn ptr))) 18 19(define-vop (%%pop-dx) 20 (:args (ptr :scs (any-reg))) 21 (:ignore ptr) 22 (:generator 1 23 (bug "VOP %%POP-DX is not implemented."))) 24 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) 33 (:ignore r-moved-ptrs 34 last-nipped-ptr last-preserved-ptr moved-ptrs 35 src dest temp) 36 (:generator 1 37 (bug "VOP %%NIP-DX is not implemented."))) 38 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) 48 (:generator 1 49 (inst move dest last-nipped-ptr) 50 (inst move src last-preserved-ptr) 51 (inst cmp csp-tn src) 52 (inst b :le DONE) 53 (inst nop) ; not strictly necessary 54 LOOP 55 (loadw temp src) 56 (inst add dest dest n-word-bytes) 57 (inst add src src n-word-bytes) 58 (storew temp dest -1) 59 (inst cmp csp-tn src) 60 (inst b :gt LOOP) 61 (inst nop) 62 DONE 63 (inst move csp-tn dest) 64 (inst sub src src dest) 65 (loop for moved = moved-ptrs then (tn-ref-across moved) 66 while 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)) 70 ((control-stack) 71 (load-stack-tn temp (tn-ref-tn moved)) 72 (inst sub temp temp src) 73 (store-stack-tn (tn-ref-tn moved) temp)))))) 74 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 78;;; to push. 79;;; 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 83;;; unworthwhile. 84(define-vop (push-values) 85 (:args (vals :more t)) 86 (:results (start :scs (any-reg) :from :load) 87 (count :scs (any-reg))) 88 (:info nvals) 89 (:temporary (:scs (descriptor-reg)) temp) 90 (:generator 20 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)) 94 (i 0 (1+ i))) 95 ((null val)) 96 (let ((tn (tn-ref-tn val))) 97 (sc-case tn 98 (descriptor-reg 99 (storew tn start i)) 100 (control-stack 101 (load-stack-tn temp tn) 102 (storew temp start i))))) 103 (inst li count (fixnumize nvals)))) 104 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)) 109 (:arg-types list) 110 (:policy :fast-safe) 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) 116 (:vop-var vop) 117 (:save-p :compute-only) 118 (:generator 0 119 (let ((loop (gen-label)) 120 (done (gen-label))) 121 122 (move list arg) 123 (move start csp-tn) 124 125 (emit-label loop) 126 (inst cmp list null-tn) 127 (inst b :eq done) 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) 134 135 (emit-label done) 136 (inst sub count csp-tn start)))) 137 138 139 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))) 153 (:generator 20 154 (sc-case skip 155 (zero 156 (move src context)) 157 (immediate 158 (inst add src context (* (tn-value skip) n-word-bytes))) 159 (any-reg 160 (inst add src context skip))) 161 (inst orcc count zero-tn num) 162 (inst b :eq done) 163 (inst move start csp-tn) 164 (inst move dst csp-tn) 165 (inst add csp-tn count) 166 (inst move i count) 167 LOOP 168 (inst subcc i 4) 169 (inst ld temp src i) 170 (inst b :ne loop) 171 (inst st temp dst i) 172 DONE)) 173