At least two more expanders should also be corrected:
(define-setf-expander mem-ref (ptr type &optional (offset 0) &environment env) "SETF expander for MEM-REF that doesn't rebind TYPE. This is necessary for the compiler macro on MEM-SET to be able to open-code (SETF MEM-REF) forms." (multiple-value-bind (temps vals stores store-form access-form) (get-setf-expansion ptr env) (declare (ignore store-form stores)) (let ((type-tmp (gensym "TYPE-")) (offset-tmp (gensym "OFFSET-")) (store (gensym "STORE-"))) (values `(,type-tmp ,offset-tmp ,@temps) `(,type ,offset ,@vals) `(,store) `(progn (mem-set ,store ,access-form ,type-tmp ,offset-tmp) ,store) `(mem-ref ,access-form ,type-tmp ,offset-tmp)))))
(define-setf-expander mem-aref (ptr type &optional (index 0) &environment env) "SETF expander for MEM-AREF." (multiple-value-bind (temps vals stores store-form access-form) (get-setf-expansion ptr env) (declare (ignore store-form stores)) (let ((type-tmp (gensym "TYPE-")) (index-tmp (gensym "INDEX-")) (store (gensym "STORE-"))) (values `(,type-tmp ,index-tmp ,@temps) `(,type ,index ,@vals) `(,store) `(progn ,(if (constantp type) (if (constantp index) `(mem-set ,store ,access-form ,type-tmp ,(* (eval index) (foreign-type-size (eval type)))) `(mem-set ,store ,access-form ,type-tmp (* ,index-tmp ,(foreign-type-size (eval type))))) `(mem-set ,store ,access-form ,type-tmp (* ,index-tmp (foreign-type-size ,type-tmp)))) ,store) `(mem-aref ,access-form ,type-tmp ,index-tmp)))))
I guess the implementation dependend setf-expanders for %mem-ref should also be adapted. It's quite easy: instead of the first example in the CLHS take second ;-)
Regards,
Marco Gidde