From 2c92c946a3cdff7bea74fb76e95cd91a89b93302 Mon Sep 17 00:00:00 2001
From: Juan Jose Garcia Ripoll <jjgarcia@users.sourceforge.net>
Date: Fri, 16 Dec 2011 23:38:00 +0100
Subject: [PATCH] The built-in classes vector is now a constant

---
 src/c/instance.d      | 23 ++++++++++-------------
 src/c/symbols_list.h  |  2 +-
 src/c/symbols_list2.h |  2 +-
 src/clos/builtin.lsp  | 11 ++++++-----
 src/cmp/sysfun.lsp    |  4 ++--
 5 files changed, 20 insertions(+), 22 deletions(-)

diff --git a/src/c/instance.d b/src/c/instance.d
index 9f107169c..126f73a60 100644
--- a/src/c/instance.d
+++ b/src/c/instance.d
@@ -274,12 +274,10 @@ enum ecl_built_in_classes {
 cl_object
 cl_class_of(cl_object x)
 {
-	cl_env_ptr the_env = ecl_process_env();
 	size_t index;
-	cl_type tp = type_of(x);
-	if (tp == t_instance)
-		@(return CLASS_OF(x));
-	switch (tp) {
+	switch (type_of(x)) {
+	case t_instance:
+		@(return CLASS_OF(x))
 	case t_fixnum:
 	case t_bignum:
 		index = ECL_BUILTIN_INTEGER; break;
@@ -377,14 +375,13 @@ cl_class_of(cl_object x)
 		ecl_internal_error("not a lisp data object");
 	}
 	{
-		cl_object output;
-		x = ECL_SYM_VAL(the_env, @'clos::*builtin-classes*');
-		/* We have to be careful because *builtin-classes* might be empty! */
-		if (Null(x)) {
-			output = cl_find_class(1,@'t');
-		} else {
-			output = ecl_aref(x, index);
-		}
+		/* We have to be careful because +builtin-classes+ might be empty! */
+		/* In any case, since +builtin-classes+ is a constant, we may
+		 * optimize the slot access */
+		cl_object v = @'clos::+builtin-classes+'->symbol.value;
+		cl_object output = Null(v)?
+			cl_find_class(1,@'t') :
+			v->vector.self.t[index];
 		@(return output)
 	}
 }
diff --git a/src/c/symbols_list.h b/src/c/symbols_list.h
index a203de2a7..a2cf087b4 100755
--- a/src/c/symbols_list.h
+++ b/src/c/symbols_list.h
@@ -1628,7 +1628,7 @@ cl_symbols[] = {
 
 #ifdef CLOS
 {CLOS_ ".COMBINED-METHOD-ARGS.", CLOS_SPECIAL, NULL, -1, Cnil},
-{CLOS_ "*BUILTIN-CLASSES*", CLOS_SPECIAL, NULL, -1, Cnil},
+{CLOS_ "+BUILTIN-CLASSES+", CLOS_ORDINARY, NULL, -1, Cnil},
 {CLOS_ "*NEXT-METHODS*", CLOS_SPECIAL, NULL, -1, Cnil},
 {CLOS_ "*OPTIMIZE-SLOT-ACCESS*", CLOS_SPECIAL, NULL, -1, Ct},
 {CLOS_ "+THE-T-CLASS+", CLOS_ORDINARY, NULL, -1, Cnil},
diff --git a/src/c/symbols_list2.h b/src/c/symbols_list2.h
index 0b7508997..1191983b3 100644
--- a/src/c/symbols_list2.h
+++ b/src/c/symbols_list2.h
@@ -1628,7 +1628,7 @@ cl_symbols[] = {
 
 #ifdef CLOS
 {CLOS_ ".COMBINED-METHOD-ARGS.",NULL},
-{CLOS_ "*BUILTIN-CLASSES*",NULL},
+{CLOS_ "+BUILTIN-CLASSES+",NULL},
 {CLOS_ "*NEXT-METHODS*",NULL},
 {CLOS_ "*OPTIMIZE-SLOT-ACCESS*",NULL},
 {CLOS_ "+THE-T-CLASS+",NULL},
diff --git a/src/clos/builtin.lsp b/src/clos/builtin.lsp
index e37273d65..3633c10b6 100644
--- a/src/clos/builtin.lsp
+++ b/src/clos/builtin.lsp
@@ -40,7 +40,7 @@
   (error "The built-in class (~A) cannot be instantiated" class))
 
 (eval-when (:compile-toplevel :execute)
-  (defconstant +builtin-classes+
+  (defconstant +builtin-classes-list+
 	 '(;(t object)
 	    (sequence)
 	      (list sequence)
@@ -91,18 +91,19 @@
 	    #+semaphores (mp::semaphore)
 	    #+sse2 (ext::sse-pack))))
 
-(loop for (name . rest) in '#.+builtin-classes+
+(loop for (name . rest) in '#.+builtin-classes-list+
    with index = 1
    with built-in-class = (find-class 'built-in-class)
-   with array = (setf *builtin-classes* (make-array #.(1+ (length +builtin-classes+))
-						    :initial-element (find-class 't)))
+   with array = (make-array #.(1+ (length +builtin-classes-list+))
+			    :initial-element (find-class 't))
    do (let* ((direct-superclasses (mapcar #'find-class (or rest '(t))))
 	     (class (make-instance built-in-class :name name
 				   :direct-superclasses direct-superclasses
 				   :direct-slots nil)))
 	(setf (find-class name) class
 	      (aref array index) class
-	      index (1+ index))))
+	      index (1+ index)))
+   finally (si::*make-constant '+builtin-classes+ array))
 
 (defmethod ensure-class-using-class ((class null) name &rest rest)
   (multiple-value-bind (metaclass direct-superclasses options)
diff --git a/src/cmp/sysfun.lsp b/src/cmp/sysfun.lsp
index 6e83f4481..df6099b4f 100644
--- a/src/cmp/sysfun.lsp
+++ b/src/cmp/sysfun.lsp
@@ -818,8 +818,8 @@
 
 #+clos
 (def-inline si:instance-class :always (standard-object) t "CLASS_OF(#0)")
-;;#+clos
-;;(def-inline class-of :unsafe (standard-object) t "CLASS_OF(#0)")
+#+clos
+(def-inline class-of :unsafe (standard-object) t "CLASS_OF(#0)")
 
 #+clos
 (def-inline si::instancep :always (t) :bool "@0;ECL_INSTANCEP(#0)")