Fix some things that break the SBCL build

git-svn-id: http://svn.internal.itasoftware.com/svn/ita/trunk/qres/lisp/quux/protobufs@541020 f8382938-511b-0410-9cdd-bb47b084005c

diff --git a/utilities.lisp b/utilities.lisp
index e563ba303838fbc56d7ecfc33329b3df7f7f0a1e..a1da5e9280250061aea985fe69fdd013be68dc64 100644 (file)
--- a/utilities.lisp
+++ b/utilities.lisp
@@ -253,14 +253,14 @@
 #+(or abcl allegro cmu sbcl lispworks)
 (defun single-float-bits (x)
   (declare (type single-float x))
-  #+abcl    (system:single-float-bits float)
+  #+abcl    (system:single-float-bits x)
   #+allegro (multiple-value-bind (high low)
-                (excl:single-float-to-shorts float)
+                (excl:single-float-to-shorts x)
               (declare (type (unsigned-byte 16) high low))
               (logior (ash high 16) low))
-  #+cmu  (kernel:single-float-bits float)
-  #+sbcl (sb-kernel:single-float-bits float)
-  #+lispworks (lispworks-float:single-float-bits float))
+  #+cmu  (kernel:single-float-bits x)
+  #+sbcl (sb-kernel:single-float-bits x)
+  #+lispworks (lispworks-float:single-float-bits x))
 
 #-(or abcl allegro cmu sbcl lispworks)
 (defun single-float-bits (x)
@@ -310,17 +310,17 @@
 #+(or abcl allegro cmu sbcl lispworks)
 (defun double-float-bits (x)
   (declare (type double-float x))
-  #+abcl    (values (system:double-float-low-bits float)
-                    (system:double-float-high-bits float))
+  #+abcl    (values (system:double-float-low-bits x)
+                    (system:double-float-high-bits x))
   #+allegro (multiple-value-bind (us3 us2 us1 us0)
-                (excl:double-float-to-shorts float)
+                (excl:double-float-to-shorts x)
               (logior (ash us1 16) us0)
               (logior (ash us3 16) us2))
-  #+cmu  (values (kernel:double-float-low-bits float)
-                 (kernel:double-float-high-bits float))
-  #+sbcl (values (sb-kernel:double-float-low-bits float)
-                 (sb-kernel:double-float-high-bits float))
-  #+lispworks (let ((bits (lispworks-float:double-float-bits float)))
+  #+cmu  (values (kernel:double-float-low-bits x)
+                 (kernel:double-float-high-bits x))
+  #+sbcl (values (sb-kernel:double-float-low-bits x)
+                 (sb-kernel:double-float-high-bits x))
+  #+lispworks (let ((bits (lispworks-float:double-float-bits x)))
                 (values (logand #xffffffff bits)
                         (ash bits -32))))
 
@@ -404,9 +404,9 @@
 
 
 #+(or abcl allegro cmu sbcl lispworks)
