From c96816eda141aefc901431a60da1a8f24008ab3b Mon Sep 17 00:00:00 2001 From: wlott <wlott> Date: Mon, 1 Apr 1991 13:43:06 +0000 Subject: [PATCH] Fixed copy-more-args to restore the stack pointer when done. Fixed tail-call- variable to actually work. --- assembly/rt/assem-rtns.lisp | 50 ++++++++++++++++++++++--------------- 1 file changed, 30 insertions(+), 20 deletions(-) diff --git a/assembly/rt/assem-rtns.lisp b/assembly/rt/assem-rtns.lisp index fb2fd9977..c76bd587e 100644 --- a/assembly/rt/assem-rtns.lisp +++ b/assembly/rt/assem-rtns.lisp @@ -7,7 +7,7 @@ ;;; Lisp, please contact Scott Fahlman (Scott.Fahlman@CS.CMU.EDU) ;;; ********************************************************************** ;;; -;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/rt/assem-rtns.lisp,v 1.2 1991/04/01 13:38:59 chiles Exp $ +;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/rt/assem-rtns.lisp,v 1.3 1991/04/01 13:43:06 wlott Exp $ ;;; (in-package "RT") @@ -258,6 +258,7 @@ (loadw srcstart csp-tn -3) (loadw dstend csp-tn -2) (loadw temp csp-tn -1) + (inst dec csp-tn (* 3 word-bytes)) (inst b lip-tn)) @@ -268,36 +269,45 @@ ;; These are really args. ((:temp args any-reg nl0-offset) ;; These are needed by the blitting code. - (:temp nargs/src any-reg lra-offset) - (:temp lexenv/dst any-reg lexenv-offset) - (:temp count any-reg nargs-offset) + (:temp count any-reg lra-offset) + (:temp dst any-reg lexenv-offset) + (:temp nargs any-reg nargs-offset) (:temp temp descriptor-reg cname-offset) ;; These are needed so we can get at the register args. (:temp a0 descriptor-reg a0-offset) (:temp a1 descriptor-reg a1-offset) (:temp a2 descriptor-reg a2-offset)) ;; Calculate NARGS (as a fixnum). - (move nargs/src csp-tn) - (inst s nargs/src args) + (move nargs csp-tn) + (inst s nargs args) ;; Load the argument registers now because the argument moving might trash ;; these locations. - (loadw a0 args (* 0 vm:word-bytes)) - (loadw a1 args (* 1 vm:word-bytes)) - (loadw a2 args (* 2 vm:word-bytes)) - ;; Calc SRC, DST, and COUNT. - (inst a count nargs/src (fixnum (- register-arg-count))) + (loadw a0 args 0) + (loadw a1 args 1) + (loadw a2 args 2) + ;; Are we done? + (inst c nargs (fixnum register-arg-count)) (inst bnc :gt done) - (inst a nargs/src args (* vm:word-bytes register-arg-count)) - (inst a lexenv/dst cfp-tn (* vm:word-bytes register-arg-count)) + ;; Calc DST and COUNT after saving those registers. + (inst inc csp-tn (* word-bytes 2)) + (storew count csp-tn -1) + (storew dst csp-tn -2) + (inst a count nargs (fixnum (- register-arg-count))) + (inst a args (* vm:word-bytes register-arg-count)) + (inst a dst cfp-tn (* vm:word-bytes register-arg-count)) LOOP ;; Copy one arg. - (loadw temp nargs/src) - (inst a nargs/src vm:word-bytes) - (storew temp lexenv/dst) - (inst a count (fixnum -1)) - (inst bc :gt loop) - (inst a lexenv/dst vm:word-bytes) + (loadw temp args) + (inst inc args vm:word-bytes) + (storew temp dst) + (inst s count (fixnum 1)) + (inst bcx :gt loop) + (inst inc dst vm:word-bytes) + ;; Restore + (loadw count csp-tn -1) + (loadw dst csp-tn -2) + (inst dec csp-tn (* word-bytes 2)) DONE ;; We are done. Do the jump. - (loadw temp lexenv/dst vm:closure-function-slot vm:function-pointer-type) + (loadw temp dst vm:closure-function-slot vm:function-pointer-type) (lisp-jump temp lip-tn)) -- GitLab