diff options
author | Andy Wingo <wingo@pobox.com> | 2015-01-11 16:36:45 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2015-01-23 16:16:02 +0100 |
commit | 92928b8619d2711e9e05b94831a479525ba9aede (patch) | |
tree | 21978fd82a49db5db06ab970a62107a2901ea9f2 | |
parent | 4702cbeb3780d0c81076bae0723a1fd544576471 (diff) | |
download | guile-92928b8619d2711e9e05b94831a479525ba9aede.tar.gz |
Re-use the vtable "size" field for GOOPS nfields
* module/oop/goops.scm (fold-<class>-slots): The first "reserved" slot
is actually for instance sizes, used by the "simple struct"
mechanism. Reuse this field for GOOPS's "nfields".
(make-standard-class, <class>, initialize): Adapt order of field
initializations.
* libguile/goops.h (SCM_CLASS_CLASS_LAYOUT, SCM_N_CLASS_SLOTS)
* libguile/goops.c (scm_sys_allocate_instance): Adapt.
-rw-r--r-- | libguile/goops.c | 2 | ||||
-rw-r--r-- | libguile/goops.h | 6 | ||||
-rw-r--r-- | module/oop/goops.scm | 13 |
3 files changed, 9 insertions, 12 deletions
diff --git a/libguile/goops.c b/libguile/goops.c index 37e3fd2b5..05bc06e15 100644 --- a/libguile/goops.c +++ b/libguile/goops.c @@ -544,7 +544,7 @@ SCM_DEFINE (scm_sys_allocate_instance, "%allocate-instance", 2, 0, 0, /* FIXME: duplicates some of scm_make_struct. */ - n = SCM_I_INUM (SCM_SLOT (class, scm_si_nfields)); + n = SCM_STRUCT_DATA_REF (class, scm_vtable_index_size); obj = scm_i_alloc_struct (SCM_STRUCT_DATA (class), n); layout = SCM_VTABLE_LAYOUT (class); diff --git a/libguile/goops.h b/libguile/goops.h index eec1973fa..8992c2b9f 100644 --- a/libguile/goops.h +++ b/libguile/goops.h @@ -67,8 +67,7 @@ "pw" /* direct methods */ \ "pw" /* cpl */ \ "pw" /* slots */ \ - "pw" /* getters-n-setters */ \ - "pw" /* nfields */ + "pw" /* getters-n-setters */ #define scm_si_redefined (scm_vtable_offset_user + 0) #define scm_si_direct_supers (scm_vtable_offset_user + 1) /* (class ...) */ @@ -78,8 +77,7 @@ #define scm_si_cpl (scm_vtable_offset_user + 5) /* (class ...) */ #define scm_si_slots (scm_vtable_offset_user + 6) /* ((name . options) ...) */ #define scm_si_getters_n_setters (scm_vtable_offset_user + 7) -#define scm_si_nfields (scm_vtable_offset_user + 8) /* an integer */ -#define SCM_N_CLASS_SLOTS (scm_vtable_offset_user + 9) +#define SCM_N_CLASS_SLOTS (scm_vtable_offset_user + 8) #define SCM_OBJ_CLASS_REDEF(x) (SCM_PACK (SCM_STRUCT_VTABLE_DATA (x) [scm_si_redefined])) #define SCM_INST(x) SCM_STRUCT_DATA (x) diff --git a/module/oop/goops.scm b/module/oop/goops.scm index 9114e4640..3a930e66e 100644 --- a/module/oop/goops.scm +++ b/module/oop/goops.scm @@ -171,8 +171,8 @@ (instance-finalizer <hidden-slot>) (print) (name <protected-hidden-slot>) - (reserved-0 <hidden-slot>) - (reserved-1 <hidden-slot>) + (nfields <hidden-slot>) + (%reserved <hidden-slot>) (redefined) (direct-supers) (direct-slots) @@ -180,8 +180,7 @@ (direct-methods) (cpl) (slots) - (getters-n-setters) - (nfields))) + (getters-n-setters))) (syntax-case x () ((_ fold visit seed) ;; The datum->syntax makes it as if the identifiers in `slots' @@ -433,12 +432,12 @@ (nfields (length slots)) (g-n-s (%compute-getters-n-setters slots))) (struct-set! z class-index-name name) + (struct-set! z class-index-nfields nfields) (struct-set! z class-index-direct-slots dslots) (struct-set! z class-index-direct-subclasses '()) (struct-set! z class-index-direct-methods '()) (struct-set! z class-index-cpl cpl) (struct-set! z class-index-slots slots) - (struct-set! z class-index-nfields nfields) (struct-set! z class-index-getters-n-setters g-n-s) (struct-set! z class-index-redefined #f) (for-each (lambda (super) @@ -479,13 +478,13 @@ ;; The `direct-supers', `direct-slots', `cpl', `slots', and ;; `getters-n-setters' fields will be updated later. (struct-set! <class> class-index-name '<class>) + (struct-set! <class> class-index-nfields (length dslots)) (struct-set! <class> class-index-direct-supers '()) (struct-set! <class> class-index-direct-slots dslots) (struct-set! <class> class-index-direct-subclasses '()) (struct-set! <class> class-index-direct-methods '()) (struct-set! <class> class-index-cpl '()) (struct-set! <class> class-index-slots dslots) - (struct-set! <class> class-index-nfields (length dslots)) (struct-set! <class> class-index-getters-n-setters (%compute-getters-n-setters dslots)) (struct-set! <class> class-index-redefined #f) @@ -2420,6 +2419,7 @@ var{initargs}." (supers (get-keyword #:dsupers initargs '()))) (let ((name (get-keyword #:name initargs '???))) (struct-set! class class-index-name name)) + (struct-set! class class-index-nfields 0) (struct-set! class class-index-direct-supers supers) (struct-set! class class-index-direct-slots dslots) (struct-set! class class-index-direct-subclasses '()) @@ -2428,7 +2428,6 @@ var{initargs}." (struct-set! class class-index-redefined #f) (let ((slots (compute-slots class))) (struct-set! class class-index-slots slots) - (struct-set! class class-index-nfields 0) (let ((getters-n-setters (compute-getters-n-setters class slots))) (struct-set! class class-index-getters-n-setters getters-n-setters)) ;; Build getters - setters - accessors |