Added benchmark runner.
authorJan Vrany <jan.vrany@fit.cvut.cz>
Tue, 28 May 2013 20:24:18 +0100
changeset 2 e48eb0a3f5a3
parent 1 1ab204c5442a
child 3 61839e9951bc
Added benchmark runner.
s/BenchmarkReportText.st
s/BenchmarkSuite.st
s/benchmarks/BenchmarkGame.st
s/benchmarks/BenchmarkGameStrcat.st
s/benchmarks/Make.proto
s/benchmarks/Make.spec
s/benchmarks/abbrev.stc
s/benchmarks/bc.mak
s/benchmarks/benchmarks.rc
s/benchmarks/jv_calipel_s_benchmarks.st
s/benchmarks/libInit.cc
s/s.rc
s/stx/BenchmarkRunner.st
s/stx/abbrev.stc
s/stx/stx.rc
s/tests/tests.rc
--- a/s/BenchmarkReportText.st	Tue May 28 11:17:46 2013 +0100
+++ b/s/BenchmarkReportText.st	Tue May 28 20:24:18 2013 +0100
@@ -26,12 +26,12 @@
     classes do:[:class|
         stream nextPutAll: '== '; nextPutAll:  class name; nextPutAll: ' =='; cr.
         (outcomes at: class) do:[:outcome|
-            PrintfScanf printf: '%-20s : %5d [ms]' on: stream arguments: { outcome instance benchmark . outcome time }.
+            PrintfScanf printf: '%20s : %5d [ms]' on: stream arguments: { outcome instance benchmark . outcome time }.
             stream cr.
         ]
     ]
 
-    "Modified: / 28-05-2013 / 11:05:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 28-05-2013 / 20:12:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
 !BenchmarkReportText class methodsFor:'documentation'!
--- a/s/BenchmarkSuite.st	Tue May 28 11:17:46 2013 +0100
+++ b/s/BenchmarkSuite.st	Tue May 28 20:24:18 2013 +0100
@@ -10,12 +10,44 @@
 
 !BenchmarkSuite class methodsFor:'instance creation'!
 
+class: class 
+    | suite current |
+
+    suite := self new.
+    current := class.
+    [ current notNil ] whileTrue:[
+        current selectorsAndMethodsDo:[:selector :method|
+            (method pragmaAt:#benchmark) notNil ifTrue:[
+                suite addBenchmark: (BenchmarkInstance class: class benchmark: selector)
+            ].
+        ].
+        current := current superclass.
+    ].
+    ^suite
+
+    "Created: / 28-05-2013 / 19:49:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+class: class benchmark: benchmark
+    ^BenchmarkInstance class: class benchmark: benchmark
+
+    "Created: / 28-05-2013 / 19:46:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
 new
     "return an initialized instance"
 
     ^ self basicNew initialize.
 ! !
 
+!BenchmarkSuite methodsFor:'adding & removing'!
+
+addBenchmark: aBenchmarkInstanceOrBenchmarkSuite
+    benchmarks add: aBenchmarkInstanceOrBenchmarkSuite
+
+    "Created: / 28-05-2013 / 19:48:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
 !BenchmarkSuite methodsFor:'initialization'!
 
 initialize
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/s/benchmarks/BenchmarkGame.st	Tue May 28 20:24:18 2013 +0100
@@ -0,0 +1,41 @@
+"{ Package: 'jv:calipel/s/benchmarks' }"
+
+Object subclass:#BenchmarkGame
+	instanceVariableNames:'iterations stream hello'
+	classVariableNames:''
+	poolDictionaries:''
+	category:'CalipeL/S-Benchmarks'
+!
+
+
+!BenchmarkGame methodsFor:'benchmarks'!
+
+strcat
+    <benchmark>
+
+    1 to: iterations do: [:idx|
+        stream nextPutAll:hello
+    ].
+
+    "Created: / 28-05-2013 / 00:49:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!BenchmarkGame methodsFor:'running'!
+
+setUp
+    <setup>
+
+    stream := WriteStream on:String new.
+    hello := 'hello' , Character cr asString.
+    iterations := 100000
+
+    "Created: / 28-05-2013 / 00:50:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!BenchmarkGame class methodsFor:'documentation'!
+
+version_HG
+
+    ^ '$Changeset: <not expanded> $'
+! !
+
--- a/s/benchmarks/BenchmarkGameStrcat.st	Tue May 28 11:17:46 2013 +0100
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,41 +0,0 @@
-"{ Package: 'jv:calipel/s/benchmarks' }"
-
-Object subclass:#BenchmarkGameStrcat
-	instanceVariableNames:'iterations stream hello'
-	classVariableNames:''
-	poolDictionaries:''
-	category:'CalipeL/S-Benchmarks'
-!
-
-
-!BenchmarkGameStrcat methodsFor:'benchmarks'!
-
-strcat
-    <benchmark>
-
-    1 to: iterations do: [:idx|
-        stream nextPutAll:hello
-    ].
-
-    "Created: / 28-05-2013 / 00:49:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-! !
-
-!BenchmarkGameStrcat methodsFor:'running'!
-
-setUp
-    <setup>
-
-    stream := WriteStream on:String new.
-    hello := 'hello' , Character cr asString.
-    iterations := 100000
-
-    "Created: / 28-05-2013 / 00:50:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-! !
-
-!BenchmarkGameStrcat class methodsFor:'documentation'!
-
-version_HG
-
-    ^ '$Changeset: <not expanded> $'
-! !
-
--- a/s/benchmarks/Make.proto	Tue May 28 11:17:46 2013 +0100
+++ b/s/benchmarks/Make.proto	Tue May 28 20:24:18 2013 +0100
@@ -121,7 +121,7 @@
 
 
 # BEGINMAKEDEPEND --- do not remove this line; make depend needs it
