← Back to branch summary

~ubuntu-branches/ubuntu/intrepid/ecl/intrepid

« back to all changes in this revision

Viewing changes to contrib/sockets/sockets.lisp

  • Committer: Bazaar Package Importer
  • Author(s): Albin Tonnerre
  • Date: 2008-06-20 18:00:19 UTC
  • mfrom: (1.1.4 upstream)
  • Revision ID: james.westby@ubuntu.com-20080620180019-7fbz1ln5444vtkkr
Tags: 0.9j-20080306-2ubuntu1
* Enabled unicode support. (Closes: LP #123530)
* Modify Maintainer value to match the DebianMaintainerField specification.

Show diffs side-by-side

added added

removed removed

Lines of Context:
contrib/sockets/sockets.lisp
1
1
;; -*- Mode: Lisp; Syntax: Common-Lisp -*-
2
 
;; $Id: sockets.lisp,v 1.30 2007/03/24 11:19:41 jgarcia Exp $
 
2
;; $Id: sockets.lisp,v 1.34 2008/03/05 20:01:55 jgarcia Exp $
3
3
 
4
4
;; This file is based on SBCL's SB-BSD-SOCKET module and has been
5
5
;; heavily modified to work with ECL by Julian Stecklina.
38
38
 "#include <sys/socket.h>"
39
39
 "#include <sys/un.h>"
40
40
 "#include <netdb.h>"
41
 
 "#include <strings.h>"
 
41
 "#include <string.h>"
42
42
 "#include <netinet/in.h>"
43
43
 "#include <errno.h>"
44
44
 "#include <fcntl.h>"
109
109
 
110
110
(define-c-constants
111
111
  +af-inet+ "AF_INET"
112
 
  +af-local+ "AF_LOCAL")
 
112
  +af-local+ #-sun4sol2 "AF_LOCAL" #+sun4sol2 "AF_UNIX"
 
113
  +eagain+ "EAGAIN"
 
114
  +eintr+ "EINTR")
113
115
 
114
116
#+:wsock
115
117
(defconstant +af-named-pipe+ -2)
437
439
        cl_type t = type_of(x);
438
440
        int ok = 0;
439
441
        if (t == t_base_string) {
440
 
                ok = (size < x->base_string.dim);
 
442
                ok = (size <= x->base_string.dim);
441
443
        } else if (t == t_vector) {
442
444
                cl_elttype aet = (cl_elttype)x->vector.elttype;
443
445
                if (aet == aet_b8 || aet == aet_i8 || aet == aet_bc) {
444
 
                        ok = (size < x->vector.dim);
 
446
                        ok = (size <= x->vector.dim);
445
447
                } else if (aet == aet_fix || aet == aet_index) {
446
 
                        size /= sizeof(cl_index);
447
 
                        ok = (size < x->vector.dim);
 
448
                        cl_index divisor = sizeof(cl_index);
 
449
                        size = (size + divisor - 1) / divisor;
 
450
                        ok = (size <= x->vector.dim);
448
451
                }
449
452
        }
450
453
        if (!ok) {
461
464
  (let ((buffer (or buffer (make-array length :element-type element-type)))
462
465
        (length (or length (length buffer)))
463
466
        (fd (socket-file-descriptor socket)))
464
 
    (let ((len-recv
 
467
 
 
468
    (multiple-value-bind (len-recv errno)
465
469
           (c-inline (fd buffer length
466
470
                      oob peek waitall)
467
471
                     (:int :object :int :bool :bool :bool)
468
 
                     :long
 
472
                  (values :long :int)
469
473
                     "
470
474
{
471
475
        int flags = ( #3 ? MSG_OOB : 0 )  |
479
483
               if (type == t_vector) { #1->vector.fillp = len; }
480
484
               else if (type == t_base_string) { #1->base_string.fillp = len; }
481
485
        }
482
 
        @(return) = len;
 
486
        @(return 0) = len;
 
487
        @(return 1) = errno;
483
488
}
484
489
"
485
 
                     :one-liner nil)))
486
 
      (if (= len-recv -1)
487
 
          (socket-error "receive")
488
 
          (values buffer len-recv)))))
 
490
                  :one-liner nil)
 
491
      (cond ((and (= len-recv -1)
 
492
                  (member errno (list +eagain+ +eintr+)))
 
493
             nil)
 
494
            ((= len-recv -1)
 
495
             (socket-error "receive"))
 
496
            (t 
 
497
             (values buffer len-recv))))))
 
498
 
489
499
 
490
500
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
491
501
;;;
1379
1389
(define-sockopt socket-dont-route "SO_DONTROUTE" bool)
1380
1390
(define-sockopt socket-linger "SO_LINGER" bool)
1381
1391
 
1382
 
#-(or :linux :wsock :cygwin)
 
1392
#-(or :sun4sol2 :linux :wsock :cygwin)
1383
1393
(define-sockopt sockopt-reuse-port "SO_REUSEPORT" bool)
1384
1394
 
1385
1395
;; Add sockopts here as you need them...