-(defun make-double-float (low-bits high-bits)
-  (declare (type (unsigned-byte 32) low-bits)
-           (type (signed-byte   32) high-bits))
+(defun make-double-float (low high)
+  (declare (type (unsigned-byte 32) low)
+           (type (signed-byte   32) high))
   #+abcl (system:make-double-float (logior (ash high 32) low))
   #+allegro (excl:shorts-to-double-float (ldb (byte 16 16) high)
                                          (ldb (byte 16 0) high)
@@ -417,16 +417,16 @@
   #+lispworks (lispworks-float:make-double-float high low))
 
 #-(or abcl allegro cmu sbcl lispworks)
-(defun make-double-float (low-bits high-bits)
-  (declare (type (unsigned-byte 32) low-bits)
-           (type (signed-byte   32) high-bits))
+(defun make-double-float (low high)
+  (declare (type (unsigned-byte 32) low)
+           (type (signed-byte   32) high))
   (cond
     ;; IEEE float special cases
-    ((and (zerop high-bits) (zerop low-bits)) 0.0d0)
-    ((and (= high-bits #x-80000000)
-          (zerop low-bits)) -0.0d0)
+    ((and (zerop high) (zerop low)) 0.0d0)
+    ((and (= high #x-80000000)
+          (zerop low)) -0.0d0)
     (t
-     (let* ((bits (logior (ash high-bits 32) low-bits))
+     (let* ((bits (logior (ash high 32) low))
             (sign (ecase (ldb (byte 1 63) bits)
                     (0 1.0d0)
                     (1 -1.0d0)))

diff --git a/wire-format.lisp b/wire-format.lisp
index 6b97b30b5aec24b60f9745fb369e0531980dd568..c0914de0e2d3d3adccbf44ac871e792e6a34a0b1 100644 (file)
--- a/wire-format.lisp
+++ b/wire-format.lisp
@@ -572,10 +572,10 @@
 (defun enum-size (val values tag)
   "Returns the size in bytes that the enum object will take when serialized."
   (declare (type (unsigned-byte 32) tag))
-  (let ((val (let ((e (find val values :key #'proto-value)))
+  (let ((idx (let ((e (find val values :key #'proto-value)))
                (and e (proto-index e)))))
-    (declare (type (unsigned-byte 32) val))
-    (i+ (length32 tag) (length32 val))))
+    (assert idx () "There is no enum value for ~S" val)
+    (i+ (length32 tag) (length32 idx))))
 
 
 ;;; Raw encoders
@@ -590,7 +590,7 @@
            (type (simple-array (unsigned-byte 8)) buffer)
            (type fixnum index))
   ;; Seven bits at a time, least significant bits first
-  (loop do (let ((bits (ldb #.(byte 7 0) val)))
+  (loop do (let ((bits (ldb (byte 7 0) val)))
              (declare (type (unsigned-byte 8) bits))
              (setq val (ash val -7))
              (setf (aref buffer index) (ilogior bits (if (zerop val) 0 128)))
@@ -607,7 +607,7 @@
   (declare (type (unsigned-byte 64) val)
            (type (simple-array (unsigned-byte 8)) buffer)
            (type fixnum index))
-  (loop do (let ((bits (ldb #.(byte 7 0) val)))
+  (loop do (let ((bits (ldb (byte 7 0) val)))
              (declare (type (unsigned-byte 8) bits))
              (setq val (ash val -7))
              (setf (aref buffer index) (ilogior bits (if (zerop val) 0 128)))
@@ -625,7 +625,7 @@
            (type fixnum index))
   (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
     (loop repeat 4 doing
-      (let ((byte (ldb #.(byte 8 0) val)))
+      (let ((byte (ldb (byte 8 0) val)))
         (declare (type (unsigned-byte 8) byte))
         (setq val (ash val -8))
         (setf (aref buffer index) byte)
@@ -642,7 +642,7 @@
            (type fixnum index))
   (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
     (loop repeat 8 doing
-      (let ((byte (ldb #.(byte 8 0) val)))
+      (let ((byte (ldb (byte 8 0) val)))
         (declare (type (unsigned-byte 8) byte))
         (setq val (ash val -8))
         (setf (aref buffer index) byte)
@@ -659,7 +659,7 @@
            (type fixnum index))
   (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
     (loop repeat 4 doing
-      (let ((byte (ldb #.(byte 8 0) val)))
+      (let ((byte (ldb (byte 8 0) val)))
         (declare (type (unsigned-byte 8) byte))
         (setq val (ash val -8))
         (setf (aref buffer index) byte)
@@ -676,7 +676,7 @@
            (type fixnum index))
   (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
     (loop repeat 8 doing
-      (let ((byte (ldb #.(byte 8 0) val)))
+      (let ((byte (ldb (byte 8 0) val)))
         (declare (type (unsigned-byte 8) byte))
         (setq val (ash val -8))
         (setf (aref buffer index) byte)
@@ -693,7 +693,7 @@
   (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
     (let ((bits (single-float-bits val)))
       (loop repeat 4 doing
-        (let ((byte (ldb #.(byte 8 0) bits)))
+        (let ((byte (ldb (byte 8 0) bits)))
           (declare (type (unsigned-byte 8) byte))
           (setq bits (ash bits -8))
           (setf (aref buffer index) byte)
@@ -711,13 +711,13 @@
     (multiple-value-bind (low high)
         (double-float-bits val)
       (loop repeat 4 doing
-        (let ((byte (ldb #.(byte 8 0) low)))
+        (let ((byte (ldb (byte 8 0) low)))
           (declare (type (unsigned-byte 8) byte))
           (setq low (ash low -8))
           (setf (aref buffer index) byte)
           (iincf index)))
       (loop repeat 4 doing
-        (let ((byte (ldb #.(byte 8 0) high)))
+        (let ((byte (ldb (byte 8 0) high)))
           (declare (type (unsigned-byte 8) byte))
           (setq high (ash high -8))
           (setf (aref buffer index) byte)
@@ -754,7 +754,7 @@
   (loop with val = 0
         for places fixnum upfrom 0 by 7
         for byte fixnum = (prog1 (aref buffer index) (iincf index))
-        do (setq val (logior val (ash (ldb #.(byte 7 0) byte) places)))
+        do (setq val (logior val (ash (ldb (byte 7 0) byte) places)))
         until (i< byte 128)
         finally (progn
                   (assert (< val #.(ash 1 32)) ()
@@ -772,7 +772,7 @@
   (loop with val = 0
         for places fixnum upfrom 0 by 7
         for byte fixnum = (prog1 (aref buffer index) (iincf index))
-        do (setq val (logior val (ash (ldb #.(byte 7 0) byte) places)))
+        do (setq val (logior val (ash (ldb (byte 7 0) byte) places)))
         until (i< byte 128)
         finally (return (values val index))))
 
@@ -804,7 +804,7 @@
             for places fixnum upfrom 0 by 8
             for byte fixnum = (prog1 (aref buffer index) (iincf index))
             do (setq val (logior val (ash byte places))))
-      (when (i= (ldb #.(byte 1 31) val) 1)              ;sign bit set, so negative value
+      (when (i= (ldb (byte 1 31) val) 1)              ;sign bit set, so negative value
         (decf val #.(ash 1 32)))
       (values val index))))
 
@@ -836,7 +836,7 @@
             for places fixnum upfrom 0 by 8
             for byte fixnum = (prog1 (aref buffer index) (iincf index))
             do (setq val (logior val (ash byte places))))
-      (when (i= (ldb #.(byte 1 63) val) 1)             ;sign bit set, so negative value
+      (when (i= (ldb (byte 1 63) val) 1)             ;sign bit set, so negative value
         (decf val #.(ash 1 64)))
       (values val index))))
 
@@ -853,7 +853,7 @@
             for places fixnum upfrom 0 by 8
             for byte fixnum = (prog1 (aref buffer index) (iincf index))
             do (setq bits (logior bits (ash byte places))))
-      (when (i= (ldb #.(byte 1 31) bits) 1)             ;sign bit set, so negative value
+      (when (i= (ldb (byte 1 31) bits) 1)             ;sign bit set, so negative value
         (decf bits #.(ash 1 32)))
       (values (make-single-float bits) index))))
 
@@ -876,7 +876,7 @@
             for byte fixnum = (prog1 (aref buffer index) (iincf index))
             do (setq high (logior high (ash byte places))))
       ;; High bits are signed, but low bits are unsigned
-      (when (i= (ldb #.(byte 1 31) high) 1)             ;sign bit set, so negative value
+      (when (i= (ldb (byte 1 31) high) 1)             ;sign bit set, so negative value
         (decf high #.(ash 1 32)))
       (values (make-double-float low high) index))))