-$(OUTDIR)BenchmarkGameStrcat.$(O) BenchmarkGameStrcat.$(H): BenchmarkGameStrcat.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)BenchmarkGame.$(O) BenchmarkGame.$(H): BenchmarkGame.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
 $(OUTDIR)jv_calipel_s_benchmarks.$(O) jv_calipel_s_benchmarks.$(H): jv_calipel_s_benchmarks.st $(INCLUDE_TOP)/stx/libbasic/LibraryDefinition.$(H) $(INCLUDE_TOP)/stx/libbasic/ProjectDefinition.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
 
 # ENDMAKEDEPEND --- do not remove this line
--- a/s/benchmarks/Make.spec	Tue May 28 11:17:46 2013 +0100
+++ b/s/benchmarks/Make.spec	Tue May 28 20:24:18 2013 +0100
@@ -50,14 +50,14 @@
 STCWARNINGS=-warnNonStandard
 
 COMMON_CLASSES= \
-	BenchmarkGameStrcat \
+	BenchmarkGame \
 	jv_calipel_s_benchmarks \
 
 
 
 
 COMMON_OBJS= \
-    $(OUTDIR_SLASH)BenchmarkGameStrcat.$(O) \
+    $(OUTDIR_SLASH)BenchmarkGame.$(O) \
     $(OUTDIR_SLASH)jv_calipel_s_benchmarks.$(O) \
 
 
--- a/s/benchmarks/abbrev.stc	Tue May 28 11:17:46 2013 +0100
+++ b/s/benchmarks/abbrev.stc	Tue May 28 20:24:18 2013 +0100
@@ -1,5 +1,5 @@
 # automagically generated by the project definition
 # this file is needed for stc to be able to compile modules independently.
 # it provides information about a classes filename, category and especially namespace.
-BenchmarkGameStrcat BenchmarkGameStrcat jv:calipel/s/benchmarks 'CalipeL/S-Benchmarks' 0
+BenchmarkGame BenchmarkGame jv:calipel/s/benchmarks 'CalipeL/S-Benchmarks' 0
 jv_calipel_s_benchmarks jv_calipel_s_benchmarks jv:calipel/s/benchmarks '* Projects & Packages *' 3
--- a/s/benchmarks/bc.mak	Tue May 28 11:17:46 2013 +0100
+++ b/s/benchmarks/bc.mak	Tue May 28 20:24:18 2013 +0100
@@ -67,7 +67,7 @@
 
 
 # BEGINMAKEDEPEND --- do not remove this line; make depend needs it
-$(OUTDIR)BenchmarkGameStrcat.$(O) BenchmarkGameStrcat.$(H): BenchmarkGameStrcat.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)BenchmarkGame.$(O) BenchmarkGame.$(H): BenchmarkGame.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
 $(OUTDIR)jv_calipel_s_benchmarks.$(O) jv_calipel_s_benchmarks.$(H): jv_calipel_s_benchmarks.st $(INCLUDE_TOP)\stx\libbasic\LibraryDefinition.$(H) $(INCLUDE_TOP)\stx\libbasic\ProjectDefinition.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
 
 # ENDMAKEDEPEND --- do not remove this line
