;; default of WRAPPER-INVALID. Instead of trying
;; to find out, I just overrode the LAYOUT
;; default here. -- WHN 19991204
- (invalid nil))
+ (invalid nil)
+ ;; This allows quick testing of wrapperness.
+ (for-std-class-p t))
(:constructor make-wrapper-internal)
(:copier nil))
(instance-slots-layout nil :type list)
(when (pcl-instance-p instance)
(get-slots instance)))
-(defmacro built-in-or-structure-wrapper (x) `(layout-of ,x))
-
(defmacro get-wrapper (inst)
(once-only ((wrapper `(wrapper-of ,inst)))
`(progn
;;; The definition of STRUCTURE-TYPE-P was moved to early-low.lisp.
-(defun get-structure-dd (type)
- (layout-info (classoid-layout (find-classoid type))))
-
-(defun structure-type-included-type-name (type)
- (let ((include (dd-include (get-structure-dd type))))
- (if (consp include)
- (car include)
- include)))
-
(defun structure-type-slot-description-list (type)
- (nthcdr (length (let ((include (structure-type-included-type-name type)))
- (and include
- (dd-slots (get-structure-dd include)))))
- (dd-slots (get-structure-dd type))))
+ (let* ((dd (find-defstruct-description type))
+ (include (dd-include dd))
+ (all-slots (dd-slots dd)))
+ (multiple-value-bind (super slot-overrides)
+ (if (consp include)
+ (values (car include) (mapcar #'car (cdr include)))
+ (values include nil))
+ (let ((included-slots
+ (when super
+ (dd-slots (find-defstruct-description super)))))
+ (loop for slot = (pop all-slots)
+ for included-slot = (pop included-slots)
+ while slot
+ when (or (not included-slot)
+ (member (dsd-name included-slot) slot-overrides :test #'eq))
+ collect slot)))))
(defun structure-slotd-name (slotd)
(dsd-name slotd))
(defun structure-slotd-writer-function (type slotd)
(if (dsd-read-only slotd)
- (let ((dd (get-structure-dd type)))
+ (let ((dd (find-defstruct-description type)))
(coerce (slot-setter-lambda-form dd slotd) 'function))
(fdefinition `(setf ,(dsd-accessor-name slotd)))))
:metaclass-name static-classoid
:metaclass-constructor make-static-classoid
:dd-type funcallable-structure)
-\f
-;;; WITH-PCL-LOCK is used around some forms that were previously
-;;; protected by WITHOUT-INTERRUPTS, but in a threaded SBCL we don't
-;;; have a useful WITHOUT-INTERRUPTS. In an unthreaded SBCL I'm not
-;;; sure what the desired effect is anyway: should we be protecting
-;;; against the possibility of recursive calls into these functions
-;;; or are we using WITHOUT-INTERRUPTS as WITHOUT-SCHEDULING?
-;;;
-;;; Users: FORCE-CACHE-FLUSHES, MAKE-INSTANCES-OBSOLETE. Note that
-;;; it's not all certain this is sufficent for threadsafety: do we
-;;; just have to protect against simultaneous calls to these mutators,
-;;; or actually to stop normal slot access etc at the same time as one
-;;; of them runs
-
-#+sb-thread
-(progn
- (defvar *pcl-lock* (sb-thread::make-spinlock))
-
- (defmacro with-pcl-lock (&body body)
- `(sb-thread::with-spinlock (*pcl-lock*)
- ,@body)))
-#-sb-thread
-(defmacro with-pcl-lock (&body body)
- `(progn ,@body))