s/stx/BenchmarkPlatformStX.st
author Jan Vrany <jan.vrany@fit.cvut.cz>
Fri, 25 Sep 2015 05:18:26 +0100
changeset 285 0cf54ee76de5
parent 283 51f9245f0cb2
child 288 3e9a0ef23dfd
permissions -rw-r--r--
Normalized Windows OS identification string with Pharo

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

"{ NameSpace: Smalltalk }"

BenchmarkPlatform subclass:#BenchmarkPlatformStX
	instanceVariableNames:''
	classVariableNames:'WinVersionXlats'
	poolDictionaries:''
	category:'CalipeL-S-Smalltalk/X'
!

!BenchmarkPlatformStX class methodsFor:'documentation'!

documentation
"
 Replace 'StandaloneStartup', 'NewClass1' and
 the empty string arguments by true values.

 Install (or change) the class by 'accepting',
 either via the menu or the keyboard (usually CMD-A).

 You can also change the category simply by editing
 the categoryString and accepting.

 To be nice to others (and yourself later), do not forget to
 add some documentation; preferably under the classes documentation
 protocol.
 (see the `create documentation stubs' item in the methodList menu;
  switch from instance to class to find this menu item.)

 Notice, that ST/X uses the convention to document the class using
 comment-only class methods (however, ST80 comments are supported and
 can be changed via the class-documentation menu).

"
! !

!BenchmarkPlatformStX class methodsFor:'initialization'!

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

    WinVersionXlats := Dictionary withKeysAndValues:#(
        "Following are taken from:
        https://msdn.microsoft.com/en-gb/library/windows/desktop/ms724832(v=vs.85).aspx"        
        '5.0'    'Windows 2000'
        '5.1'    'Windows XP'
        '5.2'    'Windows Server 2003'
        '6.0'    'Windows Vista / Server 2008'
        '6.1'    'Windows 7 / Server 2008 R2'
        '6.2'    'Windows 8 / Server 2012'
        '6.3'    'Windows 8.1 / Server 2012 R2'
        '10.0'   'Windows 10'
        ).
    self setCurrent: self new.

    "Modified: / 25-09-2015 / 05:13:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 25-09-2015 / 05:32:59 / jv"
! !

!BenchmarkPlatformStX methodsFor:'accessing-performance counters'!

millisecondTime
    ^OperatingSystem getMillisecondTime

    "Created: / 06-06-2013 / 09:30:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!BenchmarkPlatformStX methodsFor:'acessing-streams'!

stderr
    ^Stderr

    "Created: / 06-06-2013 / 09:30:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

stdout
    ^Stdout

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

!BenchmarkPlatformStX methodsFor:'configuration'!

configurationStringMachineId
    ^OperatingSystem getHostName

    "Modified: / 13-07-2013 / 22:46:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

configurationStringOS
    "superclass BenchmarkPlatform says that I am responsible to implement this method"

    | sysinfo |

    sysinfo := OperatingSystem getSystemInfo.
    OperatingSystem isMSWINDOWSlike ifTrue:[ 
        (sysinfo includesKey: #release) ifTrue:[ 
            ^ WinVersionXlats at: (sysinfo at: #release) ifAbsent:[ sysinfo at: #system ]
        ].
    ].
    ^ sysinfo at: #system

    "
    BenchmarkPlatform current configurationStringOS
    "

    "Modified: / 25-09-2015 / 05:16:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 25-09-2015 / 05:29:37 / jv"
!

configurationStringRuntime
    "superclass BenchmarkPlatform says that I am responsible to implement this method"

    ^ String streamContents:[ :str |
        str nextPutAll:'Smalltalk/X '.
        Smalltalk majorVersionNr printOn: str.
        str nextPut:$..
        Smalltalk minorVersionNr printOn: str.
        str nextPut:$..                       
        Smalltalk revisionNr printOn: str.
        str space.
        ExternalAddress pointerSize == 8 ifTrue:[
            str nextPutAll: '64bit'
        ] ifFalse:[ 
            str nextPutAll: '32bit'
        ].
    ].

    "
    BenchmarkPlatform current configurationStringRuntime
    "

    "Modified: / 21-09-2015 / 15:43:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!BenchmarkPlatformStX methodsFor:'exit'!

exit: code
    Smalltalk exit: code.

    "Created: / 06-06-2013 / 09:14:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!BenchmarkPlatformStX methodsFor:'initialization'!

initialize
    "Invoked when a new instance is created."

    super initialize.
    instruments := Array 
                    with: BenchmarkExecutionTimeInstrument new
                    with: BenchmarkScavengeCountInstrument new
                    with: BenchmarkMarkAndSweepCountInstrument new

    "Created: / 27-11-2014 / 13:42:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!BenchmarkPlatformStX methodsFor:'queries'!

isHeadless
    ^ Transcript isNil or:[Transcript isView not].

    "Created: / 06-06-2013 / 09:23:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

isSmalltalkX
    ^ true

    "Created: / 06-06-2013 / 09:39:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!BenchmarkPlatformStX methodsFor:'running'!

warmUpPost
    "Called after benchmark's warmup"

    ObjectMemory garbageCollect; tenure.

    "Created: / 07-06-2013 / 02:09:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!BenchmarkPlatformStX class methodsFor:'documentation'!

version_HG

    ^ '$Changeset: <not expanded> $'
! !


BenchmarkPlatformStX initialize!