Ignore:
Timestamp:
Jul 27, 2010, 12:59:48 AM (9 years ago)
Author:
gz
Message:

Misc tweaks and fixes from trunk (r13550,r13560,r13568,r13569,r13581,r13583,r13633-13636,r13647,r13648,r13657-r13659,r13675,r13678,r13688,r13743,r13744,r13769,r13773,r13782,r13813,r13814,r13869,r13870,r13873,r13901,r13930,r13943,r13946,r13954,r13961,r13974,r13975,r13978,r13990,r14010,r14012,r14020,r14028-r14030)

Location:
branches/qres/ccl
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • branches/qres/ccl

  • branches/qres/ccl/level-1/l1-sockets.lisp

    r13503 r14049  
    453453(defmethod socket-type ((stream udp-socket)) :datagram)
    454454(defmethod socket-connect ((stream udp-socket)) nil)
     455(defmethod socket-format ((stream udp-socket)) :binary)
    455456
    456457(defgeneric socket-os-fd (socket)
     
    949950            #+x8664-target (and (>= subtype x8664::min-8-bit-ivector-subtag)
    950951                                (<= subtype x8664::max-8-bit-ivector-subtag))
    951       (report-bad-arg buf `(or (array character)
    952                                (array (unsigned-byte 8))
     952      (report-bad-arg buf '(or (array (unsigned-byte 8))
    953953                               (array (signed-byte 8))))))
    954954  (values buf offset))
     
    10101010                                :element-type
    10111011                                (ecase (socket-format socket)
    1012                                   ((:text) 'base-char)
    1013                                   ((:binary :bivalent) '(unsigned-byte 8))))
     1012                                  ((:binary) '(unsigned-byte 8))))
    10141013                vec-offset 0))
    10151014        (%copy-ptr-to-ivector bufptr 0 vec vec-offset ret-size))
     
    14411440  (let* ((socket (#_socket #$AF_INET #$SOCK_DGRAM #$IPPROTO_IP)))
    14421441    (unwind-protect
    1443     (rlet ((realoutlen #>DWORD 0))
    1444       (do* ((reservedlen (* 4 (record-length #>INTERFACE_INFO))
    1445                          (* 2 reservedlen)))
    1446            ()
    1447         (%stack-block ((buf reservedlen))
    1448           (unless (eql 0 (#_WSAIoctl
    1449                           socket
    1450                           #$SIO_GET_INTERFACE_LIST
    1451                           (%null-ptr)
    1452                           0
    1453                           buf
    1454                           reservedlen
    1455                           realoutlen
    1456                           (%null-ptr)
    1457                           (%null-ptr)))
    1458             (return))
    1459           (let* ((noutbytes (pref realoutlen #>DWORD)))
    1460             (when (< noutbytes reservedlen)
    1461               (let* ((interfaces nil))
    1462                 (do* ((offset 0 (+ offset (record-length #>INTERFACE_INFO)))
    1463                       (nameidx 0 (1+ nameidx)))
    1464                      ((>= offset noutbytes))
    1465                   (with-macptrs ((p (%inc-ptr buf offset)))
    1466                     (push (make-ip-interface
    1467                            :name (format nil "ip~d" nameidx)
    1468                            :addr (ntohl
    1469                                   (pref (pref p #>INTERFACE_INFO.iiAddress)
    1470                                         #>sockaddr_gen.AddressIn.sin_addr.S_un.S_addr))
    1471                            :netmask (ntohl
    1472                                      (pref (pref p #>INTERFACE_INFO.iiNetmask)
    1473                                         #>sockaddr_gen.AddressIn.sin_addr.S_un.S_addr))
    1474                            :flags (pref p #>INTERFACE_INFO.iiFlags)
    1475                            :address-family #$AF_INET)
    1476                           interfaces)))
    1477                 (return interfaces)))))))
     1442         (rlet ((realoutlen #>DWORD 0))
     1443           (do* ((reservedlen (* 4 (record-length #>INTERFACE_INFO))
     1444                              (* 2 reservedlen)))
     1445                ()
     1446             (%stack-block ((buf reservedlen))
     1447               (if (eql 0  (#_WSAIoctl
     1448                            socket
     1449                            #$SIO_GET_INTERFACE_LIST
     1450                            (%null-ptr)
     1451                            0
     1452                            buf
     1453                            reservedlen
     1454                            realoutlen
     1455                            (%null-ptr)
     1456                            (%null-ptr)))
     1457               (let* ((noutbytes (pref realoutlen #>DWORD)))
     1458                 (when (< noutbytes reservedlen)
     1459                   (let* ((interfaces nil))
     1460
     1461                     (do* ((offset 0 (+ offset (record-length #>INTERFACE_INFO)))
     1462                           (nameidx 0 (1+ nameidx)))
     1463                          ((>= offset noutbytes))
     1464                       (with-macptrs ((p (%inc-ptr buf offset)))
     1465                         (push (make-ip-interface
     1466                                :name (format nil "ip~d" nameidx)
     1467                                :addr (ntohl
     1468                                       (pref (pref p #>INTERFACE_INFO.iiAddress)
     1469                                             #>sockaddr_gen.AddressIn.sin_addr.S_un.S_addr))
     1470                                :netmask (ntohl
     1471                                          (pref (pref p #>INTERFACE_INFO.iiNetmask)
     1472                                                #>sockaddr_gen.AddressIn.sin_addr.S_un.S_addr))
     1473                                :flags (pref p #>INTERFACE_INFO.iiFlags)
     1474                                :address-family #$AF_INET)
     1475                               interfaces)))
     1476                     (return interfaces))))
     1477               (let* ((err (#_WSAGetLastError)))
     1478                 (unless (eql err #$WSAEFAULT)
     1479                   (return)))))))
    14781480      (#_closesocket socket))))
    14791481
Note: See TracChangeset for help on using the changeset viewer.