X-Git-Url: http://git.kpe.io/?p=cl-modlisp.git;a=blobdiff_plain;f=impl-lispworks.lisp;h=86dfc57d5337b54cc1ab1c9736f8e7592241fc3b;hp=351b35f6904703d4f9f9b547f76203ec4a26c1a3;hb=315ebc6354619483aa1be1124eb3736cee6f7ab7;hpb=1bb49e27c591c846849c80b6e543a8b207f9dad4

diff --git a/impl-lispworks.lisp b/impl-lispworks.lisp
index 351b35f..86dfc57 100644
--- a/impl-lispworks.lisp
+++ b/impl-lispworks.lisp
@@ -4,13 +4,22 @@
 
 (require "comm")
 
-(defun make-socket-server (name port function &key wait (format :text))
-  (comm:start-up-server
-   :function (lambda (handle)
-	       (let ((stream (make-instance 'comm:socket-stream :socket handle
-					    :direction :io
-					    :element-type 'base-char)))
-		 (mp:process-run-function
-		  (next-worker-name) '()
-		  'apache-command-issuer stream function)))
-   :service port :process-name name))
+(defvar *processor*)
+(let ((*processor* nil))
+  
+  (defun make-socket-server (name function port &key wait (format :text))
+    (setq *processor* function)
+    (values
+     (comm:start-up-server
+      :service port
+      :process-name name
+      :function 'socket-worker)
+     nil))
+
+  (defun socket-worker (socket)
+    (let ((stream (make-instance 'comm:socket-stream :socket socket
+				 :direction :io
+				 :element-type 'base-char)))
+      (mp:process-run-function
+     (next-worker-name) '()
+     'apache-command-issuer stream *processor*))))