[Openmcl-cvs-notifications] r14559 - /trunk/source/compiler/optimizers.lisp
gb at clozure.com
gb at clozure.com
Thu Jan 6 18:55:02 CST 2011
Author: gb
Date: Thu Jan 6 18:55:02 2011
New Revision: 14559
Log:
In LDB compiler macro, just do a LOGAND if the bytespec's position
is 0.
Fixes ticket:805.
Modified:
trunk/source/compiler/optimizers.lisp
Modified: trunk/source/compiler/optimizers.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/compiler/optimizers.lisp (original)
+++ trunk/source/compiler/optimizers.lisp Thu Jan 6 18:55:02 2011
@@ -583,24 +583,28 @@
(string t)))
=
(define-compiler-macro ldb (&whole call &environment env byte integer)
- (cond ((and (integerp byte) (> byte 0))
- (let ((size (byte-size byte))
- (position (byte-position byte)))
- (cond ((nx-form-typep integer 'fixnum env)
- `(logand ,(byte-mask size)
- (the fixnum (ash ,integer ,(- position)))))
- (t `(load-byte ,size ,position ,integer)))))
- ((and (consp byte)
- (eq (%car byte) 'byte)
- (eq (list-length (%cdr byte)) 2))
- (let ((size (%cadr byte))
- (position (%caddr byte)))
- (if (and (nx-form-typep integer 'fixnum env) (fixnump position=
))
- ;; I'm not sure this is worth doing
- `(logand (byte-mask ,size) (the fixnum (ash ,integer ,(- pos=
ition))))
- ;; this IS worth doing
- `(load-byte ,size ,position ,integer))))
- (t call)))
+ (cond ((and (integerp byte) (> byte 0))
+ (let ((size (byte-size byte))
+ (position (byte-position byte)))
+ (cond ((nx-form-typep integer 'fixnum env)
+ `(logand ,(byte-mask size)
+ (the fixnum (ash ,integer ,(- position)))))
+ ((zerop position)
+ `(logand ,(byte-mask size) ,integer))
+ (t `(load-byte ,size ,position ,integer)))))
+ ((and (consp byte)
+ (eq (%car byte) 'byte)
+ (eq (list-length (%cdr byte)) 2))
+ (let ((size (%cadr byte))
+ (position (%caddr byte)))
+ (if (eql position 0)
+ `(logand (byte-mask ,size) ,integer)
+ (if (and (nx-form-typep integer 'fixnum env) (fixnump positio=
n))
+ ;; I'm not sure this is worth doing
+ `(logand (byte-mask ,size) (the fixnum (ash ,integer ,(- po=
sition))))
+ ;; this IS worth doing
+ `(load-byte ,size ,position ,integer)))))
+ (t call)))
=
(define-compiler-macro length (&whole call &environment env seq)
(if (nx-form-typep seq '(simple-array * (*)) env)
More information about the Openmcl-cvs-notifications
mailing list