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