Skip to content
Snippets Groups Projects
Commit 404671ac authored by wlott's avatar wlott
Browse files

Save the NFP across static function calls.

parent ee987d8d
No related branches found
No related tags found
No related merge requests found
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;; Lisp, please contact Scott Fahlman (Scott.Fahlman@CS.CMU.EDU) ;;; Lisp, please contact Scott Fahlman (Scott.Fahlman@CS.CMU.EDU)
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/static-fn.lisp,v 1.8 1990/05/11 06:53:17 wlott Exp $ ;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/static-fn.lisp,v 1.9 1990/05/18 00:56:39 wlott Exp $
;;; ;;;
;;; This file contains the VOPs and macro magic necessary to call static ;;; This file contains the VOPs and macro magic necessary to call static
;;; functions. ;;; functions.
...@@ -22,6 +22,7 @@ ...@@ -22,6 +22,7 @@
(:save-p t) (:save-p t)
(:policy :safe) (:policy :safe)
(:variant-vars symbol) (:variant-vars symbol)
(:vop-var vop)
(:temporary (:scs (any-reg)) temp) (:temporary (:scs (any-reg)) temp)
(:temporary (:scs (descriptor-reg)) move-temp) (:temporary (:scs (descriptor-reg)) move-temp)
(:temporary (:sc descriptor-reg :offset lra-offset) lra) (:temporary (:sc descriptor-reg :offset lra-offset) lra)
...@@ -30,7 +31,8 @@ ...@@ -30,7 +31,8 @@
(:temporary (:scs (descriptor-reg)) function) (:temporary (:scs (descriptor-reg)) function)
(:temporary (:scs (interior-reg) :type interior) lip) (:temporary (:scs (interior-reg) :type interior) lip)
(:temporary (:sc any-reg :offset nargs-offset) nargs) (:temporary (:sc any-reg :offset nargs-offset) nargs)
(:temporary (:sc any-reg :offset old-fp-offset) old-fp)) (:temporary (:sc any-reg :offset old-fp-offset) old-fp)
(:temporary (:sc control-stack :offset nfp-save-offset) nfp-save))
(eval-when (compile load eval) (eval-when (compile load eval)
...@@ -84,11 +86,14 @@ ...@@ -84,11 +86,14 @@
,@(temps) ,@(temps)
(:results ,@(results)) (:results ,@(results))
(:generator ,(+ 50 num-args num-results) (:generator ,(+ 50 num-args num-results)
(let ((lra-label (gen-label))) (let ((lra-label (gen-label))
(cur-nfp (current-nfp-tn vop)))
,@(moves (temp-names) (arg-names)) ,@(moves (temp-names) (arg-names))
(inst li nargs (fixnum ,num-args)) (inst li nargs (fixnum ,num-args))
(load-symbol cname symbol) (load-symbol cname symbol)
(loadw lexenv cname vm:symbol-function-slot vm:other-pointer-type) (loadw lexenv cname vm:symbol-function-slot vm:other-pointer-type)
(when cur-nfp
(store-stack-tn nfp-save cur-nfp))
(move old-fp fp-tn) (move old-fp fp-tn)
(move fp-tn csp-tn) (move fp-tn csp-tn)
(inst compute-lra-from-code lra code-tn lra-label) (inst compute-lra-from-code lra code-tn lra-label)
...@@ -110,7 +115,9 @@ ...@@ -110,7 +115,9 @@
,@(links) ,@(links)
(default-unknown-values (default-unknown-values
,(if (zerop num-results) nil 'values) ,(if (zerop num-results) nil 'values)
,num-results move-temp temp lra-label)))) ,num-results move-temp temp lra-label)))
(when cur-nfp
(load-stack-tn cur-nfp nfp-save))
,@(moves (result-names) (temp-names)))))))) ,@(moves (result-names) (temp-names))))))))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment