From 28fa103f37de7a1bd953c0f6b17adda7be566977 Mon Sep 17 00:00:00 2001 From: wlott <wlott> Date: Wed, 20 Mar 1991 03:07:01 +0000 Subject: [PATCH] Emit trace table entries for function prologues/epilogues and call sites. --- compiler/mips/call.lisp | 48 ++++++++++++++++++++++++++++++----------- 1 file changed, 35 insertions(+), 13 deletions(-) diff --git a/compiler/mips/call.lisp b/compiler/mips/call.lisp index 124337345..9f31f63d4 100644 --- a/compiler/mips/call.lisp +++ b/compiler/mips/call.lisp @@ -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))) -- GitLab