From 8fde9eb44248224bfbe393e30787a7743013e47c Mon Sep 17 00:00:00 2001 From: wlott <wlott> Date: Thu, 21 May 1992 02:20:39 +0000 Subject: [PATCH] Added :call-site code-locations. Changed default-unknown-values to emit either a :single-value-return or :unknown-return code-location. --- compiler/sparc/call.lisp | 14 +++++++++----- compiler/sparc/static-fn.lisp | 6 +++--- 2 files changed, 12 insertions(+), 8 deletions(-) diff --git a/compiler/sparc/call.lisp b/compiler/sparc/call.lisp index b998a9ac6..89f727049 100644 --- a/compiler/sparc/call.lisp +++ b/compiler/sparc/call.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/call.lisp,v 1.13 1992/04/29 16:50:41 wlott Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/call.lisp,v 1.14 1992/05/21 02:20:39 wlott Exp $") ;;; ;;; ********************************************************************** ;;; @@ -292,18 +292,20 @@ default-value-8 nop |# ;;; -(defun default-unknown-values (values nvals move-temp temp lra-label) +(defun default-unknown-values (vop values nvals move-temp temp lra-label) (declare (type (or tn-ref null) values) (type unsigned-byte nvals) (type tn move-temp temp)) (if (<= nvals 1) (progn (move csp-tn ocfp-tn) (inst nop) + (note-this-location vop :single-value-return) (inst compute-code-from-lra code-tn code-tn lra-label temp)) (let ((regs-defaulted (gen-label)) (defaulting-done (gen-label)) (default-stack-vals (gen-label))) ;; Branch off to the MV case. + (note-this-location vop :unknown-return) (inst b regs-defaulted) (if (> nvals register-arg-count) (inst subcc temp nargs-tn (fixnum register-arg-count)) @@ -473,11 +475,11 @@ default-value-8 (maybe-load-stack-tn cfp-tn fp) (inst compute-lra-from-code (callee-return-pc-tn callee) code-tn label temp) + (note-this-location vop :call-site) (inst b target) (inst nop) (emit-return-pc label) - (note-this-location vop :unknown-return) - (default-unknown-values values nvals move-temp temp label) + (default-unknown-values vop values nvals move-temp temp label) (when cur-nfp (load-stack-tn cur-nfp nfp-save))) (trace-table-entry trace-table-normal))) @@ -513,6 +515,7 @@ default-value-8 (maybe-load-stack-tn cfp-tn fp) (inst compute-lra-from-code (callee-return-pc-tn callee) code-tn label temp) + (note-this-location vop :call-site) (inst b target) (inst nop) (emit-return-pc label) @@ -556,6 +559,7 @@ default-value-8 (maybe-load-stack-tn cfp-tn fp) (inst compute-lra-from-code (callee-return-pc-tn callee) code-tn label temp) + (note-this-location vop :call-site) (inst b target) (inst nop) (emit-return-pc label) @@ -819,6 +823,7 @@ default-value-8 (do-next-filler) (return))) + (note-this-location vop :call-site) (inst j function (- (ash vm:function-header-code-offset vm:word-shift) vm:function-pointer-type)) @@ -827,7 +832,6 @@ default-value-8 ,@(ecase return (:fixed '((emit-return-pc lra-label) - (note-this-location vop :unknown-return) (default-unknown-values values nvals move-temp temp lra-label) (when cur-nfp (load-stack-tn cur-nfp nfp-save)))) diff --git a/compiler/sparc/static-fn.lisp b/compiler/sparc/static-fn.lisp index 18058d455..034575ecc 100644 --- a/compiler/sparc/static-fn.lisp +++ b/compiler/sparc/static-fn.lisp @@ -7,7 +7,7 @@ ;;; Lisp, please contact Scott Fahlman (Scott.Fahlman@CS.CMU.EDU) ;;; ********************************************************************** ;;; -;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/static-fn.lisp,v 1.2 1992/03/11 21:29:20 wlott Exp $ +;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/static-fn.lisp,v 1.3 1992/05/21 02:20:24 wlott Exp $ ;;; ;;; This file contains the VOPs and macro magic necessary to call static ;;; functions. @@ -93,11 +93,11 @@ (inst move old-fp cfp-tn) (inst move cfp-tn csp-tn) (inst compute-lra-from-code lra code-tn lra-label temp) + (note-this-location vop :call-site) (inst j func (- (ash function-header-code-offset word-shift) function-pointer-type)) (inst move code-tn func) (emit-return-pc lra-label) - (note-this-location vop :unknown-return) ,(collect ((bindings) (links)) (do ((temp (temp-names) (cdr temp)) (name 'values (gensym)) @@ -110,7 +110,7 @@ (links `(setf (tn-ref-across ,prev) ,name)))) `(let ,(bindings) ,@(links) - (default-unknown-values + (default-unknown-values vop ,(if (zerop num-results) nil 'values) ,num-results move-temp temp lra-label))) (when cur-nfp -- GitLab