[cl-irc-cvs] r152 - trunk

[ehuelsmann at common-lisp.net]

Author: ehuelsmann
Date: Sun May 14 09:56:19 2006
New Revision: 152

Modified:
   trunk/event.lisp
   trunk/protocol.lisp
   trunk/utility.lisp
Log:
Fix SBCL compile warnings, at least one of which was a bug.

Modified: trunk/event.lisp
==============================================================================
--- trunk/event.lisp	(original)
+++ trunk/event.lisp	Sun May 14 09:56:19 2006
@@ -129,8 +129,13 @@
 (defmethod default-hook ((message irc-rpl_namreply-message))
   (let* ((connection (connection message)))
     (destructuring-bind
-        (nick chan-mode channel names)
+        (nick chan-visibility channel names)
         (arguments message)
+      (declare (ignore nick chan-visibility))
+      ;; chan-visibility is (member '= '@ '*)
+      ;; '= == public
+      ;; '@ == secret
+      ;; '* == private
       (let ((channel (find-channel connection channel)))
         (unless (has-mode-p channel 'namreply-in-progress)
           (add-mode channel 'namreply-in-progress
@@ -205,6 +210,7 @@
     (destructuring-bind
         (channel &optional text)
         arguments
+      (declare (ignore text))
       (let ((channel (find-channel connection channel))
             (user (find-user connection source)))
         (when (and user channel)
@@ -225,11 +231,10 @@
     (destructuring-bind
         (target channel &rest mode-arguments)
         arguments
-    (declare (ignore target))
     (let* ((channel (find-channel connection channel))
            (mode-changes
             (when channel
-              (parse-mode-arguments connection channel arguments
+              (parse-mode-arguments connection channel mode-arguments
                                     :server-p (user connection)))))
       (dolist (change mode-changes)
         (destructuring-bind
@@ -281,7 +286,7 @@
     (destructuring-bind
         (channel nick &optional reason)
         arguments
-      (declare (ignore arguments))
+      (declare (ignore reason))
       (let* ((channel (find-channel connection channel))
              (user (find-user connection nick)))
         (when (and user channel)

Modified: trunk/protocol.lisp
==============================================================================
--- trunk/protocol.lisp	(original)
+++ trunk/protocol.lisp	Sun May 14 09:56:19 2006
@@ -260,6 +260,7 @@
 (defvar *process-count* 0)
 
 (defmethod start-process (function name)
+  (declare (ignorable name))
   #+allegro (mp:process-run-function name function)
   #+cmu (mp:make-process function :name name)
   #+lispworks (mp:process-run-function name nil function)
@@ -273,6 +274,7 @@
   (flet (#-(and sbcl (not sb-thread))
            (do-loop () (read-message-loop connection)))
     (let ((name (format nil "irc-hander-~D" (incf *process-count*))))
+      (declare (ignorable name))
       #+(or allegro cmu lispworks sb-thread openmcl armedbear)
       (start-process #'do-loop name)
       #+(and sbcl (not sb-thread))
@@ -292,6 +294,7 @@
 
 (defun stop-background-message-handler (process)
   "Stops a background message handler process returned by the start function."
+  (declare (ignorable process))
     #+cmu (mp:destroy-process process)
     #+allegro (mp:process-kill process)
     #+sb-thread (sb-thread:destroy-thread process)

Modified: trunk/utility.lisp
==============================================================================
--- trunk/utility.lisp	(original)
+++ trunk/utility.lisp	Sun May 14 09:56:19 2006
@@ -121,12 +121,13 @@
   (let ((read-fun (if (subtypep (stream-element-type stream) 'integer)
                       (if non-blocking #'read-byte-no-hang #'read-byte)
                     (if non-blocking #'read-char-no-hang #'read-char)))
-        (limit-pos 0)
+        (limit-vector (coerce limit '(vector * t)))
         (targ-max (1- (length target)))
         (limit-max (length limit))
         (limit-cur 0)
         (targ-cur -1))
-    (declare (optimize (speed 3) (debug 0)))
+    (declare (optimize (speed 3) (debug 0))
+             (type fixnum targ-cur))
     ;; In SBCL read-char is a buffered operations (depending on
     ;; stream creation parameters), so this loop should be quite efficient
     ;; For others, if this becomes an efficiency problem, please report...
@@ -135,7 +136,7 @@
           do (return (values target targ-cur t))
           else do
           (setf (elt target (incf targ-cur)) next-elt)
-          (if (eql next-elt (elt limit limit-cur))
+          (if (eql next-elt (aref limit-vector limit-cur))
               (incf limit-cur)
             (setf limit-cur 0))