diff options
-rw-r--r-- | libguile/objects.c | 6 | ||||
-rw-r--r-- | libguile/vm-i-system.c | 2 | ||||
-rw-r--r-- | module/oop/goops.scm | 7 |
3 files changed, 7 insertions, 8 deletions
diff --git a/libguile/objects.c b/libguile/objects.c index e4a3d2a3a..e68ed37ef 100644 --- a/libguile/objects.c +++ b/libguile/objects.c @@ -39,6 +39,8 @@ #include "libguile/ports.h" #include "libguile/strings.h" #include "libguile/vectors.h" +#include "libguile/programs.h" +#include "libguile/vm.h" #include "libguile/validate.h" #include "libguile/objects.h" @@ -162,7 +164,9 @@ SCM scm_apply_generic (SCM gf, SCM args) { SCM cmethod = scm_mcache_compute_cmethod (SCM_ENTITY_PROCEDURE (gf), args); - if (scm_is_pair (cmethod)) + if (SCM_PROGRAM_P (cmethod)) + return scm_vm_apply (scm_the_vm (), cmethod, args); + else if (scm_is_pair (cmethod)) return scm_eval_body (SCM_CDR (SCM_CMETHOD_CODE (cmethod)), SCM_EXTEND_ENV (SCM_CAR (SCM_CMETHOD_CODE (cmethod)), args, diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c index 677db3ecc..d677a41b3 100644 --- a/libguile/vm-i-system.c +++ b/libguile/vm-i-system.c @@ -979,6 +979,8 @@ VM_DEFINE_INSTRUCTION (48, return, "return", 0, 0, 1) vm_return: EXIT_HOOK (); RETURN_HOOK (); + SYNC_REGISTER (); + SCM_TICK; /* allow interrupt here */ { SCM ret, *data; data = SCM_FRAME_DATA_ADDRESS (fp); diff --git a/module/oop/goops.scm b/module/oop/goops.scm index 453e0a9dd..0340a4c73 100644 --- a/module/oop/goops.scm +++ b/module/oop/goops.scm @@ -38,7 +38,6 @@ make-extended-generic make-accessor ensure-accessor make-method add-method! - object-eqv? object-equal? class-slot-ref class-slot-set! slot-unbound slot-missing slot-definition-name slot-definition-options slot-definition-allocation @@ -622,12 +621,6 @@ (define-method (eqv? x y) #f) (define-method (equal? x y) (eqv? x y)) -;;; These following two methods are for backward compatibility only. -;;; They are not called by the Guile interpreter. -;;; -(define-method (object-eqv? x y) #f) -(define-method (object-equal? x y) (eqv? x y)) - ;;; ;;; methods to display/write an object ;;; |