- ,@(unless (eq return :tail)
- '((lra-label (gen-label))))
- (filler
- (remove nil
- (list :load-nargs
- ,@(if (eq return :tail)
- '((unless (location= ocfp ocfp-pass)
- :load-ocfp)
- (unless (location= return-pc
- return-pc-pass)
- :load-return-pc)
- (when cur-nfp
- :frob-nfp))
- '(:comp-lra
- (when cur-nfp
- :frob-nfp)
- :save-fp
- :load-fp))))))
- (flet ((do-next-filler ()
- (let* ((next (pop filler))
- (what (if (consp next) (car next) next)))
- (ecase what
- (:load-nargs
- ,@(if variable
- `((inst subu nargs-pass csp-tn new-fp)
- ,@(let ((index -1))
- (mapcar #'(lambda (name)
- `(inst lw ,name new-fp
- ,(ash (incf index)
- word-shift)))
- register-arg-names)))
- '((inst li nargs-pass (fixnumize nargs)))))
- ,@(if (eq return :tail)
- '((:load-ocfp
- (sc-case ocfp
- (any-reg
- (move ocfp-pass ocfp t))
- (control-stack
- (inst lw ocfp-pass cfp-tn
- (ash (tn-offset ocfp)
- word-shift)))))
- (:load-return-pc
- (sc-case return-pc
- (descriptor-reg
- (move return-pc-pass return-pc t))
- (control-stack
- (inst lw return-pc-pass cfp-tn
- (ash (tn-offset return-pc)
- word-shift)))))
- (:frob-nfp
- (inst addu nsp-tn cur-nfp
- (bytes-needed-for-non-descriptor-stack-frame))))
- `((:comp-lra
- (inst compute-lra-from-code
- return-pc-pass code-tn lra-label temp))
- (:frob-nfp
- (store-stack-tn nfp-save cur-nfp))
- (:save-fp
- (move ocfp-pass cfp-tn t))
- (:load-fp
- ,(if variable
- '(move cfp-tn new-fp)
- '(if (> nargs register-arg-count)
- (move cfp-tn new-fp)
- (move cfp-tn csp-tn)))
- (trace-table-entry trace-table-call-site))))
- ((nil)
- (inst nop))))))
-
- ,@(if named
- `((sc-case name
- (descriptor-reg (move name-pass name))
- (control-stack
- (inst lw name-pass cfp-tn
- (ash (tn-offset name) word-shift))
- (do-next-filler))
- (constant
- (inst lw name-pass code-tn
- (- (ash (tn-offset name) word-shift)
- other-pointer-lowtag))
- (do-next-filler)))
- (inst lw entry-point name-pass
- (- (ash fdefn-raw-addr-slot word-shift)
- other-pointer-lowtag))
- (do-next-filler))
- `((sc-case arg-fun
- (descriptor-reg (move lexenv arg-fun))
- (control-stack
- (inst lw lexenv cfp-tn
- (ash (tn-offset arg-fun) word-shift))
- (do-next-filler))
- (constant
- (inst lw lexenv code-tn
- (- (ash (tn-offset arg-fun) word-shift)
- other-pointer-lowtag))
- (do-next-filler)))
- (inst lw function lexenv
- (- (ash closure-fun-slot word-shift)
- fun-pointer-lowtag))
- (do-next-filler)
- (inst addu entry-point function
- (- (ash simple-fun-code-offset word-shift)
- fun-pointer-lowtag))))
- (loop
- (if (cdr filler)
- (do-next-filler)
- (return)))
-
- (do-next-filler)
- (note-this-location vop :call-site)
- (inst j entry-point)
- (inst nop))
-
- ,@(ecase return
- (:fixed
- '((trace-table-entry trace-table-normal)
- (emit-return-pc lra-label)
- (default-unknown-values vop values nvals
- move-temp temp lra-label)
- (when cur-nfp
- (load-stack-tn cur-nfp nfp-save))))
- (:unknown
- '((trace-table-entry trace-table-normal)
- (emit-return-pc lra-label)
- (note-this-location vop :unknown-return)
- (receive-unknown-values values-start nvals start count
- lra-label temp)
- (when cur-nfp
- (load-stack-tn cur-nfp nfp-save))))
- (:tail))))))
+ ,@(unless (eq return :tail)
+ '((lra-label (gen-label))))
+ (filler
+ (remove nil
+ (list :load-nargs
+ ,@(if (eq return :tail)
+ '((unless (location= ocfp ocfp-pass)
+ :load-ocfp)
+ (unless (location= return-pc
+ return-pc-pass)
+ :load-return-pc)
+ (when cur-nfp
+ :frob-nfp))
+ '(:comp-lra
+ (when cur-nfp
+ :frob-nfp)
+ :save-fp
+ :load-fp))))))
+ (flet ((do-next-filler ()
+ (let* ((next (pop filler))
+ (what (if (consp next) (car next) next)))
+ (ecase what
+ (:load-nargs
+ ,@(if variable
+ `((inst subu nargs-pass csp-tn new-fp)
+ ,@(let ((index -1))
+ (mapcar #'(lambda (name)
+ `(inst lw ,name new-fp
+ ,(ash (incf index)
+ word-shift)))
+ register-arg-names)))
+ '((inst li nargs-pass (fixnumize nargs)))))
+ ,@(if (eq return :tail)
+ '((:load-ocfp
+ (sc-case ocfp
+ (any-reg
+ (move ocfp-pass ocfp t))
+ (control-stack
+ (inst lw ocfp-pass cfp-tn
+ (ash (tn-offset ocfp)
+ word-shift)))))
+ (:load-return-pc
+ (sc-case return-pc
+ (descriptor-reg
+ (move return-pc-pass return-pc t))
+ (control-stack
+ (inst lw return-pc-pass cfp-tn
+ (ash (tn-offset return-pc)
+ word-shift)))))
+ (:frob-nfp
+ (inst addu nsp-tn cur-nfp
+ (bytes-needed-for-non-descriptor-stack-frame))))
+ `((:comp-lra
+ (inst compute-lra-from-code
+ return-pc-pass code-tn lra-label temp))
+ (:frob-nfp
+ (store-stack-tn nfp-save cur-nfp))
+ (:save-fp
+ (move ocfp-pass cfp-tn t))
+ (:load-fp
+ ,(if variable
+ '(move cfp-tn new-fp)
+ '(if (> nargs register-arg-count)
+ (move cfp-tn new-fp)
+ (move cfp-tn csp-tn)))
+ (trace-table-entry trace-table-call-site))))
+ ((nil)
+ (inst nop))))))
+
+ ,@(if named
+ `((sc-case name
+ (descriptor-reg (move name-pass name))
+ (control-stack
+ (inst lw name-pass cfp-tn
+ (ash (tn-offset name) word-shift))
+ (do-next-filler))
+ (constant
+ (inst lw name-pass code-tn
+ (- (ash (tn-offset name) word-shift)
+ other-pointer-lowtag))
+ (do-next-filler)))
+ (inst lw entry-point name-pass
+ (- (ash fdefn-raw-addr-slot word-shift)
+ other-pointer-lowtag))
+ (do-next-filler))
+ `((sc-case arg-fun
+ (descriptor-reg (move lexenv arg-fun))
+ (control-stack
+ (inst lw lexenv cfp-tn
+ (ash (tn-offset arg-fun) word-shift))
+ (do-next-filler))
+ (constant
+ (inst lw lexenv code-tn
+ (- (ash (tn-offset arg-fun) word-shift)
+ other-pointer-lowtag))
+ (do-next-filler)))
+ (inst lw function lexenv
+ (- (ash closure-fun-slot word-shift)
+ fun-pointer-lowtag))
+ (do-next-filler)
+ (inst addu entry-point function
+ (- (ash simple-fun-code-offset word-shift)
+ fun-pointer-lowtag))))
+ (loop
+ (if (cdr filler)
+ (do-next-filler)
+ (return)))
+
+ (do-next-filler)
+ (note-this-location vop :call-site)
+ (inst j entry-point)
+ (inst nop))
+
+ ,@(ecase return
+ (:fixed
+ '((trace-table-entry trace-table-normal)
+ (emit-return-pc lra-label)
+ (default-unknown-values vop values nvals
+ move-temp temp lra-label)
+ (when cur-nfp
+ (load-stack-tn cur-nfp nfp-save))))
+ (:unknown
+ '((trace-table-entry trace-table-normal)
+ (emit-return-pc lra-label)
+ (note-this-location vop :unknown-return)
+ (receive-unknown-values values-start nvals start count
+ lra-label temp)
+ (when cur-nfp
+ (load-stack-tn cur-nfp nfp-save))))
+ (:tail))))))