From 8bbcf109b6cbdfd4c92fe06cc181c56f408b8b82 Mon Sep 17 00:00:00 2001
From: "Kevin M. Rosenberg" <kevin@rosenberg.net>
Date: Sun, 13 Jul 2003 04:56:12 +0000
Subject: [PATCH] r5301: *** empty log message ***

---
 listener.lisp  | 74 ++++++++++++++++++++++++++++----------------------
 processes.lisp |  6 +++-
 2 files changed, 46 insertions(+), 34 deletions(-)

diff --git a/listener.lisp b/listener.lisp
index 19c7b0c..a757cc1 100644
--- a/listener.lisp
+++ b/listener.lisp
@@ -7,7 +7,7 @@
 ;;;; 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)
@@ -69,41 +69,16 @@
   (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*)
-       (warn "~&listener is not in active list")
+       (cmsg "~&listener ~A is not in active list" 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)
@@ -114,6 +89,39 @@
     (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)
diff --git a/processes.lisp b/processes.lisp
index 547b862..1cc6a47 100644
--- a/processes.lisp
+++ b/processes.lisp
@@ -7,7 +7,7 @@
 ;;;; 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)
@@ -60,3 +60,7 @@
   `(progn ,@body)
   )
   
+(defun process-sleep (n)
+  #+allegro (mp:process-sleep n)
+  #-allegro (sleep n))
+
-- 
2.34.1