"{ Package: 'jv:calipel/s/stx' }"

StandaloneStartup subclass:#BenchmarkRunnerAdapterStX

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	category:'CalipeL-S-Smalltalk/X'

!

BenchmarkRunnerAdapterStX class instanceVariableNames:'debugging'

"

 The following class instance variables are inherited by this class:

	StandaloneStartup - MutexHandle

	Object - 

"

!

!BenchmarkRunnerAdapterStX class methodsFor:'initialization'!

initialize

    "Invoked at system start or when the class is dynamically loaded."

    "Install signl handlers"

    self setupSignalHandlers.

    "Make sure platform is initialized"

    BenchmarkPlatformStX initialize.

    "Modified: / 01-08-2013 / 18:42:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

    "Set's system for maximum performance"

    "Set stack size to 16MB"

    Processor activeProcess setMaximumStackSize: ((1024 * 1024 * 16) max: Process 

    defaultMaximumStackSize).

    "Setup for performance"

    JavaNativeMethod cacheNativeImplementation: true.

    "ObjectMemory newSpaceSize: ObjectMemory newSpaceSize * 5."

! !

!BenchmarkRunnerAdapterStX class methodsFor:'debugging'!

dumpProcess: aProcess

    Stderr cr; cr

    "Created: / 27-06-2013 / 23:41:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

dumpProcess: aProcess on: aStream

    | ctx |

    aStream cr; cr.

    aStream nextPutAll: '== ['; nextPutAll: aProcess id printString; nextPutAll:'] '; nextPutAll: aProcess name; nextPutAll: ' =='; cr.

    aStream cr.

    aProcess == Processor activeProcess ifTrue:[ctx := thisContext] ifFalse:[ctx := aProcess suspendedContext].

    [ ctx notNil ] whileTrue:[

        aStream nextPutAll: '  '.

        ctx fullPrintOn: aStream.

        aStream cr.

        ctx := ctx sender.

    ].

    aStream cr.

    "

        self dumpProcess: Processor activeProcess on: Transcript.

    "

    "Created: / 28-06-2013 / 01:00:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

dumpProcesses

    self dumpProcessesOn: Stderr

    "

    self dumpProcessesOn: Transcript.

    "

    "Created: / 27-06-2013 / 23:41:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified (comment): / 28-06-2013 / 01:06:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

dumpProcessesOn: aStream

    Process allInstancesDo:[:process|

        process isDead ifFalse:[

            self dumpProcess: process on: aStream

        ]

    ]

    "Created: / 27-06-2013 / 23:42:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!BenchmarkRunnerAdapterStX class methodsFor:'defaults'!

allowDebugOption

    ^true

    "Created: / 21-07-2011 / 09:48:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!BenchmarkRunnerAdapterStX 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>"

! !

!BenchmarkRunnerAdapterStX class methodsFor:'startup'!

handleSIGTERM

    self dumpProcesses.

    self exit:127.

    "Created: / 27-06-2013 / 23:10:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 13-07-2013 / 15:09:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

handleSIGUSR2

    self dumpProcesses

    "Created: / 27-06-2013 / 23:10:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

setupSignalHandlers

    "On UNIX, this sets up a custom signal handler on SIGUSR2 and SIGTERM that

     dumps stacks on all threads"

    | sigusr2 sigterm |

    OperatingSystem isUNIXlike ifTrue:[

        sigterm := Signal new.

        sigterm handlerBlock: [:ex | self handleSIGTERM].

        OperatingSystem operatingSystemSignal:OperatingSystem sigTERM install: sigterm.

        OperatingSystem enableSignal: OperatingSystem sigTERM.

        sigusr2 := Signal new.

        sigusr2 handlerBlock: [:ex | self handleSIGUSR2].

        OperatingSystem operatingSystemSignal:OperatingSystem sigUSR2 install: sigusr2.

        OperatingSystem enableSignal: OperatingSystem sigUSR2.

    ].

    "

    OperatingSystem sendSignal: OperatingSystem sigUSR2 to: OperatingSystem getProcessId

    "

    "Created: / 27-06-2013 / 20:57:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 28-06-2013 / 01:11:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

setupToolsForDebug

    super setupToolsForDebug.

    debugging := Transcript isNil or:[Transcript isView not].

    "Created: / 06-11-2011 / 22:06:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 01-08-2013 / 18:42:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

usage

    "Print usage to stderr"

    Stderr  nextPutAll:  'usage: benchmark-runner.';

            nextPutAll: (OperatingSystem isMSWINDOWSlike ifTrue:['bat'] ifFalse:['sh']);

            nextPutAll: ' <options> suitespec1 [suitespec2 [suitespec3 [...]]]';

            cr; cr.

    Stderr nextPutLine: 'Smalltalk/X specific options:'.

    Stderr nextPutLine: '  --debug ................ run in debug mode (only for Smalltalk/X)'.

    Stderr nextPutLine: '  -p PACKAGE ............. load package PACKAGE before running tests'.

    Stderr nextPutLine: '  --gdb .................. run benchmark under gdb debugger. Start with'.

    Stderr nextPutLine: '                           (gdb) r -I -f "$DIR/benchmark-runner.st" ...'.

    Stderr nextPutLine: '  --cgdb ................. run benchmark under cgdb debugger. Start with'.

    Stderr nextPutLine: '                           (gdb) r -I -f "$DIR/benchmark-runner.st" ...'.

    Stderr nextPutLine: '  --callgrind ............ run benchmark under callgrind profiler. Requires'.

    Stderr nextPutLine: '                           stx:libprofiler package.'.

    Stderr cr.

    BenchmarkRunner new options.

    Smalltalk exit: 0.

    "Created: / 13-01-2012 / 11:48:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!BenchmarkRunnerAdapterStX class methodsFor:'startup-to be redefined'!

main:argv0

    [

        packages := OrderedCollection new.

        argv := argv0 asOrderedCollection.

        i := 1.

        [ i <= argv size ] whileTrue:[

            | arg |

            arg := argv at: i.

            arg = '-p' ifTrue:[

                i == argv size ifTrue:[

                    self error: '-p expects package name'.

                ] ifFalse:[

                    packages add: (argv at: i + 1).

                    argv removeIndex: i; removeIndex: i.

                    i := i - 1.

                ]

            ].

            i := i + 1.

        ].

        "/Load packages..."

        packages isEmpty ifTrue:[packages add: (BenchmarkInstance package , '/benchmarks')].

        packages do:[:each|

            (Smalltalk loadPackage: each) ifFalse:[

                self error: 'Failed to load package ''', each ,''''.

            ]

        ].

        BenchmarkRunner new main: argv

    ] on: Error do:[:ex|

        debugging ifTrue:[

            Display isNil ifTrue:[

                Smalltalk openDisplay.

            ]. 

            ex pass.

        ] ifFalse:[

            Stderr 

                nextPutAll: 'ERROR: ';

                nextPutAll: ex class printString;

                nextPutAll: ': ';

                nextPutAll: ex description;

                cr.

            Smalltalk exit: 1.

        ].

    ].

    Smalltalk exit: 0.

    "Created: / 06-06-2013 / 10:07:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!BenchmarkRunnerAdapterStX class methodsFor:'documentation'!

version_HG

    ^ '$Changeset: <not expanded> $'

! !

BenchmarkRunnerAdapterStX initialize!