-;;; Given a list of keyword substitutions `(,OLD ,NEW), and a
-;;; keyword-argument-list-style list of alternating keywords and arbitrary
-;;; values, return a new keyword-argument-list-style list with all
-;;; substitutions applied to it.
-;;;
-;;; Note: If efficiency mattered, we could do less consing. (But if efficiency
-;;; mattered, why would we be using keyword arguments at all, much less
-;;; renaming keyword arguments?)
-;;;
-;;; KLUDGE: It would probably be good to get rid of this. -- WHN 19991201
-(defun rename-keyword-args (rename-list keyword-args)
- (declare (type list rename-list keyword-args))
- ;; Walk through RENAME-LIST modifying RESULT as per each element in
- ;; RENAME-LIST.
- (do ((result (copy-list keyword-args))) ; may be modified below
- ((null rename-list) result)
- (destructuring-bind (old new) (pop rename-list)
- (declare (type keyword old new))
- ;; Walk through RESULT renaming any OLD keyword argument to NEW.
- (do ((in-result result (cddr in-result)))
- ((null in-result))
- (declare (type list in-result))
- (when (eq (car in-result) old)
- (setf (car in-result) new))))))
+;;; Ditto
+#!+sb-thread
+(defmacro define-structure-slot-addressor (name &key structure slot)
+ (let* ((dd (find-defstruct-description structure t))
+ (slotd (when dd (find slot (dd-slots dd) :key #'dsd-name)))
+ (index (when slotd (dsd-index slotd))))
+ (unless index
+ (error "Slot ~S not found in ~S." slot structure))
+ `(progn
+ (declaim (inline ,name))
+ (defun ,name (instance)
+ (declare (type ,structure instance) (optimize speed))
+ (sb!ext:truly-the
+ sb!vm:word
+ (+ (sb!kernel:get-lisp-obj-address instance)
+ (- (* ,(+ sb!vm:instance-slots-offset index) sb!vm:n-word-bytes)
+ sb!vm:instance-pointer-lowtag)))))))