[movitz-cvs] CVS update: movitz/compiler.lisp
Frode Vatvedt Fjeld
ffjeld at common-lisp.net
Mon Jun 7 22:18:37 UTC 2004
Update of /project/movitz/cvsroot/movitz
In directory common-lisp.net:/tmp/cvs-serv12896
Modified Files:
compiler.lisp
Log Message:
Changed some details regarding how variables are located in registers
and stack.
Date: Mon Jun 7 15:18:37 2004
Author: ffjeld
Index: movitz/compiler.lisp
diff -u movitz/compiler.lisp:1.61 movitz/compiler.lisp:1.62
--- movitz/compiler.lisp:1.61 Mon May 24 12:10:12 2004
+++ movitz/compiler.lisp Mon Jun 7 15:18:37 2004
@@ -8,7 +8,7 @@
;;;; Created at: Wed Oct 25 12:30:49 2000
;;;; Distribution: See the accompanying file COPYING.
;;;;
-;;;; $Id: compiler.lisp,v 1.61 2004/05/24 19:10:12 ffjeld Exp $
+;;;; $Id: compiler.lisp,v 1.62 2004/06/07 22:18:37 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
@@ -2227,13 +2227,8 @@
(defclass closure-binding (function-binding located-binding) ())
(defclass lambda-binding (function-binding) ())
-#+ignore
(defclass temporary-name (located-binding)
- ;; Is the value that this binding is bound to dynamic-extent?
- (#+ignore
- (stack-frame-allocated-p ; also a property-list
- :initform nil
- :accessor stack-frame-allocated-p)))
+ ())
(defclass borrowed-binding (located-binding)
((reference-slot
@@ -2518,6 +2513,7 @@
free later, with a more specified frame-map."
(loop with free-so-far = free-registers
repeat distance for i in pc
+ while (not (null free-so-far))
doing
(cond
((and (instruction-is i :init-lexvar)
@@ -2534,20 +2530,34 @@
(member x protect-registers))))
free-so-far)))))
(t (case (instruction-is i)
- ((nil :call)
- (return nil))
+ ((nil)
+ (return nil)) ; a label, most likely
+ ((:call)
+ (setf free-so-far
+ (remove-if (lambda (r)
+ (not (eq r :push)))
+ free-so-far)))
((:into :clc :stc :cld :std))
- ((:jnz :je :jne :jz))
+ ((:jnz :je :jne :jz :jge)
+ (setf free-so-far
+ (remove :push free-so-far)))
+ ((:pushl :popl)
+ (setf free-so-far
+ (remove-if (lambda (r)
+ (or (eq r :push)
+ (tree-search i r)))
+ free-so-far)))
((:outb)
(setf free-so-far
(set-difference free-so-far '(:eax :edx))))
((:movb :testb :andb :cmpb)
(setf free-so-far
(remove-if (lambda (r)
- (or (tree-search i r)
- (tree-search i (register32-to-low8 r))))
+ (and (not (eq r :push))
+ (or (tree-search i r)
+ (tree-search i (register32-to-low8 r)))))
free-so-far)))
- ((:shrl :cmpl :pushl :popl :leal :movl :testl :andl :addl :subl :imull)
+ ((:sarl :shrl :cmpl :leal :movl :testl :andl :addl :subl :imull)
(setf free-so-far
(remove-if (lambda (r)
(tree-search i r))
@@ -2558,11 +2568,15 @@
(return (values nil t)))
(let ((exp (expand-extended-code i funobj frame-map)))
(when (tree-search exp '(:call :local-function-init))
- (return nil))
+ (setf free-so-far
+ (remove-if (lambda (r)
+ (not (eq r :push)))
+ free-so-far)))
(setf free-so-far
(remove-if (lambda (r)
- (or (tree-search exp r)
- (tree-search exp (register32-to-low8 r))))
+ (and (not (eq r :push))
+ (or (tree-search exp r)
+ (tree-search exp (register32-to-low8 r)))))
free-so-far))))
((:local-function-init)
(destructuring-bind (binding)
@@ -2572,6 +2586,7 @@
(t (warn "Dist ~D stopped by ~A"
distance i)
(return nil)))))
+ ;; do (warn "after ~A: ~A" i free-so-far)
finally (return free-so-far)))
(defun try-locate-in-register (binding var-counts funobj frame-map)
@@ -2581,7 +2596,7 @@
(let* ((count-init-pc (gethash binding var-counts))
(count (car count-init-pc))
(init-pc (cdr count-init-pc)))
- ;; (warn "count: ~D, init-pc: ~{~&~A~}" count init-pc)
+ ;; (warn "b ~S: count: ~D, init-pc: ~{~&~A~}" binding count init-pc)
(cond
((binding-lended-p binding)
;; We can't lend a register.
@@ -2599,7 +2614,7 @@
(member binding (find-read-bindings i)
:test #'binding-eql))
(cdr init-pc)
- :end 7))
+ :end 15))
(binding-destination (third load-instruction))
(distance (position load-instruction (cdr init-pc))))
(multiple-value-bind (free-registers more-later-p)
@@ -2631,6 +2646,18 @@
(first free-registers-no-ecx))
(more-later-p
(values nil :not-now))
+ ((and distance (typep binding 'temporary-name))
+ ;; We might push/pop this variable
+ (multiple-value-bind (push-available-p maybe-later)
+ (compute-free-registers (cdr init-pc) distance funobj frame-map
+ :free-registers '(:push))
+ ;; (warn "pushing.. ~S ~A ~A" binding push-available-p maybe-later)
+ (cond
+ (push-available-p
+ (values :push))
+ (maybe-later
+ (values nil :not-now))
+ (t (values nil :never)))))
(t (values nil :never))))))))
(t (values nil :never)))))
@@ -2826,13 +2853,20 @@
(t (assert (eq status :never))))))))
do (when (and try-again (not did-assign))
(let ((binding (or (find-if (lambda (b)
+ (and (typep b 'positional-function-argument)
+ (= 0 (function-argument-argnum b))
+ (not (new-binding-located-p b frame-map))))
+ bindings-fun-arg-sorted)
+ (find-if (lambda (b)
+ (and (typep b 'positional-function-argument)
+ (= 1 (function-argument-argnum b))
+ (not (new-binding-located-p b frame-map))))
+ bindings-fun-arg-sorted)
+ (find-if (lambda (b)
(and (not (new-binding-located-p b frame-map))
(not (typep b 'function-argument))))
bindings-register-goodness-sort
- :from-end t)
- (find-if (lambda (b)
- (not (new-binding-located-p b frame-map)))
- bindings-fun-arg-sorted))))
+ :from-end t))))
(when binding
(setf (new-binding-location binding frame-map)
(post-incf stack-frame-position))
@@ -3142,6 +3176,10 @@
`((:movl (-1 ,(single-value-register result-mode))
,(single-value-register result-mode))))))
(t (ecase lexb-location
+ (:push
+ (assert (member result-mode '(:eax :ebx :ecx :edx)))
+ (assert (not indirect-p))
+ `((:popl ,result-mode)))
(:eax
(assert (not indirect-p))
(ecase result-mode
@@ -3354,6 +3392,8 @@
(if (integerp location)
`((:movl ,source (:ebp ,(stack-frame-offset location))))
(ecase location
+ ((:push)
+ `((:pushl ,source)))
((:eax :ebx :ecx :edx)
(unless (eq source location)
`((:movl ,source ,location))))
@@ -5267,14 +5307,22 @@
(t #+ignore (when (and (not (tree-search code1 reg0))
(not (tree-search code1 :call)))
(warn "got b: ~S ~S for ~S: ~{~&~A~}" form0 form1 reg0 code1))
- (append (compile-form form0 funobj env nil :push)
- (compiler-call #'compile-form
- :form form1
- :funobj funobj
- :env env
- :result-mode reg1
- :with-stack-used 1)
- `((:popl ,reg0)))))
+ (let ((binding (make-instance 'temporary-name :name (gensym "tmp-")))
+ (xenv (make-local-movitz-environment env funobj)))
+ (movitz-env-add-binding xenv binding)
+ (append (compiler-call #'compile-form
+ :form form0
+ :funobj funobj
+ :env env
+ :result-mode reg0)
+ `((:init-lexvar ,binding :init-with-register ,reg0
+ :init-with-type ,(type-specifier-primary type0)))
+ (compiler-call #'compile-form
+ :form form1
+ :funobj funobj
+ :env xenv
+ :result-mode reg1)
+ `((:load-lexical ,binding ,reg0))))))
(and functional0 functional1)
t
(compiler-values-list (all0))
@@ -5624,7 +5672,8 @@
(defun can-expand-extended-p (extended-instruction frame-map)
"Given frame-map, can we expand i at this point?"
(and (every (lambda (b)
- (new-binding-located-p (binding-target b) frame-map))
+ (or (typep (binding-target b) 'constant-object-binding)
+ (new-binding-located-p (binding-target b) frame-map)))
(find-read-bindings extended-instruction))
(let ((written-binding (find-written-binding-and-type extended-instruction)))
(or (not written-binding)
More information about the Movitz-cvs
mailing list