From ctian at common-lisp.net  Mon Aug  8 14:20:24 2011
From: ctian at common-lisp.net (ctian at common-lisp.net)
Date: Mon, 08 Aug 2011 07:20:24 -0700
Subject: [usocket-cvs] r667 - in usocket/branches/0.5.x: . backend
Message-ID: <E1QqQgq-0005Ns-DZ@common-lisp.net>

Author: ctian
Date: Mon Aug  8 07:20:23 2011
New Revision: 667

Log:
[SBCL] Fixed for "SBCL data flush problem", reported by Robert Brown and confirmed by Nikodemus Siivola.

Modified:
   usocket/branches/0.5.x/CHANGES
   usocket/branches/0.5.x/backend/sbcl.lisp

Modified: usocket/branches/0.5.x/CHANGES
==============================================================================
--- usocket/branches/0.5.x/CHANGES	Thu Jun 30 09:38:18 2011	(r666)
+++ usocket/branches/0.5.x/CHANGES	Mon Aug  8 07:20:23 2011	(r667)
@@ -3,6 +3,7 @@
 * Bugfix: [MCL] Fixed SOCKET-LISTEN on vector addresses like #(0 0 0 0)
 * Bugfix: [MCL] Fixed WAIT-FOR-INPUT on passive sockets (stream-server-usocket)
 * Bugfix: [LispWorks] Fixed using OPEN-UDP-SOCKET in delivered applications (thanks to Camille Troillard and Martin Simmons, this fix is from LispWorks-UDP project).
+* Bugfix: [SBCL] Fixed for "SBCL data flush problem", reported by Robert Brown and confirmed by Nikodemus Siivola.
 
 0.5.2:
 

