Skip to content
Snippets Groups Projects
Commit 96a6fd6a authored by wlott's avatar wlott
Browse files

Changed GENERATE-CALL-SEQUENCE to return the temporaries it wants as a

second value.
parent 1430eb35
No related branches found
No related tags found
No related merge requests found
......@@ -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)
......
......@@ -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)
......
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