mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

Re-use the vtable "size" field for GOOPS nfields

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2015-01-11 16:36:45 +01:00
parent 4702cbeb37
commit 92928b8619
3 changed files with 9 additions and 12 deletions
Download patch file Download diff file Expand all files Collapse all files

2
libguile/goops.c
View file

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

6
libguile/goops.h
View file

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

13
module/oop/goops.scm
View file

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