(make-wired-tn *fixnum-primitive-type*
control-stack-arg-scn
ocfp-save-offset)))
+
(!def-vm-support-routine make-return-pc-save-location (env)
(let ((ptype *backend-t-primitive-type*))
(specify-save-tn
;; gets confused.
(without-scheduling ()
(note-this-location vop :single-value-return)
- (inst move csp-tn ocfp-tn)
+ (move csp-tn ocfp-tn t)
(inst nop))
(when lra-label
(inst compute-code-from-lra code-tn code-tn lra-label temp)))
(aver defaults)
(assemble (*elsewhere*)
(emit-label default-stack-vals)
+ (trace-table-entry trace-table-fun-prologue)
(do ((remaining defaults (cdr remaining)))
((null remaining))
(let ((def (car remaining)))
(emit-label (car def))
(when (null (cdr remaining))
(inst b defaulting-done))
- (store-stack-tn (cdr def) null-tn)))))))
+ (store-stack-tn (cdr def) null-tn)))
+ (trace-table-entry trace-table-normal)))))
(when lra-label
(inst compute-code-from-lra code-tn code-tn lra-label temp))))
(:ignore args save)
(:vop-var vop)
(:temporary (:sc control-stack :offset nfp-save-offset) nfp-save)
+ (:temporary (:scs (non-descriptor-reg)) temp)
(:generator 20
(let ((label (gen-label))
(cur-nfp (current-nfp-tn vop)))
(:vop-var vop)
(:info ,@(unless (or variable (eq return :tail)) '(arg-locs))
,@(unless variable '(nargs))
- ,@(when (eq return :fixed) '(nvals)))
+ ,@(when (eq return :fixed) '(nvals))
+ step-instrumenting)
(:ignore ,@(unless (or variable (eq return :tail)) '(arg-locs))
- ,@(unless variable '(args)))
+ ,@(unless variable '(args))
+ ;; Step instrumentation for full calls not implemented yet.
+ ;; See the PPC backend for an example.
+ step-instrumenting)
(:temporary (:sc descriptor-reg
:offset ocfp-offset
(when cur-nfp
(inst addu nsp-tn cur-nfp
(bytes-needed-for-non-descriptor-stack-frame))))
- ;; Establish the values pointer and values count.
- (move val-ptr cfp-tn)
- (inst li nargs (fixnumize nvals))
- ;; restore the frame pointer and clear as much of the control
- ;; stack as possible.
- (move cfp-tn ocfp)
- (inst addu csp-tn val-ptr (* nvals n-word-bytes))
- ;; pre-default any argument register that need it.
- (when (< nvals register-arg-count)
- (dolist (reg (subseq (list a0 a1 a2 a3 a4 a5) nvals))
- (move reg null-tn)))
- ;; And away we go.
- (lisp-return return-pc lip)
+ (cond ((= nvals 1)
+ ;; Clear the control stack, and restore the frame pointer.
+ (move csp-tn cfp-tn)
+ (move cfp-tn ocfp)
+ ;; Out of here.
+ (lisp-return return-pc lip :offset 2))
+ (t
+ ;; Establish the values pointer and values count.
+ (move val-ptr cfp-tn)
+ (inst li nargs (fixnumize nvals))
+ ;; restore the frame pointer and clear as much of the control
+ ;; stack as possible.
+ (move cfp-tn ocfp)
+ (inst addu csp-tn val-ptr (* nvals n-word-bytes))
+ ;; pre-default any argument register that need it.
+ (when (< nvals register-arg-count)
+ (dolist (reg (subseq (list a0 a1 a2 a3 a4 a5) nvals))
+ (move reg null-tn)))
+ ;; And away we go.
+ (lisp-return return-pc lip)))
(trace-table-entry trace-table-normal)))
;;; Do unknown-values return of an arbitrary number of values (passed on the
(emit-label done))))
-;;; More args are stored consequtively on the stack, starting immediately at
-;;; the context pointer. The context pointer is not typed, so the lowtag is 0.
-;;;
+;;; More args are stored consecutively on the stack, starting
+;;; immediately at the context pointer. The context pointer is not
+;;; typed, so the lowtag is 0.
(define-full-reffer more-arg * 0 0 (descriptor-reg any-reg) * %more-arg)
-
;;; Turn more arg (context, count) into a list.
-;;;
+(defoptimizer (%listify-rest-args stack-allocate-result) ((&rest args))
+ t)
+
(define-vop (listify-rest-args)
(:args (context-arg :target context :scs (descriptor-reg))
(count-arg :target count :scs (any-reg)))
(:results (result :scs (descriptor-reg)))
(:translate %listify-rest-args)
(:policy :safe)
+ (:node-var node)
(:generator 20
- (let ((enter (gen-label))
- (loop (gen-label))
- (done (gen-label)))
+ (let* ((enter (gen-label))
+ (loop (gen-label))
+ (done (gen-label))
+ (dx-p (node-stack-allocate-p node))
+ (alloc-area-tn (if dx-p csp-tn alloc-tn)))
(move context context-arg)
(move count count-arg)
;; Check to see if there are any arguments.
;; We need to do this atomically.
(pseudo-atomic (pa-flag)
+ (when dx-p
+ (align-csp temp))
;; Allocate a cons (2 words) for each item.
- (inst or result alloc-tn list-pointer-lowtag)
+ (inst srl result alloc-area-tn n-lowtag-bits)
+ (inst sll result n-lowtag-bits)
+ (inst or result list-pointer-lowtag)
(move dst result)
(inst sll temp count 1)
(inst b enter)
- (inst addu alloc-tn alloc-tn temp)
+ (inst addu alloc-area-tn temp)
;; Store the current cons in the cdr of the previous cons.
(emit-label loop)
(emit-label enter)
;; Grab one value.
(loadw temp context)
- (inst addu context context n-word-bytes)
+ (inst addu context n-word-bytes)
;; Dec count, and if != zero, go back for more.
(inst addu count count (fixnumize -1))
(frob unknown-key-arg-error unknown-key-arg-error
sb!c::%unknown-key-arg-error key)
(frob nil-fun-returned-error nil-fun-returned-error nil fun))
+
+;;; Single-stepping
+
+(define-vop (step-instrument-before-vop)
+ (:policy :fast-safe)
+ (:vop-var vop)
+ (:generator 3
+ ;; Stub! See the PPC backend for an example.
+ (note-this-location vop :step-before-vop)))
projects / sbcl.git / blobdiff