1(in-package "SB!VM") 2 3;;;; Return-multiple with other than one value 4 5#+sb-assembling ;; we don't want a vop for this one. 6(define-assembly-routine 7 (return-multiple 8 (:return-style :none)) 9 10 ;; These four are really arguments. 11 ((:temp nvals any-reg nargs-offset) 12 (:temp vals any-reg ocfp-offset) 13 (:temp old-fp any-reg nl2-offset) 14 (:temp lra descriptor-reg lexenv-offset) 15 16 ;; These are just needed to facilitate the transfer 17 (:temp count any-reg nfp-offset) 18 (:temp src any-reg code-offset) 19 (:temp dst descriptor-reg r8-offset) 20 21 ;; These are needed so we can get at the register args. 22 (:temp r0 descriptor-reg r0-offset) 23 (:temp r1 descriptor-reg r1-offset) 24 (:temp r2 descriptor-reg r2-offset)) 25 26 ;; Note, because of the way the return-multiple vop is written, we 27 ;; can assume that we are never called with nvals == 1 (not that it 28 ;; helps overmuch). 29 30 ;; If there are more return values than there are arg-passing 31 ;; registers, then we need to arrange for the excess values to be 32 ;; moved. 33 (inst cmp nvals (fixnumize 3)) 34 (inst b :gt MOVE-STACK-VALUES) 35 36 ;; We don't need to copy stack values at this point, so default any 37 ;; unsupplied values that should be in arg-passing registers. First 38 ;; piece of black magic: A computed jump. 39 (inst add pc-tn pc-tn nvals) 40 ;; Eat a word of padding for the computed jump. 41 (inst word 0) 42 43 ;; The computed jump above will land on one of the next four 44 ;; instructions, based on the number of values to return. 45 (inst mov r0 null-tn) 46 (inst mov r1 null-tn) 47 (inst mov r2 null-tn) 48 49 ;; We've defaulted any unsupplied parameters, but now we need to 50 ;; load the supplied parameters. Second piece of black magic: A 51 ;; hairier computed jump. 52 (inst rsb count nvals (fixnumize 2)) 53 (inst add pc-tn pc-tn count) 54 55 ;; The computed jump above will land on one of the next four 56 ;; instructions, based on the number of values to return, in reverse 57 ;; order. 58 (inst ldr r2 (@ vals (* 2 n-word-bytes))) 59 60 ;; If we need to copy stack values, we land here so as to load the 61 ;; first two register values (the third will be loaded after the 62 ;; values are copied, due to register pressure). 63 MOVE-STACK-VALUES 64 (inst ldr r1 (@ vals n-word-bytes)) 65 (inst ldr r0 (@ vals)) 66 67 ;; The last instruction to set the flags was the CMP to check to see 68 ;; if we needed to move the values on the stack. If we do not need 69 ;; to move the values on the stack then we're almost done. 70 (inst b :le DONE) 71 72 ;; Copy the remaining args (including the future R2 register value) 73 ;; over the outbound stack frame. 74 (inst add src vals (* 2 n-word-bytes)) 75 (inst add dst cfp-tn (* 2 n-word-bytes)) 76 (inst sub count nvals (fixnumize 2)) 77 78 LOOP 79 (inst subs count count (fixnumize 1)) 80 (inst ldr r2 (@ src n-word-bytes :post-index)) 81 (inst str r2 (@ dst n-word-bytes :post-index)) 82 (inst b :ge LOOP) 83 84 ;; Load the last remaining register result. 85 (inst ldr r2 (@ cfp-tn (* 2 n-word-bytes))) 86 87 DONE 88 89 ;; Deallocate the unused stack space. 90 (move ocfp-tn cfp-tn) 91 (move cfp-tn old-fp) 92 (inst add dst ocfp-tn nvals) 93 (store-csp dst) 94 95 ;; Return. 96 (lisp-return lra :multiple-values)) 97 98;;;; tail-call-variable. 99 100#+sb-assembling ;; no vop for this one either. 101(define-assembly-routine 102 (tail-call-variable 103 (:return-style :none)) 104 105 ;; These are really args. 106 ((:temp args any-reg nl2-offset) 107 (:temp lexenv descriptor-reg lexenv-offset) 108 109 ;; We need to compute this 110 (:temp nargs any-reg nargs-offset) 111 112 ;; These are needed by the blitting code. 113 (:temp dest any-reg nl2-offset) ;; Not live concurrent with ARGS. 114 (:temp count any-reg nl3-offset) 115 (:temp temp descriptor-reg r8-offset) 116 (:temp stack-top non-descriptor-reg ocfp-offset) 117 118 ;; These are needed so we can get at the register args. 119 (:temp r0 descriptor-reg r0-offset) 120 (:temp r1 descriptor-reg r1-offset) 121 (:temp r2 descriptor-reg r2-offset)) 122 123 ;; We're in a tail-call scenario, so we use the existing LRA and 124 ;; OCFP, both already set up in the stack frame. We have a set of 125 ;; arguments, represented as the address of the first argument 126 ;; (ARGS) and the address just beyond the last argument (CSP-TN), 127 ;; and need to set up the arg-passing-registers (R0, R1, and R2), 128 ;; any stack arguments (the fourth and subsequent arguments, if such 129 ;; exist), and the total arg count (NARGS). 130 131 ;; Calculate NARGS (as a fixnum) 132 (load-csp nargs) 133 (inst sub nargs nargs args) 134 135 ;; Load the argument regs (must do this now, 'cause the blt might 136 ;; trash these locations, and we need ARGS to be dead for the blt) 137 (loadw r0 args 0) 138 (loadw r1 args 1) 139 (loadw r2 args 2) 140 141 ;; ARGS is now dead, we access the remaining arguments by offset 142 ;; from CSP-TN. 143 144 ;; Figure out how many arguments we really need to shift. 145 (inst subs count nargs (fixnumize register-arg-count)) 146 ;; If there aren't any stack args then we're done. 147 (inst b :le DONE) 148 149 ;; Find where our shifted arguments ned to go. 150 (inst add dest cfp-tn nargs) 151 152 ;; And come from. 153 (load-csp stack-top) 154 155 LOOP 156 ;; Copy one arg. 157 (inst ldr temp (@ stack-top (- count))) 158 (inst str temp (@ dest (- count))) 159 (inst subs count count n-word-bytes) 160 (inst b :ne LOOP) 161 162 DONE 163 ;; The call frame is all set up, so all that remains is to jump to 164 ;; the new function. We need a boxed register to hold the actual 165 ;; function object (in case of closure functions or funcallable 166 ;; instances), and R8 (known as TEMP) and, technically, CODE happen 167 ;; to be the only ones available. 168 (loadw temp lexenv closure-fun-slot fun-pointer-lowtag) 169 (lisp-jump temp)) 170 171;;;; Non-local exit noise. 172 173(define-assembly-routine (throw 174 (:return-style :none)) 175 ((:arg target descriptor-reg r0-offset) 176 (:arg start any-reg r8-offset) 177 (:arg count any-reg nargs-offset) 178 (:temp catch any-reg r1-offset) 179 (:temp tag descriptor-reg r2-offset)) 180 (declare (ignore start count)) 181 182 (load-symbol-value catch *current-catch-block*) 183 184 LOOP 185 186 (let ((error (generate-error-code nil 'unseen-throw-tag-error target))) 187 (inst cmp catch 0) 188 (inst b :eq error)) 189 190 (loadw tag catch catch-block-tag-slot) 191 (inst cmp tag target) 192 (loadw catch catch catch-block-previous-catch-slot 0 :ne) 193 (inst b :ne LOOP) 194 195 ;; As a dreadful cleverness, make use of the fact that assembly 196 ;; routines are emitted in order, with no padding, and that the body 197 ;; of UNWIND follows to arrange for the stack to be unwound to our 198 ;; chosen destination. 199 (move target catch) ;; TARGET coincides with UNWIND's BLOCK argument 200 ) 201 202(define-assembly-routine (unwind 203 (:return-style :none) 204 (:translate %continue-unwind) 205 (:policy :fast-safe)) 206 ((:arg block (any-reg descriptor-reg) r0-offset) 207 (:arg start (any-reg descriptor-reg) r8-offset) 208 (:arg count (any-reg descriptor-reg) nargs-offset) 209 (:temp ocfp non-descriptor-reg ocfp-offset) 210 (:temp lra descriptor-reg lexenv-offset) 211 (:temp cur-uwp any-reg nl2-offset)) 212 (declare (ignore start count)) 213 214 (let ((error (generate-error-code nil 'invalid-unwind-error))) 215 (inst cmp block 0) 216 (inst b :eq error)) 217 218 (load-symbol-value cur-uwp *current-unwind-protect-block*) 219 (loadw ocfp block unwind-block-uwp-slot) 220 (inst cmp cur-uwp ocfp) 221 222 (loadw ocfp cur-uwp unwind-block-uwp-slot 0 :ne) 223 (store-symbol-value ocfp *current-unwind-protect-block* :ne) 224 225 (move cur-uwp block :eq) 226 227 (loadw cfp-tn cur-uwp unwind-block-cfp-slot) 228 (loadw code-tn cur-uwp unwind-block-code-slot) 229 (loadw lra cur-uwp unwind-block-entry-pc-slot) 230 (lisp-return lra :known)) 231