X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fcross-byte.lisp;h=d693a7c8fa262ed1cf9627ad6895935865f5bcff;hb=25fe91bf63fd473d9316675b0e0ca9be0079e9eb;hp=b9b81782af266ac57e5fb60328232e1d2e6c4483;hpb=2e91e29892268b2c7e5ab557e8192fa03bce68f2;p=sbcl.git diff --git a/src/code/cross-byte.lisp b/src/code/cross-byte.lisp index b9b8178..d693a7c 100644 --- a/src/code/cross-byte.lisp +++ b/src/code/cross-byte.lisp @@ -39,20 +39,25 @@ (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) @@ -60,11 +65,11 @@ (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)))))