mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-16 06:12:25 -08:00
Code Issues Projects Releases Packages Wiki Activity

The built-in classes vector is now a constant

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2011-12-16 23:38:00 +01:00
parent 9d557937b1
commit 2c92c946a3
5 changed files with 20 additions and 22 deletions
Download patch file Download diff file Expand all files Collapse all files

23
src/c/instance.d
View file

@ -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)
}
}

2
src/c/symbols_list.h
View file

@ -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},

2
src/c/symbols_list2.h
View file

@ -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},

11
src/clos/builtin.lsp
View file

@ -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)

4
src/cmp/sysfun.lsp
View file

@ -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)")