[cl-prevalence-devel] Re: Kpax win32 patch

[Bruce Butterfield]

Sven Van Caekenberghe wrote:
> Marko,
> 
> Thx for reporting this problem.
> I 'fixed' it by no longer loading debug-prevalence by default.
> The s-xml::echo-xml function (used here for pretty printing xml) is  no 
> longer loaded by default.
> Compilation/loading using LispWorks and SBCL is now OK.
> 

FWIW, here are patches to CVS head for threaded SBCL and an update to 
#'totally-destroy so it includes a wildcard pathname (SBCL isn't happy 
with unnamed paths):


===================================================================
RCS file: /project/cl-prevalence/cvsroot/cl-prevalence/src/prevalence.lisp,v
retrieving revision 1.7
diff -u -r1.7 prevalence.lisp
--- src/prevalence.lisp 4 Oct 2004 14:25:13 -0000       1.7
+++ src/prevalence.lisp 5 Jan 2006 19:14:33 -0000
@@ -169,7 +169,7 @@
    "Totally destroy system from permanent storage by deleting any files 
used by the system, remove all root objects"
    (close-open-streams system :abort abort)
    (when (probe-file (get-directory system))
-    (dolist (pathname (directory (merge-pathnames (make-pathname :type 
(get-file-extension system))
+    (dolist (pathname (directory (merge-pathnames (make-pathname :name 
:wild :type (get-file-extension system))
                                                    (get-directory 
system))))
        (delete-file pathname)))
    (clrhash (get-root-objects system)))
Index: src/sysdeps.lisp
===================================================================
RCS file: /project/cl-prevalence/cvsroot/cl-prevalence/src/sysdeps.lisp,v
retrieving revision 1.1
diff -u -r1.1 sysdeps.lisp
--- src/sysdeps.lisp    28 Jun 2004 11:54:49 -0000      1.1
+++ src/sysdeps.lisp    5 Jan 2006 19:14:34 -0000
@@ -65,15 +65,16 @@
    #+lispworks (apply #'mp:process-run-function name '(:priority 3) 
function arguments)
    #+allegro (apply #'mp:process-run-function name function arguments)
    #+openmcl (apply #'ccl:process-run-function name function arguments)
-  #+sbcl (apply function arguments)
-  #-(or openmcl lispworks sbcl allegro) (error "not yet ported"))
+  #+sb-thread (apply #'sb-thread:make-thread function :name name arguments)
+  #-(or openmcl lispworks sb-thread allegro) (error "not yet ported"))

  (defun make-process-lock (name)
    "Create a named process lock object"
    #+lispworks (mp:make-lock :name name)
    #+openmcl (ccl:make-lock name)
    #+allegro (mp:make-process-lock :name name)
-  #-(or lispworks openmcl allegro) (error "not yet ported"))
+  #+sb-thread (sb-thread:make-mutex :name name)
+  #-(or lispworks openmcl allegro sb-thread) (error "not yet ported"))

  (defmacro with-process-lock ((lock) &body body)
    "Execute body wih the process lock grabbed, wait otherwise"
@@ -83,7 +84,8 @@
    #+lispworks `(mp:with-lock (,lock) , at body)
    #+openmcl `(ccl:with-lock-grabbed (,lock) , at body)
    #+allegro `(mp:with-process-lock (,lock) , at body)
-  #-(or lispworks openmcl allegro) (error "not yet ported"))
+  #+sb-thread `(sb-thread:with-recursive-lock (,lock) , at body)
+  #-(or lispworks openmcl allegro sb-thread) (error "not yet ported"))

  #+sbcl
  (defvar *server-processes* nil)