(defun sb!xc:deposit-field (new cross-byte int)
(cl:deposit-field new (uncross-byte cross-byte) int))
-(defun sb!c::mask-signed-field (size integer)
- (if (logbitp (1- size) integer)
- (dpb integer (byte size 0) -1)
- (ldb (byte size 0) integer)))
-
(define-setf-expander sb!xc:ldb (cross-byte int &environment env)
(multiple-value-bind (temps vals stores store-form access-form)
(get-setf-expansion int env)
(when (cdr stores)
(bug "SETF SB!XC:LDB too hairy!"))
(let ((btemp (gensym))
- (store (gensym)))
+ (store (gensym)))
(values (cons btemp temps)
- (cons cross-byte vals)
- (list store)
- `(let ((,(car stores) (cl:dpb ,store (uncross-byte ,btemp) ,access-form)))
- ,store-form
- ,store)
- `(cl:ldb (uncross-byte ,btemp) ,access-form)))))
+ (cons cross-byte vals)
+ (list store)
+ `(let ((,(car stores) (cl:dpb ,store (uncross-byte ,btemp) ,access-form)))
+ ,store-form
+ ,store)
+ `(cl:ldb (uncross-byte ,btemp) ,access-form)))))
(define-setf-expander sb!xc:mask-field (cross-byte int &environment env)
(multiple-value-bind (temps vals stores store-form access-form)
(when (cdr stores)
(bug "SETF SB!XC:MASK-FIELD too hairy!"))
(let ((btemp (gensym))
- (store (gensym)))
+ (store (gensym)))
(values (cons btemp temps)
- (cons cross-byte vals)
- (list store)
- `(let ((,(car stores) (cl:deposit-field ,store (uncross-byte ,btemp) ,access-form)))
- ,store-form
- ,store)
- `(cl:mask-field (uncross-byte ,btemp) ,access-form)))))
+ (cons cross-byte vals)
+ (list store)
+ `(let ((,(car stores) (cl:deposit-field ,store (uncross-byte ,btemp) ,access-form)))
+ ,store-form
+ ,store)
+ `(cl:mask-field (uncross-byte ,btemp) ,access-form)))))