From 075a9be5fcf2fe4bc3a2d01a33e26a0425d7fb6b Mon Sep 17 00:00:00 2001 From: Stefan Kamphausen Date: Thu, 23 Feb 2012 21:17:47 +0100 Subject: [PATCH] Added STM performance regression tests. A dedicated namespace stm was added. This contains various stress tests for Clojures STM implementation (in core.clj) plus some more function which are probably not be suitable for testing the speed, since they seemed to be dominated by GC in experiments (other.clj). Wrapper files are provided to run the tests via script/run. --- src/main/clojure/stm/core.clj | 235 +++++++++++++++++++++ src/main/clojure/stm/others.clj | 86 ++++++++ src/main/clojure/stm/rapid_fire.clj | 20 ++ src/main/clojure/stm/reader_vs_writer.clj | 20 ++ src/main/clojure/stm/settings.clj | 23 ++ src/main/clojure/stm/shared_int.clj | 20 ++ src/main/clojure/stm/stm_example_from_website.clj | 20 ++ src/main/clojure/stm/stock_exchange.clj | 20 ++ src/main/clojure/stm/util.clj | 38 ++++ 9 files changed, 482 insertions(+), 0 deletions(-) create mode 100644 src/main/clojure/stm/core.clj create mode 100644 src/main/clojure/stm/others.clj create mode 100644 src/main/clojure/stm/rapid_fire.clj create mode 100644 src/main/clojure/stm/reader_vs_writer.clj create mode 100644 src/main/clojure/stm/settings.clj create mode 100644 src/main/clojure/stm/shared_int.clj create mode 100644 src/main/clojure/stm/stm_example_from_website.clj create mode 100644 src/main/clojure/stm/stock_exchange.clj create mode 100644 src/main/clojure/stm/util.clj diff --git a/src/main/clojure/stm/core.clj b/src/main/clojure/stm/core.clj new file mode 100644 index 0000000..2d5cf3c --- /dev/null +++ b/src/main/clojure/stm/core.clj @@ -0,0 +1,235 @@ +;; Copyright (c) Rich Hickey and contributors. +;; All rights reserved. +;; The use and distribution terms for this software are covered by the +;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +;; which can be found in the file epl-v10.html at the root of this distribution. +;; By using this software in any fashion, you are agreeing to be bound by +;; the terms of this license. +;; You must not remove this notice, or any other, from this software. +;; +;; A collection of functions to test the speed of the STM implementation in +;; Clojure + +(ns + #^{:author "Stefan Kamphausen" + :doc + "A collection of functions to test the speed of the STM implementation."} + stm.core + (:use [stm.util])) + + +(defn stm-example-from-website + "Run the example from http://clojure.org/refs without any validation. + +FIXME: Could probably improve concurrency by using a random generator +per thread." + [iterations] + (letfn [(run + [nvecs nitems nthreads niters] + (let [vec-refs (vec (map (comp ref vec) + (partition nitems (range (* nvecs nitems))))) + swap #(let [v1 (rand-int nvecs) + v2 (rand-int nvecs) + i1 (rand-int nitems) + i2 (rand-int nitems)] + (dosync + (let [temp (nth @(vec-refs v1) i1)] + (alter (vec-refs v1) assoc i1 (nth @(vec-refs v2) i2)) + (alter (vec-refs v2) assoc i2 temp)))) + ] + (dorun (apply pcalls (repeat nthreads #(dotimes [_ niters] (swap))))) + (count (distinct (apply concat (map deref vec-refs))))))] + (average-time iterations #(run 100 10 10 10000)))) + +(defn rapid-fire + "Use the same function on 4 Refs which swaps the values of two Refs (reading +them first) and increments and decrements the other two. Processing is done on +some agents. Validation occurs after all agents have finished." + [iterations] + (letfn [(impl + [] + (let [size 50000 + r1 (ref 0) + r2 (ref size) + r3 (ref []) + r4 (ref [:coin]) + agts (take 10 (repeatedly #(agent 0))) + af (fn [a] + (dosync + (let [v3 (deref r3) + v4 (deref r4)] + (alter r1 inc) + (alter r2 dec) + (ref-set r3 v4) + (ref-set r4 v3))))] + (dorun + (map #(send % af) + (take size (cycle agts)))) + (apply await agts) + [@r1 @r2 @r3 @r4 size])) + (rapid + [] + (let [[v1 v2 v3 v4 sz] (impl)] + (if (or + (not= v1 sz) + (not= v2 0) + (not= v3 + (if (= 1 (mod sz 2)) [:coin] [])) + (not= v4 + (if (= 0 (mod sz 2)) [:coin] []))) + (throw (RuntimeException. + (str "Assertion failed " + [v1 v2 v3 v4 sz]))))))] + (average-time iterations rapid))) + +(defn reader-vs-writer + "Create writers and readers for 3 refs with a ratio of 2:1 and process them on +some agents. Readers validate current state of the refs. Writers just ref-set +new integers. + +Could probably improve concurrency by using a random generator per thread." + [iterations] + (letfn [(rvsw + [] + (let [n 50000 + r1 (ref 100) + r2 (ref 200) + r3 (ref 300) + readr (fn [agt] + (dosync + (let [v1 @r1 v2 @r2 v3 @r3] + (if (not= 600 + (+ v1 v2 v3)) + (throw + (RuntimeException. "Reader error")))))) + + writr (fn [agt] + (let [x1 (rand-int 300) + x2 (- x1 (rand-int (int (/ x1 2)))) + x3 (- 600 (+ x1 x2))] + (dosync + (ref-set r1 x1) + (ref-set r2 x2) + (ref-set r3 x3)))) + agts (take 5 (repeatedly #(agent 0))) + ] + (dorun + (map #(send %2 (if (= 0 (mod %1 3)) readr writr)) + (take n (range)) + (take n (cycle agts)))) + (apply await agts) + [@r1 @r2 @r3]))] + (average-time iterations rvsw))) + +(defn shared-int + "This was inspired by the example in the Master's Thesis +by Peder R. L. Nielsen and Patrick T. Kristiansen: +http://vbn.aau.dk/files/32587755/report.pdf + +Validates result after agents finished." + [iterations] + (letfn [(shared-int + [] + (let [r (ref 0) + maxv 100000 ; must be divisible by n-agts for validation + agt-fn (fn [incs] + (dotimes [_ incs] + (dosync (alter r inc)))) + n-agts 4 + agts (for [_ (range n-agts)] + (agent (int (/ maxv n-agts))))] + (doseq [a agts] + (send a agt-fn)) + (apply await agts) + (if-not (= maxv (deref r)) + (throw (RuntimeException. "Shared int failed")))))] + (average-time iterations shared-int))) + + +;; Yes, one would usually break this down into several functions. +;; It's just to have all these function contain everything so they can +;; easily be pasted at the REPL. +(defn stock-exchange + "Stupid stock trade simulation with a market of symbols with a random number +of shares each. Persons will be simulated by agents, each of which performs a +given number of trading transactions, buying a share from the market or giving +it back. The coolest thing of this stock exchange is, that the people need no +money to trade. + +Could probably improve concurrency by using a random generator per thread." + [iterations] + (letfn + [(stock-exchange-impl + [n-pers n-trades] + (let [n-shares 100 ; maximum number of shares per symbol + n-syms 9 ; number of symbols in the market + syms (vec (map #(format "%04d" %) (range n-syms))) + ;; the market is just a ref on a map with symbols as keys and the + ;; number of available shares as values + market (ref + (into {} (map + (fn [sym] {sym (rand-int n-shares)}) + syms))) + ;; for validation: sum has to be constant + mark-sum (reduce + (vals (deref market))) + ;; these are the trading people, each with an unused :id and a + ;; :portfolio of shares + persons (ref (vec (map + (fn [i] {:portfolio {} :id i}) + (range n-pers)))) + ;; agents to act as persons + agts (vec (map #(agent %) (range n-pers))) + + ;; pick a symbol from the market, plus num available + select-from-market #(let [sym (rand-nth syms) + in-market (get @market sym)] + [sym in-market]) + + ;; pick a symbol from a person's :portfolio and the number of + ;; those shares in the :portfolio + select-from-person #(let [portfolio (:portfolio %) + sym (rand-nth (keys portfolio)) + in-portfolio (get portfolio sym)] + [sym in-portfolio]) + + ;; buy from market to person + buy (fn [pers-id] + (dosync + (let [pers (nth @persons pers-id) + [sym in-market] (select-from-market)] + ;;(println "Buy: " pers sym in-market) + (when (< 0 in-market) + (alter market #(update-in % [sym] dec)) + (alter + persons + (fn [ps] + (if-not (get-in ps [pers-id :portfolio sym]) + (assoc-in ps + [pers-id :portfolio sym] + 1) + (update-in ps + [pers-id :portfolio sym] + inc))))))) + pers-id) + ;; sell from person to market + sell (fn [pers-id] + (dosync + (let [pers (nth @persons pers-id) + [sym in-portf] (select-from-person pers)] + ;;(println "Sell: " pers sym in-portf) + (when (and (not (nil? sym)) + (not (nil? in-portf)) + (< 0 in-portf)) + (alter market #(update-in % [sym] inc)) + (alter persons + #(update-in % + [pers-id :portfolio sym] + dec))))) + pers-id)] ; end huge let + (doseq [a agts] + (dotimes [i n-trades] + (send a (if (= 2 (mod i 3)) sell buy)))) + (apply await agts) + ))] ; end letfn + (average-time iterations #(stock-exchange-impl 100 1000)))) + diff --git a/src/main/clojure/stm/others.clj b/src/main/clojure/stm/others.clj new file mode 100644 index 0000000..8f8f08d --- /dev/null +++ b/src/main/clojure/stm/others.clj @@ -0,0 +1,86 @@ +;; Copyright (c) Rich Hickey and contributors. +;; All rights reserved. +;; The use and distribution terms for this software are covered by the +;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +;; which can be found in the file epl-v10.html at the root of this distribution. +;; By using this software in any fashion, you are agreeing to be bound by +;; the terms of this license. +;; You must not remove this notice, or any other, from this software. +;; +;; Other STM performance functions, whose applicability to regression +;; testing seems questionable. + +(ns stm.others + (:use [stm.util])) + +(defn run-logist-outer + "Run a parallel computation of the logistic map with calculation of values +*outside* of the transaction. + +Average runtime of this seems to be dominated by GC. Not sure whether +this fn is suitable for regression testing. + +Example adapted from http://www.clojure.buch.de" + [iterations] + (let [main-data (ref []) + + logist-iter + (fn [mu nskip ntake] + (let [logist #(* mu % (- 1.0 %))] + (loop [x 0.5 + step 0 + acc []] + (if (> step (+ nskip ntake)) + acc + (if (< step nskip) + (recur (logist x) (inc step) acc) + (recur (logist x) (inc step) + (conj acc x))))))) + + calc + (fn [] + (dorun + (pmap + (fn [mu] + (let [xs (logist-iter mu 5000 100) + points (vec (map (fn [x] [mu x]) xs))] + (dosync + (alter main-data into points)))) + (range 2.90 4 0.001))))] + (average-time iterations calc))) + +(defn run-logist-inner + "Run a parallel computation of the logistic map with calculation of values +*inside* of the transaction. + +Average runtime of this seems to be dominated by GC. Not sure whether +this fn is suitable for regression testing. + +Example adapted from http://www.clojure.buch.de" + [iterations] + (let [main-data (ref []) + + logist-iter + (fn [mu nskip ntake] + (let [logist #(* mu % (- 1.0 %))] + (loop [x 0.5 + step 0 + acc []] + (if (> step (+ nskip ntake)) + acc + (if (< step nskip) + (recur (logist x) (inc step) acc) + (recur (logist x) (inc step) + (conj acc x))))))) + + calc + (fn [] + (dorun + (pmap + (fn [mu] + (dosync + (let [xs (logist-iter mu 5000 100) + points (vec (map (fn [x] [mu x]) xs))] + (alter main-data into points)))) + (range 2.90 4 0.001))))] + (average-time iterations calc))) diff --git a/src/main/clojure/stm/rapid_fire.clj b/src/main/clojure/stm/rapid_fire.clj new file mode 100644 index 0000000..b49d883 --- /dev/null +++ b/src/main/clojure/stm/rapid_fire.clj @@ -0,0 +1,20 @@ +;; Copyright (c) Rich Hickey and contributors. +;; All rights reserved. +;; The use and distribution terms for this software are covered by the +;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +;; which can be found in the file epl-v10.html at the root of this distribution. +;; By using this software in any fashion, you are agreeing to be bound by +;; the terms of this license. +;; You must not remove this notice, or any other, from this software. +;; + +(ns + stm.rapid-fire + (:require [stm.core :as sc] + [stm.settings :as st] + [stm.util :as su]) + (:gen-class)) + +(defn -main [& args] + (su/main-function sc/rapid-fire st/global-settings)) + diff --git a/src/main/clojure/stm/reader_vs_writer.clj b/src/main/clojure/stm/reader_vs_writer.clj new file mode 100644 index 0000000..40d1253 --- /dev/null +++ b/src/main/clojure/stm/reader_vs_writer.clj @@ -0,0 +1,20 @@ +;; Copyright (c) Rich Hickey and contributors. +;; All rights reserved. +;; The use and distribution terms for this software are covered by the +;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +;; which can be found in the file epl-v10.html at the root of this distribution. +;; By using this software in any fashion, you are agreeing to be bound by +;; the terms of this license. +;; You must not remove this notice, or any other, from this software. +;; + +(ns + stm.reader-vs-writer + (:require [stm.core :as sc] + [stm.settings :as st] + [stm.util :as su]) + (:gen-class)) + +(defn -main [& args] + (su/main-function sc/reader-vs-writer st/global-settings)) + diff --git a/src/main/clojure/stm/settings.clj b/src/main/clojure/stm/settings.clj new file mode 100644 index 0000000..43f647b --- /dev/null +++ b/src/main/clojure/stm/settings.clj @@ -0,0 +1,23 @@ +;; Copyright (c) Rich Hickey and contributors. +;; All rights reserved. +;; The use and distribution terms for this software are covered by the +;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +;; which can be found in the file epl-v10.html at the root of this distribution. +;; By using this software in any fashion, you are agreeing to be bound by +;; the terms of this license. +;; You must not remove this notice, or any other, from this software. +;; +;; Settings for the performance testing functions. Currently it's +;; just the number of iterations per function + +(ns stm.settings) + +(def global-settings + {:iterations + {:stm-example-from-website 20 + :rapid-fire 20 + :reader-vs-writer 20 + :shared-int 20 + :stock-exchange 20}}) + + \ No newline at end of file diff --git a/src/main/clojure/stm/shared_int.clj b/src/main/clojure/stm/shared_int.clj new file mode 100644 index 0000000..0582971 --- /dev/null +++ b/src/main/clojure/stm/shared_int.clj @@ -0,0 +1,20 @@ +;; Copyright (c) Rich Hickey and contributors. +;; All rights reserved. +;; The use and distribution terms for this software are covered by the +;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +;; which can be found in the file epl-v10.html at the root of this distribution. +;; By using this software in any fashion, you are agreeing to be bound by +;; the terms of this license. +;; You must not remove this notice, or any other, from this software. +;; + +(ns + stm.shared-int + (:require [stm.core :as sc] + [stm.settings :as st] + [stm.util :as su]) + (:gen-class)) + +(defn -main [& args] + (su/main-function sc/shared-int st/global-settings)) + diff --git a/src/main/clojure/stm/stm_example_from_website.clj b/src/main/clojure/stm/stm_example_from_website.clj new file mode 100644 index 0000000..cb3642b --- /dev/null +++ b/src/main/clojure/stm/stm_example_from_website.clj @@ -0,0 +1,20 @@ +;; Copyright (c) Rich Hickey and contributors. +;; All rights reserved. +;; The use and distribution terms for this software are covered by the +;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +;; which can be found in the file epl-v10.html at the root of this distribution. +;; By using this software in any fashion, you are agreeing to be bound by +;; the terms of this license. +;; You must not remove this notice, or any other, from this software. +;; + +(ns + stm.stm-example-from-website + (:require [stm.core :as sc] + [stm.settings :as st] + [stm.util :as su]) + (:gen-class)) + +(defn -main [& args] + (su/main-function sc/stm-example-from-website st/global-settings)) + diff --git a/src/main/clojure/stm/stock_exchange.clj b/src/main/clojure/stm/stock_exchange.clj new file mode 100644 index 0000000..745be1e --- /dev/null +++ b/src/main/clojure/stm/stock_exchange.clj @@ -0,0 +1,20 @@ +;; Copyright (c) Rich Hickey and contributors. +;; All rights reserved. +;; The use and distribution terms for this software are covered by the +;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +;; which can be found in the file epl-v10.html at the root of this distribution. +;; By using this software in any fashion, you are agreeing to be bound by +;; the terms of this license. +;; You must not remove this notice, or any other, from this software. +;; + +(ns + stm.stock-exchange + (:require [stm.core :as sc] + [stm.settings :as st] + [stm.util :as su]) + (:gen-class)) + +(defn -main [& args] + (su/main-function sc/stock-exchange st/global-settings)) + diff --git a/src/main/clojure/stm/util.clj b/src/main/clojure/stm/util.clj new file mode 100644 index 0000000..232ee52 --- /dev/null +++ b/src/main/clojure/stm/util.clj @@ -0,0 +1,38 @@ +;; Copyright (c) Rich Hickey and contributors. +;; All rights reserved. +;; The use and distribution terms for this software are covered by the +;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +;; which can be found in the file epl-v10.html at the root of this distribution. +;; By using this software in any fashion, you are agreeing to be bound by +;; the terms of this license. +;; You must not remove this notice, or any other, from this software. +;; + +(ns stm.util) + +(defn average-time [n f] + (println "Average time after " n "repetitions:" + (double + (/ + (reduce + + + (map + (fn [x] + (let [start (System/nanoTime)] + (time (f)) + (- (System/nanoTime) start))) + (range n))) + (* n 1000000))))) + +(defmacro main-function [backend-fn settings] + (let [nm (name backend-fn) + tx (str (.replace nm "-" " ") "(%d)\n") + kw (keyword nm)] + `(let [start# (System/nanoTime) + iters# (-> ~settings :iterations ~kw)] + (printf ~tx iters#) + (~backend-fn iters#) + (println + "This run took" (/ (- (System/nanoTime) start#) 1000000.0) + "msecs") + (shutdown-agents)))) \ No newline at end of file -- 1.7.7