r5301: *** empty log message ***

diff --git a/listener.lisp b/listener.lisp
index 19c7b0c308542bbaf2b8b527abeae7cf19f8b240..a757cc1d73541402f8e24e7c37f152e019df3c50 100644 (file)
--- a/listener.lisp
+++ b/listener.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Jun 2003
 ;;;;
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Jun 2003
 ;;;;

-;;;; $Id: listener.lisp,v 1.5 2003/07/11 06:58:32 kevin Exp $
+;;;; $Id: listener.lisp,v 1.6 2003/07/13 04:53:32 kevin Exp $

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


@@ -69,41 +69,16 @@
   (case state
     (:start
      (when (member listener *active-listeners*)
   (case state
     (:start
      (when (member listener *active-listeners*)

-       (warn "~&listener already started")
-       (return-from init/listener listener))
-     (handler-case
-        (progn
-          (setf (name listener) (next-server-name (base-name listener)))
-          (make-socket-server listener))
-       (error (e)
-        (format t "~&Error while trying to start listener~&  ~A" e)
-        (decf *listener-count*)
-        nil)
-       (:no-error (res)
-        (declare (ignore res))
-        (push listener *active-listeners*)
-        listener)))
+       (cmsg "~&listener ~A already initialized" listener)
+       (return-from init/listener))
+     (when (listener-startup listener)
+       (push listener *active-listeners*)
+       listener))

     (:stop
      (unless (member listener *active-listeners*)
     (:stop
      (unless (member listener *active-listeners*)

-       (warn "~&listener is not in active list")
+       (cmsg "~&listener ~A is not in active list" listener)

        (return-from init/listener listener))
        (return-from init/listener listener))

-     (dolist (worker (workers listener))
-       (when (and (typep worker 'worker)
-                 (connection worker))
-        (errorset (close-active-socket
-                   (connection worker)) nil)
-        (setf (connection worker) nil))
-       (when (process worker)
-        (errorset (destroy-process (process worker)) nil)
-        (setf (process worker) nil)))
-     (setf (workers listener) nil)
-     (with-slots (process socket) listener
-       (when socket
-        (errorset (close-passive-socket socket) nil)
-        (setf socket nil))
-       (when process
-        (errorset (destroy-process process) nil)
-        (setf process nil)))
+     (listener-shutdown listener)

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


@@ -114,6 +89,39 @@
     (ignore-errors
        (init/listener listener :stop))))
 
     (ignore-errors
        (init/listener listener :stop))))
 

+(defun listener-startup (listener)
+  (handler-case
+      (progn
+       (setf (name listener) (next-server-name (base-name listener)))
+       (make-socket-server listener))
+    (error (e)
+      (format t "~&Error while trying to start listener on port ~A~&  ~A" 
+             (port listener) e)
+      (decf *listener-count*)
+      nil)
+    (:no-error (res)
+      (declare (ignore res))
+      listener)))
+
+(defun listener-shutdown (listener)
+  (dolist (worker (workers listener))
+    (when (and (typep worker 'worker)
+              (connection worker))
+      (errorset (close-active-socket
+                (connection worker)) nil)
+      (setf (connection worker) nil))
+    (when (process worker)
+      (errorset (destroy-process (process worker)) nil)
+      (setf (process worker) nil)))
+  (setf (workers listener) nil)
+  (with-slots (process socket) listener
+    (when socket
+      (errorset (close-passive-socket socket) nil)
+      (setf socket nil))
+    (when process
+      (errorset (destroy-process process) nil)
+      (setf process nil))))
+

 ;; Low-level functions
 
 (defun next-server-name (base-name)
 ;; Low-level functions
 
 (defun next-server-name (base-name)

diff --git a/processes.lisp b/processes.lisp
index 547b862bafcf9b195c1916034af2a5a864ac49c4..1cc6a473ed6d3faed93a93d193cb58991af06abb 100644 (file)
--- a/processes.lisp
+++ b/processes.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  June 2003
 ;;;;
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  June 2003
 ;;;;

-;;;; $Id: processes.lisp,v 1.3 2003/07/11 02:37:33 kevin Exp $
+;;;; $Id: processes.lisp,v 1.4 2003/07/13 04:53:32 kevin Exp $

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


@@ -60,3 +60,7 @@
   `(progn ,@body)
   )
   
   `(progn ,@body)
   )
   

+(defun process-sleep (n)
+  #+allegro (mp:process-sleep n)
+  #-allegro (sleep n))
+