[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