+
+
+(deftype endian () '(member :native :little :big))
+
+(defmacro define-memory-accessor (type)
+ (let* ((get-swapped (intern (format nil "GET-~A-SWAPPED" type)))
+ (set-swapped (intern (format nil "SET-~A-SWAPPED" type)))
+ (ref (intern (format nil "REF-~A" type)))
+ (ref-native (intern (format nil "REF-NATIVE-~A" type))))
+ `(progn
+ (declaim (inline ,get-swapped) (inline ,set-swapped))
+ (defbinding ,get-swapped () ,type
+ (location pointer)
+ (offset int))
+ (defbinding ,set-swapped () nil
+ (location pointer)
+ (offset int)
+ (value ,type))
+ (declaim
+ (ftype (function (pointer &optional fixnum endian) ,type) ,ref)
+ (inline ,ref))
+ (defun ,ref (location &optional offset (endian :native))
+ (ecase endian
+ ((:native #-big-endian :little #+big-endian :big)
+ (,ref-native location offset))
+ ((#-big-endian :big #+big-endian :little)
+ (,get-swapped location offset))))
+ (declaim
+ (ftype
+ (function (,type pointer &optional fixnum endian) ,type)
+ (setf ,ref))
+ (inline (setf ,ref)))
+ (defun (setf ,ref) (value location &optional offset (endian :native))
+ (ecase endian
+ ((:native #-big-endian :little #+big-endian :big)
+ (setf (,ref-native location offset) value))
+ ((#-big-endian :big #+big-endian :little)
+ (,set-swapped location offset value)
+ value))))))
+
+#+cmu
+(defmacro with-pinned-objects (objects &body body)
+ (declare (ignore objects))
+ `(without-gcing ,@body))
+