[Openmcl-cvs-notifications] r13902 - /release/1.5/source/level-1/l1-sockets.lisp

[rme at clozure.com]

Author: rme
Date: Tue Jun 29 12:38:31 2010
New Revision: 13902

Log:
Revert r13894 and merge r13773: udp sockets only support :binary format.

Modified:
    release/1.5/source/level-1/l1-sockets.lisp

Modified: release/1.5/source/level-1/l1-sockets.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
--- release/1.5/source/level-1/l1-sockets.lisp (original)
+++ release/1.5/source/level-1/l1-sockets.lisp Tue Jun 29 12:38:31 2010
@@ -452,6 +452,7 @@
 =

 (defmethod socket-type ((stream udp-socket)) :datagram)
 (defmethod socket-connect ((stream udp-socket)) nil)
+(defmethod socket-format ((stream udp-socket)) :binary)
 =

 (defgeneric socket-os-fd (socket)
   (:documentation
@@ -948,16 +949,14 @@
                                 (<=3D subtype x8632::max-8-bit-ivector-sub=
tag))
             #+x8664-target (and (>=3D subtype x8664::min-8-bit-ivector-sub=
tag)
                                 (<=3D subtype x8664::max-8-bit-ivector-sub=
tag))
-      (report-bad-arg buf `(or (array character)
-			       (array (unsigned-byte 8))
+      (report-bad-arg buf '(or (array (unsigned-byte 8))
 			       (array (signed-byte 8))))))
   (values buf offset))
 =

 (defmethod send-to ((socket udp-socket) msg size
-		    &key remote-host remote-port offset (external-format :ISO-8859-1))
+		    &key remote-host remote-port offset)
   "Send a UDP packet over a socket."
   (let ((fd (socket-device socket)))
-    (when (stringp msg) (setf msg (ccl::ENCODE-STRING-TO-OCTETS msg :exter=
nal-format external-format)))
     (multiple-value-setq (msg offset) (verify-socket-buffer msg offset siz=
e))
     (unless remote-host
       (setq remote-host (or (getf (socket-keys socket) :remote-host)
@@ -973,16 +972,15 @@
 	    (if remote-host (host-as-inet-host remote-host) #$INADDR_ANY))
       (setf (pref sockaddr :sockaddr_in.sin_port)
 	    (if remote-port (port-as-inet-port remote-port "udp") 0))
-            (%stack-block ((bufptr size))
+      (%stack-block ((bufptr size))
         (%copy-ivector-to-ptr msg offset bufptr 0 size)
 	(socket-call socket "sendto"
 	  (with-eagain fd :output
 	    (c_sendto fd bufptr size 0 sockaddr (record-length :sockaddr_in))))))=
))
 =

-(defmethod receive-from ((socket udp-socket) size &key buffer extract offs=
et (encoding #.(lookup-character-encoding :iso-8859-1)))
+(defmethod receive-from ((socket udp-socket) size &key buffer extract offs=
et)
   "Read a UDP packet from a socket. If no packets are available, wait for
-  a packet to arrive. =

-  Returns four values:
+a packet to arrive. Returns four values:
   The buffer with the data
   The number of bytes read
   The 32-bit unsigned IP address of the sender of the data
@@ -1004,21 +1002,16 @@
       (setf (pref sockaddr :sockaddr_in.sin_port) 0)
       (setf (pref namelen :signed) (record-length :sockaddr_in))
       (%stack-block ((bufptr size))
-        (setq ret-size (socket-call socket "recvfrom"
-                                    (with-eagain fd :input
-                                      (c_recvfrom fd bufptr size 0 sockadd=
r namelen))))
-        (unless vec
-          (setq vec (make-array ret-size
-                                :element-type
-                                (ecase (socket-format socket)
-                                  ((:text) 'base-char)
-                                  ((:binary :bivalent) '(unsigned-byte 8))=
))
-                vec-offset 0))
-        =

-        (ecase (socket-format socket)
-          ((:text) (funcall (character-encoding-memory-decode-function enc=
oding) bufptr ret-size 0 vec))
-          ((:binary (%copy-ptr-to-ivector bufptr 0 vec vec-offset ret-size=
)))))
-      =

+	(setq ret-size (socket-call socket "recvfrom"
+			 (with-eagain fd :input
+			   (c_recvfrom fd bufptr size 0 sockaddr namelen))))
+	(unless vec
+	  (setq vec (make-array ret-size
+				:element-type
+				(ecase (socket-format socket)
+				  ((:binary) '(unsigned-byte 8))))
+		vec-offset 0))
+	(%copy-ptr-to-ivector bufptr 0 vec vec-offset ret-size))
       (values (cond ((null buffer)
 		     vec)
 		    ((or (not extract)