mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-05-09 09:10:44 -07:00
Code Issues Projects Releases Packages Wiki Activity

[wip]

Browse source
This commit is contained in:
Daniel Kochmański 2026-05-08 23:17:21 +02:00
parent d923a3a4b2
commit 3c677220b3
5 changed files with 19 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

8
src/c/clos/gfun.d
View file

@ -56,6 +56,14 @@ user_function_dispatch(cl_narg narg, ...)
cl_object
clos_set_funcallable_instance_function(cl_object x, cl_object function_or_t)
{
/* XXX the code below leads to crash (!) */
/* if (ecl_unlikely(ECL_FUNCALLABLE_P(x))) { */
/* FEwrong_type_nth_arg(@[clos::set-funcallable-instance-function], */
/* 1, x, @[clos::funcallable-standard-object]); */
/* } */
/* and this works */
if (ecl_unlikely(!ECL_INSTANCEP(x)))
FEwrong_type_nth_arg(@[clos::set-funcallable-instance-function],
1, x, @[ext::instance]);

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

@ -69,6 +69,13 @@ si_instance_slotds(cl_object x)
@(return x->instance.slotds);
}
cl_object
si_instance_fun_set(cl_object x)
{
x->instance.isgf = ECL_NULL_DISPATCH;
@(return x);
}
cl_object
si_instance_sig_set(cl_object x)
{

1
src/c/symbols_list.h
View file

@ -1321,6 +1321,7 @@ cl_symbols[] = {
{SYS_ "INSTANCE-NEW-STAMP" ECL_FUN("si_instance_new_stamp", si_instance_new_stamp, 1) ECL_VAR(SI_ORDINARY, OBJNULL)},
{SYS_ "INSTANCE-GET-STAMP" ECL_FUN("si_instance_get_stamp", si_instance_get_stamp, 1) ECL_VAR(SI_ORDINARY, OBJNULL)},
{SYS_ "INSTANCE-SLOTDS" ECL_FUN("si_instance_slotds", si_instance_slotds, 1) ECL_VAR(SI_ORDINARY, OBJNULL)},
{SYS_ "INSTANCE-FUN-SET" ECL_FUN("si_instance_fun_set", si_instance_fun_set, 1) ECL_VAR(SI_ORDINARY, OBJNULL)},
{SYS_ "INSTANCE-SIG-SET" ECL_FUN("si_instance_sig_set", si_instance_sig_set, 1) ECL_VAR(SI_ORDINARY, OBJNULL)},
{SYS_ "INSTANCE-CLASS" ECL_FUN("si_instance_class", si_instance_class, 1) ECL_VAR(SI_ORDINARY, OBJNULL)},
{SYS_ "INSTANCE-CLASS-SET" ECL_FUN("si_instance_class_set", si_instance_class_set, 2) ECL_VAR(SI_ORDINARY, OBJNULL)},

5
src/clos/standard.lsp
View file

@ -98,10 +98,9 @@
;; the class. -- jd 2021-12-10
(assert (class-finalized-p class))
(let ((x (si::allocate-raw-instance nil class (class-size class))))
(si::instance-sig-set x)
(si:instance-sig-set x)
(when (subtypep class 'funcallable-standard-class)
;; INV this will initialize (x)->instance.isgf.
(set-funcallable-instance-function x nil))
(si:instance-fun-set x))
x))
(defmethod make-instance ((class class) &rest initargs)

1
src/h/external.h
View file

@ -862,6 +862,7 @@ extern ECL_API cl_object si_instance_obsolete_p(cl_object x);
extern ECL_API cl_object si_instance_new_stamp(cl_object x);
extern ECL_API cl_object si_instance_get_stamp(cl_object x);
extern ECL_API cl_object si_instance_slotds(cl_object x);
extern ECL_API cl_object si_instance_fun_set(cl_object x);
extern ECL_API cl_object si_instance_sig_set(cl_object x);
extern ECL_API cl_object ecl_allocate_instance(cl_object clas, cl_index size);