From: Matthew D Swank
Subject: light (heh) weight threads redux
Date: Mon, 10 Oct 2005 10:39:28 +0000
Message-ID: <pan.2005.10.10.08.46.49.151625@c.net> Just as a comparison I implemented a pipeline version of the sieve of
Eratosthenes using both native threads in sbcl, and my pokey trampoline
monad. I realize the code isn't runnable as given, but I just wanted to
show the flavor of the difference. The thread monad (and associated
macrology) isn't what you would call optimized, but it is quite expressive.
;;;sieve of Eratosthenes
;;;native version: don't try an n larger than 2000 to 3000
;;;or thread exhaustion will result
(defun sieve (n)
(let ((rv-chan (channel))
(out-chan (channel)))
(labels ((processor (p in-chan out-chan)
(let ((n (recv in-chan)))
(cond ((eql -1 n)
(send out-chan -1))
(t (when (not (zerop (mod n p)))
(send out-chan n))
(processor p in-chan out-chan)))))
(pipeline (channel)
(let ((prime (recv channel))
(new-out (channel)))
(send rv-chan prime)
(when (not (eql -1 prime))
(fork (pipeline new-out)
(processor prime channel new-out)))))
(collect-rv (current)
(let ((n (recv rv-chan)))
(if (eql -1 n)
current
(collect-rv (cons n current))))))
(fork (collect-rv '())
(progn
(dotimes (x (- n 2))
(send out-chan (+ x 2)))
(send out-chan -1))
(pipeline out-chan)))))
;;;sieve of Eratosthenes
;;;monadic version-- sucks up the memory, but i can create an arbitrary
;;;number of threads for example n=10000 uses over 1200 threads
(defun sieve (n)
(monad-let* ((rv-chan (unit 'thread (channel)))
(o-chan (unit 'thread (channel))))
(labels ((processor (p in-chan out-chan)
(monad-let* ((n (recv-msg in-chan)))
(cond ((eql -1 n)
(send-msg out-chan (unit 'thread -1)))
(t (monad-progn
(if (not (zerop (mod n p)))
(send-msg out-chan (unit 'thread n))
(unit 'thread nil ))
(processor p in-chan out-chan))))))
(pipeline (channel)
(monad-let* ((prime (recv-msg channel))
(new-out (unit 'thread (channel))))
(send-msg rv-chan (unit 'thread prime))
(if (not (eql -1 prime))
(fork-proc (pipeline new-out)
(processor prime channel new-out))
(unit 'thread nil))))
(collect-rv (current)
(monad-let* ((n (recv-msg rv-chan)))
(if (eql -1 n)
(unit 'thread current)
(collect-rv (cons n current)))))
(generator (n max)
(if (> n max)
;;bail out value, used to shut down all the listening
;;threads
(send-msg o-chan (unit 'thread -1))
(monad-progn
(send-msg o-chan (unit 'thread n))
(generator (+ n 1) max)))))
(monad-progn
(fork-proc (collect-rv '())
(fork-proc
(pipeline o-chan)
(generator 2 n)))))))
;;;;;;;;;;;;;
(time (run (monad-threads::sieve 3000)))
Evaluation took:
11.816 seconds of real time
11.064318 seconds of user run time
0.706893 seconds of system run time
0 page faults and
331,996,872 bytes consed.
(2999 2971 2969 2963 2957 2953 2939 2927 2917 2909 2903 2897 2887 2879 2861
2857 2851 2843 2837 2833 2819 2803 2801 2797 2791 2789 2777 2767 2753 2749
2741 2731 2729 2719 2713 2711 2707 2699 2693 2689 2687 2683 2677 2671 2663
2659 2657 2647 2633 2621 2617 2609 2593 2591 2579 2557 2551 2549 2543 2539
2531 2521 2503 2477 2473 2467 2459 2447 2441 2437 2423 2417 2411 2399 2393
2389 2383 2381 2377 2371 2357 2351 2347 2341 2339 2333 2311 2309 2297 2293
2287 2281 2273 2269 2267 2251 2243 2239 2237 2221 2213 2207 2203 2179 2161
2153 2143 2141 2137 2131 2129 2113 2111 2099 2089 2087 2083 2081 2069 2063
2053 2039 2029 2027 2017 2011 2003 1999 1997 1993 1987 1979 1973 1951 1949
1933 1931 1913 1907 1901 1889 1879 1877 1873 1871 1867 1861 1847 1831 1823
1811 1801 1789 1787 1783 1777 1759 1753 1747 1741 1733 1723 1721 1709 1699
1697 1693 1669 1667 1663 1657 1637 1627 1621 1619 1613 1609 1607 1601 1597
1583 1579 1571 1567 1559 1553 1549 1543 1531 1523 1511 1499 1493 1489 1487
1483 1481 1471 1459 1453 1451 1447 1439 1433 1429 1427 1423 1409 1399 1381
1373 1367 1361 1327 1321 1319 1307 1303 1301 1297 1291 1289 1283 1279 1277
1259 1249 1237 1231 1229 1223 1217 1213 1201 1193 1187 1181 1171 1163 1153
1151 1129 1123 1117 1109 1103 1097 1093 1091 1087 1069 1063 1061 1051 1049
1039 1033 1031 1021 1019 1013 1009 997 991 983 977 971 967 953 947 941 937 929
919 911 907 887 883 881 877 863 859 857 853 839 829 827 823 821 811 809 797
787 773 769 761 757 751 743 739 733 727 719 709 701 691 683 677 673 661 659
653 647 643 641 631 619 617 613 607 601 599 593 587 577 571 569 563 557 547
541 523 521 509 503 499 491 487 479 467 463 461 457 449 443 439 433 431 421
419 409 401 397 389 383 379 373 367 359 353 349 347 337 331 317 313 311 307
293 283 281 277 271 269 263 257 251 241 239 233 229 227 223 211 199 197 193
191 181 179 173 167 163 157 151 149 139 137 131 127 113 109 107 103 101 97 89
83 79 73 71 67 61 59 53 47 43 41 37 31 29 23 19 17 13 11 7 5 3 2)
(time (native-threads::sieve 3000))
Evaluation took:
3.927 seconds of real time
3.319495 seconds of user run time
0.587911 seconds of system run time
0 page faults and
6,431,424 bytes consed.
(2999 2971 2969 2963 2957 2953 2939 2927 2917 2909 2903 2897 2887 2879 2861
2857 2851 2843 2837 2833 2819 2803 2801 2797 2791 2789 2777 2767 2753 2749
2741 2731 2729 2719 2713 2711 2707 2699 2693 2689 2687 2683 2677 2671 2663
2659 2657 2647 2633 2621 2617 2609 2593 2591 2579 2557 2551 2549 2543 2539
2531 2521 2503 2477 2473 2467 2459 2447 2441 2437 2423 2417 2411 2399 2393
2389 2383 2381 2377 2371 2357 2351 2347 2341 2339 2333 2311 2309 2297 2293
2287 2281 2273 2269 2267 2251 2243 2239 2237 2221 2213 2207 2203 2179 2161
2153 2143 2141 2137 2131 2129 2113 2111 2099 2089 2087 2083 2081 2069 2063
2053 2039 2029 2027 2017 2011 2003 1999 1997 1993 1987 1979 1973 1951 1949
1933 1931 1913 1907 1901 1889 1879 1877 1873 1871 1867 1861 1847 1831 1823
1811 1801 1789 1787 1783 1777 1759 1753 1747 1741 1733 1723 1721 1709 1699
1697 1693 1669 1667 1663 1657 1637 1627 1621 1619 1613 1609 1607 1601 1597
1583 1579 1571 1567 1559 1553 1549 1543 1531 1523 1511 1499 1493 1489 1487
1483 1481 1471 1459 1453 1451 1447 1439 1433 1429 1427 1423 1409 1399 1381
1373 1367 1361 1327 1321 1319 1307 1303 1301 1297 1291 1289 1283 1279 1277
1259 1249 1237 1231 1229 1223 1217 1213 1201 1193 1187 1181 1171 1163 1153
1151 1129 1123 1117 1109 1103 1097 1093 1091 1087 1069 1063 1061 1051 1049
1039 1033 1031 1021 1019 1013 1009 997 991 983 977 971 967 953 947 941 937 929
919 911 907 887 883 881 877 863 859 857 853 839 829 827 823 821 811 809 797
787 773 769 761 757 751 743 739 733 727 719 709 701 691 683 677 673 661 659
653 647 643 641 631 619 617 613 607 601 599 593 587 577 571 569 563 557 547
541 523 521 509 503 499 491 487 479 467 463 461 457 449 443 439 433 431 421
419 409 401 397 389 383 379 373 367 359 353 349 347 337 331 317 313 311 307
293 283 281 277 271 269 263 257 251 241 239 233 229 227 223 211 199 197 193
191 181 179 173 167 163 157 151 149 139 137 131 127 113 109 107 103 101 97 89
83 79 73 71 67 61 59 53 47 43 41 37 31 29 23 19 17 13 11 7 5 3 2)
--
"You do not really understand something unless you can
explain it to your grandmother." — Albert Einstein. From: Matthew D Swank
Subject: Re: light (heh) weight threads redux
Date: Wed, 12 Oct 2005 06:24:18 +0000
Message-ID: <pan.2005.10.12.06.24.18.207080@c.net> On Mon, 10 Oct 2005 05:39:28 -0500, Matthew D Swank wrote:
This is a little better:
CONCUR> (let ((*schedule-quantum* 20))
(time (run (sieve 3000))))
Evaluation took:
2.407 seconds of real time
2.196666 seconds of user run time
0.205968 seconds of system run time
0 page faults and
71,324,712 bytes consed.
.....
Evaluation took:
2.863 seconds of real time
2.260656 seconds of user run time
0.59291 seconds of system run time
0 page faults and
6,454,152 bytes consed.
My threads still cons a lot though.
Of course the overhead for either of the threaded versions is elephantine
compared to a simple sequential version:
(defun sieve-seq (n)
(labels ((filter-divisor (lst)
(let* ((p (car lst))
(filtered (delete-if
#'(lambda (num)
(zerop (mod num p)))
(cdr lst))))
(if filtered
(cons p (filter-divisor filtered))
(list p))))
(range (min max &optional lst)
(if (> min max)
lst
(range min (1- max) (cons max lst)))))
(filter-divisor (range 2 n))))
CONCUR>(time (sieve-seq 3000))
Evaluation took:
0.011 seconds of real time
0.010998 seconds of user run time
0.0 seconds of system run time
0 page faults and
40,960 bytes consed.
Matt (talking to himself :)
--
"You do not really understand something unless you can
explain it to your grandmother." — Albert Einstein.