- ,@(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))
- '(#!-gengc
- :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 subq csp-tn new-fp nargs-pass)
- ,@(let ((index -1))
- (mapcar #'(lambda (name)
- `(inst ldl ,name
- ,(ash (incf index)
- word-shift)
- new-fp))
- register-arg-names)))
- '((inst li (fixnumize nargs) nargs-pass))))
- ,@(if (eq return :tail)
- '((:load-ocfp
- (sc-case ocfp
- (any-reg
- (inst move ocfp ocfp-pass))
- (control-stack
- (inst ldl ocfp-pass
- (ash (tn-offset ocfp)
- word-shift)
- cfp-tn))))
- (:load-return-pc
- (sc-case return-pc
- (#!-gengc descriptor-reg #!+gengc any-reg
- (inst move return-pc return-pc-pass))
- (control-stack
- (inst ldl return-pc-pass
- (ash (tn-offset return-pc)
- word-shift)
- cfp-tn))))
- (:frob-nfp
- (inst addq cur-nfp
- (bytes-needed-for-non-descriptor-stack-frame)
- nsp-tn)))
- `(#!-gengc
- (: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
- (inst move cfp-tn ocfp-pass))
- (:load-fp
- ,(if variable
- '(move new-fp cfp-tn)
- '(if (> nargs register-arg-count)
- (move new-fp cfp-tn)
- (move csp-tn cfp-tn)))
- (trace-table-entry trace-table-call-site))))
- ((nil))))))
-
- ,@(if named
- `((sc-case name
- (descriptor-reg (move name name-pass))
- (control-stack
- (inst ldl name-pass
- (ash (tn-offset name) word-shift) cfp-tn)
- (do-next-filler))
- (constant
- (inst ldl name-pass
- (- (ash (tn-offset name) word-shift)
- other-pointer-type) code-tn)
- (do-next-filler)))
- (inst ldl entry-point
- (- (ash fdefn-raw-addr-slot word-shift)
- other-pointer-type) name-pass)
- (do-next-filler))
- `((sc-case arg-fun
- (descriptor-reg (move arg-fun lexenv))
- (control-stack
- (inst ldl lexenv
- (ash (tn-offset arg-fun) word-shift) cfp-tn)
- (do-next-filler))
- (constant
- (inst ldl lexenv
- (- (ash (tn-offset arg-fun) word-shift)
- other-pointer-type) code-tn)
- (do-next-filler)))
- #!-gengc
- (inst ldl function
- (- (ash closure-function-slot word-shift)
- function-pointer-type) lexenv)
- #!-gengc
- (do-next-filler)
- #!-gengc
- (inst addq function
- (- (ash function-code-offset word-shift)
- function-pointer-type) entry-point)
- #!+gengc
- (inst ldl entry-point
- (- (ash closure-entry-point-slot word-shift)
- function-pointer-type) lexenv)
- #!+gengc
- (do-next-filler)))
- (loop
- (if (cdr filler)
- (do-next-filler)
- (return)))
-
- (note-this-location vop :call-site)
- (do-next-filler)
- (inst jsr zero-tn entry-point))
-
- ,@(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)
- (maybe-load-stack-nfp-tn cur-nfp nfp-save temp)))
- (: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)
- (maybe-load-stack-nfp-tn cur-nfp nfp-save temp)))
- (: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))
+ '(#!-gengc
+ :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 subq csp-tn new-fp nargs-pass)
+ ,@(let ((index -1))
+ (mapcar (lambda (name)
+ `(inst ldl ,name
+ ,(ash (incf index)
+ word-shift)
+ new-fp))
+ register-arg-names)))
+ '((inst li (fixnumize nargs) nargs-pass))))
+ ,@(if (eq return :tail)
+ '((:load-ocfp
+ (sc-case ocfp
+ (any-reg
+ (inst move ocfp ocfp-pass))
+ (control-stack
+ (inst ldl ocfp-pass
+ (ash (tn-offset ocfp)
+ word-shift)
+ cfp-tn))))
+ (:load-return-pc
+ (sc-case return-pc
+ (#!-gengc descriptor-reg #!+gengc any-reg
+ (inst move return-pc return-pc-pass))
+ (control-stack
+ (inst ldl return-pc-pass
+ (ash (tn-offset return-pc)
+ word-shift)
+ cfp-tn))))
+ (:frob-nfp
+ (inst addq cur-nfp
+ (bytes-needed-for-non-descriptor-stack-frame)
+ nsp-tn)))
+ `(#!-gengc
+ (: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
+ (inst move cfp-tn ocfp-pass))
+ (:load-fp
+ ,(if variable
+ '(move new-fp cfp-tn)
+ '(if (> nargs register-arg-count)
+ (move new-fp cfp-tn)
+ (move csp-tn cfp-tn)))
+ (trace-table-entry trace-table-call-site))))
+ ((nil))))))
+
+ ,@(if named
+ `((sc-case name
+ (descriptor-reg (move name name-pass))
+ (control-stack
+ (inst ldl name-pass
+ (ash (tn-offset name) word-shift) cfp-tn)
+ (do-next-filler))
+ (constant
+ (inst ldl name-pass
+ (- (ash (tn-offset name) word-shift)
+ other-pointer-lowtag) code-tn)
+ (do-next-filler)))
+ (inst ldl entry-point
+ (- (ash fdefn-raw-addr-slot word-shift)
+ other-pointer-lowtag) name-pass)
+ (do-next-filler))
+ `((sc-case arg-fun
+ (descriptor-reg (move arg-fun lexenv))
+ (control-stack
+ (inst ldl lexenv
+ (ash (tn-offset arg-fun) word-shift) cfp-tn)
+ (do-next-filler))
+ (constant
+ (inst ldl lexenv
+ (- (ash (tn-offset arg-fun) word-shift)
+ other-pointer-lowtag) code-tn)
+ (do-next-filler)))
+ #!-gengc
+ (inst ldl function
+ (- (ash closure-fun-slot word-shift)
+ fun-pointer-lowtag) lexenv)
+ #!-gengc
+ (do-next-filler)
+ #!-gengc
+ (inst addq function
+ (- (ash simple-fun-code-offset word-shift)
+ fun-pointer-lowtag) entry-point)
+ #!+gengc
+ (inst ldl entry-point
+ (- (ash closure-entry-point-slot word-shift)
+ fun-pointer-lowtag) lexenv)
+ #!+gengc
+ (do-next-filler)))
+ (loop
+ (if (cdr filler)
+ (do-next-filler)
+ (return)))
+
+ (note-this-location vop :call-site)
+ (do-next-filler)
+ (inst jsr zero-tn entry-point))
+
+ ,@(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)
+ (maybe-load-stack-nfp-tn cur-nfp nfp-save temp)))
+ (: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)
+ (maybe-load-stack-nfp-tn cur-nfp nfp-save temp)))
+ (:tail))))))