From d8421b5c13980bd12509706cdb02ab0afd8c8da7 Mon Sep 17 00:00:00 2001 From: wlott <wlott> Date: Thu, 10 May 1990 04:40:58 +0000 Subject: [PATCH] Fixed a lifetime problem with nvals != 1 return. Don't load the old-fp if it is on the stack, 'cause we can just load it into the passing location. --- compiler/mips/call.lisp | 22 +++++++++++++++------- 1 file changed, 15 insertions(+), 7 deletions(-) diff --git a/compiler/mips/call.lisp b/compiler/mips/call.lisp index 51affca10..add9a7459 100644 --- a/compiler/mips/call.lisp +++ b/compiler/mips/call.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman (FAHLMAN@CMUC). ;;; ********************************************************************** ;;; -;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/call.lisp,v 1.6 1990/05/09 06:39:00 wlott Exp $ +;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/call.lisp,v 1.7 1990/05/10 04:40:58 wlott Exp $ ;;; ;;; This file contains the VM definition of function call for the MIPS. ;;; @@ -797,8 +797,8 @@ default-value-5 (expand `(define-vop (return) (:args - (old-fp :scs (descriptor-reg any-reg)) - (return-pc :scs (descriptor-reg)) + (old-fp :scs (any-reg) :load-if (not (sc-is old-fp control-stack))) + (return-pc :scs (descriptor-reg) :to (:eval 1)) (values :more t)) (:ignore values) (:info nvals) @@ -807,8 +807,8 @@ default-value-5 :from (:eval 0) :to (:eval 1)) ,name)) register-arg-names register-arg-offsets) - (:temporary (:sc descriptor-reg :offset nargs-offset) nargs) - (:temporary (:sc descriptor-reg :offset old-fp-offset) val-ptr) + (:temporary (:sc any-reg :offset nargs-offset) nargs) + (:temporary (:sc any-reg :offset old-fp-offset) val-ptr) (:temporary (:scs (interior-reg) :type interior) lip) (:vop-var vop) (:generator 6 @@ -817,7 +817,11 @@ default-value-5 (let ((cur-nfp (current-nfp-tn vop))) (when cur-nfp (move nsp-tn cur-nfp))) - (move fp-tn old-fp) + (sc-case old-fp + (any-reg + (move fp-tn old-fp)) + (control-stack + (load-stack-tn fp-tn old-fp))) (inst addu lip return-pc (- (* 3 word-bytes) other-pointer-type)) (inst j lip) (move code-tn return-pc)) @@ -825,7 +829,11 @@ default-value-5 (inst li nargs (fixnum nvals)) (move val-ptr fp-tn) (inst addu csp-tn val-ptr (* nvals word-bytes)) - (move fp-tn old-fp) + (sc-case old-fp + (any-reg + (move fp-tn old-fp)) + (control-stack + (load-stack-tn fp-tn old-fp))) (let ((cur-nfp (current-nfp-tn vop))) (when cur-nfp (move nsp-tn cur-nfp))) -- GitLab