--- a/s/benchmarks/benchmarks.rc	Tue May 28 11:17:46 2013 +0100
+++ b/s/benchmarks/benchmarks.rc	Tue May 28 20:24:18 2013 +0100
@@ -25,7 +25,7 @@
       VALUE "LegalCopyright", "My CopyRight or CopyLeft\0"
       VALUE "ProductName", "ProductName\0"
       VALUE "ProductVersion", "6.2.3.0\0"
-      VALUE "ProductDate", "Tue, 28 May 2013 10:15:46 GMT\0"
+      VALUE "ProductDate", "Tue, 28 May 2013 19:23:27 GMT\0"
     END
 
   END
--- a/s/benchmarks/jv_calipel_s_benchmarks.st	Tue May 28 11:17:46 2013 +0100
+++ b/s/benchmarks/jv_calipel_s_benchmarks.st	Tue May 28 20:24:18 2013 +0100
@@ -65,7 +65,7 @@
 
     ^ #(
         "<className> or (<className> attributes...) in load order"
-        BenchmarkGameStrcat
+        BenchmarkGame
         #'jv_calipel_s_benchmarks'
     )
 !
--- a/s/benchmarks/libInit.cc	Tue May 28 11:17:46 2013 +0100
+++ b/s/benchmarks/libInit.cc	Tue May 28 20:24:18 2013 +0100
@@ -27,7 +27,7 @@
 void _libjv_calipel_s_benchmarks_Init(pass, __pRT__, snd)
 OBJ snd; struct __vmData__ *__pRT__; {
 __BEGIN_PACKAGE2__("libjv_calipel_s_benchmarks", _libjv_calipel_s_benchmarks_Init, "jv:calipel/s/benchmarks");
-_BenchmarkGameStrcat_Init(pass,__pRT__,snd);
+_BenchmarkGame_Init(pass,__pRT__,snd);
 _jv_137calipel_137s_137benchmarks_Init(pass,__pRT__,snd);
 
 
--- a/s/s.rc	Tue May 28 11:17:46 2013 +0100
+++ b/s/s.rc	Tue May 28 20:24:18 2013 +0100
@@ -25,7 +25,7 @@
       VALUE "LegalCopyright", "My CopyRight or CopyLeft\0"
       VALUE "ProductName", "ProductName\0"
       VALUE "ProductVersion", "6.2.3.0\0"
-      VALUE "ProductDate", "Tue, 28 May 2013 10:16:12 GMT\0"
+      VALUE "ProductDate", "Tue, 28 May 2013 19:23:47 GMT\0"
     END
 
   END
--- a/s/stx/BenchmarkRunner.st	Tue May 28 11:17:46 2013 +0100
+++ b/s/stx/BenchmarkRunner.st	Tue May 28 20:24:18 2013 +0100
@@ -7,6 +7,232 @@
 	category:'CalipeL/S-Smalltalk/X'
 !
 
+BenchmarkRunner class instanceVariableNames:'packages params classes profiler debugging'
+
+"
+ The following class instance variables are inherited by this class:
+
+	StandaloneStartup - MutexHandle
+	Object - 
+"
+!
+
+
+!BenchmarkRunner class methodsFor:'initialization'!
+
+initialize
+    "Invoked at system start or when the class is dynamically loaded."
+
+    "/ please change as required (and remove this comment)
+    debugging := Transcript notNil and:[Transcript isView].
+
+    "Modified: / 28-05-2013 / 13:26:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!BenchmarkRunner class methodsFor:'defaults'!
+
+allowDebugOption
+
+    ^true
+
+    "Created: / 21-07-2011 / 09:48:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!BenchmarkRunner class methodsFor:'multiple applications support'!
+
+applicationRegistryPath
+    "the key under which this application stores its process ID in the registry
+     as a collection of path-components.
+     i.e. if #('foo' 'bar' 'baz') is returned here, the current applications ID will be stored
+     in HKEY_CURRENT_USER\Software\foo\bar\baz\CurrentID.
+     (would also be used as a relative path for a temporary lock file under unix).
+     Used to detect if another instance of this application is already running."
+
+    ^ #('jv' 'calipel' 's')
+
+    "Modified: / 28-05-2013 / 13:02:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+applicationUUID
+    "answer an application-specific unique uuid.
+     This is used as the name of some exclusive OS-resource, which is used to find out,
+     if another instance of this application is already running.
+     Under win32, a mutex is used; under unix, an exclusive file in the tempDir could be used.
+     If redefined, please return a real UUID (i.e. UUID fromString:'.....') and not a string or
+     similar possibly conflicting identifier.
+     You can paste a fresh worldwide unique id via the editor's more-misc-paste UUID menuFunction."
+
+    ^ UUID fromString: 'a7f3d0c5-429c-4be8-b857-4ff6ba6b0b65'
+
+    "Modified: / 28-05-2013 / 13:02:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!BenchmarkRunner class methodsFor:'startup'!
+
+setupToolsForDebug
+
+    super setupToolsForDebug.
+    debugging := true.
+
+    "Created: / 06-11-2011 / 22:06:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+usage
+
+    Stderr nextPutLine:'usage:'; cr;
+           nextPutAll:'   benchmark-runner.';
+           nextPutAll: (OperatingSystem isMSWINDOWSlike ifTrue:['bat'] ifFalse:['sh']);
+           nextPutAll: ' -b <benchmark> -n <n>'; cr; cr.
+
+    Stderr nextPutLine:'  --help .................. output this message'.
+"/    Stderr nextPutLine:'  --verbose ............... verbose startup'.
+"/    Stderr nextPutLine:'  --noBanner .............. no splash screen'.
+"/    Stderr nextPutLine:'  --newAppInstance ........ start as its own application process (do not reuse a running instance)'.
+"/    self allowScriptingOption ifTrue:[
+"/        Stderr nextPutLine:'  --scripting portNr ...... enable scripting via port (or stdin/stdOut, if 0)'.
+"/    ].
+    self allowDebugOption ifTrue:[
+        Stderr nextPutLine:'  --debug ................. enable Debugger'.
+    ].
+
+    "/                 '  ......................... '
+    Stderr nextPutLine:'  -b <benchmark>'.
+    Stderr nextPutLine:'  --benchmark=<benchmark> . benchmark to run (class name)'.
+    Stderr nextPutLine:'  -n <n>'.
+    Stderr nextPutLine:'  --passes ................ how many passes of given benchmark (integer)'.
+    Stderr nextPutLine:'  -j'.
+    Stderr nextPutLine:'  --java ..,............... run Java version of the benchmark (default)'.
+    Stderr nextPutLine:'  -s'.
+    Stderr nextPutLine:'  --smalltalk ............. run Smalltalk version of the benchmark'.
+
+
+
+    "
+    self usage
+    "
+
+    "Created: / 13-01-2012 / 11:48:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 31-10-2012 / 11:05:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!BenchmarkRunner class methodsFor:'startup-to be redefined'!
+
+exit: code
+    debugging ifFalse:[
+        Smalltalk exit: code
+    ].
+
+    "Created: / 02-11-2012 / 02:32:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+main:argv
+    | i suite result report file |
+
+    packages := OrderedCollection new.
+    params := Dictionary new.
+    profiler := nil.
+    classes := OrderedCollection new.
+    report := BenchmarkReport text.
+
+    argv isEmptyOrNil ifTrue:[
+        self usage.
+        self exit: 1
+    ].
+
+    i := 1.
+    [ i <= argv size ] whileTrue:[
+        | arg |
+
+        arg := argv at: i.
+        i := i + 1.
+        arg first == $- ifTrue:[
+            arg = '-o' ifTrue:[
+                file := argv at: i.
+                i := i + 1.
+            ].
+            arg = '-p' ifTrue:[
+                packages add: (argv at: i).
+                i := i + 1.
+            ].
+            arg = '-r' ifTrue:[
+                | reportNm |
+
+                reportNm := (argv at: i).
+                i := i + 1.
+                report := Smalltalk at: reportNm asSymbol.
+                report isNil ifTrue:[
+                    self error: 'No report class named ''', reportNm, ''''.
+                ].
+            ].
+            arg = '--text' ifTrue:[
+                report := BenchmarkReport text.
+            ].
+"
+            arg = '--json' ifTrue:[
+                report := BenchmarkReport json.
+            ].
+"
+            arg second = $D ifTrue:[
+                | eqIdx |
+
+                ((arg size > 2) and:[(eqIdx := arg indexOf: $= startingAt: 3) ~~ 0]) ifTrue:[
+                    params at: (arg copyFrom: 3 to: eqIdx - 1) put: (arg copyFrom: eqIdx + 1)
+                ] ifFalse:[
+                    self error: 'No parameter value'
+                ]
+            ]
+        ] ifFalse:[
+            classes add: arg.
+        ]
+    ].
+
+    "/Load packages..."
+    packages isEmpty ifTrue:[packages add: (BenchmarkInstance package , '/benchmarks')].
+    packages do:[:each|
+        (Smalltalk loadPackage: each) ifFalse:[
+            self error: 'Failed to load package ''', each ,''''.
+            self exit: 2.
+        ]
+    ].
+
+    "Build suite"
+    suite := BenchmarkSuite new.
+    classes do:[:each|
+        | classNm class selector |    
+        i := each indexOf: $#.
+        i ~~ 0 ifTrue:[
+            classNm := each copyTo: i - 1.
+            selector := (each copyFrom: i + 1) asSymbol.
+        ] ifFalse:[
+            classNm := each.
+        ].
+        class := Smalltalk at: classNm asSymbol.
+        class isNil ifTrue:[
+            self error: 'Class ', classNm , ' does not exists'.
+        ].
+        class autoload.
+        selector isNil ifTrue:[
+            suite addBenchmark: (BenchmarkSuite class: class)
+        ] ifFalse:[
+            suite addBenchmark: (BenchmarkSuite class: class benchmark: selector)
+        ]
+    ].
+
+    "Run suite"
+    result := BenchmarkResult new.
+    suite run: result with: params.
+
+    "Write report"
+    file notNil ifTrue:[
+        report write: result on: file asFilename writeStream
+    ] ifFalse:[
+        report write: result on: Transcript ? Stdout.
+    ].
+
+    self exit: 0.
+
+    "Modified: / 28-05-2013 / 20:11:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
 
 !BenchmarkRunner class methodsFor:'documentation'!
 
@@ -15,3 +241,5 @@
     ^ '$Changeset: <not expanded> $'
 ! !
 
+
+BenchmarkRunner initialize!
--- a/s/stx/abbrev.stc	Tue May 28 11:17:46 2013 +0100
+++ b/s/stx/abbrev.stc	Tue May 28 20:24:18 2013 +0100
@@ -1,5 +1,5 @@
 # automagically generated by the project definition
 # this file is needed for stc to be able to compile modules independently.
 # it provides information about a classes filename, category and especially namespace.
-BenchmarkRunner BenchmarkRunner jv:calipel/s/stx 'CalipeL/S-Smalltalk/X' 1
+BenchmarkRunner BenchmarkRunner jv:calipel/s/stx 'CalipeL/S-Smalltalk/X' 6
 jv_calipel_s_stx jv_calipel_s_stx jv:calipel/s/stx '* Projects & Packages *' 3
--- a/s/stx/stx.rc	Tue May 28 11:17:46 2013 +0100
+++ b/s/stx/stx.rc	Tue May 28 20:24:18 2013 +0100
@@ -25,7 +25,7 @@
       VALUE "LegalCopyright", "My CopyRight or CopyLeft\0"
       VALUE "ProductName", "ProductName\0"
       VALUE "ProductVersion", "6.2.3.0\0"
-      VALUE "ProductDate", "Tue, 28 May 2013 10:16:00 GMT\0"
+      VALUE "ProductDate", "Tue, 28 May 2013 19:23:21 GMT\0"
     END
 
   END
--- a/s/tests/tests.rc	Tue May 28 11:17:46 2013 +0100
+++ b/s/tests/tests.rc	Tue May 28 20:24:18 2013 +0100
@@ -25,7 +25,7 @@
       VALUE "LegalCopyright", "My CopyRight or CopyLeft\0"
       VALUE "ProductName", "ProductName\0"
       VALUE "ProductVersion", "6.2.3.0\0"
-      VALUE "ProductDate", "Tue, 28 May 2013 10:16:06 GMT\0"
+      VALUE "ProductDate", "Tue, 28 May 2013 19:22:53 GMT\0"
     END
 
   END