[movitz-cvs] CVS update: movitz/compiler.lisp
Frode Vatvedt Fjeld
ffjeld at common-lisp.net
Tue Jul 20 11:39:21 UTC 2004
Update of /project/movitz/cvsroot/movitz
In directory common-lisp.net:/tmp/cvs-serv12513
Modified Files:
compiler.lisp
Log Message:
Fixed a bug in make-load-lexical wrt. loading a variable for :untagged-fixnum-ecx.
Date: Tue Jul 20 04:39:21 2004
Author: ffjeld
Index: movitz/compiler.lisp
diff -u movitz/compiler.lisp:1.78 movitz/compiler.lisp:1.79
--- movitz/compiler.lisp:1.78 Tue Jul 20 02:08:38 2004
+++ movitz/compiler.lisp Tue Jul 20 04:39:21 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.78 2004/07/20 09:08:38 ffjeld Exp $
+;;;; $Id: compiler.lisp,v 1.79 2004/07/20 11:39:21 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
@@ -3209,68 +3209,69 @@
(warn "The variable ~S is used even if it was declared ignored."
(binding-name binding)))
(let ((protect-registers (cons :edx protect-registers)))
- (flet ((chose-tmp-register (&optional preferred)
- (or tmp-register
- (unless (member preferred protect-registers)
- preferred)
- (first (set-difference '(:eax :ebx :edx)
- protect-registers))
- (error "Unable to chose a temporary register.")))
- (install-for-single-value (lexb lexb-location result-mode indirect-p)
- (cond
- ((and (eq result-mode :untagged-fixnum-ecx)
- (integerp lexb-location))
- (assert (not indirect-p))
- `((:movl ,(make-indirect-reference :ebp (stack-frame-offset lexb-location))
- :ecx)
- (:sarl ,+movitz-fixnum-shift+ :ecx)))
- ((integerp lexb-location)
- (append `((:movl ,(make-indirect-reference :ebp (stack-frame-offset lexb-location))
- ,(single-value-register result-mode)))
- (when indirect-p
- `((:movl (-1 ,(single-value-register result-mode))
- ,(single-value-register result-mode))))))
- (t (ecase (operator 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
- ((:ebx :ecx :edx :esi) `((:movl :eax ,result-mode)))
- ((:eax :single-value) nil)
- (:untagged-fixnum-ecx
- `((:movl :eax :ecx)
- (:sarl ,movitz:+movitz-fixnum-shift+ :ecx)))))
- ((:ebx :ecx :edx)
- (assert (not indirect-p))
- (unless (eq result-mode lexb-location)
+ (labels ((chose-tmp-register (&optional preferred)
+ (or tmp-register
+ (unless (member preferred protect-registers)
+ preferred)
+ (first (set-difference '(:eax :ebx :edx)
+ protect-registers))
+ (error "Unable to chose a temporary register.")))
+ (install-for-single-value (lexb lexb-location result-mode indirect-p)
+ (cond
+ ((and (eq result-mode :untagged-fixnum-ecx)
+ (integerp lexb-location))
+ (assert (not indirect-p))
+ (assert (not (member :eax protect-registers)))
+ (append (install-for-single-value lexb lexb-location :eax nil)
+ `((,*compiler-global-segment-prefix*
+ :call (:edi ,(global-constant-offset 'unbox-u32))))))
+ ((integerp lexb-location)
+ (append `((:movl ,(make-indirect-reference :ebp (stack-frame-offset lexb-location))
+ ,(single-value-register result-mode)))
+ (when indirect-p
+ `((:movl (-1 ,(single-value-register result-mode))
+ ,(single-value-register result-mode))))))
+ (t (ecase (operator 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
- ((:eax :single-value) `((:movl ,lexb-location :eax)))
- ((:ebx :ecx :edx :esi) `((:movl ,lexb-location ,result-mode)))
+ ((:ebx :ecx :edx :esi) `((:movl :eax ,result-mode)))
+ ((:eax :single-value) nil)
(:untagged-fixnum-ecx
- `((:movl ,lexb-location :ecx)
- (:sarl ,movitz:+movitz-fixnum-shift+ :ecx))))))
- (:argument-stack
- (assert (<= 2 (function-argument-argnum lexb)) ()
- "lexical :argument-stack argnum can't be ~A." (function-argument-argnum lexb))
- (cond
- ((eq result-mode :untagged-fixnum-ecx)
+ `((:movl :eax :ecx)
+ (:sarl ,movitz:+movitz-fixnum-shift+ :ecx)))))
+ ((:ebx :ecx :edx)
(assert (not indirect-p))
- `((:movl (:ebp ,(argument-stack-offset lexb)) :ecx)
- (:sarl ,+movitz-fixnum-shift+ :ecx)))
- (t (append `((:movl (:ebp ,(argument-stack-offset lexb))
- ,(single-value-register result-mode)))
- (when indirect-p
- `((:movl (-1 ,(single-value-register result-mode))
- ,(single-value-register result-mode))))))))
- (:untagged-fixnum-ecx
- (ecase result-mode
- ((:eax :ebx :ecx :edx)
- `((:leal ((:ecx ,+movitz-fixnum-factor+)) ,result-mode)))
- (:untagged-fixnum-ecx
- nil))))))))
+ (unless (eq result-mode lexb-location)
+ (ecase result-mode
+ ((:eax :single-value) `((:movl ,lexb-location :eax)))
+ ((:ebx :ecx :edx :esi) `((:movl ,lexb-location ,result-mode)))
+ (:untagged-fixnum-ecx
+ `((:movl ,lexb-location :ecx)
+ (:sarl ,movitz:+movitz-fixnum-shift+ :ecx))))))
+ (:argument-stack
+ (assert (<= 2 (function-argument-argnum lexb)) ()
+ "lexical :argument-stack argnum can't be ~A." (function-argument-argnum lexb))
+ (cond
+ ((eq result-mode :untagged-fixnum-ecx)
+ (assert (not indirect-p))
+ `((:movl (:ebp ,(argument-stack-offset lexb)) :ecx)
+ (:sarl ,+movitz-fixnum-shift+ :ecx)))
+ (t (append `((:movl (:ebp ,(argument-stack-offset lexb))
+ ,(single-value-register result-mode)))
+ (when indirect-p
+ `((:movl (-1 ,(single-value-register result-mode))
+ ,(single-value-register result-mode))))))))
+ (:untagged-fixnum-ecx
+ (ecase result-mode
+ ((:eax :ebx :ecx :edx)
+ `((:leal ((:ecx ,+movitz-fixnum-factor+)) ,result-mode)))
+ (:untagged-fixnum-ecx
+ nil))))))))
(etypecase binding
(forwarding-binding
(assert (not (binding-lended-p binding)) (binding)
More information about the Movitz-cvs
mailing list