Modified: usocket/branches/0.5.x/backend/sbcl.lisp
==============================================================================
--- usocket/branches/0.5.x/backend/sbcl.lisp	Thu Jun 30 09:38:18 2011	(r666)
+++ usocket/branches/0.5.x/backend/sbcl.lisp	Mon Aug  8 07:20:23 2011	(r667)
@@ -298,10 +298,24 @@
                 ;; Now that we're connected make the stream.
                 (setf (socket-stream usocket)
                       (sb-bsd-sockets:socket-make-stream socket
-                                                         :input t
-                                                         :output t
-                                                         :buffering :full
-                                                         :element-type element-type))))
+                        :input t :output t :buffering :full
+			:element-type element-type
+			;; Robert Brown <robert.brown at gmail.com> said on Aug 4, 2011:
+			;; ... This means that SBCL streams created by usocket have a true
+			;; serve-events property.  When writing large amounts of data to several
+			;; streams, the kernel will eventually stop accepting data from SBCL.
+			;; When this happens, SBCL either waits for I/O to be possible on
+			;; the file descriptor it's writing to or queues the data to be flushed later.
+			;; Because usocket streams specify serve-events as true, SBCL
+			;; always queues.  Instead, it should wait for I/O to be available and
+			;; write the remaining data to the socket.  That's what serve-events
+			;; equal to NIL gets you.
+			;;
+			;; Nikodemus Siivola <nikodemus at random-state.net> said on Aug 8, 2011:
+			;; It's set to T for purely historical reasons, and will soon change to
+			;; NIL in SBCL. (The docstring has warned of T being a temporary default
+			;; for as long as the :SERVE-EVENTS keyword argument has existed.)
+			:serve-events nil))))
              (:datagram
               (when (or local-host local-port)
                 (sb-bsd-sockets:socket-bind socket



From ctian at common-lisp.net  Sat Aug 13 05:58:28 2011
From: ctian at common-lisp.net (ctian at common-lisp.net)
Date: Fri, 12 Aug 2011 22:58:28 -0700
Subject: [usocket-cvs] r668 - in usocket/trunk: . backend
Message-ID: <E1Qs7Eq-0000gz-Bf@common-lisp.net>

Author: ctian
Date: Fri Aug 12 22:58:27 2011
New Revision: 668

Log:
Merge all changes from branch 0.5.x (r663-667) before tagging 0.5.3

Modified:
   usocket/trunk/CHANGES
   usocket/trunk/backend/lispworks.lisp
   usocket/trunk/backend/mcl.lisp
   usocket/trunk/backend/sbcl.lisp

Modified: usocket/trunk/CHANGES
==============================================================================
--- usocket/trunk/CHANGES	Mon Aug  8 07:20:23 2011	(r667)
+++ usocket/trunk/CHANGES	Fri Aug 12 22:58:27 2011	(r668)
@@ -1,3 +1,10 @@
+0.5.3:
+
+* Bugfix: [MCL] Fixed SOCKET-LISTEN on vector addresses like #(0 0 0 0)
+* Bugfix: [MCL] Fixed WAIT-FOR-INPUT on passive sockets (stream-server-usocket)
+* Bugfix: [LispWorks] Fixed using OPEN-UDP-SOCKET in delivered applications (thanks to Camille Troillard and Martin Simmons, this fix is from LispWorks-UDP project).
+* Bugfix: [SBCL] Fixed for "SBCL data flush problem", reported by Robert Brown and confirmed by Nikodemus Siivola.
+
 0.5.2:
 
 * General: [SBCL] SOCKET-CONNECT's TIMEOUT argument was limited on non-Windows platforms.

Modified: usocket/trunk/backend/lispworks.lisp
==============================================================================
--- usocket/trunk/backend/lispworks.lisp	Mon Aug  8 07:20:23 2011	(r667)
+++ usocket/trunk/backend/lispworks.lisp	Fri Aug 12 22:58:27 2011	(r668)
@@ -28,8 +28,7 @@
 
 #+win32
 (eval-when (:load-toplevel :execute)
-  (fli:register-module "ws2_32")
-  (comm::ensure-sockets))
+  (fli:register-module "ws2_32"))
 
 (fli:define-foreign-function (get-host-name-internal "gethostname" :source)
       ((return-string (:reference-return (:ef-mb-string :limit 257)))
@@ -188,6 +187,20 @@
   "Open a unconnected UDP socket.
    For binding on address ANY(*), just not set LOCAL-ADDRESS (NIL),
    for binding on random free unused port, set LOCAL-PORT to 0."
+
+  ;; Note: move (ensure-sockets) here to make sure delivered applications
+  ;; correctly have networking support initialized.
+  ;;
+  ;; Following words was from Martin Simmons, forwarded by Camille Troillard:
+
+  ;; Calling comm::ensure-sockets at load time looks like a bug in Lispworks-udp
+  ;; (it is too early and also unnecessary).
+
+  ;; The LispWorks comm package calls comm::ensure-sockets when it is needed, so I
+  ;; think open-udp-socket should probably do it too.  Calling it more than once is
+  ;; safe and it will be very fast after the first time.
+  #+win32 (comm::ensure-sockets)
+
   (let ((socket-fd (comm::socket comm::*socket_af_inet* *socket_sock_dgram* *socket_ip_proto_udp*)))
     (if socket-fd
       (progn

Modified: usocket/trunk/backend/mcl.lisp
==============================================================================
--- usocket/trunk/backend/mcl.lisp	Mon Aug  8 07:20:23 2011	(r667)
+++ usocket/trunk/backend/mcl.lisp	Fri Aug 12 22:58:27 2011	(r668)
@@ -98,7 +98,7 @@
 	 (socket (with-mapped-conditions ()
 		   (make-instance 'passive-socket 
 				  :local-port port
-				  :local-host host
+				  :local-host (host-to-hbo host)
 				  :reuse-address reuseaddress
 				  :backlog backlog))))
     (make-stream-server-socket socket :element-type element-type)))
@@ -230,8 +230,7 @@
     (declare (special ccl::*passive-interface-address*))
     new))
 
-
-(defun wait-for-input-internal (wait-list &key timeout &aux result)
+(defmethod input-available-p ((stream ccl::opentransport-stream))
   (macrolet ((when-io-buffer-lock-grabbed ((lock &optional multiple-value-p) &body body)
 	       "Evaluates the body if and only if the lock is successfully grabbed"
 	       ;; like with-io-buffer-lock-grabbed but returns immediately instead of polling the lock
@@ -249,23 +248,34 @@
 	       (declare (type ccl::lock lock))
 	       ;; crucial - clears bogus lock.value as in grab-io-buffer-lock-out-of-line:
 	       (ccl::%io-buffer-lock-really-grabbed-p lock)
-	       (ccl:store-conditional lock nil ccl:*current-process*))
-	     (input-available (stream)
-	       "similar to stream-listen on buffered-input-stream-mixin but without waiting for lock"
-	       (let ((io-buffer (ccl::stream-io-buffer stream)))
-		 (or (not (eql 0 (ccl::io-buffer-incount io-buffer)))
-		     (ccl::io-buffer-untyi-char io-buffer)
-		     (locally (declare (optimize (speed 3) (safety 0)))
-		       (when-io-buffer-lock-grabbed ((ccl::io-buffer-lock io-buffer))
-		         (funcall (ccl::io-buffer-listen-function io-buffer) stream io-buffer))))))
-	     (ready-sockets (sockets)
-	       (dolist (sock sockets result)
-		 (when (input-available (socket-stream sock))
-		   (push sock result)))))
-      (with-mapped-conditions ()
-	(ccl:process-wait-with-timeout
-	 "socket input"
-	 (when timeout (truncate (* timeout 60)))
-	 #'ready-sockets
-	 (wait-list-waiters wait-list)))
-      (nreverse result))))
+	       (ccl:store-conditional lock nil ccl:*current-process*)))
+      "similar to stream-listen on buffered-input-stream-mixin but without waiting for lock"
+      (let ((io-buffer (ccl::stream-io-buffer stream)))
+	(or (not (eql 0 (ccl::io-buffer-incount io-buffer)))
+	    (ccl::io-buffer-untyi-char io-buffer)
+	    (locally (declare (optimize (speed 3) (safety 0)))
+	      (when-io-buffer-lock-grabbed ((ccl::io-buffer-lock io-buffer))
+       	        (funcall (ccl::io-buffer-listen-function io-buffer) stream io-buffer))))))))
+
+(defmethod connection-established-p ((stream ccl::opentransport-stream))
+  (ccl::with-io-buffer-locked ((ccl::stream-io-buffer stream nil))
+    (let ((state (ccl::opentransport-stream-connection-state stream)))
+      (not (eq :unbnd state)))))
+
+(defun wait-for-input-internal (wait-list &key timeout &aux result)
+  (labels ((ready-sockets (sockets)
+	     (dolist (sock sockets result)
+	       (when (cond ((stream-usocket-p sock)
+			    (input-available-p (socket-stream sock)))
+			   ((stream-server-usocket-p sock)
+			    (let ((ot-stream (first (socket-streams (socket sock)))))
+			      (or (input-available-p ot-stream)
+				  (connection-established-p ot-stream)))))
+		 (push sock result)))))
+    (with-mapped-conditions ()
+      (ccl:process-wait-with-timeout
+       "socket input"
+       (when timeout (truncate (* timeout 60)))
+       #'ready-sockets
+       (wait-list-waiters wait-list)))
+    (nreverse result)))

