Changeset 14562

Timestamp:

Jan 7, 2011, 7:53:59 PM (10 years ago)

Author:

rme

Message:

Merge r14559 (LDB compiler macro enhancement) from trunk.

Location:

release/1.6/source

Files:

• . (modified) (1 prop)
• compiler/optimizers.lisp (modified) (1 diff)
• level-0/l0-misc.lisp (modified) (1 prop)

release/1.6/source/compiler/optimizers.lisp

@@ -584 +584 @@
 
 (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 ,(- position))))
-              ;; 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 position))
+               ;; I'm not sure this is worth doing
+               `(logand (byte-mask ,size) (the fixnum (ash ,integer ,(- position))))
+               ;; this IS worth doing
+               `(load-byte ,size ,position ,integer)))))
+        (t call)))
 
 (define-compiler-macro length (&whole call &environment env seq)