Commit 81a85f37 authored by Daniel Kochmański's avatar Daniel Kochmański
Browse files

clos: introduce a new system function si:instance-obsolete-p

It helps to determine whether the instance needs to be updated for a
class after redefinition. Currently it is done by comparing the
signature with the instance's class slots.
parent 97f174c0
......@@ -106,9 +106,7 @@ add_new_index(const cl_env_ptr env, cl_object gfun, cl_object instance, cl_objec
static void
ensure_up_to_date_instance(cl_object instance)
{
cl_object clas = ECL_CLASS_OF(instance);
cl_object slots = ECL_CLASS_SLOTS(clas);
unlikely_if (slots != ECL_UNBOUND && instance->instance.sig != slots) {
if (si_instance_obsolete_p(instance) == ECL_T) {
_ecl_funcall2(@'clos::update-instance', instance);
}
}
......
......@@ -40,6 +40,20 @@ si_allocate_raw_instance(cl_object orig, cl_object clas, cl_object size)
@(return orig);
}
cl_object
si_instance_obsolete_p(cl_object x)
{
/* The up-to-date status of a class is determined by instance.sig.
This slot contains a list of slot definitions that was used to
create the instance. When the class is updated, the list is newly
created. Structures are also "instances" but keep ECL_UNBOUND
instead of the list. */
if (x->instance.sig == ECL_UNBOUND)
return ECL_NIL;
return (x->instance.sig != ECL_CLASS_SLOTS(ECL_CLASS_OF(x)))
? ECL_T : ECL_NIL;
}
cl_object
si_instance_sig(cl_object x)
{
......
......@@ -1294,6 +1294,7 @@ cl_symbols[] = {
{SYS_ "GENERIC-FUNCTION-P", SI_ORDINARY, si_generic_function_p, 1, OBJNULL},
{SYS_ "INSTANCE-REF", SI_ORDINARY, si_instance_ref, 2, OBJNULL},
{SYS_ "INSTANCE-SET", SI_ORDINARY, si_instance_set, 3, OBJNULL},
{SYS_ "INSTANCE-OBSOLETE-P", SI_ORDINARY, si_instance_obsolete_p, 1, OBJNULL},
{SYS_ "INSTANCE-SIG", SI_ORDINARY, si_instance_sig, 1, OBJNULL},
{SYS_ "INSTANCE-SIG-SET", SI_ORDINARY, si_instance_sig_set, 1, OBJNULL},
{SYS_ "INSTANCE-CLASS", SI_ORDINARY, si_instance_class, 1, OBJNULL},
......
......@@ -1294,6 +1294,7 @@ cl_symbols[] = {
{SYS_ "GENERIC-FUNCTION-P","si_generic_function_p",1},
{SYS_ "INSTANCE-REF","si_instance_ref",2},
{SYS_ "INSTANCE-SET","si_instance_set",3},
{SYS_ "INSTANCE-OBSOLETE-P","si_instance_obsolete_p",1},
{SYS_ "INSTANCE-SIG","si_instance_sig",1},
{SYS_ "INSTANCE-SIG-SET","si_instance_sig_set",1},
{SYS_ "INSTANCE-CLASS","si_instance_class",1},
......
......@@ -141,19 +141,16 @@
;;; INSTANCE UPDATE PREVIOUS
;;;
(eval-when (:compile-toplevel :execute)
(defmacro ensure-up-to-date-instance (instance)
;; The up-to-date status of a class is determined by
;; instance.sig. This slot of the C structure contains a list of
;; slot definitions that was used to create the instance. When the
;; class is updated, the list is newly created. Structures are also
;; "instances" but keep ECL_UNBOUND instead of the list.
`(let* ((i ,instance)
(s (si::instance-sig i)))
(declare (:read-only i s))
(with-early-accessors (+standard-class-slots+)
(when (si:sl-boundp s)
(unless (eq s (class-slots (si::instance-class i)))
(update-instance i)))))))
(defmacro ensure-up-to-date-instance (instance)
;; The up-to-date status of a class is determined by
;; instance.sig. This slot of the C structure contains a list of
;; slot definitions that was used to create the instance. When the
;; class is updated, the list is newly created. Structures are
;; also "instances" but keep ECL_UNBOUND instead of the list.
`(let ((instance ,instance))
(declare (:read-only instance))
(when (si::instance-obsolete-p instance)
(update-instance instance)))))
(defun update-instance (x)
(si::instance-sig-set x))
......
......@@ -840,6 +840,7 @@ extern ECL_API cl_object si_instancep(cl_object x);
extern ECL_API cl_object si_unbound(void);
extern ECL_API cl_object si_sl_boundp(cl_object x);
extern ECL_API cl_object si_sl_makunbound(cl_object x, cl_object index);
extern ECL_API cl_object si_instance_obsolete_p(cl_object x);
extern ECL_API cl_object si_instance_sig(cl_object x);
extern ECL_API cl_object si_instance_sig_set(cl_object x);
......
......@@ -1026,11 +1026,11 @@ struct ecl_condition_variable {
#define ECL_CLASS_OF(x) (x)->instance.clas
#define ECL_SPEC_FLAG(x) (x)->instance.slots[0]
#define ECL_SPEC_OBJECT(x) (x)->instance.slots[3]
#define ECL_CLASS_NAME(x) (x)->instance.slots[3+0]
#define ECL_CLASS_NAME(x) (x)->instance.slots[3+0]
#define ECL_CLASS_SUPERIORS(x) (x)->instance.slots[3+1]
#define ECL_CLASS_INFERIORS(x) (x)->instance.slots[3+2]
#define ECL_CLASS_SLOTS(x) (x)->instance.slots[3+3]
#define ECL_CLASS_CPL(x) (x)->instance.slots[3+4]
#define ECL_CLASS_SLOTS(x) (x)->instance.slots[3+3]
#define ECL_CLASS_CPL(x) (x)->instance.slots[3+4]
#define ECL_INSTANCEP(x) ((ECL_IMMEDIATE(x)==0) && ((x)->d.t==t_instance))
#define ECL_NOT_FUNCALLABLE 0
#define ECL_STANDARD_DISPATCH 1
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment