r5267: *** empty log message ***

diff --git a/README b/README
index 9ecc16ea3e5d8589daf1518641ebf2e2b27db027..4c480a46f0bf33e956138bc9691eaa20d0b97b7b 100644 (file)
--- a/README
+++ b/README
@@ -1,5 +1,6 @@
 KMRCL is a collection of utility functions. It is used as a base for
 some of Kevin M. Rosenberg's Common Lisp packages.
 
 KMRCL is a collection of utility functions. It is used as a base for
 some of Kevin M. Rosenberg's Common Lisp packages.
 

-The web site for KMRCL is http://lisp.b9.com/
+The web site for KMRCL is http://files.b9.com/kmrcl/
+

 
 

diff --git a/debian/changelog b/debian/changelog
index 98ac156715a905d163f218e6efc8cb2cbe7b2c15..33d53a8b73c2144cada46fd00cfd596f69380859 100644 (file)
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,9 @@
+cl-kmrcl (1.52-3) unstable; urgency=low
+
+  * New upstream
+
+ -- Kevin M. Rosenberg <kmr@debian.org>  Thu, 10 Jul 2003 12:52:04 -0600
+

 cl-kmrcl (1.51-1) unstable; urgency=low
 
   * New upstream with support of OpenMCL's MOP
 cl-kmrcl (1.51-1) unstable; urgency=low
 
   * New upstream with support of OpenMCL's MOP

diff --git a/debian/copyright b/debian/copyright
index cb26fba64e79f2f606e7af3bedae10d04264c469..e8ac01d9d912d761253c289d6f0a51dcd594f31a 100644 (file)
--- a/debian/copyright
+++ b/debian/copyright
@@ -5,7 +5,7 @@ It was downloaded from ftp://ftp.b9.com/kmrcl
 
 Upstream Author: Kevin M. Rosenberg <kevin@rosenberg.net>
 
 
 Upstream Author: Kevin M. Rosenberg <kevin@rosenberg.net>
 

-Copyright (C) 2000-2002 by Kevin M. Rosenberg.
+Copyright (C) 2000-2003 by Kevin M. Rosenberg.

 
 This code is free software; you can redistribute it and/or modify it
 under the terms of the version 2.1 of the GNU Lesser General Public
 
 This code is free software; you can redistribute it and/or modify it
 under the terms of the version 2.1 of the GNU Lesser General Public

diff --git a/listener.lisp b/listener.lisp
index d37d72d924c54f51a3c82c948ba149e5d71667d0..19fbdbe71b317e0e8d494045e283dacef1fb0000 100644 (file)
--- a/listener.lisp
+++ b/listener.lisp
@@ -5,9 +5,9 @@
 ;;;; Name:          listener.lisp
 ;;;; Purpose:       Listener and worker processes
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Name:          listener.lisp
 ;;;; Purpose:       Listener and worker processes
 ;;;; Programmer:    Kevin M. Rosenberg

-;;;; Date Started:  Dec 2002
+;;;; Date Started:  Jun 2003

 ;;;;
 ;;;;

-;;;; $Id: listener.lisp,v 1.2 2003/07/09 22:12:52 kevin Exp $
+;;;; $Id: listener.lisp,v 1.3 2003/07/10 18:52:10 kevin Exp $

 ;;;; *************************************************************************
 
 (in-package #:kmrcl)
 ;;;; *************************************************************************
 
 (in-package #:kmrcl)


@@ -29,8 +29,8 @@
             :initform nil)
    (function-args :initarg :function-args :accessor function-args
                  :initform nil)
             :initform nil)
    (function-args :initarg :function-args :accessor function-args
                  :initform nil)

-   (process :initarg :process :accessor process)
-   (socket :initarg :socket :accessor socket)
+   (process :initarg :process :accessor process :initform nil)
+   (socket :initarg :socket :accessor socket :initform nil)

    (workers :initform nil :accessor workers
            :documentation "list of worker threads")
    (name :initform "" :accessor name :initarg :name)
    (workers :initform nil :accessor workers
            :documentation "list of worker threads")
    (name :initform "" :accessor name :initarg :name)


