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