dmbcs/guile
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

remove self field of vtables

Browse source 
* libguile/struct.h (SCM_VTABLE_BASE_LAYOUT, scm_vtable_index_self):
  Remove "self" field.  Renumber the other fields.
* module/oop/goops.scm (<self-slot>): Remove.
  (fold-class-slots): Adapt for "self" slot removal.  Adapt all users.
  (class-redefinition): Now that there is no "self" slot to update, use
  %modify-instance instead of %modify-class.
* libguile/goops.c (class_self): Remove.
  (scm_sys_modify_class): Remove.
* libguile/goops.h (scm_sys_modify_class): Remove.
* module/rnrs/records/procedural.scm: Import vtable-offset-user.
  Renumber rtd indexes using vtable-offset-user.
* module/srfi/srfi-35.scm (%condition-type-vtable): Remove mention of
  vtable fields.
* module/system/base/types.scm (address->inferior-struct): Adapt for
  different vtable field layout.
This commit is contained in:
Andy Wingo 2017-09-13 22:23:20 +02:00
commit ee5994a517
7 changed files with 23 additions and 48 deletions
Download patch file Download diff file Expand all files Collapse all files

10
module/oop/goops.scm
View file

@ -42,7 +42,7 @@
;; Slot types.
<slot>
<foreign-slot> <protected-slot> <hidden-slot> <opaque-slot>
<read-only-slot> <self-slot> <protected-opaque-slot>
<read-only-slot> <protected-opaque-slot>
<protected-hidden-slot> <protected-read-only-slot>
<scm-slot> <int-slot> <float-slot> <double-slot>
@ -186,7 +186,6 @@
(define-macro-folder fold-class-slots
(layout #:class <protected-read-only-slot>)
(flags #:class <hidden-slot>)
(self #:class <self-slot>)
(instance-finalizer #:class <hidden-slot>)
(print)
(name #:class <protected-hidden-slot>)
@ -306,15 +305,12 @@
;; A simple way to compute class layout for the concrete
;; types used in <class>.
(syntax-rules (<protected-read-only-slot>
<self-slot>
<hidden-slot>
<protected-hidden-slot>)
((_ (name) tail)
(string-append "pw" tail))
((_ (name #:class <protected-read-only-slot>) tail)
(string-append "pr" tail))
((_ (name #:class <self-slot>) tail)
(string-append "sr" tail))
((_ (name #:class <hidden-slot>) tail)
(string-append "uh" tail))
((_ (name #:class <protected-hidden-slot>) tail)
@ -779,7 +775,6 @@ slots as we go."
(let ((type (get-keyword #:class (%slot-definition-options slot))))
(if (and type (subclass? type <foreign-slot>))
(values (cond
((subclass? type <self-slot>) #\s)
((subclass? type <protected-slot>) #\p)
(else #\u))
(cond
@ -892,7 +887,6 @@ slots as we go."
(define-standard-class <hidden-slot> (<foreign-slot>))
(define-standard-class <opaque-slot> (<foreign-slot>))
(define-standard-class <read-only-slot> (<foreign-slot>))
(define-standard-class <self-slot> (<read-only-slot>))
(define-standard-class <protected-opaque-slot> (<protected-slot>
<opaque-slot>))
(define-standard-class <protected-hidden-slot> (<protected-slot>
@ -3110,7 +3104,7 @@ var{initargs}."
(class-direct-supers new))
;; Swap object headers
(%modify-class old new)
(%modify-instance old new)
;; Now old is NEW!