@@ -80,16 +80,21 @@
        (warn "~&listener is not in active list")
        (return-from init/listener listener))
      (dolist (worker (workers listener))
        (warn "~&listener is not in active list")
        (return-from init/listener listener))
      (dolist (worker (workers listener))

-       (close-active-socket (connection worker))
-       (destroy-process (process worker))
-       (setf (connection worker) nil)
-       (setf (process worker) nil))
+       (with-slots (connection process) worker
+        (when connection
+          (errorset (close-active-socket connection) nil)
+          (setf connection nil))
+        (when process
+          (errorset (destroy-process process) nil)
+          (setf process nil))))

      (setf (workers listener) nil)
      (with-slots (process socket) listener
      (setf (workers listener) nil)
      (with-slots (process socket) listener

-       (errorset (close-passive-socket socket) t)
-       (errorset (destroy-process process) t)
-       (setf process nil)
-       (setf socket nil))
+       (when socket
+        (errorset (close-passive-socket socket) nil)
+        (setf socket nil))
+       (when process
+        (errorset (destroy-process process) nil)
+        (setf process nil)))

      (setq *active-listeners* (remove listener *active-listeners*)))
     (:restart
      (init/listener listener :stop)
      (setq *active-listeners* (remove listener *active-listeners*)))
     (:restart
      (init/listener listener :stop)


@@ -109,12 +114,22 @@
   (format nil "~A-worker-~D" base-name (incf *worker-count*)))
 
 (defun make-socket-server (listener)
   (format nil "~A-worker-~D" base-name (incf *worker-count*)))
 
 (defun make-socket-server (listener)

-  (setf (socket listener) (create-inet-listener
-                          (port listener)
-                          :format (listener-format listener)))
-  (setf (process listener) (make-process
-                           (name listener)
-                           #'(lambda () (start-socket-server listener))))
+  #+lispworks
+  (progn
+    (setf (process listener)
+      (comm:start-up-server :process-name (name listener)
+                           :service (port listener) 
+                           :function
+                           #'(lambda (handle) 
+                               (lw-worker handle listener)))))
+  #-lispworks
+  (progn
+    (setf (socket listener) (create-inet-listener
+                            (port listener)
+                            :format (listener-format listener)))
+    (setf (process listener) (make-process
+                             (name listener)
+                             #'(lambda () (start-socket-server listener)))))

   listener)
 
 
   listener)
 
 


@@ -162,3 +177,21 @@
                (make-process (name worker) (thread-fun worker)))
              (push worker (workers listener))))))
     (errorset (close-passive-socket (socket listener)) nil)))
                (make-process (name worker) (thread-fun worker)))
              (push worker (workers listener))))))
     (errorset (close-passive-socket (socket listener)) nil)))