Modified: usocket/trunk/backend/sbcl.lisp
==============================================================================
--- usocket/trunk/backend/sbcl.lisp	Mon Aug  8 07:20:23 2011	(r667)
+++ usocket/trunk/backend/sbcl.lisp	Fri Aug 12 22:58:27 2011	(r668)
@@ -298,10 +298,24 @@
                 ;; Now that we're connected make the stream.
                 (setf (socket-stream usocket)
                       (sb-bsd-sockets:socket-make-stream socket
-                                                         :input t
-                                                         :output t
-                                                         :buffering :full
-                                                         :element-type element-type))))
+                        :input t :output t :buffering :full
+			:element-type element-type
+			;; Robert Brown <robert.brown at gmail.com> said on Aug 4, 2011:
+			;; ... This means that SBCL streams created by usocket have a true
+			;; serve-events property.  When writing large amounts of data to several
+			;; streams, the kernel will eventually stop accepting data from SBCL.
+			;; When this happens, SBCL either waits for I/O to be possible on
+			;; the file descriptor it's writing to or queues the data to be flushed later.
+			;; Because usocket streams specify serve-events as true, SBCL
+			;; always queues.  Instead, it should wait for I/O to be available and
+			;; write the remaining data to the socket.  That's what serve-events
+			;; equal to NIL gets you.
+			;;
+			;; Nikodemus Siivola <nikodemus at random-state.net> said on Aug 8, 2011:
+			;; It's set to T for purely historical reasons, and will soon change to
+			;; NIL in SBCL. (The docstring has warned of T being a temporary default
+			;; for as long as the :SERVE-EVENTS keyword argument has existed.)
+			:serve-events nil))))
              (:datagram
               (when (or local-host local-port)
                 (sb-bsd-sockets:socket-bind socket



From ctian at common-lisp.net  Sat Aug 13 05:59:28 2011
From: ctian at common-lisp.net (ctian at common-lisp.net)
Date: Fri, 12 Aug 2011 22:59:28 -0700
Subject: [usocket-cvs] r669 - usocket/tags/0.5.3
Message-ID: <E1Qs7Fo-0000i3-Oz@common-lisp.net>

Author: ctian
Date: Fri Aug 12 22:59:28 2011
New Revision: 669

Log:
Created tag 0.5.3.

Added:
   usocket/tags/0.5.3/
      - copied from r668, usocket/branches/0.5.x/



From hhubner at common-lisp.net  Tue Aug 16 07:58:23 2011
From: hhubner at common-lisp.net (hhubner at common-lisp.net)
Date: Tue, 16 Aug 2011 00:58:23 -0700
Subject: [usocket-cvs] r671 - in usocket/trunk: . backend
Message-ID: <E1QtEXX-0004p1-Dw@common-lisp.net>

Author: hhubner
Date: Tue Aug 16 00:58:22 2011
New Revision: 671

Log:
Allegro CL modern mode fixes

Modified:
   usocket/trunk/backend/allegro.lisp
   usocket/trunk/usocket.lisp

Modified: usocket/trunk/backend/allegro.lisp
==============================================================================
--- usocket/trunk/backend/allegro.lisp	Fri Aug 12 23:08:37 2011	(r670)
+++ usocket/trunk/backend/allegro.lisp	Tue Aug 16 00:58:22 2011	(r671)
@@ -199,5 +199,5 @@
       ;; [Same code is also used in openmcl.lisp]
       (dolist (x active-internal-sockets)
         (setf (state (gethash x (wait-list-map wait-list)))
-              :READ))
+              :read))
       wait-list)))

