[movitz-cvs] CVS update: movitz/losp/muerte/los-closette.lisp

[Frode Vatvedt Fjeld]

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

Modified Files:
	los-closette.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:32 2004
Author: ffjeld

Index: movitz/losp/muerte/los-closette.lisp
diff -u movitz/losp/muerte/los-closette.lisp:1.7 movitz/losp/muerte/los-closette.lisp:1.8
--- movitz/losp/muerte/los-closette.lisp:1.7	Wed Apr 14 18:01:30 2004
+++ movitz/losp/muerte/los-closette.lisp	Mon Apr 19 11:06:32 2004
@@ -10,7 +10,7 @@
 ;;;; Author:        Frode Vatvedt Fjeld <frodef at acm.org>
 ;;;; Created at:    Tue Jul 23 14:29:10 2002
 ;;;;                
-;;;; $Id: los-closette.lisp,v 1.7 2004/04/14 22:01:30 ffjeld Exp $
+;;;; $Id: los-closette.lisp,v 1.8 2004/04/19 15:06:32 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -208,12 +208,17 @@
 
 (defun (setf find-class) (class class-name)
   (check-type class (or null class))
+  #+ignore
   (case class-name
     ((t) (setf (%run-time-context-slot 'the-class-t) class))
     (null (setf (%run-time-context-slot 'the-class-null) class))
     (symbol (setf (%run-time-context-slot 'the-class-symbol) class))
     (fixnum (setf (%run-time-context-slot 'the-class-fixnum) class))
     (cons (setf (%run-time-context-slot 'the-class-cons) class)))
+  (let ((map (load-global-constant classes)))
+    (when (member class-name (svref map 0))
+      (setf (svref map (1+ (position class-name (svref map 0))))
+	class)))
   (if class
       (setf (gethash class-name *class-table*) class)
     (remhash class-name *class-table*))
@@ -896,9 +901,6 @@
   `(defun ,name (instance)
      (with-inline-assembly (:returns :multiple-values)
        (:compile-form (:result-mode :eax) instance)
-;;;       (:leal (:eax -2) :ecx)
-;;;       (:testb 7 :cl)
-;;;       (:jnz '(:sub-program () (:int 68)))
        (:movl (:eax ,(bt:slot-offset 'movitz::movitz-std-instance 'movitz::slots))
 	      :eax)
        (:movl (:eax ,(+ (bt:slot-offset 'movitz::movitz-vector 'movitz::data)
@@ -1776,11 +1778,6 @@
     (warn "CLOS was already bootstrapped: ~S"
 	  (get 'clos-bootstrap 'have-bootstrapped)))
   (setf (get 'clos-bootstrap 'have-bootstrapped) :in-progress)
-  #+ignore
-  (setf (runtime-context-slot 'the-class-t) (gethash 't *class-table*)
-	(runtime-context-slot 'the-class-null) (gethash 'null *class-table*)
-	(runtime-context-slot 'the-class-symbol) (gethash 'symbol *class-table*)
-	(runtime-context-slot 'the-class-cons) (gethash 'cons *class-table*))
   (let ((real-camuc #'compute-applicable-methods-using-classes)
 	(real-class-slots #'class-slots)
 	(real-class-precedence-list #'class-precedence-list)