mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2025-12-06 02:40:26 -08:00
Code Issues Projects Releases Packages Wiki Activity

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

Browse source 
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.
This commit is contained in:
Daniel Kochmański 2020-04-13 15:38:58 +02:00
parent 97f174c0a5
commit 81a85f37bd
7 changed files with 31 additions and 19 deletions
Download patch file Download diff file Expand all files Collapse all files

4
src/c/clos/accessor.d
View file

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

14
src/c/clos/instance.d
View file

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

1
src/c/symbols_list.h
View file

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

1
src/c/symbols_list2.h
View file

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

23
src/clos/std-slot-value.lsp
View file

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

1
src/h/external.h
View file

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

6
src/h/object.h
View file

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