Modified: usocket/trunk/usocket.lisp
==============================================================================
--- usocket/trunk/usocket.lisp	Fri Aug 12 23:08:37 2011	(r670)
+++ usocket/trunk/usocket.lisp	Tue Aug 16 00:58:22 2011	(r671)
@@ -325,11 +325,12 @@
          (sockets-ready 0))
     (dolist (x (wait-list-waiters socket-or-sockets))
       (when (setf (state x)
-                  #+(and win32 (or sbcl ecl)) NIL ; they cannot relay on LISTEN
+                  #+(and win32 (or sbcl ecl)) nil ; they cannot rely on LISTEN
                   #-(and win32 (or sbcl ecl))
                   (if (and (stream-usocket-p x)
                            (listen (socket-stream x)))
-                      :READ NIL))
+                      :read
+                      nil))
         (incf sockets-ready)))
     ;; the internal routine is responsibe for
     ;; making sure the wait doesn't block on socket-streams of



From ctian at common-lisp.net  Sat Aug 27 05:43:52 2011
From: ctian at common-lisp.net (ctian at common-lisp.net)
Date: Fri, 26 Aug 2011 22:43:52 -0700
Subject: [usocket-cvs] r672 - usocket/branches/0.5.x
Message-ID: <E1QxBgO-0004ls-F1@common-lisp.net>

Author: ctian
Date: Fri Aug 26 22:43:51 2011
New Revision: 672

Log:
[ECL] Fixed for ECL's MAKE-BUILD by removing some unecessary code (reported by Juan Jose Garcia-Ripoll, the ECL maintainer)

Modified:
   usocket/branches/0.5.x/CHANGES
   usocket/branches/0.5.x/package.lisp
   usocket/branches/0.5.x/usocket-test.asd
   usocket/branches/0.5.x/usocket.asd

Modified: usocket/branches/0.5.x/CHANGES
==============================================================================
--- usocket/branches/0.5.x/CHANGES	Tue Aug 16 00:58:22 2011	(r671)
+++ usocket/branches/0.5.x/CHANGES	Fri Aug 26 22:43:51 2011	(r672)
@@ -1,3 +1,7 @@
+0.5.4:
+
+* Bugfix: [ECL] Fixed for ECL's MAKE-BUILD by removing some unecessary code (reported by Juan Jose Garcia-Ripoll, the ECL maintainer)
+
 0.5.3:
 
 * Bugfix: [MCL] Fixed SOCKET-LISTEN on vector addresses like #(0 0 0 0)

Modified: usocket/branches/0.5.x/package.lisp
==============================================================================
--- usocket/branches/0.5.x/package.lisp	Tue Aug 16 00:58:22 2011	(r671)
+++ usocket/branches/0.5.x/package.lisp	Fri Aug 26 22:43:51 2011	(r672)
@@ -3,8 +3,6 @@
 
 ;;;; See the LICENSE file for licensing information.
 
