Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv2421
Modified Files: compiler.lisp Log Message: Tweaked eql some more.
Date: Sat Nov 20 02:29:54 2004 Author: ffjeld
Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.112 movitz/compiler.lisp:1.113 --- movitz/compiler.lisp:1.112 Sat Nov 20 00:56:14 2004 +++ movitz/compiler.lisp Sat Nov 20 02:29:52 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.112 2004/11/19 23:56:14 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.113 2004/11/20 01:29:52 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------
@@ -2575,8 +2575,11 @@
(defun instruction-uncontinues-p (instruction) "Is it impossible for control to return after instruction?" - (member (instruction-is instruction) - '(:jmp :ret))) + (or (member (instruction-is instruction) + '(:jmp :ret)) + (member instruction + '((:int 100)) + :test #'equalp)))
(defun sub-environment-p (env1 env2) (cond @@ -6589,7 +6592,7 @@ (rotatef x y) (rotatef x-type y-type) (rotatef x-singleton y-singleton)) - (let (;;(x-loc (new-binding-location (binding-target x) frame-map :default nil)) + (let (;; (x-loc (new-binding-location (binding-target x) frame-map :default nil)) (y-loc (new-binding-location (binding-target y) frame-map :default nil))) #+ignore (warn "eql ~S/~S ~S/~S" @@ -6617,7 +6620,6 @@ (case (operator return-mode) (:boolean-branch-on-false (when (not eql) - (warn "constant eql ~S to ~S" instruction (operands return-mode)) `((:jmp ',(operands return-mode))))) (t (break "Constant EQL: ~S ~S" (car x-singleton) (car y-singleton)))))) ((and x-singleton @@ -6652,15 +6654,22 @@ (movitz-immediate-value (car x-singleton)) y-loc))) (make-branch)))) + ((and x-singleton + (typep (car x-singleton) 'movitz-symbol) + (member y-loc '(:eax :ebx :edx))) + (append (make-load-constant (car x-singleton) y-loc funobj frame-map :op :cmpl) + (make-branch))) (y-singleton (break "y-singleton")) - ((or (movitz-subtypep x-type 'fixnum) - (movitz-subtypep x-type 'character) - (movitz-subtypep y-type 'fixnum) - (movitz-subtypep y-type 'character)) + ((or (movitz-subtypep x-type '(or fixnum character symbol vector)) + (movitz-subtypep y-type '(or fixnum character symbol vector))) (append (make-load-eax-ebx) `((:cmpl :eax :ebx)) (make-branch))) + #+ignore + ((warn "eql ~S/~S ~S/~S" + x x-loc + y y-loc)) ((eq :boolean-branch-on-false (operator return-mode)) (let ((eql-done (gensym "eql-done-")) (on-false-label (operands return-mode)))