X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Flow.lisp;h=1f9a12cda948d6533e291e58751b68e302ba12f0;hb=22aec7852f4861e5dab28cc0d619c24b62590dad;hp=871b1705c12749779fad7e07a0c27e3a46477a8a;hpb=8160f3ac81fff66563276cfbc7546d43891dae5c;p=sbcl.git diff --git a/src/pcl/low.lisp b/src/pcl/low.lisp index 871b170..1f9a12c 100644 --- a/src/pcl/low.lisp +++ b/src/pcl/low.lisp @@ -351,12 +351,44 @@ (defun structure-slotd-reader-function (slotd) (fdefinition (dsd-accessor-name slotd))) -(defun structure-slotd-writer-function (slotd) - (unless (dsd-read-only slotd) - (fdefinition `(setf ,(dsd-accessor-name slotd))))) +(defun structure-slotd-writer-function (type slotd) + (if (dsd-read-only slotd) + (let ((dd (get-structure-dd type))) + (coerce (slot-setter-lambda-form dd slotd) 'function)) + (fdefinition `(setf ,(dsd-accessor-name slotd))))) (defun structure-slotd-type (slotd) (dsd-type slotd)) (defun structure-slotd-init-form (slotd) (dsd-default slotd)) + +;;; 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 +(defstruct spinlock (value 0)) +(defvar *pcl-lock* (make-spinlock)) + +(defmacro with-pcl-lock (&body body) + `(progn + (sb-thread::get-spinlock *pcl-lock* 1 (sb-thread::current-thread-id)) + (unwind-protect + (progn ,@body) + (setf (spinlock-value *pcl-lock*) 0)))) +);progn + +#-sb-thread +(defmacro with-pcl-lock (&body body) + `(progn ,@body))