Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv11596

Modified Files: basic-macros.lisp Log Message: Changed the way (find-class '<foo>) is optimized for certain well-known classes. The idea is to avoid the normal hash-table lookup for some often-named classes.

Date: Mon Apr 19 11:06:26 2004 Author: ffjeld

Index: movitz/losp/muerte/basic-macros.lisp diff -u movitz/losp/muerte/basic-macros.lisp:1.16 movitz/losp/muerte/basic-macros.lisp:1.17 --- movitz/losp/muerte/basic-macros.lisp:1.16 Sun Apr 18 19:15:53 2004 +++ movitz/losp/muerte/basic-macros.lisp Mon Apr 19 11:06:26 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Wed Nov 8 18:44:57 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: basic-macros.lisp,v 1.16 2004/04/18 23:15:53 ffjeld Exp $ +;;;; $Id: basic-macros.lisp,v 1.17 2004/04/19 15:06:26 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------

@@ -860,13 +860,26 @@ (declare (ignore errorp)) (if (not (movitz:movitz-constantp symbol env)) form - (case (movitz::translate-program (movitz::eval-form symbol env) :muerte.cl :cl) - ((t) `(load-global-constant the-class-t)) - (fixnum '(load-global-constant the-class-fixnum)) - (null `(load-global-constant the-class-null)) - (symbol '(load-global-constant the-class-symbol)) - (cons '(load-global-constant the-class-cons)) - (t form)))) + (let* ((type (movitz:movitz-eval symbol env)) + (cl-type (movitz::translate-program type :muerte.cl :cl))) + (cond + ((eq t cl-type) + `(load-global-constant the-class-t)) + ((member type (movitz::image-classes-map movitz:*image*)) + `(with-inline-assembly (:returns :register) + (:globally (:movl (:edi (:edi-offset classes)) (:result-register))) + (:movl ((:result-register) ,(movitz::class-object-offset type)) + (:result-register)))) + (t (warn "unknown find-class: ~A" cl-type) + form)) + #+ignore + (case cl-type + ((t) `(load-global-constant the-class-t)) + (fixnum '(load-global-constant the-class-fixnum)) + (null `(load-global-constant the-class-null)) + (symbol '(load-global-constant the-class-symbol)) + (cons '(load-global-constant the-class-cons)) + (t form)))))

(define-compiler-macro class-of (object) `(with-inline-assembly (:returns :eax) @@ -886,7 +899,7 @@ (:leal ((:result-register) ,(- (movitz::tag :other))) :ecx) (:testb 7 :cl) - (:jnz '(:sub-program () (:int 68))) + (:jnz '(:sub-program () (:int 66))) (:movl ((:result-register) ,(bt:slot-offset 'movitz::movitz-std-instance slot)) (:result-register))))))

@@ -898,7 +911,7 @@ (:leal (:ebx ,(- (movitz::tag :other))) :ecx) (:testb 7 :cl) - (:jnz '(:sub-program () (:int 68))) + (:jnz '(:sub-program () (:int 66))) (:movl :eax (:ebx ,(bt:slot-offset 'movitz::movitz-std-instance slot)))))))

@@ -982,11 +995,6 @@ (:locally (:movl (:edi (:edi-offset ,name)) :ecx))) `(with-inline-assembly (:returns :untagged-fixnum-ecx) (:globally (:movl (:edi (:edi-offset ,name)) :ecx))))) - -;;;(define-compiler-macro (setf %runtime-context-slot) (value slot-name) -;;; `(with-inline-assembly (:returns :eax) -;;; (:compile-form (:result-mode :eax) ,value) -;;; (:movl :eax (:edi ,(movitz::global-constant-offset (movitz::eval-form slot-name))))))

(define-compiler-macro halt-cpu () (let ((infinite-loop-label (make-symbol "infinite-loop")))