--- with-timeout-orig.lisp	2008-09-11 01:46:15.000000000 +1200
+++ with-timeout.lisp	2008-09-12 15:49:25.140625000 +1200
@@ -21,22 +21,23 @@
 If `seconds` is nil, then the body will be run normally until it completes
 or is interrupted."
   (let ((gseconds (gensym "seconds-"))
+	(gdoit (gensym "doit-"))
 	#+(and sbcl (not sb-thread))
 	(glabel (gensym "label-"))
 	#+(and sbcl (not sb-thread))
 	(gused-timer? (gensym "used-timer-")))
     `(let ((,gseconds ,seconds))
-       (flet ((doit ()
-		(progn ,@body)))
-	 (cond (,gseconds
+       (flet ((,gdoit ()
+		,@body))
+	 (cond ((and (numberp ,gseconds) (> ,gseconds 0))
 		#+allegro
 		(mp:with-timeout (,gseconds (error 'timeout-error)) 
-		  (doit))
+		  (,gdoit))
 		#+cmu
-		(mp:with-timeout (,gseconds) (doit))
+		(mp:with-timeout (,gseconds) (,gdoit))
 		#+(and sbcl sb-thread)
 		(handler-case 
-		    (sb-ext:with-timeout ,gseconds (doit))
+		    (sb-ext:with-timeout ,gseconds (,gdoit))
 		  (sb-ext::timeout (c)
 		    (error 'timeout-error)))
 		#+(and sbcl (not sb-thread))
@@ -47,7 +48,7 @@
 					  (setf ,gused-timer? t)
 					  (throw ',glabel nil)))
 		     ,gseconds)
-		    (doit))
+		    (,gdoit))
 		  (when ,gused-timer?
 		    (error 'timeout-error)))
 		#+(or digitool openmcl ccl)
@@ -59,7 +60,7 @@
 			      (,process (ccl:process-run-function 
 					 ,checker-process
 					 (lambda ()
-					   (setf ,result (progn (doit))))))) 
+					   (setf ,result (,gdoit)))))) 
 			 (ccl:process-wait-with-timeout
 			  ,waiting-process
 			  (* ,gseconds #+(or openmcl ccl)
@@ -69,8 +70,23 @@
 			 (when (ccl::process-active-p ,process)
 			   (ccl:process-kill ,process)
 			   (cerror "Timeout" 'timeout-error))
-			 (values ,result)))
-		#-(or allegro cmu sbcl openmcl ccl mcl digitool)
-		(progn (doit)))
+			 ,result))
+		#+lispworks
+		,(let ((gresult (gensym "result-"))
+		       (gprocess (gensym "process-")))
+		      `(let* (,gresult
+			      (,gprocess (mp:process-run-function "WITH-TIMEOUT"
+								  '()
+								  (lambda ()
+								    (setq ,gresult (,gdoit))))))
+			 (unless (mp:process-wait-with-timeout "WITH-TIMEOUT"
+							       ,gseconds
+							       (lambda ()
+								 (not (mp:process-alive-p ,gprocess))))
+			   (mp:process-kill ,gprocess)
+			   (cerror "Timeout" 'timeout-error))
+			 ,gresult))
+		#-(or allegro cmu sbcl openmcl ccl mcl digitool lispworks)
+		(,gdoit))
 	       (t
-		(doit)))))))))
+		(,gdoit)))))))))
