Skip to content
Snippets Groups Projects
Commit 28fa103f authored by wlott's avatar wlott
Browse files

Emit trace table entries for function prologues/epilogues and call sites.

parent f5f5e02e
No related branches found
No related tags found
No related merge requests found
......@@ -7,11 +7,11 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/call.lisp,v 1.37 1991/02/20 15:14:17 ram Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/call.lisp,v 1.38 1991/03/20 03:07:01 wlott Exp $")
;;;
;;; **********************************************************************
;;;
;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/call.lisp,v 1.37 1991/02/20 15:14:17 ram Exp $
;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/call.lisp,v 1.38 1991/03/20 03:07:01 wlott Exp $
;;;
;;; This file contains the VM definition of function call for the MIPS.
;;;
......@@ -176,6 +176,7 @@
;; Make sure the function is aligned, and drop a label pointing to this
;; function header.
(align vm:lowtag-bits)
(trace-table-entry trace-table-function-prologue)
(emit-label start-lab)
;; Allocate function header.
(inst function-header-word)
......@@ -193,20 +194,23 @@
(when nfp
(inst addu nsp-tn nsp-tn
(- (bytes-needed-for-non-descriptor-stack-frame)))
(move nfp nsp-tn)))))
(move nfp nsp-tn)))
(trace-table-entry trace-table-normal)))
(define-vop (allocate-frame)
(:results (res :scs (any-reg))
(nfp :scs (any-reg)))
(:info callee)
(:generator 2
(trace-table-entry trace-table-function-prologue)
(move res csp-tn)
(inst addu csp-tn csp-tn
(* vm:word-bytes (sb-allocated-size 'control-stack)))
(when (ir2-environment-number-stack-p callee)
(inst addu nsp-tn nsp-tn
(- (bytes-needed-for-non-descriptor-stack-frame)))
(move nfp nsp-tn))))
(move nfp nsp-tn))
(trace-table-entry trace-table-normal)))
;;; Allocate a partial frame for passing stack arguments in a full call. Nargs
;;; is the number of arguments passed. If no stack arguments are passed, then
......@@ -343,13 +347,15 @@ default-value-8
(let ((defaults (defaults)))
(when defaults
(assemble (*elsewhere*)
(trace-table-entry trace-table-call-site)
(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))))))))
(undefined-value))
......@@ -391,6 +397,7 @@ default-value-8
(emit-label done)
(assemble (*elsewhere*)
(trace-table-entry trace-table-call-site)
(emit-label variable-values)
(inst compute-code-from-lra code-tn code-tn lra-label temp)
(do ((arg register-arg-tns (rest arg))
......@@ -400,7 +407,8 @@ default-value-8
(move start args)
(move count nargs)
(inst b done)
(inst nop)))
(inst nop)
(trace-table-entry trace-table-normal)))
(undefined-value))
......@@ -456,6 +464,7 @@ default-value-8
(:temporary (:sc any-reg :offset old-fp-offset :from :eval) ocfp)
(:ignore arg-locs args ocfp)
(:generator 5
(trace-table-entry trace-table-call-site)
(let ((label (gen-label))
(cur-nfp (current-nfp-tn vop)))
(when cur-nfp
......@@ -472,7 +481,8 @@ default-value-8
(note-this-location vop :unknown-return)
(default-unknown-values values nvals move-temp temp label)
(when cur-nfp
(load-stack-tn cur-nfp nfp-save)))))
(load-stack-tn cur-nfp nfp-save)))
(trace-table-entry trace-table-normal)))
;;; Non-TR local call for a variable number of return values passed according
......@@ -494,6 +504,7 @@ default-value-8
(:vop-var vop)
(:temporary (:sc control-stack :offset nfp-save-offset) nfp-save)
(:generator 20
(trace-table-entry trace-table-call-site)
(let ((label (gen-label))
(cur-nfp (current-nfp-tn vop)))
(when cur-nfp
......@@ -510,7 +521,8 @@ default-value-8
(note-this-location vop :unknown-return)
(receive-unknown-values values-start nvals start count label temp)
(when cur-nfp
(load-stack-tn cur-nfp nfp-save)))))
(load-stack-tn cur-nfp nfp-save)))
(trace-table-entry trace-table-normal)))
;;;; Local call with known values return:
......@@ -535,6 +547,7 @@ default-value-8
(:temporary (:sc control-stack :offset nfp-save-offset) nfp-save)
(:temporary (:scs (non-descriptor-reg)) temp)
(:generator 5
(trace-table-entry trace-table-call-site)
(let ((label (gen-label))
(cur-nfp (current-nfp-tn vop)))
(when cur-nfp
......@@ -550,7 +563,8 @@ default-value-8
(emit-return-pc label)
(note-this-location vop :known-return)
(when cur-nfp
(load-stack-tn cur-nfp nfp-save)))))
(load-stack-tn cur-nfp nfp-save)))
(trace-table-entry trace-table-normal)))
;;; Return from known values call. We receive the return locations as
;;; arguments to terminate their lifetimes in the returning function. We
......@@ -572,6 +586,7 @@ default-value-8
(:ignore val-locs vals)
(:vop-var vop)
(:generator 6
(trace-table-entry trace-table-function-epilogue)
(maybe-load-stack-tn old-fp-temp old-fp)
(maybe-load-stack-tn return-pc-temp return-pc)
(move csp-tn fp-tn)
......@@ -581,7 +596,8 @@ default-value-8
(bytes-needed-for-non-descriptor-stack-frame))))
(inst addu lip return-pc-temp (- vm:word-bytes vm:other-pointer-type))
(inst j lip)
(move fp-tn old-fp-temp)))
(move fp-tn old-fp-temp)
(trace-table-entry trace-table-normal)))
;;;; Full call:
......@@ -712,6 +728,7 @@ default-value-8
(if (eq return :tail) 0 10)
15
(if (eq return :unknown) 25 0))
(trace-table-entry trace-table-call-site)
(let* ((cur-nfp (current-nfp-tn vop))
,@(unless (eq return :tail)
'((lra-label (gen-label))))
......@@ -841,7 +858,8 @@ default-value-8
lra-label temp)
(when cur-nfp
(load-stack-tn cur-nfp nfp-save))))
(:tail))))))
(:tail)))
(trace-table-entry trace-table-normal))))
(define-full-call call nil :fixed nil)
......@@ -926,6 +944,7 @@ default-value-8
(:vop-var vop)
(:generator 6
;; Clear the number stack.
(trace-table-entry trace-table-function-epilogue)
(let ((cur-nfp (current-nfp-tn vop)))
(when cur-nfp
(inst addu nsp-tn cur-nfp
......@@ -949,7 +968,8 @@ default-value-8
(dolist (reg (subseq (list a0 a1 a2 a3 a4 a5) nvals))
(move reg null-tn)))
;; And away we go.
(lisp-return return-pc lip)))))
(lisp-return return-pc lip)))
(trace-table-entry trace-table-normal)))
;;; Do unknown-values return of an arbitrary number of values (passed on the
;;; stack.) We check for the common case of a single return value, and do that
......@@ -973,6 +993,7 @@ default-value-8
(:vop-var vop)
(:generator 13
(trace-table-entry trace-table-function-epilogue)
(let ((not-single (gen-label)))
;; Clear the number stack.
(let ((cur-nfp (current-nfp-tn vop)))
......@@ -997,7 +1018,8 @@ default-value-8
(move vals vals-arg)
(move nvals nvals-arg)
(inst j (make-fixup 'return-multiple :assembly-routine))
(inst nop))))
(inst nop))
(trace-table-entry trace-table-normal)))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment