mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-16 06:12:25 -08:00
Code Issues Projects Releases Packages Wiki Activity

Remove type checks from slot accessors and optimize all slot accessors to standard classes.

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2011-12-15 10:27:17 +01:00
parent 4b565e6955
commit afdb75f15b
1 changed files with 6 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

9
src/clos/standard.lsp
View file

@ -571,7 +571,7 @@ because it contains a reference to the undefined class~% ~A"
`(si::instance-ref ,slotd #.(position 'location +slot-definition-slots+
:key #'first))))
(values #'(lambda (self)
(declare (optimize (safety 1) (speed 3) (debug 0))
(declare (optimize (safety 0) (speed 3) (debug 0))
(standard-object self))
(ensure-up-to-date-instance self)
(let* ((class (si:instance-class self))
@ -585,7 +585,7 @@ because it contains a reference to the undefined class~% ~A"
value
(values (slot-unbound (class-of self) self slot-name)))))
#'(lambda (value self)
(declare (optimize (safety 1) (speed 3) (debug 0))
(declare (optimize (safety 0) (speed 3) (debug 0))
(standard-object self))
(ensure-up-to-date-instance self)
(let* ((class (si:instance-class self))
@ -634,8 +634,11 @@ because it contains a reference to the undefined class~% ~A"
(location (safe-slot-definition-location slotd)))
(cond ((and (eq allocation :instance) (typep location 'fixnum))
(std-class-sealed-accessors (slot-definition-location slotd)))
;; When a class is the specified STANDARD-CLASS, then the
;; user may not write any method around SLOT-VALUE-USING-CLASS
;; This allows us to write optimized versions of the accessors.
((and (eq allocation :instance)
(slot-value standard-class 'optimize-slot-access))
(eq standard-class +the-standard-class+))
(std-class-optimized-accessors name))
(t
(std-class-accessors name))))