-(in-package :usocket-system)
-
 (defpackage :usocket
   (:use :common-lisp #+abcl :java)
   (:export   #:*wildcard-host*
@@ -86,20 +84,3 @@
              #:insufficient-implementation ; conditions regarding usocket support level
              #:unsupported
              #:unimplemented))
-
-(in-package :usocket)
-
-;;; Logical Pathname Translations, learn from CL-HTTP source code
-
-(eval-when (:load-toplevel :execute)
-  (let* ((defaults #+asdf (asdf:component-pathname (asdf:find-system :usocket))
-                   #-asdf *load-truename*)
-         (home (make-pathname :name :wild :type :wild
-                              :directory (append (pathname-directory defaults)
-                                                 '(:wild-inferiors))
-                              :host (pathname-host defaults)
-                              :defaults defaults
-			      :version :newest)))
-    (setf (logical-pathname-translations "usocket")
-          `(("**;*.*.NEWEST" ,home)
-            ("**;*.*" ,home)))))

Modified: usocket/branches/0.5.x/usocket-test.asd
==============================================================================
--- usocket/branches/0.5.x/usocket-test.asd	Tue Aug 16 00:58:22 2011	(r671)
+++ usocket/branches/0.5.x/usocket-test.asd	Fri Aug 26 22:43:51 2011	(r672)
@@ -4,14 +4,6 @@
 
 ;;;; See the LICENSE file for licensing information.
 
-(in-package :cl-user)
-
-(unless (find-package ':usocket-system)
-  (make-package ':usocket-system
-		:use '(:cl :asdf)))
-
-(in-package :usocket-system)
-
 (defsystem usocket-test
     :name "usocket test"
     :author "Erik Enge"

Modified: usocket/branches/0.5.x/usocket.asd
==============================================================================
--- usocket/branches/0.5.x/usocket.asd	Tue Aug 16 00:58:22 2011	(r671)
+++ usocket/branches/0.5.x/usocket.asd	Fri Aug 26 22:43:51 2011	(r672)
@@ -4,13 +4,6 @@
 
 ;;;; See the LICENSE file for licensing information.
 
-(in-package :cl-user)
-
-(defpackage usocket-system
-    (:use :cl :asdf))
-
-(in-package :usocket-system)
-
 (defsystem usocket
     :name "usocket"
     :author "Erik Enge & Erik Huelsmann"



From ctian at common-lisp.net  Sat Aug 27 05:46:28 2011
From: ctian at common-lisp.net (ctian at common-lisp.net)
Date: Fri, 26 Aug 2011 22:46:28 -0700
Subject: [usocket-cvs] r673 - in usocket/branches/0.5.x: . backend
Message-ID: <E1QxBiu-00056a-QQ@common-lisp.net>

Author: ctian
Date: Fri Aug 26 22:46:28 2011
New Revision: 673

Log:
[ACL] Fixed for Allegro CL modern mode (merged from trunk, r671)

Modified:
   usocket/branches/0.5.x/CHANGES
   usocket/branches/0.5.x/backend/allegro.lisp
   usocket/branches/0.5.x/usocket.lisp

Modified: usocket/branches/0.5.x/CHANGES
==============================================================================
--- usocket/branches/0.5.x/CHANGES	Fri Aug 26 22:43:51 2011	(r672)
+++ usocket/branches/0.5.x/CHANGES	Fri Aug 26 22:46:28 2011	(r673)
@@ -1,6 +1,7 @@
 0.5.4:
 
 * Bugfix: [ECL] Fixed for ECL's MAKE-BUILD by removing some unecessary code (reported by Juan Jose Garcia-Ripoll, the ECL maintainer)
+* Bugfix: [ACL] Fixed for Allegro CL modern mode.
 
 0.5.3:
 

Modified: usocket/branches/0.5.x/backend/allegro.lisp
==============================================================================
--- usocket/branches/0.5.x/backend/allegro.lisp	Fri Aug 26 22:43:51 2011	(r672)
+++ usocket/branches/0.5.x/backend/allegro.lisp	Fri Aug 26 22:46:28 2011	(r673)
@@ -199,5 +199,5 @@
       ;; [Same code is also used in openmcl.lisp]
       (dolist (x active-internal-sockets)
         (setf (state (gethash x (wait-list-map wait-list)))
-              :READ))
+              :read))
       wait-list)))

Modified: usocket/branches/0.5.x/usocket.lisp
==============================================================================
--- usocket/branches/0.5.x/usocket.lisp	Fri Aug 26 22:43:51 2011	(r672)
+++ usocket/branches/0.5.x/usocket.lisp	Fri Aug 26 22:46:28 2011	(r673)
@@ -325,11 +325,12 @@
          (sockets-ready 0))
     (dolist (x (wait-list-waiters socket-or-sockets))
       (when (setf (state x)
-                  #+(and win32 (or sbcl ecl)) NIL ; they cannot relay on LISTEN
+                  #+(and win32 (or sbcl ecl)) nil ; they cannot rely on LISTEN
                   #-(and win32 (or sbcl ecl))
                   (if (and (stream-usocket-p x)
                            (listen (socket-stream x)))
-                      :READ NIL))
+                      :read
+                      nil))
         (incf sockets-ready)))
     ;; the internal routine is responsibe for
     ;; making sure the wait doesn't block on socket-streams of