From: Christophe Rhodes <csr21@cam.ac.uk>
Date: Mon, 19 Jul 2004 12:44:27 +0000 (+0000)
Subject: 0.8.12.37:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=6ab9c60f1c53cc7cc912d644658bc23453a82ac4;p=sbcl.git

0.8.12.37:
	Fix for Fedora Core 2 from Juho Snellman
	... <linux/unistd.h>, not <asm/unistd.h>
	... also include test for bad scaling in threads/GC
---

diff --git a/src/runtime/linux-os.c b/src/runtime/linux-os.c
index 7dcad35..eb1a5a0 100644
--- a/src/runtime/linux-os.c
+++ b/src/runtime/linux-os.c
@@ -48,7 +48,7 @@
 size_t os_vm_page_size;
 
 #ifdef LISP_FEATURE_SB_FUTEX
-#include <asm/unistd.h>
+#include <linux/unistd.h>
 #include <errno.h>
 
 /* values taken from the kernel's linux/futex.h.  This header file
diff --git a/tests/threads.impure.lisp b/tests/threads.impure.lisp
index c0feefe..4881bc4 100644
--- a/tests/threads.impure.lisp
+++ b/tests/threads.impure.lisp
@@ -15,6 +15,30 @@
 
 (in-package "SB-THREAD") ; this is white-box testing, really
 
+;;; We had appalling scaling properties for a while.  Make sure they
+;;; don't reappear.
+(defun scaling-test (function &optional (nthreads 5))
+  "Execute FUNCTION with NTHREADS lurking to slow it down."
+  (let ((queue (sb-thread:make-waitqueue))
+        (mutex (sb-thread:make-mutex)))
+    ;; Start NTHREADS idle threads.
+    (dotimes (i nthreads)
+      (sb-thread:make-thread (lambda ()
+                               (sb-thread:condition-wait queue mutex)
+			       (sb-ext:quit))))
+    (let ((start-time (get-internal-run-time)))
+      (funcall function)
+      (prog1 (- (get-internal-run-time) start-time)
+	(sb-thread:condition-broadcast queue)))))
+(defun fact (n)
+  "A function that does work with the CPU."
+  (if (zerop n) 1 (* n (fact (1- n)))))
+(let ((work (lambda () (fact 15000))))
+  (let ((zero (scaling-test work 0))
+	(four (scaling-test work 4)))
+    ;; a slightly weak assertion, but good enough for starters.
+    (assert (< four (* 1.5 zero)))))
+
 ;;; For one of the interupt-thread tests, we want a foreign function
 ;;; that does not make syscalls
 
diff --git a/version.lisp-expr b/version.lisp-expr
index b43de9a..8ffa9ec 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.12.36"
+"0.8.12.37"