From 96a6fd6aab85f6eba40a3501147585e58fb699f4 Mon Sep 17 00:00:00 2001
From: wlott <wlott>
Date: Thu, 1 Nov 1990 01:16:55 +0000
Subject: [PATCH] Changed GENERATE-CALL-SEQUENCE to return the temporaries it
 wants as a second value.

---
 assembly/assemfile.lisp    | 109 +++++++++++++++++--------------------
 assembly/mips/support.lisp |  55 ++++++++++++-------
 2 files changed, 84 insertions(+), 80 deletions(-)

diff --git a/assembly/assemfile.lisp b/assembly/assemfile.lisp
index 7b696b173..a52cc5f3d 100644
--- a/assembly/assemfile.lisp
+++ b/assembly/assemfile.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/assemfile.lisp,v 1.21 1990/10/31 23:44:09 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/assemfile.lisp,v 1.22 1990/11/01 01:16:13 wlott Exp $
 ;;;
 ;;; This file contains the extra code necessary to feed an entire file of
 ;;; assembly code to the assembler.
@@ -141,67 +141,56 @@
 	 (results (remove :res vars :key #'reg-spec-kind :test-not #'eq))
 	 (return-style (or (cadr (assoc :return-style options)) :raw))
 	 (cost (or (cadr (assoc :cost options)) 247))
-	 (lip (make-symbol "LIP"))
-	 (lra (make-symbol "LRA"))
-	 (temp (make-symbol "TEMP"))
-	 (vop (make-symbol "VOP"))
-	 (nfp-save (make-symbol "NFP-SAVE")))
+	 (vop (make-symbol "VOP")))
     (unless (member return-style '(:raw :full-call :none))
       (error "Unknown return-style for ~S: ~S" name return-style))
-    `(define-vop ,(if (atom name) (list name) name)
-       (:args ,@(mapcar #'arg-or-res-spec args))
-       ,@(let ((index -1))
-	   (mapcar #'(lambda (arg)
-		       `(:temporary (:sc ,(reg-spec-sc arg)
-				     :offset ,(reg-spec-offset arg)
-				     :from (:argument ,(incf index))
-				     :to (:eval 2))
-				    ,(reg-spec-temp arg)))
-		   args))
-       ,@(mapcar #'(lambda (temp)
-		     `(:temporary (:sc ,(reg-spec-sc temp)
-				   :offset ,(reg-spec-offset temp)
-				   :from (:eval 1)
-				   :to (:eval 3))
-				  ,(reg-spec-name temp)))
-		 temps)
-       (:temporary (:scs (interior-reg) :type interior
-			 :from (:eval 0) :to (:eval 1))
-		   ,lip)
-       ,@(when (eq return-style :full-call)
-	   `((:temporary (:sc descriptor-reg :offset lra-offset
-			      :from (:eval 0) :to (:eval 1))
-			 ,lra)
-	     (:temporary (:scs (non-descriptor-reg)
-			       :from (:eval 0) :to (:eval 1))
-			 ,temp)
-	     (:temporary (:sc control-stack :offset nfp-save-offset) ,nfp-save)
-	     (:vop-var ,vop)))
-       ,@(let ((index -1))
-	   (mapcar #'(lambda (res)
-		       `(:temporary (:sc ,(reg-spec-sc res)
-				     :offset ,(reg-spec-offset res)
-				     :from (:eval 2)
-				     :to (:result ,(incf index))
-				     :target ,(reg-spec-name res))
-				    ,(reg-spec-temp res)))
-		   results))
-       (:results ,@(mapcar #'arg-or-res-spec results))
-       (:ignore ,lip ,@(mapcar #'reg-spec-name temps))
-       ,@(remove-if #'(lambda (x)
-			(member x '(:return-style :cost)))
-		    options
-		    :key #'car)
-       (:generator ,cost
-	 ,@(mapcar #'(lambda (arg)
-		       `(move ,(reg-spec-temp arg)
-			      ,(reg-spec-name arg)))
-		   args)
-	 ,@(generate-call-sequence name return-style vop temp nfp-save lra)
-	 ,@(mapcar #'(lambda (res)
-		       `(move ,(reg-spec-name res)
-			      ,(reg-spec-temp res)))
-		   results)))))
+    (multiple-value-bind
+	(call-sequence call-temps)
+	(generate-call-sequence name return-style vop)
+      `(define-vop ,(if (atom name) (list name) name)
+	 (:args ,@(mapcar #'arg-or-res-spec args))
+	 ,@(let ((index -1))
+	     (mapcar #'(lambda (arg)
+			 `(:temporary (:sc ,(reg-spec-sc arg)
+					   :offset ,(reg-spec-offset arg)
+					   :from (:argument ,(incf index))
+					   :to (:eval 2))
+				      ,(reg-spec-temp arg)))
+		     args))
+	 ,@(mapcar #'(lambda (temp)
+		       `(:temporary (:sc ,(reg-spec-sc temp)
+					 :offset ,(reg-spec-offset temp)
+					 :from (:eval 1)
+					 :to (:eval 3))
+				    ,(reg-spec-name temp)))
+		   temps)
+	 ,@call-temps
+	 (:vop-var ,vop)
+	 ,@(let ((index -1))
+	     (mapcar #'(lambda (res)
+			 `(:temporary (:sc ,(reg-spec-sc res)
+					   :offset ,(reg-spec-offset res)
+					   :from (:eval 2)
+					   :to (:result ,(incf index))
+					   :target ,(reg-spec-name res))
+				      ,(reg-spec-temp res)))
+		     results))
+	 (:results ,@(mapcar #'arg-or-res-spec results))
+	 (:ignore ,@(mapcar #'reg-spec-name temps))
+	 ,@(remove-if #'(lambda (x)
+			  (member x '(:return-style :cost)))
+		      options
+		      :key #'car)
+	 (:generator ,cost
+	   ,@(mapcar #'(lambda (arg)
+			 `(move ,(reg-spec-temp arg)
+				,(reg-spec-name arg)))
+		     args)
+	   ,@call-sequence
+	   ,@(mapcar #'(lambda (res)
+			 `(move ,(reg-spec-name res)
+				,(reg-spec-temp res)))
+		     results))))))
 
 (defmacro define-assembly-routine (name&options vars &rest code)
   (multiple-value-bind (name options)
diff --git a/assembly/mips/support.lisp b/assembly/mips/support.lisp
index 3861a4a7e..46985f73f 100644
--- a/assembly/mips/support.lisp
+++ b/assembly/mips/support.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/mips/support.lisp,v 1.1 1990/10/31 23:44:31 wlott Exp $
+;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/mips/support.lisp,v 1.2 1990/11/01 01:16:55 wlott Exp $
 ;;;
 ;;; This file contains the machine specific support routines needed by
 ;;; the file assembler.
@@ -17,27 +17,42 @@
 (defun generate-call-sequence (name style vop temp nfp-save lra)
   (ecase style
     (:raw
-     `((inst jal (make-fixup ',name :assembly-routine))
-       (inst nop)))
+     (values
+      `((inst jal (make-fixup ',name :assembly-routine))
+	(inst nop))
+      nil))
     (:full-call
-     `((let ((lra-label (gen-label))
-	     (cur-nfp (current-nfp-tn ,vop)))
-	 (when cur-nfp
-	   (store-stack-tn ,nfp-save cur-nfp))
-	 (inst compute-lra-from-code ,lra code-tn lra-label ,temp)
-	 (inst j (make-fixup ',name :assembly-routine))
-	 (inst nop)
-	 (emit-return-pc lra-label)
-	 (note-this-location ,vop :unknown-return)
-	 (move csp-tn old-fp-tn)
-	 (inst nop)
-	 (inst compute-code-from-lra code-tn code-tn
-	       lra-label ,temp)
-	 (when cur-nfp
-	   (load-stack-tn cur-nfp ,nfp-save)))))
+     (let ((temp (make-symbol "TEMP"))
+	   (nfp-save (make-symbol "NFP-SAVE"))
+	   (lra (make-symbol "LRA")))
+       (values
+	`((let ((lra-label (gen-label))
+		(cur-nfp (current-nfp-tn ,vop)))
+	    (when cur-nfp
+	      (store-stack-tn ,nfp-save cur-nfp))
+	    (inst compute-lra-from-code ,lra code-tn lra-label ,temp)
+	    (inst j (make-fixup ',name :assembly-routine))
+	    (inst nop)
+	    (emit-return-pc lra-label)
+	    (note-this-location ,vop :unknown-return)
+	    (move csp-tn old-fp-tn)
+	    (inst nop)
+	    (inst compute-code-from-lra code-tn code-tn
+		  lra-label ,temp)
+	    (when cur-nfp
+	      (load-stack-tn cur-nfp ,nfp-save))))
+	`((:temporary (:scs (non-descriptor-reg) :from (:eval 0) :to (:eval 1))
+		      ,temp)
+	  (:temporary (:sc descriptor-reg :offset lra-offset
+			   :from (:eval 0) :to (:eval 1))
+		      ,lra)
+	  (:temporary (:scs (control-stack) :offset nfp-save-offset)
+		      ,nfp-save)))))
     (:none
-     `((inst j (make-fixup ',name :assembly-routine))
-       (inst nop)))))
+     (values
+      `((inst j (make-fixup ',name :assembly-routine))
+	(inst nop))
+      nil))))
 
 
 (defun generate-return-sequence (style)
-- 
GitLab