+
+#+lispworks
+(defun lw-worker (handle listener)
+  (let ((connection (make-instance 'comm:socket-stream
+                     :socket handle
+                     :direction :io
+                     :element-type 'base-char)))
+    (if (wait listener)
+       (apply (listener-function listener)
+              connection
+              (function-args listener))
+      (let ((worker (make-instance 'worker :listener listener
+                                  :connection connection
+                                  :name (next-worker-name
+                                                 (base-name listener)))))
+       (setf (process worker)
+         (make-process (name worker) (thread-fun worker)))
+       (push worker (workers listener))))))

diff --git a/sockets.lisp b/sockets.lisp
index a0d4472de2a8d6c334d3389fe0d7e5284e0ca59a..6af47d86c92ed7b6292c9f861001704425f7a661 100644 (file)
--- a/sockets.lisp
+++ b/sockets.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg with excerpts from portableaserve
 ;;;; Date Started:  Jun 2003
 ;;;;
 ;;;; Programmer:    Kevin M. Rosenberg with excerpts from portableaserve
 ;;;; Date Started:  Jun 2003
 ;;;;

-;;;; $Id: sockets.lisp,v 1.2 2003/07/09 22:12:52 kevin Exp $
+;;;; $Id: sockets.lisp,v 1.3 2003/07/10 18:52:10 kevin Exp $

 ;;;; *************************************************************************
 
 (in-package #:kmrcl)
 ;;;; *************************************************************************
 
 (in-package #:kmrcl)


@@ -18,126 +18,6 @@
   #+allegro (require :socket))
 
 
   #+allegro (require :socket))
 
 

-#+lispworks
-(progn
-  
-(define-condition lw-stream-error (error)
-  ((stream :initarg :stream
-           :reader stream-error-stream)
-   (action :initarg :action
-           :reader stream-error-action)
-   (code :initarg :code
-         :reader stream-error-code)
-   (identifier :initarg :identifier
-               :reader stream-error-identifier))
-  (:report (lambda (condition stream)
-             (format stream "A stream error occured (action=~A identifier=~A code=~A stream=~S)."
-                     (stream-error-action condition)
-                     (stream-error-identifier condition)
-                     (stream-error-code condition)
-                     (stream-error-stream condition)))))
-
-(define-condition socket-error (lw-stream-error)
-  ()
-  (:report (lambda (condition stream)
-             (format stream "A socket error occured (action=~A identifier=~A code=~A stream=~S)."
-                     (stream-error-action condition)
-                     (stream-error-identifier condition)
-                     (stream-error-code condition)
-                     (stream-error-stream condition)))))
-
-(defclass socket ()
-    ((passive-socket :type fixnum
-                    :initarg :passive-socket
-                    :reader socket-os-fd)))
-  
-  (defclass passive-socket (socket)
-    ((element-type :type (member signed-byte unsigned-byte base-char)
-                  :initarg :element-type
-                  :reader element-type)
-     (port :type fixnum
-          :initarg :port
-          :reader local-port)))
-
-  (defmethod print-object ((passive-socket passive-socket) stream)
-    (print-unreadable-object (passive-socket stream :type t :identity nil)
-      (format stream "@~d on port ~d" (socket-os-fd passive-socket) (local-port passive-socket))))
-
-  (defclass binary-socket-stream (comm:socket-stream) ())
-(defclass input-binary-socket-stream (binary-socket-stream)())
-(defclass output-binary-socket-stream (binary-socket-stream)())
-(defclass bidirectional-binary-socket-stream (input-binary-socket-stream output-binary-socket-stream)())
-
-#+unix
-(defun %socket-error-identifier (code)
-  (case code
-    (32 :x-broken-pipe)
-    (98 :address-in-use)
-    (99 :address-not-available)
-    (100 :network-down)
-    (102 :network-reset)
-    (103 :connection-aborted)
-    (104 :connection-reset)
-    (105 :no-buffer-space)
-    (108 :shutdown)
-    (110 :connection-timed-out)
-    (111 :connection-refused)
-    (112 :host-down)
-    (113 :host-unreachable)
-    (otherwise :unknown)))
-
-#+win32
-(defun %socket-error-identifier (code)
-  (case code
-    (10048 :address-in-use)
-    (10049 :address-not-available)
-    (10050 :network-down)
-    (10052 :network-reset)
-    (10053 :connection-aborted)
-    (10054 :connection-reset)
-    (10055 :no-buffer-space)
-    (10058 :shutdown)
-    (10060 :connection-timed-out)
-    (10061 :connection-refused)
-    (10064 :host-down)
-    (10065 :host-unreachable)
-    (otherwise :unknown)))
-
-(defun socket-error (stream error-code action format-string &rest format-args)
-  (let ((code (if (numberp error-code) error-code #+unix(lw:errno-value))))
-    (error 'socket-error :stream stream :code code
-           :identifier (if (keywordp error-code)
-                           error-code
-                         (%socket-error-identifier error-code))
-           :action action
-           :format-control "~A occured while doing socket IO (~?)"
-           :format-arguments (list 'socket-error format-string format-args))))
-
-
-(defmethod comm::socket-error ((stream binary-socket-stream) error-code format-string &rest format-args)
-  (apply #'socket-error stream error-code :IO format-string format-args))
-
-(defmethod stream-input-available ((fd fixnum))
-  (comm::socket-listen fd))
-
-(defmethod stream-input-available ((stream stream::os-file-handle-stream))
-  (stream-input-available (stream::os-file-handle-stream-file-handle stream)))
-
-(defmethod stream-input-available ((stream comm:socket-stream))
-  (or (comm::socket-listen (comm:socket-stream-socket stream))
-      (listen stream)))
-
-(defmethod stream-input-available ((stream passive-socket))
-  (comm::socket-listen (socket-os-fd stream)))
-
-(defun %new-passive-socket (local-port)
-  (multiple-value-bind (socket error-location error-code)
-      (comm::create-tcp-socket-for-service local-port)
-    (cond (socket socket)
-         (t (error 'socket-error :action error-location :code error-code :identifier :unknown)))))
-
-) ;; lispworks
-

 #+sbcl
 (defun listen-to-inet-port (&key (port 0) (kind :stream) (reuse nil))
   "Create, bind and listen to an inet socket on *:PORT.
 #+sbcl
 (defun listen-to-inet-port (&key (port 0) (kind :stream) (reuse nil))
   "Create, bind and listen to an inet socket on *:PORT.


@@ -166,13 +46,8 @@ setsockopt SO_REUSEADDR if :reuse is not nil"
   #+sbcl
   (listen-to-inet-port :port port :reuse reuse-address)
   #+clisp (ext:socket-server port)
   #+sbcl
   (listen-to-inet-port :port port :reuse reuse-address)
   #+clisp (ext:socket-server port)

-  #+lispworks
-  (let ((comm::*use_so_reuseaddr* reuse-address))
-    (make-instance 'passive-socket
-                  :port port
-                  :passive-socket (%new-passive-socket port)
-                  :element-type (case format
-                                  (:text 'base-char))))
+  #-(or allegro clisp cmu sbcl)
+  (warn "create-inet-listener not supported on this implementation")

   )
 
 (defun make-fd-stream (socket &key input output element-type)
   )
 
 (defun make-fd-stream (socket &key input output element-type)


@@ -188,6 +63,10 @@ setsockopt SO_REUSEADDR if :reuse is not nil"
 
 
 (defun accept-tcp-connection (listener)
 
 
 (defun accept-tcp-connection (listener)

+  #+allegro
+  (socket:accept-connection listener)
+  #+clisp
+  (ext:socket-accept listener)

   #+cmu
   (progn
     (mp:process-wait-until-fd-usable listener :input)
   #+cmu
   (progn
     (mp:process-wait-until-fd-usable listener :input)


@@ -201,20 +80,8 @@ setsockopt SO_REUSEADDR if :reuse is not nil"
      (sb-bsd-sockets:socket-accept listener)
      :element-type 'base-char
      :input t :output t))
      (sb-bsd-sockets:socket-accept listener)
      :element-type 'base-char
      :input t :output t))

-  #+allegro
-  (socket:accept-connection listener)
-  #+clisp
-  (ext:socket-accept listener)
-  #+lispworks
-  (progn
-    (loop while (not (stream-input-available listener))
-         do (sleep 1))
-    (make-instance 'bidirectional-binary-socket-stream
-                  :socket (comm::get-fd-from-socket
-                           (socket-os-fd listener))
-                  :direction :io
-                  :element-type (element-type listener)))
-    
+  #-(or allegro clisp cmu sbcl)
+  (warn "accept-tcp-connection not supported on this implementation")

   )
 
 
   )
 
 


@@ -228,11 +95,12 @@ setsockopt SO_REUSEADDR if :reuse is not nil"
 
 (defun close-passive-socket (socket)
   #+allegro (close socket)
 
 (defun close-passive-socket (socket)
   #+allegro (close socket)

+  #+clisp (close socket)

   #+cmu (unix:unix-close socket)
   #+sbcl (sb-unix:unix-close
          (sb-bsd-sockets:socket-file-descriptor socket))
   #+cmu (unix:unix-close socket)
   #+sbcl (sb-unix:unix-close
          (sb-bsd-sockets:socket-file-descriptor socket))

-  #+clisp (close socket)
-  #+lispworks (comm::close-socket (socket-os-fd socket))
+  #-(or allegro clisp cmu sbcl)
+  (warn "close-passive-socket not supported on this implementation")

   )
 
 
   )