[Sbcl-commits] CVS: sbcl/tests threads.impure.lisp,1.3,1.4

[Daniel B. <da...@us...>]

Update of /cvsroot/sbcl/sbcl/tests
In directory sc8-pr-cvs1:/tmp/cvs-serv2903/tests

Modified Files:
	threads.impure.lisp 
Log Message:
0.8.3.1

	Merge stop_the_world branch: a new scheme for stopping threads
	during GC, that avoids the use of ptrace and lets any of the
	threads stop any of the others.  This is a summary log entry:
	see branch commits for details

	New C functions maybe_defer_handler and run_deferred_handler,
	which encapsulate a lot of the "is it safe to run this handler
	now?  no, ok, copy its siginfo somewhere safe and do it later"
	cruft that's presently done ad hoc.

	Stack scavenging now looks for esp in the most recent
	interrupt context for each thread.  Requires that threads
	save said interrupt contexts in sig_stop_for_gc_handler

	Clean up some compiler warnings in gencgc.c

	Lisp-level changes: approximately a reversion to old-style (or
	single-threaded) GC.  Haven't actually added the gc hooks back
	in yet, but now there's at least a place for them to go.

	Lock around SUB-GC to remove window that may allow two threads 
	to attempt to collect at once.  

	WITHOUT-INTERRUPTS around SUB-GC to protect c-level spinlocks
	used in gc_{stop,start}_the_world

	(C-level spinlocks are just integers manipulated by get_spinlock(),
	release_spinlock().  There's no unwind-protect or anything 
	involved in their use, so a thread interrupted when it's 
	holding one of these will continue to hold it)

	Remove #if 0 from around the copying of sigmask in
        undo_fake_foreign_function_call.  Replace sizeof(sigmask_t)
        with an expression involving the value of NSIG and the rash
        assumption that sigset_t is a bitmask.

	Moved get_spinlock into foo-arch.h and made it static inline.
	Added release_spinlock for parity

	Delete irritating message from sigcont_handler

	New test cases



Index: threads.impure.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/threads.impure.lisp,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- threads.impure.lisp	21 Aug 2003 11:38:42 -0000	1.3
+++ threads.impure.lisp	25 Aug 2003 21:00:02 -0000	1.4
@@ -100,7 +100,8 @@
     child))
 
 ;;; separate tests for (a) interrupting Lisp code, (b) C code, (c) a syscall,
-;;; (d) waiting on a lock
+;;; (d) waiting on a lock, (e) some code which we hope is likely to be
+;;; in pseudo-atomic
 
 (let ((child (test-interrupt (lambda () (loop)))))  (terminate-thread child))
 
@@ -122,10 +123,33 @@
 		     (assert (eql (mutex-value lock) (current-thread-id))))
 		   (assert (not (eql (mutex-value lock) (current-thread-id)))))))
     ;;hold onto lock for long enough that child can't get it immediately
-    (sleep 5))
+    (sleep 20)
+    (interrupt-thread child (lambda () (format t "l ~A~%" (mutex-value lock))))
+    (format t "parent releasing lock~%"))
   (terminate-thread child))
 
-;; better would be "wait until all child threads have exited"
-(sleep 3)
+(defun alloc-stuff () (copy-list '(1 2 3 4 5)))
+(let ((c (test-interrupt (lambda () (loop (alloc-stuff))))))
+  ;; NB this only works on x86
+  (dotimes (i 70)
+    (sleep (random 1d0))
+    (interrupt-thread c
+		      (lambda ()
+			(princ ".") (force-output)
+			(assert (zerop SB-KERNEL:*PSEUDO-ATOMIC-ATOMIC*)))))
+  (terminate-thread c))
+
+;; I'm not sure that this one is always successful.  Note race potential:
+;; I haven't checked if decf is atomic here
+(let ((done 2))
+  (make-thread (lambda () (dotimes (i 100) (sb-ext:gc)) (decf done)))
+  (make-thread (lambda () (dotimes (i 25) (sb-ext:gc :full t)) (decf done)))
+  (loop
+   (when (zerop done) (return))
+   (sleep 1)))
+
+;; give the other thread time to die before we leave, otherwise the
+;; overall exit status is 0, not 104
+(sleep 2) 
 
 (sb-ext:quit :unix-status 104)