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

"{ NameSpace: Smalltalk }"

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

!

setupForPerformance

    "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 javaNativeCodeOptimization: true.

    "ObjectMemory newSpaceSize: ObjectMemory newSpaceSize * 5."

    "Created: / 22-05-2014 / 12:17:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

setupJITJava:aBoolean

    ObjectMemory javaJustInTimeCompilation:aBoolean.

    "Created: / 22-05-2014 / 12:17:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

setupJITSmalltalk:aBoolean

    ObjectMemory justInTimeCompilation:aBoolean.

    "Created: / 22-05-2014 / 12:17:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!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 nextPutLine: '  --disable-jit .......... disable JIT compilation for both, Smalltalk and'.

    Stderr nextPutLine: '                           Java.'.

    Stderr nextPutLine: '  --disable-jit-java ...., disable Java JIT only.'.

    Stderr nextPutLine: '  --disable-jit-smalltalk  disable Smalltalk JIT only.'.

    Stderr cr.

    BenchmarkRunner new options.

    Smalltalk exit: 0.

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

    "Modified: / 22-05-2014 / 12:21:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

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

main:argv0

    | runner argv i packages enableSmalltalkJIT enableJavaJIT status |

    runner := BenchmarkRunner new.

    enableSmalltalkJIT := enableJavaJIT := true.

    status := BenchmarkRunner statusSuccess.

    [

        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.

                ]

            ].

            arg = '--disable-jit' ifTrue:[

                enableSmalltalkJIT := enableJavaJIT := false.

                argv removeIndex: i.

                i := i - 1.

            ].

            arg = '--disable-jit-java' ifTrue:[

                enableJavaJIT := false.

                argv removeIndex: i.

                i := i - 1.

            ].

            arg = '--disable-jit-smalltalk' ifTrue:[

                enableJavaJIT := false.

                argv removeIndex: i.

                i := i - 1.

            ].

            (arg = '--arguments') ifTrue:[

                | arguments argumentsF parsed |

                i > argv size ifTrue:[

                    self error: arg, ' requires a file parameter.'

                ].

                argumentsF := (arguments := (argv at: i + 1)) asFilename.

                argumentsF exists ifFalse:[

                    self error:'no such file: ', arguments.

                ].

                parsed := OrderedCollection new.

                argumentsF readingFileDo:[:f | runner parseArguments: f into: parsed ].

                argv removeIndex: i; removeIndex: i.

                i := i - 1.

                argv addAll: parsed beforeIndex: i + 1.

            ].

            (arg startsWith: '-Xdump-compile-map=') ifTrue:[

                "Ignore here - this is for VMs with no -Xdump-compile-map support"

                argv 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 ,''''.

            ]

        ].

        self setupForPerformance.

        self setupJITSmalltalk: (enableSmalltalkJIT).

        self setupJITJava: (enableJavaJIT).

        status := runner main: argv

    ] on: Error do:[:ex|

        status := BenchmarkRunner statusError.

        debugging ifTrue:[

            Display isNil ifTrue:[

                Smalltalk openDisplay.

            ].

            ex pass.

        ] ifFalse:[

            Stderr

                nextPutAll: 'ERROR: ';

                nextPutAll: ex class printString;

                nextPutAll: ': ';

                nextPutAll: ex description;

                cr.

            Smalltalk exit: status.

        ].

    ].

    Smalltalk exit: status.

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

    "Modified: / 22-10-2015 / 14:58:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!BenchmarkRunnerAdapterStX class methodsFor:'documentation'!

version_HG

    ^ '$Changeset: <not expanded> $'

! !

BenchmarkRunnerAdapterStX initialize!