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

[Sven Van Caekenberghe]

Thanks Bruce, I applied your patched (to S-SYSDEPS).

Sven

On 05 Jan 2006, at 20:18, Bruce Butterfield wrote:

> 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)