r5233: *** empty log message ***

[cl-modlisp.git] / impl-lispworks.lisp

diff --git a/impl-lispworks.lisp b/impl-lispworks.lisp
index 351b35f6904703d4f9f9b547f76203ec4a26c1a3..86dfc57d5337b54cc1ab1c9736f8e7592241fc3b 100644 (file)
--- 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*))))