diff options
author | Andy Wingo <wingo@pobox.com> | 2009-02-03 21:13:01 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2009-02-03 21:13:01 +0100 |
commit | ef7e18683c06a3a1524787becd29b8c11dbc5674 (patch) | |
tree | 8a4b4f4bbc34b9a126d44cf432373ab127910cb8 | |
parent | e94ecc68c285426544c195dc6d388e3ff0c87dd4 (diff) | |
download | guile-ef7e18683c06a3a1524787becd29b8c11dbc5674.tar.gz |
inline dispatch to program cmethods, tick in return, remove old goops methods
* libguile/objects.c (scm_apply_generic): Inline the case when the
generic is a program.
* libguile/vm-i-system.c (return): Tick when functions return.
* module/oop/goops.scm (object-eqv?, object-equal?): Remove these
historical methods.
-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 ;;; |