[Vm-dev] VM Maker: CogBenchmarks-eem.1.mcz

3 Sep 2014


      Eliot Miranda uploaded a new version of CogBenchmarks to project VM Maker:
http://source.squeak.org/VMMaker/CogBenchmarks-eem.1.mcz
==================== Summary ====================
Name: CogBenchmarks-eem.1
Author: eem
Time: 3 September 2014, 10:02:40.405 am
UUID: 5bb3e9ae-f915-4f72-94f0-1b09062e7f44
Ancestors:
Move the Cog benchmarks to their own package.
==================== Snapshot ====================
SystemOrganization addCategory: #'CogBenchmarks-DeltaBlue'!
SystemOrganization addCategory: #'CogBenchmarks-Richards'!
SystemOrganization addCategory: #'CogBenchmarks-SMark'!
SystemOrganization addCategory: #'CogBenchmarks-Shootout'!
Object subclass: #DBAbstractConstraint
    instanceVariableNames: 'strength'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'CogBenchmarks-DeltaBlue'!
!DBAbstractConstraint commentStamp: '<historical>' prior: 0!
I am an abstract class representing a system-maintainable relationship (or "constraint") between a set of variables. I supply a strength instance variable; concrete subclasses provide a means of storing the constrained variables and other information required to represent a constraint.
Instance variables:
    strength			the strength of this constraint <Strength>!
----- Method: DBAbstractConstraint>>addConstraint (in category 'adding') -----
addConstraint
    "Activate this constraint and attempt to satisfy it."
self addToGraph.
    DBPlanner current incrementalAdd: self.!
----- Method: DBAbstractConstraint>>addToGraph (in category 'adding') -----
addToGraph
    "Add myself to the constraint graph."
self subclassResponsibility!
----- Method: DBAbstractConstraint>>chooseMethod: (in category 'planning') -----
chooseMethod: mark
    "Decide if I can be satisfied and record that decision. The output of
     the choosen method must not have the given mark and must have a
     walkabout strength less than that of this constraint."
self subclassResponsibility!
----- Method: DBAbstractConstraint>>destroyConstraint (in category 'adding') -----
destroyConstraint
    "Deactivate this constraint, remove it from the constraint graph,
     possibly causing other constraints to be satisfied, and destroy it."
(self isSatisfied) ifTrue: [DBPlanner current incrementalRemove: self].
    self removeFromGraph.
    self release.!
----- Method: DBAbstractConstraint>>execute (in category 'planning') -----
execute
    "Enforce this constraint. Assume that it is satisfied."
self subclassResponsibility!
----- Method: DBAbstractConstraint>>inputsDo: (in category 'planning') -----
inputsDo: aBlock
    "Assume that I am satisfied. Evaluate the given block on all my current
     input variables."
self subclassResponsibility!
----- Method: DBAbstractConstraint>>inputsKnown: (in category 'planning') -----
inputsKnown: mark
    "Assume that I am satisfied. Answer true if all my current inputs are
     known. A variable is known if either a) it is 'stay' (i.e. it is a
     constant at plan execution time), b) it has the given mark (indicating
     that it has been computed by a constraint appearing earlier in the
     plan), or c) it is not determined by any constraint."
self inputsDo:
    	[ :v |
    	 (v mark = mark or: [v stay or: [v determinedBy isNil]]) ifFalse:
    		[^false]].
    ^true!
----- Method: DBAbstractConstraint>>isInput (in category 'testing') -----
isInput
    "Normal constraints are not input constraints. An input constraint is
     one that depends on external state, such as the mouse, the keyboard,
     a clock, or some arbitrary piece of imperative code."
^false!
----- Method: DBAbstractConstraint>>isSatisfied (in category 'testing') -----
isSatisfied
    "Answer true if this constraint is satisfied in the current solution."
self subclassResponsibility!
----- Method: DBAbstractConstraint>>longPrintOn: (in category 'printing') -----
longPrintOn: aStream
aStream nextPut: $(.
    self shortPrintOn: aStream.
    aStream space; nextPutAll: self strength printString.
    (self isSatisfied)
    	ifTrue:
    		[aStream cr; space; space; space.
    		 self inputsDo:
    			[ :in | aStream nextPutAll: 'v', in printString, ' '].
    		aStream nextPutAll: '-> '.
    		aStream nextPutAll: 'v', self output printString]
    	ifFalse:
    		[aStream space; nextPutAll: 'UNSATISFIED'].
    aStream nextPut: $); cr.!
----- Method: DBAbstractConstraint>>markUnsatisfied (in category 'planning') -----
markUnsatisfied
    "Record the fact that I am unsatisfied."
self subclassResponsibility!
----- Method: DBAbstractConstraint>>output (in category 'planning') -----
output
    "Answer my current output variable. Raise an error if I am not
     currently satisfied."
self subclassResponsibility!
----- Method: DBAbstractConstraint>>printOn: (in category 'printing') -----
printOn: aStream
self shortPrintOn: aStream!
----- Method: DBAbstractConstraint>>recalculate (in category 'planning') -----
recalculate
    "Calculate the walkabout strength, the stay flag, and, if it is 'stay',
     the value for the current output of this constraint. Assume this
     constraint is satisfied."
self subclassResponsibility!
----- Method: DBAbstractConstraint>>removeFromGraph (in category 'adding') -----
removeFromGraph
    "Remove myself from the constraint graph."
self subclassResponsibility!
----- Method: DBAbstractConstraint>>satisfy: (in category 'planning') -----
satisfy: mark
    "Attempt to find a way to enforce this (still unsatisfied) constraint.
     If successful, record the solution, perhaps modifying the current
     dataflow graph.  Answer the constraint that this constraint overrides,
     if there is one, or nil, if there isn't."
| overridden out |
    self chooseMethod: mark.
    self isSatisfied
    	ifTrue:			"constraint can be satisfied"
    		["mark inputs to allow cycle detection in addPropagate"
    		 self inputsDo: [ :in | in mark: mark].
    		 out := self output.
    		 overridden := out determinedBy.
    		 overridden ifNotNil: [overridden markUnsatisfied].
    		 out determinedBy: self.
    		 (DBPlanner current addPropagate: self mark: mark) ifFalse:
    			[self notify:
    				('Cycle encountered adding:\   ',
    				 self printString,
    				 '\Constraint removed.') withCRs.
    			 ^nil].
    		 out mark: mark]
    	ifFalse:			"constraint cannot be satisfied"
    		[overridden := nil.
    		 (strength sameAs: (DBStrength required)) ifTrue:
    			[self notify: 'Failed to satisfy a required constraint']].
    ^ overridden!
----- Method: DBAbstractConstraint>>shortPrintOn: (in category 'printing') -----
shortPrintOn: aStream
aStream nextPutAll: self class name, '(', self printString, ')'.!
----- Method: DBAbstractConstraint>>strength (in category 'accessing') -----
strength
    ^ strength!
----- Method: DBAbstractConstraint>>strength: (in category 'accessing') -----
strength: anObject
    strength := anObject!
DBAbstractConstraint subclass: #DBBinaryConstraint
    instanceVariableNames: 'direction v1 v2'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'CogBenchmarks-DeltaBlue'!
!DBBinaryConstraint commentStamp: '<historical>' prior: 0!
I am an abstract superclass for constraints having two possible output variables.
Instance variables:
    v1, v2		possible output variables <Variable>
    direction		one of:
    				#forward (v2 is output)
    				#backward (	v1 is output)
    				nil (not satisfied)!
----- Method: DBBinaryConstraint class>>var:var:strength: (in category 'instance creation') -----
var: variable1 var: variable2 strength: strengthSymbol
    "Install a constraint with the given strength equating the given
     variables."
^(self new) var: variable1 var: variable2 strength: strengthSymbol!
----- Method: DBBinaryConstraint>>addToGraph (in category 'adding') -----
addToGraph
    "Add myself to the constraint graph."
v1 addConstraint: self.
    v2 addConstraint: self.
    direction := nil.!
----- Method: DBBinaryConstraint>>chooseMethod: (in category 'planning') -----
chooseMethod: mark
    "Decide if I can be satisfied and which way I should flow based on the relative strength of the variables I relate, and record that decision."
v1 mark == mark ifTrue:		"forward or nothing"
    	[ ^ direction := ((v2 mark ~= mark) and: [strength stronger: v2 walkStrength])
    		ifTrue: [ #forward ]
    		ifFalse: [ nil ] ].
v2 mark == mark ifTrue:		"backward or nothing"
    	[ ^ direction := ((v1 mark ~= mark) and: [strength stronger: v1 walkStrength])
    		ifTrue: [ #backward ]
    		ifFalse: [ nil ] ].
"if we get here, neither variable is marked, so we have choice"
    (v1 walkStrength weaker: v2 walkStrength)
    	ifTrue:
    		[ ^ direction := (strength stronger: v1 walkStrength)
    			ifTrue: [ #backward ]
    			ifFalse: [ nil ]]
    	ifFalse:
    		[ ^ direction := (strength stronger: v2 walkStrength)
    			ifTrue: [ #forward ]
    			ifFalse: [ nil ]]. !
----- Method: DBBinaryConstraint>>execute (in category 'planning') -----
execute
    "Enforce this constraint. Assume that it is satisfied."
self subclassResponsibility!
----- Method: DBBinaryConstraint>>inputsDo: (in category 'planning') -----
inputsDo: aBlock
    "Evaluate the given block on my current input variable."
direction == #forward
    	ifTrue: [ aBlock value: v1 ]
    	ifFalse: [ aBlock value: v2 ].!
----- Method: DBBinaryConstraint>>isSatisfied (in category 'testing') -----
isSatisfied
    "Answer true if this constraint is satisfied in the current solution."
^ direction notNil!
----- Method: DBBinaryConstraint>>markUnsatisfied (in category 'planning') -----
markUnsatisfied
    "Record the fact that I am unsatisfied."
direction := nil.!
----- Method: DBBinaryConstraint>>output (in category 'planning') -----
output
    "Answer my current output variable."
^ direction == #forward
    	ifTrue: [ v2 ]
    	ifFalse: [ v1 ]!
----- Method: DBBinaryConstraint>>recalculate (in category 'planning') -----
recalculate
    "Calculate the walkabout strength, the stay flag, and, if it is 'stay',
         the value for the current output of this constraint. Assume this
     constraint is satisfied."
| in out |
    direction == #forward
    	ifTrue: [in := v1. out := v2]
    	ifFalse: [in := v2. out := v1].
    out walkStrength: (strength weakest: in walkStrength).
    out stay: in stay.
    out stay ifTrue: [ self execute ].		"stay optimization"!
----- Method: DBBinaryConstraint>>removeFromGraph (in category 'adding') -----
removeFromGraph
    "Remove myself from the constraint graph."
v1 ifNotNil: [v1 removeConstraint: self].
    v2 ifNotNil: [v2 removeConstraint: self].
    direction := nil.!
----- Method: DBBinaryConstraint>>var:var:strength: (in category 'initialize') -----
var: variable1 var: variable2 strength: strengthSymbol
    "Initialize myself with the given variables and strength."
strength := DBStrength of: strengthSymbol.
    v1 := variable1.
    v2 := variable2.
    direction := nil.
    self addConstraint.!
DBBinaryConstraint subclass: #DBEqualityConstraint
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'CogBenchmarks-DeltaBlue'!
!DBEqualityConstraint commentStamp: '<historical>' prior: 0!
I constrain two variables to have the same value: "v1 = v2".!
----- Method: DBEqualityConstraint>>execute (in category 'planning') -----
execute
    "Enforce this constraint. Assume that it is satisfied."
direction == #forward
    	ifTrue: [v2 value: v1 value]
    	ifFalse: [v1 value: v2 value].!
DBBinaryConstraint subclass: #DBScaleConstraint
    instanceVariableNames: 'offset scale'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'CogBenchmarks-DeltaBlue'!
!DBScaleConstraint commentStamp: '<historical>' prior: 0!
I relate two variables by the linear scaling relationship:
"v2 = (v1 * scale) + offset". Either v1 or v2 may be changed to maintain this
relationship but the scale factor and offset are considered read-only.
Instance variables:
    scale		scale factor input variable <Variable>
    offset		offset input variable <Variable>!
----- Method: DBScaleConstraint class>>var:var:var:var:strength: (in category 'instance creation') -----
var: src var: scale var: offset var: dst strength: strengthSymbol
    "Install a scale constraint with the given strength on the given variables."
^(self new) src: src scale: scale offset: offset dst: dst strength: strengthSymbol!
----- Method: DBScaleConstraint>>addToGraph (in category 'adding') -----
addToGraph
    "Add myself to the constraint graph."
super addToGraph.
    scale addConstraint: self.
    offset addConstraint: self.
!
----- Method: DBScaleConstraint>>execute (in category 'planning') -----
execute
    "Enforce this constraint. Assume that it is satisfied."
direction == #forward
    	ifTrue: [v2 value: v1 value * scale value + offset value]
    	ifFalse: [v1 value: v2 value - offset value // scale value].!
----- Method: DBScaleConstraint>>inputsDo: (in category 'planning') -----
inputsDo: aBlock
    "Evaluate the given block on my current input variable."
direction == #forward
    	ifTrue: [ aBlock 
    			value: v1; 
    			value: scale; 
    			value: offset]
    	ifFalse: [ aBlock 
    			value: v2; 
    			value: scale; 
    			value: offset].!
----- Method: DBScaleConstraint>>recalculate (in category 'planning') -----
recalculate
    "Calculate the walkabout strength, the stay flag, and, if it is 'stay', the value for the current output of this constraint. Assume this constraint is satisfied."
| in out |
    direction == #forward
    	ifTrue: [in := v1. out := v2]
    	ifFalse: [out := v1. in := v2].
    out walkStrength: (strength weakest: in walkStrength).
    out stay: (in stay and: [scale stay and: [offset stay]]).
    out stay ifTrue: [self execute].		"stay optimization"!
----- Method: DBScaleConstraint>>removeFromGraph (in category 'adding') -----
removeFromGraph
    "Remove myself from the constraint graph."
super removeFromGraph.
    scale ifNotNil: [scale removeConstraint: self].
    offset ifNotNil: [offset removeConstraint: self].
!
----- Method: DBScaleConstraint>>src:scale:offset:dst:strength: (in category 'initialize') -----
src: srcVar scale: scaleVar offset: offsetVar dst: dstVar strength: strengthSymbol
    "Initialize myself with the given variables and strength."
strength := DBStrength of: strengthSymbol.
    v1 := srcVar.
    v2 := dstVar.
    scale := scaleVar.
    offset := offsetVar.
    direction := nil.
    self addConstraint.!
DBAbstractConstraint subclass: #DBUnaryConstraint
    instanceVariableNames: 'output satisfied'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'CogBenchmarks-DeltaBlue'!
!DBUnaryConstraint commentStamp: '<historical>' prior: 0!
I am an abstract superclass for constraints having a single possible output variable.
Instance variables:
    output		possible output variable <Variable>
    satisfied		true if I am currently satisfied <Boolean>!
DBUnaryConstraint subclass: #DBEditConstraint
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'CogBenchmarks-DeltaBlue'!
!DBEditConstraint commentStamp: '<historical>' prior: 0!
I mark variables that should, with some level of preference, stay the same. I have one method with zero inputs and one output, which does nothing. Planners may exploit the fact that, if I am satisfied, my output will not change during plan execution. This is called "stay optimization."!
----- Method: DBEditConstraint>>execute (in category 'planning') -----
execute
    "Edit constraints do nothing."!
----- Method: DBEditConstraint>>isInput (in category 'testing') -----
isInput
    "I indicate that a variable is to be changed by imperative code."
^true!
DBUnaryConstraint subclass: #DBStayConstraint
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'CogBenchmarks-DeltaBlue'!
!DBStayConstraint commentStamp: '<historical>' prior: 0!
I mark variables that should, with some level of preference, stay the same.
I have one method with zero inputs and one output, which does nothing. Planners
may exploit the fact that, if I am satisfied, my output will not change during
plan execution. This is called "stay optimization."!
----- Method: DBStayConstraint>>execute (in category 'planning') -----
execute
    "Stay constraints do nothing."!
----- Method: DBUnaryConstraint class>>var:strength: (in category 'instance creation') -----
var: aVariable strength: strengthSymbol
    "Install an edit constraint with the given strength on the given
     variable."
^(self new) var: aVariable strength: strengthSymbol!
----- Method: DBUnaryConstraint>>addToGraph (in category 'adding') -----
addToGraph
    "Add myself to the constraint graph."
output addConstraint: self.
    satisfied := false.!
----- Method: DBUnaryConstraint>>chooseMethod: (in category 'planning') -----
chooseMethod: mark
    "Decide if I can be satisfied and record that decision."
satisfied :=
    	output mark ~= mark and:
    	[strength stronger: output walkStrength].!
----- Method: DBUnaryConstraint>>execute (in category 'planning') -----
execute
    "Enforce this constraint. Assume that it is satisfied."
self subclassResponsibility!
----- Method: DBUnaryConstraint>>inputsDo: (in category 'planning') -----
inputsDo: aBlock
    "I have no input variables."!
----- Method: DBUnaryConstraint>>isSatisfied (in category 'testing') -----
isSatisfied
    "Answer true if this constraint is satisfied in the current solution."
^satisfied!
----- Method: DBUnaryConstraint>>markUnsatisfied (in category 'planning') -----
markUnsatisfied
    "Record the fact that I am unsatisfied."
satisfied := false.!
----- Method: DBUnaryConstraint>>output (in category 'planning') -----
output
    "Answer my current output variable."
^ output!
----- Method: DBUnaryConstraint>>recalculate (in category 'planning') -----
recalculate
    "Calculate the walkabout strength, the stay flag, and, if it is 'stay',
     the value for the current output of this constraint. Assume this
     constraint is satisfied."
output walkStrength: strength.
    output stay: self isInput not.
    output stay ifTrue: [self execute].	"stay optimization"!
----- Method: DBUnaryConstraint>>removeFromGraph (in category 'adding') -----
removeFromGraph
    "Remove myself from the constraint graph."
output ifNotNil: [ :out | out removeConstraint: self].
    satisfied := false.!
----- Method: DBUnaryConstraint>>var:strength: (in category 'initialize') -----
var: aVariable strength: strengthSymbol
    "Initialize myself with the given variable and strength."
strength := DBStrength of: strengthSymbol.
    output := aVariable.
    satisfied := false.
    self addConstraint.!
Object subclass: #DBPlanner
    instanceVariableNames: 'currentMark'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'CogBenchmarks-DeltaBlue'!
DBPlanner class
    instanceVariableNames: 'currentPlanner'!
!DBPlanner commentStamp: '<historical>' prior: 0!
This benchmark is an implementation of the DeltaBlue Constraint Solver described in `The DeltaBlue Algorithm: An Incremental Constraint Hierarchy Solver'', by Bjorn N. Freeman-Benson and John Maloney, Communications of the ACM, January 1990 (also as University of Washington TR 89-08-06).
!
DBPlanner class
    instanceVariableNames: 'currentPlanner'!
----- Method: DBPlanner class>>current (in category 'accessing') -----
current
    ^ currentPlanner!
----- Method: DBPlanner class>>new (in category 'instance creation') -----
new
    ^ currentPlanner := super new!
----- Method: DBPlanner>>addConstraintsConsuming:to: (in category 'private') -----
addConstraintsConsuming: v to: aCollection
| determiningC |
    determiningC := v determinedBy.
    v constraints do:
    	[ :c |
    	 (c == determiningC or: [c isSatisfied not]) ifFalse:
    		[aCollection add: c]].!
----- Method: DBPlanner>>addPropagate:mark: (in category 'private') -----
addPropagate: c mark: mark
    "Recompute the walkabout strengths and stay flags of all variables
     downstream of the given constraint and recompute the actual values
     of all variables whose stay flag is true. If a cycle is detected,
     remove the given constraint and answer false. Otherwise, answer true.
Details: Cycles are detected when a marked variable is encountered
     downstream of the given constraint. The sender is assumed to have
     marked the inputs of the given constraint with the given mark. Thus,
     encountering a marked node downstream of the output constraint means
     that there is a path from the constraint's output to one of its
     inputs."
| todo d |
    todo := OrderedCollection with: c.
    [todo isEmpty] whileFalse:
    	[d := todo removeFirst.
    	 (d output mark = mark) ifTrue:
    		[self incrementalRemove: c.
    		 ^ false].
    	 d recalculate.
    	 self addConstraintsConsuming: d output to: todo].
    ^ true!
----- Method: DBPlanner>>changeVar:newValue: (in category 'private') -----
changeVar: aVariable newValue: newValue
| editConstraint plan |
    editConstraint := DBEditConstraint var: aVariable strength: #preferred.
    plan := self extractPlanFromConstraints: (Array with: editConstraint).
    10 timesRepeat: [
    	aVariable value: newValue.
    	plan execute].
    editConstraint destroyConstraint.!
----- Method: DBPlanner>>constraintsConsuming:do: (in category 'private') -----
constraintsConsuming: v do: aBlock
| determiningC |
    determiningC := v determinedBy.
    v constraints do:
    	[ :c |
    	 (c == determiningC or: [c isSatisfied not]) ifFalse:
    		[aBlock value: c]].!
----- Method: DBPlanner>>extractPlanFromConstraints: (in category 'planning') -----
extractPlanFromConstraints: constraints
    "Extract a plan for resatisfaction starting from the outputs of the
     given constraints, usually a set of input constraints."
| sources |
    sources := OrderedCollection new.
    constraints do:
    	[: c | (c isInput and: [c isSatisfied]) ifTrue: [sources add: c]].
    ^self makePlan: sources!
----- Method: DBPlanner>>extractPlanFromVariables: (in category 'planning') -----
extractPlanFromVariables: variables
    "Extract a plan from the dataflow graph having the given variables. It
     is assumed that the given set of variables is complete, or at least
     that it contains all the input variables."
| sources |
    sources := OrderedCollection new.
    variables do:
    	[: v |
    	 (v constraints) do:
    		[: c | (c isInput and: [c isSatisfied]) ifTrue: [sources add: c]]].
    ^self makePlan: sources!
----- Method: DBPlanner>>incrementalAdd: (in category 'adding') -----
incrementalAdd: c
    "Attempt to satisfy the given constraint and, if successful,
     incrementally update the dataflow graph.
Details: If satifying the constraint is successful, it may override a
     weaker constraint on its output. The algorithm attempts to resatisfy
     that constraint using some other method. This process is repeated
     until either a) it reaches a variable that was not previously
     determined by any constraint or b) it reaches a constraint that
     is too weak to be satisfied using any of its methods. The variables
     of constraints that have been processed are marked with a unique mark
     value so that we know where we've been. This allows the algorithm to
     avoid getting into an infinite loop even if the constraint graph has
     an inadvertent cycle."
| mark overridden |
    mark := self newMark.
    overridden := c satisfy: mark.
    [overridden isNil] whileFalse:
    	[overridden := overridden satisfy: mark].!
----- Method: DBPlanner>>incrementalRemove: (in category 'adding') -----
incrementalRemove: c
    "Entry point for retracting a constraint. Remove the given constraint,
     which should be satisfied, and incrementally update the dataflow
     graph.
Details: Retracting the given constraint may allow some currently
     unsatisfiable downstream constraint be satisfied. We thus collect a
     list of unsatisfied downstream constraints and attempt to satisfy
     each one in turn. This list is sorted by constraint strength,
     strongest first, as a heuristic for avoiding unnecessarily adding
     and then overriding weak constraints."
| out unsatisfied |
    out := c output.
    c markUnsatisfied.
    c removeFromGraph.
    unsatisfied := self removePropagateFrom: out.
    unsatisfied do: [: u | self incrementalAdd: u].!
----- Method: DBPlanner>>initialize (in category 'initialize') -----
initialize
super initialize.
currentMark := 1.!
----- Method: DBPlanner>>makePlan: (in category 'planning') -----
makePlan: sources
    "Extract a plan for resatisfaction starting from the given satisfied
     source constraints, usually a set of input constraints. This method
     assumes that stay optimization is desired; the plan will contain only
     constraints whose output variables are not stay. Constraints that do
     no computation, such as stay and edit constraints, are not included
     in the plan.
Details: The outputs of a constraint are marked when it is added to
     the plan under construction. A constraint may be appended to the plan
     when all its input variables are known. A variable is known if either
     a) the variable is marked (indicating that has been computed by a
     constraint appearing earlier in the plan), b) the variable is 'stay'
     (i.e. it is a constant at plan execution time), or c) the variable
     is not determined by any constraint. The last provision is for past
     states of history variables, which are not stay but which are also
     not computed by any constraint."
| mark plan todo c |
    mark := self newMark.
    plan := DBPlan new.
    todo := sources.
    [todo isEmpty] whileFalse:
    	[c := todo removeFirst.
    	 ((c output mark ~= mark) and:		"not in plan already and..."
    	  [c inputsKnown: mark]) ifTrue:	"eligible for inclusion"
    		[plan addLast: c.
    		 c output mark: mark.
    		 self addConstraintsConsuming: c output to: todo]].
    ^ plan!
----- Method: DBPlanner>>newMark (in category 'private') -----
newMark
    "Select a previously unused mark value.
Details: We just keep incrementing. If necessary, the counter will
     turn into a LargePositiveInteger. In that case, it will be a bit
     slower to compute the next mark but the algorithms will all behave
     correctly. We reserve the value '0' to mean 'unmarked'. Thus, this
     generator starts at '1' and will never produce '0' as a mark value."
^currentMark := currentMark + 1!
----- Method: DBPlanner>>propagateFrom: (in category 'planning') -----
propagateFrom: v
    "The given variable has changed. Propagate new values downstream."
| todo c |
    todo := OrderedCollection new.
    self addConstraintsConsuming: v to: todo.
    [todo isEmpty] whileFalse:
    	[c := todo removeFirst.
    	 c execute.
    	 self addConstraintsConsuming: c output to: todo].!
----- Method: DBPlanner>>removePropagateFrom: (in category 'private') -----
removePropagateFrom: out
    "Update the walkabout strengths and stay flags of all variables
     downstream of the given constraint. Answer a collection of unsatisfied
     constraints sorted in order of decreasing strength."
| unsatisfied todo v |
    unsatisfied := SortedCollection sortBlock:
    	[ :c1 :c2 | c1 strength stronger: c2 strength].
    out determinedBy: nil.
    out walkStrength: DBStrength absoluteWeakest.
    out stay: true.
    todo := OrderedCollection with: out.
    [todo isEmpty] whileFalse:
    	[v := todo removeFirst.
    	 v constraints do:
    	 	[ :c | c isSatisfied ifFalse: [unsatisfied add: c]].
    	 self constraintsConsuming: v do:
    		[ :c |
    		 c recalculate.
    		 todo add: c output]].
    ^ unsatisfied!
Object subclass: #DBStrength
    instanceVariableNames: 'symbolicValue arithmeticValue'
    classVariableNames: 'AbsoluteStrongest AbsoluteWeakest Required StrengthConstants StrengthTable'
    poolDictionaries: ''
    category: 'CogBenchmarks-DeltaBlue'!
!DBStrength commentStamp: '<historical>' prior: 0!
Strengths are used to measure the relative importance of constraints. The hierarchy of available strengths is determined by the class variable StrengthTable (see my class initialization method). Because Strengths are invariant, references to Strength instances are shared (i.e. all references to
"Strength of: #required" point to a single, shared instance). New strengths may be inserted in the strength hierarchy without disrupting current constraints.
Instance variables:
    symbolicValue		symbolic strength name (e.g. #required) <Symbol>
    arithmeticValue		index of the constraint in the hierarchy, used for comparisons <Number>!
----- Method: DBStrength class>>absoluteStrongest (in category 'constants') -----
absoluteStrongest
^AbsoluteStrongest!
----- Method: DBStrength class>>absoluteWeakest (in category 'constants') -----
absoluteWeakest
^AbsoluteWeakest!
----- Method: DBStrength class>>initialize (in category 'initialize') -----
initialize
    "Initialize the symbolic strength table. Fix the internally caches
     values of all existing instances."
    "Strength initialize"
StrengthTable := Dictionary new.
    StrengthTable at: #absoluteStrongest put: -10000.
    StrengthTable at: #required put: -800.
    StrengthTable at: #strongPreferred put: -600.
    StrengthTable at: #preferred put: -400.
    StrengthTable at: #strongDefault put: -200.
    StrengthTable at: #default put: 0.
    StrengthTable at: #weakDefault put: 500.
    StrengthTable at: #absoluteWeakest put: 10000.
StrengthConstants := Dictionary new.
    StrengthTable keys do:
    	[: strengthSymbol |
    		StrengthConstants
    			at: strengthSymbol
    			put: ((super new) initializeWith: strengthSymbol)].
AbsoluteStrongest := DBStrength of: #absoluteStrongest.
    AbsoluteWeakest := DBStrength of: #absoluteWeakest.
    Required := DBStrength of: #required.!
----- Method: DBStrength class>>of: (in category 'instance creation') -----
of: aSymbol
    "Answer an instance with the specified strength."
^ StrengthConstants at: aSymbol!
----- Method: DBStrength class>>required (in category 'constants') -----
required
^Required!
----- Method: DBStrength>>arithmeticValue (in category 'private') -----
arithmeticValue
    "Answer my arithmetic value. Used for comparisons. Note that
     STRONGER constraints have SMALLER arithmetic values."
^arithmeticValue!
----- Method: DBStrength>>initializeWith: (in category 'private') -----
initializeWith: symVal
    "Record my symbolic value and reset my arithmetic value."
symbolicValue := symVal.
    arithmeticValue := StrengthTable at: symbolicValue.!
----- Method: DBStrength>>printOn: (in category 'printing') -----
printOn: aStream
    "Append a string which represents my strength onto aStream."
aStream nextPutAll: '%', symbolicValue, '%'.!
----- Method: DBStrength>>sameAs: (in category 'comparing') -----
sameAs: aStrength
    "Answer true if I am the same strength as the given Strength."
^ arithmeticValue = aStrength arithmeticValue!
----- Method: DBStrength>>stronger: (in category 'comparing') -----
stronger: aStrength
    "Answer true if I am stronger than the given Strength."
^ arithmeticValue < aStrength arithmeticValue!
----- Method: DBStrength>>strongest: (in category 'max / min') -----
strongest: aStrength
    "Answer the stronger of myself and aStrength."
^ (aStrength stronger: self)
    	ifTrue: [aStrength]
    	ifFalse: [self]!
----- Method: DBStrength>>weaker: (in category 'comparing') -----
weaker: aStrength
    "Answer true if I am weaker than the given Strength."
^ arithmeticValue > aStrength arithmeticValue!
----- Method: DBStrength>>weakest: (in category 'max / min') -----
weakest: aStrength
    "Answer the weaker of myself and aStrength."
^ (aStrength weaker: self)
    	ifTrue: [aStrength]
    	ifFalse: [self].!
Object subclass: #DBVariable
    instanceVariableNames: 'constraints determinedBy mark stay value walkStrength'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'CogBenchmarks-DeltaBlue'!
!DBVariable commentStamp: '<historical>' prior: 0!
I represent a constrained variable. In addition to my value, I maintain the structure of the constraint graph, the current dataflow graph, and various parameters of interest to the DeltaBlue incremental constraint solver.
Instance variables:
    value			my value; changed by constraints, read by client <Object>
    constraints		normal constraints that reference me <Array of Constraint>
    determinedBy	the constraint that currently determines
    				my value (or nil if there isn''t one) <Constraint>
    walkStrength		my walkabout strength <Strength>
    stay			true if I am a planning-time constant <Boolean>
    mark			used by the planner to mark constraints <Number>!
----- Method: DBVariable class>>value: (in category 'instance creation') -----
value: aValue
^self new value: aValue!
----- Method: DBVariable>>addConstraint: (in category 'accessing') -----
addConstraint: aConstraint
    "Add the given constraint to the set of all constraints that refer
     to me."
constraints add: aConstraint.!
----- Method: DBVariable>>constraints (in category 'accessing') -----
constraints
    ^ constraints!
----- Method: DBVariable>>determinedBy (in category 'accessing') -----
determinedBy
    ^ determinedBy!
----- Method: DBVariable>>determinedBy: (in category 'accessing') -----
determinedBy: anObject
    determinedBy := anObject!
----- Method: DBVariable>>initialize (in category 'initialize') -----
initialize
super initialize.
value := 0.
    constraints := OrderedCollection new: 2.
    determinedBy := nil.
    walkStrength := DBStrength absoluteWeakest.
    stay := true.
    mark := 0.!
----- Method: DBVariable>>longPrintOn: (in category 'printing') -----
longPrintOn: aStream
self shortPrintOn: aStream.
    aStream nextPutAll: '   Constraints: '.
    (constraints isEmpty)
    	ifTrue: [aStream cr; tab; nextPutAll: 'none']
    	ifFalse:
    		[constraints do:
    			[: c | aStream cr; tab. c shortPrintOn: aStream]].
    (determinedBy isNil) ifFalse:
    	[aStream cr; nextPutAll: '   Determined by: '.
    	 aStream cr; tab. determinedBy shortPrintOn: aStream].
    aStream cr.!
----- Method: DBVariable>>mark (in category 'accessing') -----
mark
    ^ mark!
----- Method: DBVariable>>mark: (in category 'accessing') -----
mark: anObject
    mark := anObject!
----- Method: DBVariable>>printOn: (in category 'printing') -----
printOn: aStream
self shortPrintOn: aStream!
----- Method: DBVariable>>removeConstraint: (in category 'accessing') -----
removeConstraint: c
    "Remove all traces of c from this variable."
constraints remove: c ifAbsent: [].
    determinedBy == c ifTrue: [determinedBy := nil].!
----- Method: DBVariable>>setValue: (in category 'update') -----
setValue: aValue
    "Attempt to assign the given value to me using a strength of
     #preferred."
self setValue: aValue strength: #preferred.!
----- Method: DBVariable>>setValue:strength: (in category 'update') -----
setValue: aValue strength: strengthSymbol
    "Attempt to assign the given value to me using the given strength."
| editConstraint |
    editConstraint := DBEditConstraint var: self strength: strengthSymbol.
    (editConstraint isSatisfied) ifTrue:
    	[self value: aValue.
    	 DBPlanner propagateFrom: self].
    editConstraint destroyConstraint.!
----- Method: DBVariable>>shortPrintOn: (in category 'printing') -----
shortPrintOn: aStream
aStream nextPutAll: 'V(', self printString, ', '.
    aStream nextPutAll: walkStrength printString, ', '.
    (stay isNil) ifFalse:
    	[aStream nextPutAll: (stay ifTrue: ['stay, '] ifFalse: ['changing, '])].
    aStream nextPutAll: value printString.
    aStream nextPutAll: ')'.
    aStream cr.!
----- Method: DBVariable>>stay (in category 'accessing') -----
stay
    ^ stay!
----- Method: DBVariable>>stay: (in category 'accessing') -----
stay: anObject
    stay := anObject!
----- Method: DBVariable>>value (in category 'accessing') -----
value
    ^ value!
----- Method: DBVariable>>value: (in category 'accessing') -----
value: anObject
    value := anObject!
----- Method: DBVariable>>walkStrength (in category 'accessing') -----
walkStrength
    ^ walkStrength!
----- Method: DBVariable>>walkStrength: (in category 'accessing') -----
walkStrength: anObject
    walkStrength := anObject!
Object subclass: #RichObject
    instanceVariableNames: ''
    classVariableNames: 'DeviceA DeviceB DevicePacketKind HandlerA HandlerB Idler WorkPacketKind Worker'
    poolDictionaries: ''
    category: 'CogBenchmarks-Richards'!
!RichObject commentStamp: '<historical>' prior: 0!
This class mostly adds some constants that are used in the Richards benchmarks.!
RichObject subclass: #RichDeviceTaskDataRecord
    instanceVariableNames: 'pending'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'CogBenchmarks-Richards'!
!RichDeviceTaskDataRecord commentStamp: '<historical>' prior: 0!
A task that suspends itself after each time it has been run to simulate waiting for data from an external device.
!
----- Method: RichDeviceTaskDataRecord>>pending (in category 'accessing') -----
pending
    ^ pending!
----- Method: RichDeviceTaskDataRecord>>pending: (in category 'accessing') -----
pending: anObject
    pending := anObject!
RichObject subclass: #RichHandlerTaskDataRecord
    instanceVariableNames: 'workIn deviceIn'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'CogBenchmarks-Richards'!
!RichHandlerTaskDataRecord commentStamp: '<historical>' prior: 0!
A task that manipulates work packets and then suspends itself.!
----- Method: RichHandlerTaskDataRecord>>deviceIn (in category 'accessing') -----
deviceIn
    ^ deviceIn!
----- Method: RichHandlerTaskDataRecord>>deviceIn: (in category 'accessing') -----
deviceIn: anObject
    deviceIn := anObject!
----- Method: RichHandlerTaskDataRecord>>deviceInAdd: (in category 'accessing') -----
deviceInAdd: packet
    deviceIn := self append: packet head: deviceIn!
----- Method: RichHandlerTaskDataRecord>>workIn (in category 'accessing') -----
workIn
    ^ workIn!
----- Method: RichHandlerTaskDataRecord>>workIn: (in category 'accessing') -----
workIn: anObject
    workIn := anObject!
----- Method: RichHandlerTaskDataRecord>>workInAdd: (in category 'accessing') -----
workInAdd: packet
    workIn := self append: packet head: workIn!
RichObject subclass: #RichIdleTaskDataRecord
    instanceVariableNames: 'control count'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'CogBenchmarks-Richards'!
!RichIdleTaskDataRecord commentStamp: '<historical>' prior: 0!
An idle task doesn't do any work itself but cycles control between the two device tasks.!
----- Method: RichIdleTaskDataRecord>>control (in category 'accessing') -----
control
    ^ control!
----- Method: RichIdleTaskDataRecord>>control: (in category 'accessing') -----
control: anObject
    control := anObject!
----- Method: RichIdleTaskDataRecord>>count (in category 'accessing') -----
count
    ^ count!
----- Method: RichIdleTaskDataRecord>>count: (in category 'accessing') -----
count: anObject
    count := anObject!
----- Method: RichIdleTaskDataRecord>>initialize (in category 'initialize') -----
initialize
    control := 1.
    	count := 10000!
----- Method: RichObject class>>initialize (in category 'initialize') -----
initialize
    super initialize.
    	DeviceA := 5.
    	DeviceB := 6.
    	DevicePacketKind := 1.
    	HandlerA := 3.
    	HandlerB := 4.
    	Idler := 1.
    	Worker := 2.
    	WorkPacketKind := 2!
----- Method: RichObject>>append:head: (in category 'utilities') -----
append: packet head: queueHead
    | mouse link |
    packet link: nil.
    queueHead ifNil: [ ^ packet ].
    mouse := queueHead.
    [ (link := mouse link) isNil]
    whileFalse: [ mouse := link ].
    mouse link: packet.
    ^ queueHead!
RichObject subclass: #RichPacket
    instanceVariableNames: 'data datum identity kind link'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'CogBenchmarks-Richards'!
!RichPacket commentStamp: '<historical>' prior: 0!
A simple package of data that is manipulated by the tasks.  The exact layout of the payload data carried by a packet is not importaint, and neither is the nature of the work performed on packets by the tasks. Besides carrying data, packets form linked lists and are hence used both as data and worklists.!
----- Method: RichPacket class>>create:identity:kind: (in category 'instance creation') -----
create: link identity: identity kind: kind 
    ^ self new
    	link: link
    	identity: identity
    	kind: kind!
----- Method: RichPacket>>data (in category 'accessing') -----
data
    ^ data!
----- Method: RichPacket>>datum (in category 'accessing') -----
datum
    ^ datum!
----- Method: RichPacket>>datum: (in category 'accessing') -----
datum: anObject
    datum := anObject!
----- Method: RichPacket>>identity (in category 'accessing') -----
identity
    ^ identity!
----- Method: RichPacket>>identity: (in category 'accessing') -----
identity: anObject
    identity := anObject!
----- Method: RichPacket>>kind (in category 'accessing') -----
kind
    ^ kind!
----- Method: RichPacket>>link (in category 'accessing') -----
link
    ^ link!
----- Method: RichPacket>>link: (in category 'accessing') -----
link: anObject
    link := anObject!
----- Method: RichPacket>>link:identity:kind: (in category 'initialize') -----
link: aLink identity: anIdentity kind: aKind 
    link := aLink.
    identity := anIdentity. 
    kind := aKind.
    datum := 1.
    data := ByteArray new: 4!
RichObject subclass: #RichRunner
    instanceVariableNames: 'taskList currentTask currentTaskIdentity taskTable queuePacketCount holdCount'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'CogBenchmarks-Richards'!
!RichRunner commentStamp: '<historical>' prior: 0!
Richards simulates the task dispatcher of an operating system.!
----- Method: RichRunner class>>start (in category 'starting') -----
start
    "RichardsBenchmark start"
^self new start!
----- Method: RichRunner>>createDevice:priority:work:state: (in category 'creation') -----
createDevice: identity priority: priority work: work state: state 
    | data |
    data := RichDeviceTaskDataRecord new.
    self
    createTask: identity
    priority: priority
    work: work
    state: state
    function: 
        [:work1 :word | | data1 functionWork |
        data1 := word.
        functionWork := work1.
        functionWork 
    	ifNil:
    	    [(functionWork := data1 pending) isNil
    		ifTrue: [self wait]
    		ifFalse: 
    		    [data1 pending: nil.
    		    self queuePacket: functionWork]]
    	ifNotNil: 
    	    [data1 pending: functionWork.
    	    self holdSelf]]
    data: data!
----- Method: RichRunner>>createHandler:priority:work:state: (in category 'creation') -----
createHandler: identity priority: priority work: work state: state 
    | data |
    data := RichHandlerTaskDataRecord new.
    self
    createTask: identity
    priority: priority
    work: work
    state: state
    function: 
        [:work1 :word | | data1 workPacket count devicePacket |
        data1 := word.
        work1 
    	ifNotNil: [WorkPacketKind == work1 kind 
    	    ifTrue: [data1 workInAdd: work1]
    	    ifFalse: [data1 deviceInAdd: work1]].
        (workPacket := data1 workIn) 
    	ifNil: [self wait]
    	ifNotNil: 
    	    [count := workPacket datum.
    	    count > 4
    		ifTrue: 
    		    [data1 workIn: workPacket link.
    		    self queuePacket: workPacket]
    		ifFalse:
    		    [(devicePacket := data1 deviceIn) 
    			ifNil: [self wait]
    			ifNotNil: 
    			    [data1 deviceIn: devicePacket link.
    			    devicePacket datum: (workPacket data at: count).
    			    workPacket datum: count + 1.
    			    self queuePacket: devicePacket]]]]
    data: data!
----- Method: RichRunner>>createIdler:priority:work:state: (in category 'creation') -----
createIdler: identity priority: priority work: work state: state 
    | data |
    data := RichIdleTaskDataRecord new.
    self
    createTask: identity
    priority: priority
    work: work
    state: state
    function: 
        [:work1 :word | | data1 |
        data1 := word.
        data1 count: data1 count - 1.
        0 = data1 count
    	ifTrue: [self holdSelf]
    	ifFalse:
    	    [0 = (data1 control bitAnd: 1)
    		ifTrue: 
    		    [data1 control: data1 control // 2.
    		    self release: DeviceA]
    		ifFalse: 
    		    [data1 control: (data1 control // 2 bitXor: 53256).
    		    self release: DeviceB]]]
    data: data!
----- Method: RichRunner>>createPacket:identity:kind: (in category 'creation') -----
createPacket: link identity: identity kind: kind 
    ^ RichPacket
    	create: link
    	identity: identity
    	kind: kind!
----- Method: RichRunner>>createTask:priority:work:state:function:data: (in category 'creation') -----
createTask: identity priority: priority work: work state: state function: aBlock data: data 
    | t |
    t := RichTaskControlBlock
    	link: taskList
    	create: identity
    	priority: priority
    	initialWorkQueue: work
    	initialState: state
    	function: aBlock
    	privateData: data.
    taskList := t.
    taskTable at: identity put: t!
----- Method: RichRunner>>createWorker:priority:work:state: (in category 'creation') -----
createWorker: identity priority: priority work: work state: state 
    | data |
    data := RichWorkerTaskDataRecord new.
    self
    createTask: identity
    priority: priority
    work: work
    state: state
    function: 
        [:work1 :word | | data1 |
        data1 := word.
        work1
    	ifNil: [self wait]
    	ifNotNil: 
    	    [data1 destination: (HandlerA = data1 destination
    		    ifTrue: [HandlerB]
    		    ifFalse: [HandlerA]).
    	    work1 identity: data1 destination.
    	    work1 datum: 1.
    	    1 to: 4 do: [ :i | 
    		data1 count: data1 count + 1.
    		data1 count > 26 ifTrue: [data1 count: 1].
    		work1 data at: i put: $A asInteger + data1 count - 1].
    	    self queuePacket: work1]]
    data: data!
----- Method: RichRunner>>findTask: (in category 'private') -----
findTask: identity 
    | t |
    t := taskTable at: identity.
    t ifNil: [self error: 'findTask failed'].
    ^ t!
----- Method: RichRunner>>holdSelf (in category 'private') -----
holdSelf
    holdCount := holdCount + 1.
    currentTask taskHolding: true.
    ^ currentTask link!
----- Method: RichRunner>>initScheduler (in category 'private') -----
initScheduler
    queuePacketCount := holdCount := 0.
    taskTable := Array new: 6.
    taskList := nil!
----- Method: RichRunner>>queuePacket: (in category 'private') -----
queuePacket: packet 
    | t |
    t := self findTask: packet identity.
    t ifNil: [ ^ nil ].
    queuePacketCount := queuePacketCount + 1.
    packet link: nil.
    packet identity: currentTaskIdentity.
    ^ t addInput: packet checkPriority: currentTask!
----- Method: RichRunner>>release: (in category 'private') -----
release: identity 
    | t |
    t := self findTask: identity.
    t ifNil: [ ^ nil ].
    t taskHolding: false.
    ^ t priority > currentTask priority
    ifTrue: [ t ]
    ifFalse: [ currentTask ]!
----- Method: RichRunner>>schedule (in category 'scheduling') -----
schedule
    currentTask := taskList. 
    [currentTask isNil]
    whileFalse: 
        [currentTask isTaskHoldingOrWaiting
    	ifTrue: [currentTask := currentTask link]
    	ifFalse: 
    	    [currentTaskIdentity := currentTask identity.
    	    currentTask := currentTask runTask]]!
----- Method: RichRunner>>start (in category 'initialize') -----
start
    | workQ |
    self initScheduler.
    self
    createIdler: Idler
    priority: 0
    work: nil
    state: RichTaskState running.
    workQ := self
    	createPacket: nil
    	identity: Worker
    	kind: WorkPacketKind.
    workQ := self
    	createPacket: workQ
    	identity: Worker
    	kind: WorkPacketKind.
    self
    createWorker: Worker
    priority: 1000
    work: workQ
    state: RichTaskState waitingWithPacket.
    workQ := self
    	createPacket: nil
    	identity: DeviceA
    	kind: DevicePacketKind.
    workQ := self
    	createPacket: workQ
    	identity: DeviceA
    	kind: DevicePacketKind.
    workQ := self
    	createPacket: workQ
    	identity: DeviceA
    	kind: DevicePacketKind.
    self
    createHandler: HandlerA
    priority: 2000
    work: workQ
    state: RichTaskState waitingWithPacket.
    workQ := self
    	createPacket: nil
    	identity: DeviceB
    	kind: DevicePacketKind.
    workQ := self
    	createPacket: workQ
    	identity: DeviceB
    	kind: DevicePacketKind.
    workQ := self
    	createPacket: workQ
    	identity: DeviceB
    	kind: DevicePacketKind.
    self
    createHandler: HandlerB
    priority: 3000
    work: workQ
    state: RichTaskState waitingWithPacket.
    self
    createDevice: DeviceA
    priority: 4000
    work: nil
    state: RichTaskState waiting.
    self
    createDevice: DeviceB
    priority: 5000
    work: nil
    state: RichTaskState waiting.
    self schedule.
    queuePacketCount = 23246 & (holdCount = 9297) ifFalse: [self error: 'wrong result'].
!
----- Method: RichRunner>>wait (in category 'private') -----
wait 
    currentTask taskWaiting: true.
    ^ currentTask!
RichObject subclass: #RichTaskState
    instanceVariableNames: 'packetPendingIV taskHolding taskWaiting'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'CogBenchmarks-Richards'!
!RichTaskState commentStamp: '<historical>' prior: 0!
Abstract task that manipulates work packets.!
RichTaskState subclass: #RichTaskControlBlock
    instanceVariableNames: 'link identity priority input state function handle'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'CogBenchmarks-Richards'!
!RichTaskControlBlock commentStamp: '<historical>' prior: 0!
A task control block manages a task and the queue of work packages associated with it.!
----- Method: RichTaskControlBlock class>>link:create:priority:initialWorkQueue:initialState:function:privateData: (in category 'instance creation') -----
link: link create: identity priority: priority initialWorkQueue: initialWorkQueue initialState: initialState function: aBlock privateData: privateData 
    ^ self new
    	link: link
    	identity: identity
    	priority: priority
    	initialWorkQueue: initialWorkQueue
    	initialState: initialState
    	function: aBlock
    	privateData: privateData!
----- Method: RichTaskControlBlock>>addInput:checkPriority: (in category 'scheduling') -----
addInput: packet checkPriority: oldTask
    input 
    ifNil: 
        [input := packet.
        packetPendingIV := true.
        priority > oldTask priority ifTrue: [ ^ self ]]
    ifNotNil: 
        [ input := self append: packet head: input ].
    ^ oldTask!
----- Method: RichTaskControlBlock>>identity (in category 'accessing') -----
identity
    ^ identity!
----- Method: RichTaskControlBlock>>link (in category 'accessing') -----
link
    ^ link!
----- Method: RichTaskControlBlock>>link:identity:priority:initialWorkQueue:initialState:function:privateData: (in category 'initialize') -----
link: aLink identity: anIdentity priority: aPriority initialWorkQueue: anInitialWorkQueue initialState: anInitialState function: aBlock privateData: aPrivateData 
    link := aLink.
    identity := anIdentity.
    priority := aPriority.
    input := anInitialWorkQueue.
    packetPendingIV := anInitialState isPacketPending.
    taskWaiting := anInitialState isTaskWaiting.
    taskHolding := anInitialState isTaskHolding.
    function := aBlock.
    handle := aPrivateData!
----- Method: RichTaskControlBlock>>priority (in category 'accessing') -----
priority
    ^ priority!
----- Method: RichTaskControlBlock>>runTask (in category 'scheduling') -----
runTask
    | message |
    self isWaitingWithPacket
    ifTrue: 
        [message := input.
        input := message link.
        input 
    	ifNil: [self running]
    	ifNotNil: [self packetPending]]
    ifFalse: [message := nil].
    ^ function value: message value: handle!
----- Method: RichTaskState class>>packetPending (in category 'instance creation') -----
packetPending
    ^super new packetPending!
----- Method: RichTaskState class>>running (in category 'instance creation') -----
running
    ^super new running!
----- Method: RichTaskState class>>waiting (in category 'instance creation') -----
waiting
    ^super new waiting!
----- Method: RichTaskState class>>waitingWithPacket (in category 'instance creation') -----
waitingWithPacket
    ^super new waitingWithPacket!
----- Method: RichTaskState>>isPacketPending (in category 'testing') -----
isPacketPending
    ^packetPendingIV!
----- Method: RichTaskState>>isRunning (in category 'testing') -----
isRunning
    ^packetPendingIV not and: [taskWaiting not and: [taskHolding not]]!
----- Method: RichTaskState>>isTaskHolding (in category 'testing') -----
isTaskHolding
    ^taskHolding!
----- Method: RichTaskState>>isTaskHoldingOrWaiting (in category 'testing') -----
isTaskHoldingOrWaiting
    ^taskHolding or: [packetPendingIV not and: [taskWaiting]]!
----- Method: RichTaskState>>isTaskWaiting (in category 'testing') -----
isTaskWaiting
    ^taskWaiting!
----- Method: RichTaskState>>isWaiting (in category 'testing') -----
isWaiting
    ^packetPendingIV not and: [taskWaiting and: [taskHolding not]]!
----- Method: RichTaskState>>isWaitingWithPacket (in category 'testing') -----
isWaitingWithPacket
    ^packetPendingIV and: [taskWaiting and: [taskHolding not]]!
----- Method: RichTaskState>>packetPending (in category 'initialize') -----
packetPending
    packetPendingIV := true.
    taskWaiting := false.
    taskHolding := false!
----- Method: RichTaskState>>running (in category 'initialize') -----
running
    packetPendingIV := taskWaiting := taskHolding := false!
----- Method: RichTaskState>>taskHolding: (in category 'accessing') -----
taskHolding: anObject
    ^ taskHolding := anObject!
----- Method: RichTaskState>>taskWaiting: (in category 'accessing') -----
taskWaiting: anObject
    ^ taskWaiting := anObject!
----- Method: RichTaskState>>waiting (in category 'initialize') -----
waiting
    packetPendingIV := taskHolding := false.
    taskWaiting := true!
----- Method: RichTaskState>>waitingWithPacket (in category 'initialize') -----
waitingWithPacket
    taskHolding := false.
    taskWaiting := packetPendingIV := true!
RichObject subclass: #RichWorkerTaskDataRecord
    instanceVariableNames: 'destination count'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'CogBenchmarks-Richards'!
!RichWorkerTaskDataRecord commentStamp: '<historical>' prior: 0!
A task that manipulates work packets.!
----- Method: RichWorkerTaskDataRecord>>count (in category 'accessing') -----
count
    ^ count!
----- Method: RichWorkerTaskDataRecord>>count: (in category 'accessing') -----
count: anObject
    count := anObject!
----- Method: RichWorkerTaskDataRecord>>destination (in category 'accessing') -----
destination
    ^ destination!
----- Method: RichWorkerTaskDataRecord>>destination: (in category 'accessing') -----
destination: anObject
    destination := anObject!
----- Method: RichWorkerTaskDataRecord>>initialize (in category 'as yet unclassified') -----
initialize
    destination := HandlerA.
    count := 0 !
Object subclass: #SMarkHarness
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'CogBenchmarks-SMark'!
!SMarkHarness commentStamp: '<historical>' prior: 0!
A benchmark harness steers the execution and reporting of benchmarks.
For that purpose, it will use a designated benchmark runner to do the execution and a benchmark reporter to output the results.
The benchmark harness is also parameterized by the benchmark suites that are to be executed.
The simplest way to execute a benchmark suite is to use SMarkSuite >> #run.
However, directly using the harness classes gives more freedom on reporting and execution strategies.
A typical call of the harness from the commandline would result in the following invokation:
    SMarkHarness run: {'SMarkHarness'. 'SMarkLoops.benchIntLoop'. 1. 1. 5}!
SMarkHarness subclass: #ReBenchHarness
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'CogBenchmarks-SMark'!
!ReBenchHarness commentStamp: 'StefanMarr 5/16/2011 09:10' prior: 0!
The ReBenchHarness is optimized for use from the command-line.
It is especially meant to be used together with ReBench, a tool to execute and document benchmarks reproducibly.
See: https://github.com/smarr/ReBench#readme!
----- Method: ReBenchHarness class>>defaultArgumentParser (in category 'helper') -----
defaultArgumentParser
    ^ ReBenchHarnessArgumentParser!
----- Method: ReBenchHarness class>>defaultReporter (in category 'defaults') -----
defaultReporter
    ^ ReBenchReporter!
----- Method: ReBenchHarness class>>defaultRunner (in category 'defaults') -----
defaultRunner
    ^ SMarkWeakScalingRunner!
----- Method: ReBenchHarness class>>usageBenchmarkParameters: (in category 'helper') -----
usageBenchmarkParameters: usage
    ^ usage,		' processes          optional, number of processes/threads used by the benchmarks', String crlf,
    			' inner-iterations   optional, number of iterations done by a single process', String crlf,
    			' problemSize        optional, depending on benchmark for instance size of used data set', String crlf.
    			!
----- Method: ReBenchHarness class>>usageHeader (in category 'helper') -----
usageHeader
    | usage |
    usage := 'SMark Benchmark Framework, version: ', self version, String crlf.
    usage := usage, String crlf.
    usage := usage, 'Usage: <vm+image> ', self name,
    			' <suiteOrBenchmark> [processes [inner-iterations [problemSize]]]', String crlf.
    usage := usage, String crlf.
    
    usage := usage, '  This harness is used for weak-scalling benchmarks.', String crlf.
    usage := usage, '  Use the SMarkHarness for more general settings, it offers more options.', String crlf.
    
    usage := usage, String crlf.
    ^ usage!
----- Method: ReBenchHarness class>>usageReporter: (in category 'helper') -----
usageReporter: usage
    "Will rely on default, which is good for ReBench, so do not advertise option."
    ^ usage!
----- Method: ReBenchHarness class>>usageRunner: (in category 'helper') -----
usageRunner: usage
    "Will rely on default, which is good for ReBench, so do not advertise option."
    ^ usage!
----- Method: SMarkHarness class>>defaultArgumentParser (in category 'helper') -----
defaultArgumentParser
    ^ SMarkHarnessArgumentParser!
----- Method: SMarkHarness class>>defaultOutputDestination (in category 'defaults') -----
defaultOutputDestination
    ^ Smalltalk at:       #ScriptConsole
                ifAbsent: [SMarkReporter defaultOutputDestination]!
----- Method: SMarkHarness class>>defaultReporter (in category 'defaults') -----
defaultReporter
    ^ SMarkReporter defaultReporter!
----- Method: SMarkHarness class>>defaultRunner (in category 'defaults') -----
defaultRunner
    ^ SMarkSuite defaultRunner!
----- Method: SMarkHarness class>>execute:andReport: (in category 'benchmarking') -----
execute: runner andReport: reporter
    runner reportConfiguration: self defaultOutputDestination.
    runner execute.
    reporter runner: runner.
    reporter outputStream: self defaultOutputDestination.
    reporter report.!
----- Method: SMarkHarness class>>execute:using:andReport: (in category 'benchmarking') -----
execute: aBenchmarkOrSuite using: aRunnerClass andReport: withAReporterClass
    | parsedBenchmarkOrSuite runner reporter |
    
    parsedBenchmarkOrSuite := self parseBenchmarkOrSuite: aBenchmarkOrSuite.
    
    runner := aRunnerClass new.
    reporter := withAReporterClass new.
    self instructRunner: runner with: parsedBenchmarkOrSuite.
    self execute: runner andReport: reporter.   !
----- Method: SMarkHarness class>>parseArguments: (in category 'helper') -----
parseArguments: arguments
    | parser |
    parser := self defaultArgumentParser new.
    parser harness: self.
    ^ parser parse: arguments.!
----- Method: SMarkHarness class>>run: (in category 'script entry') -----
run: arguments
    "Executed from the command line using something similar to
     ./vm my.image SMarkHarness SMarkRunner SMarkReporter SMarkLoops>>benchIntLoop 1 1 5
     ./vm my.image SMarkHarness SMarkRunner SMarkReporter SMarkLoops.benchIntLoop 1 1 5"
| runner reporter runnerAndReporter |
    
    (self shouldShowUsage: arguments)
    	ifTrue: [
    		self usage.
    		^ self.
    	].
    
    runnerAndReporter := self parseArguments: arguments.
    runner := runnerAndReporter first.
    reporter := runnerAndReporter second.  
    
    self execute: runner andReport: reporter. !
----- Method: SMarkHarness class>>shouldShowUsage: (in category 'helper') -----
shouldShowUsage: arguments
    
    arguments size < 2 ifTrue: [^ true ].
    
    ^ arguments anySatisfy: [:elem | (elem = '--help') or: [elem = '-?'] ].  !
----- Method: SMarkHarness class>>usage (in category 'helper') -----
usage
    | usage |
    "Example usage: SMarkHarness SMarkRunner SMarkReporter SMarkLoops.benchIntLoop 1 1 5"
    
    usage := self usageHeader.
    
    usage := usage, 'Arguments:', String crlf.
    usage := self usageRunner:   usage.
    usage := self usageReporter: usage.
    usage := usage, ' suiteOrBenchmark   required, either a SMarkSuite with benchmarks,', String crlf.
    usage := usage, '                              or a benchmark denoted by Suite.benchName', String crlf.
    usage := self usageBenchmarkParameters: usage.
    
    self defaultOutputDestination print: usage.!
----- Method: SMarkHarness class>>usageBenchmarkParameters: (in category 'helper') -----
usageBenchmarkParameters: usage
    ^ usage,	' iterations         optional, number of times the benchmarks are repeated', String crlf,
    			' processes          optional, number of processes/threads used by the benchmarks', String crlf,
    			' problemSize        optional, depending on benchmark for instance number of', String crlf,
    			'                              inner iterations or size of used data set', String crlf.
!
----- Method: SMarkHarness class>>usageHeader (in category 'helper') -----
usageHeader
    | usage |
    usage := 'SMark Benchmark Framework, version: ', self version, String crlf.
    usage := usage, String crlf.
    usage := usage, 'Usage: <vm+image> ', self name, ' [runner] [reporter] <suiteOrBenchmark>', String crlf.
    usage := usage, '                               [iterations [processes [problemSize]]]', String crlf.
    usage := usage, String crlf.
    ^ usage!
----- Method: SMarkHarness class>>usageReporter: (in category 'helper') -----
usageReporter: usage
    ^ usage,	' reporter           optional, a SMarkReporter class that processes', String crlf,
    			'                              and displays the results', String crlf.
    !
----- Method: SMarkHarness class>>usageRunner: (in category 'helper') -----
usageRunner: usage
    ^ usage, ' runner             optional, a SMarkRunner class that executes the benchmarks', String crlf.!
----- Method: SMarkHarness class>>version (in category 'helper') -----
version
    (Smalltalk classNamed: #ConfigurationOfBenchmarking)
    	ifNotNilDo: [:cfg |
    		^ cfg project currentVersion versionNumber asString.
    	].
      
    (Smalltalk classNamed: #MCPackage)
    	ifNotNilDo: [:mcp |
    		| package |
    		package := mcp named: 'SMark'.
    		package hasWorkingCopy ifTrue: [
    			^ package workingCopy ancestors first name.
    		].
    	].
    
    ^ ''.!
Object subclass: #SMarkHarnessArgumentParser
    instanceVariableNames: 'runner reporter suiteOrBenchmark iterations processes problemSize i current numParams currentObj arguments suite specificBenchmark suiteClass harness'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'CogBenchmarks-SMark'!
SMarkHarnessArgumentParser subclass: #ReBenchHarnessArgumentParser
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'CogBenchmarks-SMark'!
----- Method: ReBenchHarnessArgumentParser>>determineBenchmarkParametersFromArguments (in category 'argument parsing') -----
determineBenchmarkParametersFromArguments
    i := i + 1.
    i <= numParams ifTrue: [
    	processes := (arguments at: i) asInteger.
    	i := i + 1.
    	i <= numParams ifTrue: [
    		iterations := (arguments at: i) asInteger.
    		i := i + 1.
    		i <= numParams ifTrue: [
    			problemSize := arguments at: i.
    		]
    	]
    ].!
----- Method: ReBenchHarnessArgumentParser>>determineReporter (in category 'argument parsing') -----
determineReporter
    reporter := harness defaultReporter new.!
----- Method: ReBenchHarnessArgumentParser>>determineRunner (in category 'argument parsing') -----
determineRunner
    runner := harness defaultRunner new.!
----- Method: ReBenchHarnessArgumentParser>>instructRunner (in category 'helper') -----
instructRunner
    super instructRunner.
    
    runner iterations: runner class defaultNumberOfIterations.
    runner innerIterations: iterations.!
----- Method: SMarkHarnessArgumentParser>>determineBenchmarkParameters (in category 'argument parsing') -----
determineBenchmarkParameters
    "Initialize with defaults, will be overwritten in case
     it is specified."
    iterations := runner class defaultNumberOfIterations.
    processes  := runner class defaultNumberOfProcesses.
    problemSize:= suiteClass defaultProblemSize.
    
    self determineBenchmarkParametersFromArguments.!
----- Method: SMarkHarnessArgumentParser>>determineBenchmarkParametersFromArguments (in category 'argument parsing') -----
determineBenchmarkParametersFromArguments
    i := i + 1.
    i <= numParams ifTrue: [
    	iterations := (arguments at: i) asInteger.
    	i := i + 1.
    	i <= numParams ifTrue: [
    		processes := (arguments at: i) asInteger.
    		i := i + 1.
    		i <= numParams ifTrue: [
    			problemSize := arguments at: i.
    		]
    	]
    ].!
----- Method: SMarkHarnessArgumentParser>>determineReporter (in category 'argument parsing') -----
determineReporter
    (currentObj isKindOf: SMarkReporter)
    	ifFalse: [ reporter := harness defaultReporter new. ]
    	ifTrue:  [ reporter := currentObj.
    		i := i + 1.
    		i <= numParams ifTrue: [
    			current := arguments at: i.
    		]
    	].!
----- Method: SMarkHarnessArgumentParser>>determineRunner (in category 'argument parsing') -----
determineRunner
    (currentObj isKindOf: SMarkRunner)
    	ifFalse: [ runner := harness defaultRunner new. ]
    	ifTrue:  [ runner := currentObj.
    		i := i + 1.
    		i <= numParams ifTrue: [
    			current := arguments at: i.
    			currentObj := (Smalltalk classNamed: current) ifNotNilDo: [:cls | cls new].
    		]
    	].!
----- Method: SMarkHarnessArgumentParser>>determineSuiteOrBenchmark (in category 'argument parsing') -----
determineSuiteOrBenchmark
    self parseBenchmarkOrSuite: current.!
----- Method: SMarkHarnessArgumentParser>>harness: (in category 'accessing') -----
harness: aHarness
    harness := aHarness!
----- Method: SMarkHarnessArgumentParser>>instructRunner (in category 'helper') -----
instructRunner
    suite := suiteClass new.
    specificBenchmark ifNotNil: [
    	suite runOnly: specificBenchmark.
    ].
    
    runner suite: suite.
    runner iterations: iterations.
    runner processes: processes.
    runner problemSize: problemSize.!
----- Method: SMarkHarnessArgumentParser>>parse: (in category 'parsing') -----
parse: argumentsArray
    arguments := argumentsArray.
    numParams := arguments size.
    
    i := 2.
    current := arguments at: i.
    currentObj := (Smalltalk classNamed: current) ifNotNilDo: [:cls | cls new].
    	
    self determineRunner.
    self determineReporter.
    
    self determineSuiteOrBenchmark.
    
    self determineBenchmarkParameters.
    
    self instructRunner.
    
    ^ {runner. reporter}!
----- Method: SMarkHarnessArgumentParser>>parseBenchmarkOrSuite: (in category 'argument parsing') -----
parseBenchmarkOrSuite: aBenchmarkOrSuite
    "Identify the benchmark suite or suite and benchmark method
     that should be executed. The string should be of the format 'Class>>benchName' or 'Class.benchName' for shell/bash compatibility.
     Accepts a string, class, or array.
     Returns, a class, or an array of a class and a symbol."
    | parsed |
    (aBenchmarkOrSuite isKindOf: Class)
    	ifTrue: [
    		suiteClass := aBenchmarkOrSuite.
    		^ suiteClass
    	].
      
    (aBenchmarkOrSuite isKindOf: Array)
    	ifTrue:  [ parsed := aBenchmarkOrSuite. ]
    	ifFalse: [ parsed := aBenchmarkOrSuite findTokens: '>.'. ].
    
    ((parsed size > 2) or: [parsed size < 1])
    			ifTrue: [ Error signal: 'The passed argument has to represent two elements. A class/classname and a method symbol' ].
    
    suiteClass := parsed first.
    
    (suiteClass isKindOf: Class) 
    	ifFalse: [ suiteClass := Smalltalk at: (suiteClass asSymbol) ifAbsent: [Error signal: 'Class that was supposed to represent a benchmark suite was not found: ', suiteClass asString ]].
    
    parsed size = 1
    	ifTrue: [^suiteClass].
specificBenchmark := parsed second asSymbol.
    
    ^ { suiteClass. specificBenchmark }
!
Object subclass: #SMarkReporter
    instanceVariableNames: 'runner stream'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'CogBenchmarks-SMark'!
!SMarkReporter commentStamp: '<historical>' prior: 0!
SMarkReporter is a simple formatter of benchmark results.
Subclass such as SMarkSimpleStatisticsReporter might implement more advanced reporting functionality, e.g., including a statistical evaluation of the results.
Example:
| f |
    f := TextStream on: String new.
    SMarkSimpleStatisticsReporter reportFor: (SMarkTestRunnerSuiteForAutosizing run: 10) on: f.
    f contents!
----- Method: SMarkReporter class>>defaultOutputDestination (in category 'defaults') -----
defaultOutputDestination
    ^ ScriptConsole!
----- Method: SMarkReporter class>>defaultReporter (in category 'defaults') -----
defaultReporter
    ^ SMarkSimpleStatisticsReporter!
----- Method: SMarkReporter class>>reportFor: (in category 'reporting') -----
reportFor: aRunner
    self reportFor: aRunner on: self defaultOutputDestination.!
----- Method: SMarkReporter class>>reportFor:on: (in category 'reporting') -----
reportFor: aRunner on: aStream
    | reporter |
    reporter := self new.
    reporter runner: aRunner.
    reporter outputStream: aStream.
    reporter report.
    ^ reporter.!
----- Method: SMarkReporter>>benchmarkFooter: (in category 'reporting') -----
benchmarkFooter: aName
    stream cr.!
----- Method: SMarkReporter>>benchmarkHeader: (in category 'reporting') -----
benchmarkHeader: aName
    stream << 'Benchmark ' << (aName asString); cr.!
----- Method: SMarkReporter>>footer (in category 'reporting') -----
footer
    "No output at the moment"
    ^ self!
----- Method: SMarkReporter>>header (in category 'reporting') -----
header
    | suiteName |
    suiteName := runner suite class name asString.
    stream << 'Report for: ' << suiteName; cr.!
----- Method: SMarkReporter>>initialize (in category 'initialization') -----
initialize
    super initialize.
    stream := self class defaultOutputDestination.!
----- Method: SMarkReporter>>outputStream: (in category 'accessing') -----
outputStream: aStream
    stream := aStream  !
----- Method: SMarkReporter>>report (in category 'accessing') -----
report
    self header.
    
    runner results keysAndValuesDo: [:key :value |
    	self benchmarkHeader: key.
    	self reportAllRuns: value of: key.
    	self benchmarkFooter: key.
    ].
self footer.
    ^ self!
----- Method: SMarkReporter>>reportAllRuns:of: (in category 'reporting') -----
reportAllRuns: aListOfResults of: benchmark
    aListOfResults do: [:result |
    	result criteria keysAndValuesDo: [:benchName :timer |
    		stream << benchName << ': ' << (timer totalTime asString, 'ms'); cr.]]!
----- Method: SMarkReporter>>runner: (in category 'accessing') -----
runner: aRunner
    runner := aRunner.!
SMarkReporter subclass: #SMarkSimpleStatisticsReporter
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'CogBenchmarks-SMark'!
SMarkSimpleStatisticsReporter subclass: #ReBenchReporter
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'CogBenchmarks-SMark'!
!ReBenchReporter commentStamp: '<historical>' prior: 0!
A ReBenchReporter is reporter for the ReBench framework (cf. https://github.com/smarr/ReBench).
It is used be the ReBenchHarness, which is the main class of interest for users that just want to execute benchmarks.!
----- Method: ReBenchReporter>>benchmarkHeader: (in category 'as yet unclassified') -----
benchmarkHeader: aName
    ^ self!
----- Method: SMarkSimpleStatisticsReporter>>confidenceVariance: (in category 'statistics') -----
confidenceVariance: times
    | numMeasurements |
    numMeasurements := times size.
    (numMeasurements >= 30) 
    	ifTrue: [
    		^ (self gaussianConfidenceFactor) * (times stdev) / (numMeasurements asFloat sqrt)].
    	
    "use the students T distribution for small probe counts"
    ^ (self studentsTConfidenceFactorFor: numMeasurements) * (times stdev) / (numMeasurements asFloat sqrt)!
----- Method: SMarkSimpleStatisticsReporter>>gaussianConfidenceFactor (in category 'statistics') -----
gaussianConfidenceFactor
    "used for large probe counts >= 30"
    "1 ~ 68.27%"
    "1.644853626951 ~ 90%"
    "2 ~ 95.45%"
    ^ 1.644853626951!
----- Method: SMarkSimpleStatisticsReporter>>reportAllRuns:of: (in category 'reporting') -----
reportAllRuns: aListOfResults of: benchmark
    | criteria |
criteria := aListOfResults first criteria.
    
    criteria keysDo: [:criterion |
    	| times |
    	times := self resultsFor: criterion from: aListOfResults.
    	self reportResult: times for: criterion of: benchmark.
    	stream cr.
    ].!
----- Method: SMarkSimpleStatisticsReporter>>reportResult:for:of: (in category 'reporting') -----
reportResult: aResultsArray for: aCriterion of: benchmark
    | convidenceVariance significantDigits |
stream << benchmark <<  ' ' <<  aCriterion <<  ': iterations='.
    aResultsArray size printOn: stream .
    stream << ' runtime: '.
    
    aResultsArray size < 2 ifTrue: [
    	aResultsArray average printOn: stream.
    	stream << 'ms'.
    	^ self.
    ].
    
    convidenceVariance := self confidenceVariance: aResultsArray.  
    
    "only print significant "
    significantDigits := self significantDigits: convidenceVariance.
aResultsArray average printOn: stream showingDecimalPlaces: significantDigits.
    stream << 'ms +/-'.
    convidenceVariance printOn: stream showingDecimalPlaces: significantDigits.!
----- Method: SMarkSimpleStatisticsReporter>>resultsFor:from: (in category 'helper') -----
resultsFor: aCriterion from: aListOfResults
    ^aListOfResults collect: [:result | (result criteria at: aCriterion) totalTime]
    !
----- Method: SMarkSimpleStatisticsReporter>>significantDigits: (in category 'statistics') -----
significantDigits: confidenceVariance
    confidenceVariance = 0 
    	ifTrue: [ ^ 2].
    
    confidenceVariance >= 10
    	ifTrue: [ ^ 0].
    
    ^ 1 - (confidenceVariance log floor)!
----- Method: SMarkSimpleStatisticsReporter>>studentsTConfidenceFactorFor: (in category 'statistics') -----
studentsTConfidenceFactorFor: aNumberOfMeasurements
    "used for small probe counts < 30"
    "the students T distribution sucks to calculate since the value depends on the probeCout"
    "these values are for a confidence interval of ~90%"
    | values |
    values := Array new: 30.
    values at: 1  put: 6.314.
    values at: 2  put: 2.920.
    values at: 3  put: 2.353.
    values at: 4  put: 2.132.
    values at: 5  put: 2.015.
    values at: 6  put: 1.943.
    values at: 7  put: 1.895.
    values at: 8  put: 1.860.
    values at: 9  put: 1.833.
    values at: 10 put: 1.812.
    values at: 11 put: 1.796.
    values at: 12 put: 1.782.
    values at: 13 put: 1.771.
    values at: 14 put: 1.761.
    values at: 15 put: 1.753.
    values at: 16 put: 1.746.
    values at: 17 put: 1.740.
    values at: 18 put: 1.734.
    values at: 19 put: 1.729.
    values at: 20 put: 1.725.
    values at: 21 put: 1.721.
    values at: 22 put: 1.717.
    values at: 23 put: 1.714.
    values at: 24 put: 1.711.
    values at: 25 put: 1.708.
    values at: 26 put: 1.706.
    values at: 27 put: 1.703.
    values at: 28 put: 1.701.
    values at: 29 put: 1.699.
    values at: 30 put: 1.697.
    ^ values at: aNumberOfMeasurements.
    !
----- Method: SMarkSimpleStatisticsReporter>>totalResultsFor: (in category 'helper') -----
totalResultsFor: aListOfResults
    ^aListOfResults collect: [:timer | timer total]
    !
Object subclass: #SMarkResult
    instanceVariableNames: 'time benchName suite criteria'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'CogBenchmarks-SMark'!
!SMarkResult commentStamp: 'StefanMarr 3/18/2011 23:45' prior: 0!
A benchmark result is characterized by:
 - the total execution time (#total is the least a benchmark results in)
 - the name of the benchmark that was executed
 - the suite object specifies the used input used for the benchmark
 - dictionary of additional the criteria and the related timings
A benchmark can produced multiple resuts for different criteria. The standard criterion is #total.!
----- Method: SMarkResult>>benchmarkName (in category 'accessing') -----
benchmarkName
    ^ benchName!
----- Method: SMarkResult>>benchmarkName: (in category 'accessing') -----
benchmarkName: aString
    benchName := aString!
----- Method: SMarkResult>>criteria (in category 'accessing') -----
criteria
    ^ criteria!
----- Method: SMarkResult>>criteria: (in category 'accessing') -----
criteria: aCollectionOfTimers
    criteria := aCollectionOfTimers!
----- Method: SMarkResult>>suite (in category 'accessing') -----
suite
    ^ suite!
----- Method: SMarkResult>>suite: (in category 'accessing') -----
suite: aBenchmarkSuite
    suite := aBenchmarkSuite!
----- Method: SMarkResult>>total (in category 'accessing') -----
total
    ^ time!
----- Method: SMarkResult>>total: (in category 'accessing') -----
total: aTime
    time := aTime!
Object subclass: #SMarkRunner
    instanceVariableNames: 'numIterations suite runner results currentBenchmark timers problemSize numProcesses'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'CogBenchmarks-SMark'!
SMarkRunner subclass: #SMarkAutosizeRunner
    instanceVariableNames: 'targetTime innerLoopIterations'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'CogBenchmarks-SMark'!
----- Method: SMarkAutosizeRunner class>>defaultTargetTime (in category 'defaults') -----
defaultTargetTime
    "300 milliseconds seems to be a reasonable target time for most problems.
     It is a compromise between the general measurment noise as well as timer accuracy
     and the absolute runtime of benchmarks"
    ^ 300!
----- Method: SMarkAutosizeRunner>>initialize (in category 'initialization') -----
initialize
    super initialize.
    targetTime := self class defaultTargetTime.!
----- Method: SMarkAutosizeRunner>>performBenchmark: (in category 'benchmarking') -----
performBenchmark: aSelector
    "First determine a useful number of inner loop iterations until the targetTime is reached."
    | execTime i |
    "make sure no timers are recorded for this"
    timers := nil.
    
    i := 1.
    execTime := Time millisecondsToRun: [ suite perform: aSelector. ].
    
    [ execTime > targetTime ] whileFalse: [
    	i := i * 2. "Was thinking of doing something fancy here, but just go with this simple staight-forward solution"
    	execTime := Time millisecondsToRun: [ 1 to: i do: [:ignored| suite perform: aSelector]].
    ].
innerLoopIterations := i.
    
    "Then start executing the benchmark"
    ^ super performBenchmark: aSelector.!
----- Method: SMarkAutosizeRunner>>runBaseBenchmark (in category 'benchmarking') -----
runBaseBenchmark
    "baseBenchmark is not supported with autosizing. I do not see how that can be made possible since all different benchmarks will have different number of iterations, and the only way how a consistent baseline could be found would be to normalize the results, but well, incooprorating the baseline measurement with the statistical evaluation is harder than just substracting a one time value..., I am not going to do that here for the moment. Stefan 2011-03-20"
    
    (suite respondsTo: #baseBenchmark) 
    	ifFalse: [ ^ nil ].
    
    "I decided to go here with a silent solution to avoid thinking about logging frameworks and Transcript to console convertion..."
    self recordResults: (self class defaultTimer new: 'total') for: #baseBenchmark  !
----- Method: SMarkAutosizeRunner>>targetTime (in category 'accessing') -----
targetTime
    "Target time in milliseconds"
    ^ targetTime!
----- Method: SMarkAutosizeRunner>>targetTime: (in category 'accessing') -----
targetTime: anIntInMilliseconds
    "Target time in milliseconds"
    targetTime := anIntInMilliseconds!
----- Method: SMarkAutosizeRunner>>timedBenchmarkExecution: (in category 'benchmarking') -----
timedBenchmarkExecution: aSelector
    "Will do a timed execution of the benchmark and return the result timer"
    | timer |
    timers := Dictionary new.
timer := self createTimer: 'total'.
    
    timer start.
    1 to: innerLoopIterations do: [:ignored|
    	suite perform: aSelector.
    ].
    timer stop.
    
    self recordResults: timer for: aSelector.
    
    ^ timer!
SMarkRunner subclass: #SMarkCogRunner
    instanceVariableNames: 'warmingUp'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'CogBenchmarks-SMark'!
!SMarkCogRunner commentStamp: 'StefanMarr 12/30/2011 23:24' prior: 0!
This runner is doing warmup on for Cog VMs with just-in-time compilation.
The goal is to bring the JIT compiler into a steady state where no jitting is performed anymore during benchmarking.!
----- Method: SMarkCogRunner>>initialize (in category 'initialization') -----
initialize
    super initialize.
    warmingUp := false.!
----- Method: SMarkCogRunner>>performBenchmark: (in category 'initialization') -----
performBenchmark: aSelector
    "Based on an email by Eliot from May 16th, 2011.
     The first time a method is executed it will get into the inline cache.
     The second time, it is found in the inline cache, which triggers the JIT compiler to produce code.
     Thus, the third time it should be executed in the steady state."
    warmingUp := true.
    	suite runBenchmark: aSelector.
    	Smalltalk garbageCollect.
    	suite runBenchmark: aSelector.
    	Smalltalk garbageCollect.
    warmingUp := false.
    
    ^ super performBenchmark: aSelector.!
----- Method: SMarkCogRunner>>recordResults:for: (in category 'initialization') -----
recordResults: timer for: aSelector
    "Only record the results when we are not in warmup mode."
    warmingUp ifFalse: [
    	super recordResults: timer for: aSelector.
    ].!
SMarkRunner subclass: #SMarkProfileRunner
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'CogBenchmarks-SMark'!
!SMarkProfileRunner commentStamp: '<historical>' prior: 0!
This runner profiles the benchmarks for better analysis. Unlike the classical benchmark runner this one will not collect the results. Instead it will execute the benchmarks in the system profiler.!
----- Method: SMarkProfileRunner class>>execute:selector: (in category 'profiling') -----
execute: aSuite selector: aBenchmarkSelector
    | runner |
    runner := self new.
    aSuite runner: runner.
    runner 
    	suite: aSuite;
    	execute: aBenchmarkSelector.
    ^ runner!
----- Method: SMarkProfileRunner class>>execute:selector:iterations: (in category 'profiling') -----
execute: aSuite selector: aBenchmarkSelector iterations: nIterations
    | runner |
    runner := self new.
    aSuite runner: runner.
    runner 
    	suite: aSuite;
    	iterations: nIterations;
    	execute: aBenchmarkSelector.
    ^ runner!
----- Method: SMarkProfileRunner>>execute (in category 'profiling') -----
execute
    "run all benchmnarks in a benchmark suite "
    [ suite run ] timeProfile!
----- Method: SMarkProfileRunner>>execute: (in category 'profiling') -----
execute: aSelector
    
    [ self performBenchmark: aSelector ] timeProfile!
----- Method: SMarkProfileRunner>>initialize (in category 'initialization') -----
initialize
    super initialize.
    numIterations := 1.!
----- Method: SMarkProfileRunner>>performBenchmark: (in category 'benchmarks') -----
performBenchmark: aSelector
    currentBenchmark := aSelector.
    
    1 to: numIterations do: [:i|
    	suite runBenchmark: aSelector ].	
    
    currentBenchmark := nil.!
----- Method: SMarkProfileRunner>>timedBenchmarkExecution: (in category 'benchmarks') -----
timedBenchmarkExecution: aSelector
    suite perform: aSelector!
----- Method: SMarkRunner class>>defaultNumberOfIterations (in category 'defaults') -----
defaultNumberOfIterations
    ^ 1!
----- Method: SMarkRunner class>>defaultNumberOfProcesses (in category 'defaults') -----
defaultNumberOfProcesses
    ^ 1!
----- Method: SMarkRunner class>>defaultTimer (in category 'defaults') -----
defaultTimer
    ^ SMarkTimer!
----- Method: SMarkRunner class>>execute: (in category 'benchmarking') -----
execute: aSuite
    ^ self execute: aSuite with: 1.!
----- Method: SMarkRunner class>>execute:with: (in category 'benchmarking') -----
execute: aSuite with: nIterations
    | runner |
    runner := self new.
    aSuite runner: runner.
    runner suite: aSuite.
    runner iterations: nIterations.  
    runner execute.
    ^ runner!
----- Method: SMarkRunner>>createTimer: (in category 'helper') -----
createTimer: name
    "Create and register a new timer for the current benchmark"
    | timer |
    timer := self class defaultTimer new: name.
    
    timers ifNotNil: [
    	timers at: name put: timer.
    ].
    
    ^ timer.!
----- Method: SMarkRunner>>execute (in category 'execution') -----
execute
    suite run.
    self runBaseBenchmark.
    ^ results
    !
----- Method: SMarkRunner>>initialize (in category 'initialization') -----
initialize
    super initialize.
    numIterations := self class defaultNumberOfIterations.
    numProcesses  := self class defaultNumberOfProcesses.
    results := Dictionary new.!
----- Method: SMarkRunner>>iterations (in category 'accessing') -----
iterations
    ^ numIterations!
----- Method: SMarkRunner>>iterations: (in category 'accessing') -----
iterations: anInteger
    numIterations := anInteger!
----- Method: SMarkRunner>>performBenchmark: (in category 'benchmarking') -----
performBenchmark: aSelector
    currentBenchmark := aSelector.
    
    1 to: numIterations do: [:i|
    	"self timedBenchmarkExecution: aSelector."
    	suite runBenchmark: aSelector.  
    ].	
    
    currentBenchmark := nil.
    
    ^ results at: (suite benchmarkNameForSelector: aSelector)!
----- Method: SMarkRunner>>printOn: (in category 'printing') -----
printOn: aStream
    ^ self reportOn: aStream.!
----- Method: SMarkRunner>>problemSize (in category 'accessing') -----
problemSize
    <omniUnenforced> "Hint for the OMOP that it is part of the meta infrastructure"
    ^ problemSize!
----- Method: SMarkRunner>>problemSize: (in category 'accessing') -----
problemSize: aValue
    "Do some conversion to make it easier for the benchmarks"
    (aValue isString and: [aValue isAllDigits]) ifTrue: [
    	problemSize := Number readFrom: aValue.
    	^ self.
    ].
problemSize := aValue!
----- Method: SMarkRunner>>processes (in category 'accessing') -----
processes
    "The standard runner does use only a single process, but in case a benchmark supports parallelism it can query for the intended degree of parallelism"
    ^ numProcesses!
----- Method: SMarkRunner>>processes: (in category 'accessing') -----
processes: anInt
    "The standard runner does use only a single process, but a benchmark can use that to do its own parallelism"
    numProcesses := anInt!
----- Method: SMarkRunner>>recordResults:for: (in category 'helper') -----
recordResults: timer for: aSelector
    | result name |
    name := suite benchmarkNameForSelector: aSelector.
    
    result := SMarkResult new.
    result total: timer totalTime.
    result benchmarkName: name.
    result suite: suite.
    result criteria: timers.
    
    (results at: name ifAbsentPut: OrderedCollection new) add: result.!
----- Method: SMarkRunner>>report (in category 'accessing') -----
report
    SMarkReporter defaultReporter reportFor: self.  
    !
----- Method: SMarkRunner>>reportConfiguration: (in category 'reporting') -----
reportConfiguration: aStream
    aStream << 'Runner Configuration:';cr.
    aStream << ('  iterations: ', numIterations asString); cr.
    aStream << ('  processes: ', numProcesses asString); cr.
    aStream << ('  problem size: ', problemSize asString); cr.
!
----- Method: SMarkRunner>>reportOn: (in category 'reporting') -----
reportOn: aStream
    SMarkReporter defaultReporter reportFor: self on: aStream  
    !
----- Method: SMarkRunner>>results (in category 'accessing') -----
results
    ^ results!
----- Method: SMarkRunner>>runBaseBenchmark (in category 'benchmarking') -----
runBaseBenchmark
    "In certain sitatuations it is one wants a baseline that is incooprated in all 
     benchmark results to be substracted from the final values.
    
    #baseBenchmark can be used to charaterize such a baseline"
    
    (suite respondsTo: #baseBenchmark) 
    	ifFalse: [ ^ nil ].
    
    ^ self performBenchmark: #baseBenchmark.!
----- Method: SMarkRunner>>suite (in category 'accessing') -----
suite
    ^ suite!
----- Method: SMarkRunner>>suite: (in category 'accessing') -----
suite: aBenchmarkSuite
    suite := aBenchmarkSuite.
    suite runner: self.!
----- Method: SMarkRunner>>timedBenchmarkExecution: (in category 'benchmarking') -----
timedBenchmarkExecution: aSelector
    "Will do a timed execution of the benchmark and return the result timer"
    | timer result |
    timers := Dictionary new.
timer := self createTimer: 'total'.
    
    timer start.
    result := suite perform: aSelector.
    timer stop.
    suite processResult: result withTimer: timer.
    
    self recordResults: timer for: aSelector.
    
    ^ timer!
SMarkRunner subclass: #SMarkWeakScalingRunner
    instanceVariableNames: 'numInnerIterations runningProcesses completionSignal runningProcessesMtx'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'CogBenchmarks-SMark'!
----- Method: SMarkWeakScalingRunner class>>defaultNumberOfInnerIterations (in category 'defaults') -----
defaultNumberOfInnerIterations
    "The number of iterations of the inner loop
     in which the benchmark is executed."
    ^ 1!
----- Method: SMarkWeakScalingRunner>>execute:withProcesses:withTimer: (in category 'benchmarking') -----
execute: aSelector withProcesses: numberOfProcesses withTimer: timer
    "This case is meant for all cases. REM: this is also used for numProc==1 to be able to measure the process start overhead in all cases.
     It will start the processes and wait for their completion."
    
    | processes |
    processes			:= Array new: numberOfProcesses.
    runningProcessesMtx := Semaphore forMutualExclusion.
    completionSignal		:= Semaphore new.
    runningProcesses := numberOfProcesses.
    
    "First initialize the processes"
    1 to: numberOfProcesses do: [ :procNum |
    	| proc |
    	proc := SMarkWeakScalingRunnerExecutor createFor: aSelector for: numInnerIterations with: self and: suite.
    	proc priority: Processor highestPriority.
    	proc name: (self class name, '-',  procNum asString).
    	processes at: procNum put: proc.
    	"On: procNum"
    ].
    
    "Now, execute the benchmark and do the timing now"
    timer start.
    1 to: numberOfProcesses do: [ :procNum |
    	(processes at: procNum) resume.
    ].
    completionSignal wait.
    timer stop.
    !
----- Method: SMarkWeakScalingRunner>>executorCompleted (in category 'benchmarking') -----
executorCompleted
    runningProcessesMtx critical: [
    	runningProcesses := runningProcesses - 1.
    	(runningProcesses == 0) ifTrue: [
    		completionSignal signal.
    	]
    ]!
----- Method: SMarkWeakScalingRunner>>initialize (in category 'initialization') -----
initialize
    super initialize.
    numProcesses			:= self class defaultNumberOfProcesses.
    numInnerIterations	:= self class defaultNumberOfInnerIterations.
!
----- Method: SMarkWeakScalingRunner>>innerIterations (in category 'benchmarking') -----
innerIterations
    "The number of inner iterations the benchmark is executed inside a processes"
    ^ numInnerIterations!
----- Method: SMarkWeakScalingRunner>>innerIterations: (in category 'benchmarking') -----
innerIterations: anInteger
    "The number of inner iterations the benchmark is executed inside a processes"
    numInnerIterations := anInteger!
----- Method: SMarkWeakScalingRunner>>processes (in category 'benchmarking') -----
processes
    ^ numProcesses!
----- Method: SMarkWeakScalingRunner>>processes: (in category 'benchmarking') -----
processes: anInteger
    numProcesses := anInteger!
----- Method: SMarkWeakScalingRunner>>reportConfiguration: (in category 'reporting') -----
reportConfiguration: aStream
    super reportConfiguration: aStream.
    aStream << ('inner iterations: ', numInnerIterations asString); cr.!
----- Method: SMarkWeakScalingRunner>>timedBenchmarkExecution: (in category 'benchmarking') -----
timedBenchmarkExecution: aSelector
    "Will do a timed execution of the benchmark and return the result timer"
    | timer |
    timers := Dictionary new.
timer := self createTimer: 'total'.
    
    self execute: aSelector withProcesses: numProcesses withTimer: timer.
    
    self recordResults: timer for: aSelector.
    
    ^ timer!
Object subclass: #SMarkSuite
    instanceVariableNames: 'runner selectedBenchmarks'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'CogBenchmarks-SMark'!
!SMarkSuite commentStamp: '<historical>' prior: 0!
A Benchmark Suite is a set of benchmarks and it knows what exactly needs to be executed.
However, it does not really know how to execute it.
It knows all the magic, that is, how to set up and tear down the environment for the benchmarks, but does not have the knowledge of how many iterations need to be done and how to evaluate any results that might be produced.
Please see also SMarkHarness, which is the main class relevant for users to execute benchmarks with SMark.
Usage:
Choose a suite (i.e. one of my subclasses) and use the class-side #run or run: messages.
To get an example print the result of the following expression:
    
    SMarkCompiler run: 10
    
    SMarkLoops runOnly: #benchArrayAccess
!
SMarkSuite subclass: #SMarkDeltaBlue
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'CogBenchmarks-DeltaBlue'!
!SMarkDeltaBlue commentStamp: '<historical>' prior: 0!
One-way constraint solver Benchmark. The main focus in DeltaBlue is on polymorphism and object-oriented programming
To run the benchmark, execute the expression 'SMarkDeltaBlue run: 10'.!
----- Method: SMarkDeltaBlue>>benchDeltaBlue (in category 'benchmarking') -----
benchDeltaBlue
    "This the combined benchmark."
    
    | n |
    
    n := self problemSize.
    
    DBStrength initialize.
    
    self doChain: n. 
    self doProjection: n!
----- Method: SMarkDeltaBlue>>defaultProblemSize (in category 'defaults') -----
defaultProblemSize
    ^ 20000!
----- Method: SMarkDeltaBlue>>doChain: (in category 'benchmarking') -----
doChain: n
| vars editConstraint plan planner |
planner := DBPlanner new.
    vars := (1 to: n+1) collect: [ :i | DBVariable new].
"thread a chain of equality constraints through the variables"
    1 to: n do:
    	[ :i || v1 v2 |
    	 v1 := vars at: i.
    	 v2 := vars at: i + 1.
    	 DBEqualityConstraint var: v1 var: v2 strength: #required].
DBStayConstraint var: vars last strength: #strongDefault.
    editConstraint := DBEditConstraint var: (vars first) strength: #preferred.
    plan := planner extractPlanFromConstraints: (Array with: editConstraint).
    1 to: 100 do: [ :v | 
    	vars first value: v.
    	plan execute.
    	vars last value ~= v ifTrue: [self error: 'Chain test failed!!!!']].
    editConstraint destroyConstraint!
----- Method: SMarkDeltaBlue>>doProjection: (in category 'benchmarking') -----
doProjection: n
    "This test constructs a two sets of variables related to each other by
     a simple linear transformation (scale and offset)."
| scale offset src dst planner dests |
    planner := DBPlanner new.
    dests := OrderedCollection new.
    scale := DBVariable value: 10.
    offset := DBVariable value: 1000.
    1 to: n do:
    	[ :i |
    	src := DBVariable value: i.
    	dst := DBVariable value: i.
    	dests add: dst.
    	DBStayConstraint var: src strength: #default.
    	DBScaleConstraint var: src var: scale var: offset var: dst strength: #required].
planner changeVar: src newValue: 17.
    dst value ~= 1170 ifTrue: [self error: 'Projection test 1 failed!!!!'].
planner changeVar: dst newValue: 1050.
    src value ~= 5 ifTrue: [self error: 'Projection test 2 failed!!!!'].
planner changeVar: scale newValue: 5.
    1 to: n - 1 do: [ :i |
    	(dests at: i) value ~= (i*5 + 1000)
    		ifTrue: [self error: 'Projection test 3 failed!!!!']].
planner changeVar: offset newValue: 2000.
    1 to: n - 1 do: [ :i |
    	(dests at: i) value ~= (i*5 + 2000)
    		ifTrue: [self error: 'Projection test 4 failed!!!!']].!
----- Method: SMarkDeltaBlue>>problemSize (in category 'accessing') -----
problemSize
    <omniUnenforced> "Hint for the OMOP that it is part of the meta infrastructure"
    | ps |
    ps := super problemSize.
    
    ps isInteger ifFalse: [	^ self defaultProblemSize].
    	
    ^ ps!
SMarkSuite subclass: #SMarkRichards
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'CogBenchmarks-Richards'!
!SMarkRichards commentStamp: '<historical>' prior: 0!
Richards is an OS kernel simulation benchmark, originally written in BCPL by Martin Richards. The main focus in Richards is on property access and calling functions and methods.
To run the benchmark, execute the expression 'SMarkRichards run: 10'.!
----- Method: SMarkRichards>>benchRichards (in category 'benchs') -----
benchRichards
RichObject initialize.
    self problemSize timesRepeat: [ RichRunner start ]!
----- Method: SMarkRichards>>defaultProblemSize (in category 'benchs') -----
defaultProblemSize
    ^ 50!
----- Method: SMarkRichards>>problemSize (in category 'benchs') -----
problemSize
    <omniUnenforced> "Hint for the OMOP that it is part of the meta infrastructure"
    | ps |
    ps := super problemSize.
    
    ps isInteger ifFalse: [	^ self defaultProblemSize].
    	
    ^ ps!
----- Method: SMarkSuite class>>defaultProblemSize (in category 'defaults') -----
defaultProblemSize
    ^ nil!
----- Method: SMarkSuite class>>defaultRunner (in category 'defaults') -----
defaultRunner
    ^ self onCog: [SMarkCogRunner]
           else:  [SMarkRunner]!
----- Method: SMarkSuite class>>isAbstractClass (in category 'benchmarking') -----
isAbstractClass
    "This is a hack that is necessary in Squeak since it does not provide #isAbstractClass.
     Actually this class is supposed to be abstract, but well, inheritance..."
    
    ^ false!
----- Method: SMarkSuite class>>onCog:else: (in category 'platform support') -----
onCog: cogSpecificBlock else: general
    ^ (Smalltalk vm isRunningCogit)
    	ifTrue:  [cogSpecificBlock value]
    	ifFalse: [general value]!
----- Method: SMarkSuite class>>profile: (in category 'profiling') -----
profile: aSelector
    ^ self profileRunner 
    	execute: self new selector: aSelector.!
----- Method: SMarkSuite class>>profile:iterations: (in category 'profiling') -----
profile: aSelector iterations: nIterations
    ^ self profileRunner 
    	execute: self new selector: aSelector iterations: nIterations.!
----- Method: SMarkSuite class>>profileAll (in category 'profiling') -----
profileAll
    ^ self profileRunner 
    	execute: self new.!
----- Method: SMarkSuite class>>profileRunner (in category 'profiling') -----
profileRunner
    ^ SMarkProfileRunner!
----- Method: SMarkSuite class>>run (in category 'benchmarking') -----
run
    "Execute the suite one time."
    ^ self defaultRunner execute: self new.!
----- Method: SMarkSuite class>>run: (in category 'benchmarking') -----
run: nIterations
    "Execute the suite a given number of iterations."
    
    ^ self defaultRunner execute: self new with: nIterations.!
----- Method: SMarkSuite class>>runOnly: (in category 'benchmarking') -----
runOnly: aSelector
  "aSelector should refer to a benchmark method.
   Example:
     SMarkLoops runOnly: #benchFloatLoop
  "
  ^ self defaultRunner execute: (self new runOnly: aSelector)!
----- Method: SMarkSuite class>>runOnly:iterations: (in category 'benchmarking') -----
runOnly: aSelector iterations: anInteger
    "Execute only the bench name aSelector from the suite."
    
    ^ self defaultRunner execute: (self new runOnly: aSelector) with: anInteger!
----- Method: SMarkSuite>>benchmarkNameForSelector: (in category 'helper') -----
benchmarkNameForSelector: selector
    "Extracts the actual name of the benchmark from the selector"
    (selector beginsWith: #bench) ifTrue: [ ^ selector copyFrom: 6 to: selector size].
    ^ selector asSymbol
    !
----- Method: SMarkSuite>>cleanUpInstanceVariables (in category 'running') -----
cleanUpInstanceVariables
    "Make sure all variables that are 'user variables' get cleaned"
    
    self class allInstVarNames do: [ :name |
    	name = 'runner' ifFalse: [
    		self instVarNamed: name put: nil ] ]!
----- Method: SMarkSuite>>performCustomSelector:with: (in category 'benchmarking') -----
performCustomSelector: aSelector with: aPrefix
    | customSelector |
    customSelector := (aPrefix, aSelector capitalized) asSymbol.
    (self respondsTo: customSelector) ifTrue: [ 
    	self perform: customSelector].!
----- Method: SMarkSuite>>problemSize (in category 'benchmarking') -----
problemSize
    <omniUnenforced> "Hint for the OMOP that it is part of the meta infrastructure"
    runner             ifNil: [^ self class defaultProblemSize].
    runner problemSize ifNil: [^ self class defaultProblemSize].
    ^ runner problemSize!
----- Method: SMarkSuite>>processResult:withTimer: (in category 'benchmarking') -----
processResult: anObject withTimer: aSMarkTimer
    "subclass responsability. You can verify your results here, or do things with the timer."
    ^self.!
----- Method: SMarkSuite>>run (in category 'benchmarking') -----
run
    "Executes all the benchmarks in the suite, 
     coordinating with the runner when necessary"
    
    | potentialBenchmarkSelectors |
    selectedBenchmarks
    	ifNotNil: [ potentialBenchmarkSelectors := selectedBenchmarks ]
    	ifNil:    [ potentialBenchmarkSelectors := self class allSelectors ].				
    
    potentialBenchmarkSelectors
    	do: [ :selector |
    		(self shouldRunSelector: selector)
    			ifTrue: [
    				runner performBenchmark: selector ]
    	].
    !
----- Method: SMarkSuite>>runBenchmark: (in category 'benchmarking') -----
runBenchmark: aSelector
    
    [self setUp.
     self performCustomSelector: aSelector with: #setUp.
     runner timedBenchmarkExecution: aSelector] ensure: [
    	self performCustomSelector: aSelector with: #tearDown.
    	self tearDown.
    	self cleanUpInstanceVariables]!
----- Method: SMarkSuite>>runOnly: (in category 'benchmarking') -----
runOnly: aSymbol
    selectedBenchmarks := IdentitySet newFrom: { aSymbol }.!
----- Method: SMarkSuite>>runner (in category 'accessing') -----
runner
    ^ runner!
----- Method: SMarkSuite>>runner: (in category 'accessing') -----
runner: aRunner
    runner := aRunner.!
----- Method: SMarkSuite>>selectedBenchmarks (in category 'benchmarking') -----
selectedBenchmarks
    ^ selectedBenchmarks!
----- Method: SMarkSuite>>setUp (in category 'running') -----
setUp
    "It is the subclass' responsibility to set up the necessary environment for a benchmark"
    ^ self!
----- Method: SMarkSuite>>shouldRunSelector: (in category 'testing') -----
shouldRunSelector: selector
    "Tells whether the given selector is in the form bench*, and thus is a benchmark that should be executed."
    
    (selector includes: $:) ifTrue: [ ^ false ].
    ^ selector beginsWith: #bench!
----- Method: SMarkSuite>>tearDown (in category 'running') -----
tearDown
    "It is the subclass' responsibility to clean up the environment after a benchmark"
    ^ self!
Object subclass: #SMarkTimer
    instanceVariableNames: 'startTime elapsedTime name'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'CogBenchmarks-SMark'!
!SMarkTimer commentStamp: '<historical>' prior: 0!
A SMarkTimer is a simple timer.
A subclass can measure alternative metrics, or for instance use different time sources.
A subclass of SMarkRunner can then use the custom timer class by overriding SMarkRunner class >> #defaultTimer.!
----- Method: SMarkTimer class>>new: (in category 'instance creation') -----
new: aName
    | timer |
    
    timer := super new.
    timer name: aName.
    
    ^timer!
----- Method: SMarkTimer>>currentMillis (in category 'timing') -----
currentMillis
^ Time millisecondClockValue!
----- Method: SMarkTimer>>initialize (in category 'initialization') -----
initialize
    super initialize.
    elapsedTime := 0!
----- Method: SMarkTimer>>name (in category 'accessing') -----
name
    ^name!
----- Method: SMarkTimer>>name: (in category 'accessing') -----
name: aString
    name := aString !
----- Method: SMarkTimer>>reset (in category 'timing') -----
reset
    startTime := 0.
    elapsedTime := 0.!
----- Method: SMarkTimer>>start (in category 'timing') -----
start
    startTime := self currentMillis.!
----- Method: SMarkTimer>>stop (in category 'timing') -----
stop
    | elapsedInThisPeriod current |
    current := self currentMillis.
    
    elapsedInThisPeriod := Time milliseconds: current since: startTime.
    
    elapsedTime := elapsedTime + elapsedInThisPeriod.!
----- Method: SMarkTimer>>totalTime (in category 'accessing') -----
totalTime
    ^elapsedTime!
Object subclass: #SMarkTransporter
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'CogBenchmarks-SMark'!
!SMarkTransporter commentStamp: 'StefanMarr 4/5/2012 21:43' prior: 0!
SMarkTransporter is a used to interact with a git-fileout system used in the RoarVM project to manage Smalltalk source code.
SMarkTransporter is not actually a Transporter class, since there are currently no needs for customization.
Thus, it is just a dummy class for future use, and to hold #transportersForFileOutMenu.
!
----- Method: SMarkTransporter class>>transportersForFileOutMenu (in category 'transporter') -----
transportersForFileOutMenu
    ^ { (Smalltalk at: #Transporter ifAbsent: [^#()])
    		forPackage: (PackageInfo named: 'SMark') }!
Object subclass: #SMarkWeakScalingRunnerExecutor
    instanceVariableNames: 'numInnerIterations benchmarkSelector suite runner'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'CogBenchmarks-SMark'!
----- Method: SMarkWeakScalingRunnerExecutor class>>createFor:for:with:and: (in category 'as yet unclassified') -----
createFor: aSelector for: numIterations with: aRunner and: aSuite
    | o |
    o := self new.
    o runner: aRunner.
    o suite: aSuite.
    o innerIterations: numIterations.
    o benchmarkSelector: aSelector.
    ^ ([ o run ] newProcess)!
----- Method: SMarkWeakScalingRunnerExecutor>>benchmarkSelector: (in category 'accessing') -----
benchmarkSelector: aSelector
    benchmarkSelector := aSelector!
----- Method: SMarkWeakScalingRunnerExecutor>>innerIterations: (in category 'accessing') -----
innerIterations: anInt
    numInnerIterations := anInt!
----- Method: SMarkWeakScalingRunnerExecutor>>run (in category 'benchmarking') -----
run
    1 to: numInnerIterations do: [:i |
    	suite perform: benchmarkSelector.].
    
    runner executorCompleted.!
----- Method: SMarkWeakScalingRunnerExecutor>>runner: (in category 'accessing') -----
runner: aRunner
    runner := aRunner!
----- Method: SMarkWeakScalingRunnerExecutor>>suite: (in category 'accessing') -----
suite: aSuite
    suite := aSuite!
Object subclass: #ShootoutBody
    instanceVariableNames: 'x y z vx vy vz mass'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'CogBenchmarks-Shootout'!
----- Method: ShootoutBody class>>daysPerYear (in category 'constants') -----
daysPerYear
    ^365.24!
----- Method: ShootoutBody class>>jupiter (in category 'constants') -----
jupiter
    ^self new
    	x: 4.84143144246472090
    	y: -1.16032004402742839
    	z: -1.03622044471123109e-1
    	vx: 1.66007664274403694e-3 * self daysPerYear
    	vy: 7.69901118419740425e-3 * self daysPerYear
    	vz: -6.90460016972063023e-5 * self daysPerYear
    	mass: 9.54791938424326609e-4 * self solarMass!
----- Method: ShootoutBody class>>neptune (in category 'constants') -----
neptune
    ^self new
    	x: 1.53796971148509165e1
    	y: -2.59193146099879641e1
    	z: 1.79258772950371181e-1
    	vx: 2.68067772490389322e-3 * self daysPerYear
    	vy: 1.62824170038242295e-3 * self daysPerYear
    	vz: -9.51592254519715870e-5 * self daysPerYear
    	mass: 5.15138902046611451e-5 * self solarMass!
----- Method: ShootoutBody class>>pi (in category 'constants') -----
pi
    ^3.141592653589793!
----- Method: ShootoutBody class>>saturn (in category 'constants') -----
saturn
    ^self new
    	x: 8.34336671824457987
    	y: 4.12479856412430479
    	z: -4.03523417114321381e-1
    	vx: -2.76742510726862411e-3 * self daysPerYear
    	vy: 4.99852801234917238e-3 * self daysPerYear
    	vz: 2.30417297573763929e-5 * self daysPerYear
    	mass: 2.85885980666130812e-4 * self solarMass!
----- Method: ShootoutBody class>>solarMass (in category 'constants') -----
solarMass
    ^4.0 * self pi * self pi!
----- Method: ShootoutBody class>>sun (in category 'constants') -----
sun
    ^self new
    	x: 0.0
    	y: 0.0
    	z: 0.0
    	vx: 0.0
    	vy: 0.0
    	vz: 0.0
    	mass: self solarMass!
----- Method: ShootoutBody class>>uranus (in category 'constants') -----
uranus
    ^self new
    	x: 1.28943695621391310e1
    	y: -1.51111514016986312e1
    	z: -2.23307578892655734e-1
    	vx: 2.96460137564761618e-3 * self daysPerYear
    	vy: 2.37847173959480950e-3 * self daysPerYear
    	vz: -2.96589568540237556e-5 * self daysPerYear
    	mass: 4.36624404335156298e-5 * self solarMass!
----- Method: ShootoutBody>>addMomentumTo: (in category 'nbody') -----
addMomentumTo: anArray
    anArray at: 1 put: (anArray at: 1) + (vx * mass).
    anArray at: 2 put: (anArray at: 2) + (vy * mass).
    anArray at: 3 put: (anArray at: 3) + (vz * mass).
    ^anArray!
----- Method: ShootoutBody>>and:velocityAfter: (in category 'nbody') -----
and: aBody velocityAfter: dt
    | dx dy dz distance mag |
    dx := x - aBody x.
    dy := y - aBody y.
    dz := z - aBody z.
distance := ((dx*dx) + (dy*dy) + (dz*dz)) sqrt.
    mag := dt / (distance * distance * distance).
self decreaseVelocity: dx y: dy z: dz m: aBody mass * mag.
    aBody increaseVelocity: dx y: dy z: dz m: mass * mag!
----- Method: ShootoutBody>>decreaseVelocity:y:z:m: (in category 'nbody') -----
decreaseVelocity: dx y: dy z: dz m: m
    vx := vx - (dx * m).
    vy := vy - (dy * m).
    vz := vz - (dz * m)!
----- Method: ShootoutBody>>increaseVelocity:y:z:m: (in category 'nbody') -----
increaseVelocity: dx y: dy z: dz m: m
    vx := vx + (dx * m).
    vy := vy + (dy * m).
    vz := vz + (dz * m)!
----- Method: ShootoutBody>>kineticEnergy (in category 'nbody') -----
kineticEnergy
    ^0.5 * mass * ((vx * vx) + (vy * vy) + (vz * vz))!
----- Method: ShootoutBody>>mass (in category 'accessing') -----
mass
    ^mass!
----- Method: ShootoutBody>>offsetMomentum: (in category 'nbody') -----
offsetMomentum: anArray
    | m |
    m := self class solarMass.
    vx := (anArray at: 1) negated / m.
    vy := (anArray at: 2) negated / m.
    vz := (anArray at: 3) negated / m!
----- Method: ShootoutBody>>positionAfter: (in category 'nbody') -----
positionAfter: dt
    x := x + (dt * vx).
    y := y + (dt * vy).
    z := z + (dt * vz)!
----- Method: ShootoutBody>>potentialEnergy: (in category 'nbody') -----
potentialEnergy: aBody
    | dx dy dz distance |
    dx := x - aBody x.
    dy := y - aBody y.
    dz := z - aBody z.
distance := ((dx*dx) + (dy*dy) + (dz*dz)) sqrt.
    ^mass * aBody mass / distance!
----- Method: ShootoutBody>>x (in category 'accessing') -----
x
    ^x!
----- Method: ShootoutBody>>x:y:z:vx:vy:vz:mass: (in category 'accessing') -----
x: d1 y: d2 z: d3 vx: d4 vy: d5 vz: d6 mass: d7
    x := d1.
    y := d2.
    z := d3.
    vx := d4.
    vy := d5.
    vz := d6.
    mass := d7!
----- Method: ShootoutBody>>y (in category 'accessing') -----
y
    ^y!
----- Method: ShootoutBody>>z (in category 'accessing') -----
z
    ^z!
Object subclass: #ShootoutChameneosColour
    instanceVariableNames: 'color'
    classVariableNames: 'Blue Red Yellow'
    poolDictionaries: ''
    category: 'CogBenchmarks-Shootout'!
----- Method: ShootoutChameneosColour class>>blue (in category 'accessing') -----
blue
   ^Blue!
----- Method: ShootoutChameneosColour class>>blue: (in category 'accessing') -----
blue: anObject
   Blue := anObject!
----- Method: ShootoutChameneosColour class>>createBlue (in category 'initialize-release') -----
createBlue
   "comment stating purpose of message"
^super new color: #blue!
----- Method: ShootoutChameneosColour class>>createRed (in category 'initialize-release') -----
createRed
   "comment stating purpose of message"
^super new color: #red!
----- Method: ShootoutChameneosColour class>>createYellow (in category 'initialize-release') -----
createYellow
   "comment stating purpose of message"
^super new color: #yellow!
----- Method: ShootoutChameneosColour class>>generateReportOfColoursOn: (in category 'printing') -----
generateReportOfColoursOn: readOut
   | colours |
   colours := Array
            with: Blue
            with: Red
            with: Yellow.
   colours do:
         [:aColour |
         colours do:
               [:anotherColour |
               aColour printOn: readOut.
               readOut nextPutAll: ' + '.
               anotherColour printOn: readOut.
               readOut nextPutAll: ' -> '.
               (aColour complementaryColourFor: anotherColour) printOn: readOut.
               readOut nl]].
   ^readOut!
----- Method: ShootoutChameneosColour class>>initialize (in category 'initialize-release') -----
initialize
   "self initialize"
Red := self createRed.
   Blue := self createBlue.
   Yellow := self createYellow!
----- Method: ShootoutChameneosColour class>>red (in category 'accessing') -----
red
   ^Red!
----- Method: ShootoutChameneosColour class>>red: (in category 'accessing') -----
red: anObject
   Red := anObject!
----- Method: ShootoutChameneosColour class>>yellow (in category 'accessing') -----
yellow
   ^Yellow!
----- Method: ShootoutChameneosColour class>>yellow: (in category 'accessing') -----
yellow: anObject
   Yellow := anObject!
----- Method: ShootoutChameneosColour>>color (in category 'accessing') -----
color
   ^color!
----- Method: ShootoutChameneosColour>>color: (in category 'accessing') -----
color: aColor
   color := aColor!
----- Method: ShootoutChameneosColour>>complementaryColourFor: (in category 'as yet unclassified') -----
complementaryColourFor: aChameneosColour
   "determine the complementary colour defined as..."
self == aChameneosColour ifTrue: [^self].
   self isBlue
      ifTrue:
         [aChameneosColour isRed
            ifTrue: [^self class yellow]
            ifFalse: [^self class red]].
   self isRed
      ifTrue:
         [aChameneosColour isBlue
            ifTrue: [^self class yellow]
            ifFalse: [^self class blue]].
   aChameneosColour isBlue
      ifTrue: [^self class red]
      ifFalse: [^self class blue]!
----- Method: ShootoutChameneosColour>>hasSameColorAs: (in category 'testing') -----
hasSameColorAs: aChameneos
   ^self color == aChameneos color!
----- Method: ShootoutChameneosColour>>isBlue (in category 'testing') -----
isBlue
   ^self == self class blue!
----- Method: ShootoutChameneosColour>>isRed (in category 'testing') -----
isRed
   ^self == self class red!
----- Method: ShootoutChameneosColour>>isYellow (in category 'testing') -----
isYellow
   ^self == self class yellow!
----- Method: ShootoutChameneosColour>>printOn: (in category 'printing') -----
printOn: aStream
   aStream nextPutAll: self color!
Object subclass: #ShootoutCreature
    instanceVariableNames: 'creatureName colour selfMet creaturesMet'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'CogBenchmarks-Shootout'!
----- Method: ShootoutCreature class>>withName:colour: (in category 'initialize-release') -----
withName: aName colour: aColour
   ^(ShootoutCreature new initialize)
      name: aName;
      colour: aColour!
----- Method: ShootoutCreature>>colour (in category 'accessing') -----
colour
   ^colour!
----- Method: ShootoutCreature>>colour: (in category 'accessing') -----
colour: anObject
   colour := anObject!
----- Method: ShootoutCreature>>creaturesMet (in category 'accessing') -----
creaturesMet
   ^creaturesMet!
----- Method: ShootoutCreature>>creaturesMet: (in category 'accessing') -----
creaturesMet: anObject
   creaturesMet := anObject!
----- Method: ShootoutCreature>>initialize (in category 'initialize-release') -----
initialize
   selfMet := 0.
   creaturesMet := 0!
----- Method: ShootoutCreature>>name (in category 'accessing') -----
name
   ^creatureName!
----- Method: ShootoutCreature>>name: (in category 'accessing') -----
name: anObject
   creatureName := anObject!
----- Method: ShootoutCreature>>selfMet (in category 'accessing') -----
selfMet
   ^selfMet!
----- Method: ShootoutCreature>>selfMet: (in category 'accessing') -----
selfMet: anObject
   ^selfMet := anObject!
----- Method: ShootoutCreature>>visitMall: (in category 'controlling') -----
visitMall: mall
[| partner |
   partner := mall visitWith: self.
   partner ifNotNil:
         [colour := colour complementaryColourFor: partner colour.
         self == partner ifTrue: [selfMet := selfMet + 1].
         creaturesMet := creaturesMet + 1].
   partner isNil]
         whileFalse!
Object subclass: #ShootoutMall
    instanceVariableNames: 'guard maxRendezvous open process queue cache pairCache'
    classVariableNames: 'Units'
    poolDictionaries: ''
    category: 'CogBenchmarks-Shootout'!
----- Method: ShootoutMall class>>createAllowing: (in category 'initialize-release') -----
createAllowing: maxRendezvous
   "Private"
^self basicNew initialize maxRendezvous: maxRendezvous!
----- Method: ShootoutMall class>>createCreaturesWith: (in category 'initialize-release') -----
createCreaturesWith: aCollectionOfColours
   "Private"
| aName |
   aName := 0.
   ^aCollectionOfColours collect:
         [:aColour |
         aName := aName + 1.
         ShootoutCreature withName: aName colour: aColour]!
----- Method: ShootoutMall class>>generateReportFor:printOn: (in category 'printing') -----
generateReportFor: creatures printOn: stream
   | sum |
   sum := creatures inject: 0 into: [:accum :each | accum + each creaturesMet].
   creatures do:
         [:aCreature |
         aCreature creaturesMet printOn: stream.
         stream
            space;
            nextPutAll: (self units at: aCreature selfMet + 1);
            nl].
   stream space.
   sum printString
      do: [:el | stream nextPutAll: (self units at: el digitValue + 1)]
      separatedBy: [stream space].
   ^stream!
----- Method: ShootoutMall class>>generateReportForColours:printOn: (in category 'printing') -----
generateReportForColours: colours printOn: stream
   stream space.
   colours do: [:colour | colour printOn: stream] separatedBy: [stream space].
   ^stream!
----- Method: ShootoutMall class>>initialize (in category 'initialize-release') -----
initialize
   "self initialize"
Units := #('zero' 'one' 'two' 'three' 'four' 'five' 'six' 'seven' 'eight' 'nine')!
----- Method: ShootoutMall class>>new (in category 'initialize-release') -----
new
   ^self shouldNotImplement!
----- Method: ShootoutMall class>>openMall:forCreatures:usingGuard: (in category 'private') -----
openMall: aMall forCreatures: creatures usingGuard: sema
   | processes |
   processes := creatures
            collect: [:aCreature |
               [aCreature visitMall: aMall.
               sema signal] newProcess].
   processes do:
         [:proc |
         proc priority: Processor userBackgroundPriority.
         proc resume]!
----- Method: ShootoutMall class>>openMallWith:forNumberOfMeets: (in category 'initialize-release') -----
openMallWith: aCollectionOfColours forNumberOfMeets: aNumber
   | mall creatures guard |
   mall := self createAllowing: aNumber.
   mall run.
   creatures := self createCreaturesWith: aCollectionOfColours.
   guard := Semaphore new.
   self
      openMall: mall
      forCreatures: creatures
      usingGuard: guard.
   self
      waitForClosingOfMall: mall
      withCreatures: creatures
      usingGuard: guard.
   ^creatures!
----- Method: ShootoutMall class>>runBenchMark:on: (in category 'public') -----
runBenchMark: number on: anOutputStream
   "self runBenchMark: 60000 on: Transcript."
| firstTestColours secondTestColours blue red yellow creatures |
   blue := ShootoutChameneosColour blue.
   red := ShootoutChameneosColour red.
   yellow := ShootoutChameneosColour yellow.
   firstTestColours := Array
            with: blue
            with: red
            with: yellow.
   secondTestColours := (OrderedCollection new)
            add: blue;
            add: red;
            add: yellow;
            add: red;
            add: yellow;
            add: blue;
            add: red;
            add: yellow;
            add: red;
            add: blue;
            yourself.
   (ShootoutChameneosColour generateReportOfColoursOn: anOutputStream) nl.
   (self generateReportForColours: firstTestColours printOn: anOutputStream)
      nl.
   creatures := ShootoutMall openMallWith: firstTestColours forNumberOfMeets: number.
   (self generateReportFor: creatures printOn: anOutputStream)
      nl;
      nl.
   (self generateReportForColours: secondTestColours printOn: anOutputStream)
      nl.
   creatures := ShootoutMall openMallWith: secondTestColours forNumberOfMeets: number.
   (self generateReportFor: creatures printOn: anOutputStream)
      nl;
      nl!
----- Method: ShootoutMall class>>units (in category 'accessing') -----
units
   ^Units!
----- Method: ShootoutMall class>>waitForClosingOfMall:withCreatures:usingGuard: (in category 'private') -----
waitForClosingOfMall: aMall withCreatures: creatures usingGuard: guard
   creatures size timesRepeat: [guard wait].
   aMall close!
----- Method: ShootoutMall>>close (in category 'controlling') -----
close
   open := false!
----- Method: ShootoutMall>>initialize (in category 'initialize-release') -----
initialize
   guard := Semaphore forMutualExclusion.
   queue := SharedQueue new.
   cache := OrderedCollection new.
   1 to: 10 do: [:x | cache add: ShootoutPair new]!
----- Method: ShootoutMall>>maxRendezvous: (in category 'accessing') -----
maxRendezvous: max
   maxRendezvous := max!
----- Method: ShootoutMall>>obtainPair (in category 'private') -----
obtainPair
   ^cache removeFirst!
----- Method: ShootoutMall>>processVisitors (in category 'private') -----
processVisitors
   [open] whileTrue:
         [1 to: maxRendezvous
            do:
               [:x |
               | first second |
               first := queue next.
               second := queue next.
               self setPartnersOn: first and: second.
               first signal.
               second signal].
         [queue isEmpty] whileFalse: [queue next signal]].
   process terminate.
   process := nil!
----- Method: ShootoutMall>>releasePair: (in category 'private') -----
releasePair: pair
   pair release.
   cache addFirst: pair!
----- Method: ShootoutMall>>run (in category 'initialize-release') -----
run
   open := true.
   process ifNil:
         [process := [self processVisitors] newProcess.
         process priority: Processor userBackgroundPriority -1 ].
   process resume!
----- Method: ShootoutMall>>setPartnersOn:and: (in category 'private') -----
setPartnersOn: first and: second
   first partner: second me.
   second partner: first me.
!
----- Method: ShootoutMall>>shutdown (in category 'private') -----
shutdown
   [queue isEmpty] whileFalse: [queue next signal].
   process terminate.
   process := nil!
----- Method: ShootoutMall>>visitWith: (in category 'controlling') -----
visitWith: aChameneos
   | pair partner |
   pair := self obtainPair.
   pair me: aChameneos.
   queue nextPut: pair.
   pair wait.
   partner := pair partner.
   self releasePair: pair.
   ^partner!
Object subclass: #ShootoutNBodySystem
    instanceVariableNames: 'bodies'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'CogBenchmarks-Shootout'!
----- Method: ShootoutNBodySystem>>after: (in category 'nbody') -----
after: dt
    1 to: bodies size do: [:i|
    	i+1 to: bodies size do: [:j|
    		(bodies at: i) and: (bodies at: j) velocityAfter: dt].
    ].
    bodies do: [:each| each positionAfter: dt]!
----- Method: ShootoutNBodySystem>>energy (in category 'nbody') -----
energy
    | e |
    e := 0.0.
    1 to: bodies size do: [:i|
    	e := e + (bodies at: i) kineticEnergy.
i+1 to: bodies size do: [:j|
    		e := e - ((bodies at: i) potentialEnergy: (bodies at: j))].
    ].
    ^e!
----- Method: ShootoutNBodySystem>>initialize (in category 'initialize-release') -----
initialize
    bodies := (OrderedCollection new
    	add: ShootoutBody sun; add: ShootoutBody jupiter; add: ShootoutBody saturn;
    	add: ShootoutBody uranus; add: ShootoutBody neptune; yourself) asArray.
bodies first offsetMomentum:
    	(bodies inject: (Array with: 0.0 with: 0.0 with: 0.0)
    		into: [:m :each | each addMomentumTo: m])!
Object subclass: #ShootoutPair
    instanceVariableNames: 'partner me sema'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'CogBenchmarks-Shootout'!
----- Method: ShootoutPair class>>new (in category 'instance creation') -----
new
   "Answer a newly created and initialized instance."
   ^super new initialize.!
----- Method: ShootoutPair class>>with: (in category 'instance creation') -----
with: me
   "Answer a newly created and initialized instance."
self halt.
   ^super new initialize me: me!
----- Method: ShootoutPair>>initialize (in category 'initialize-release') -----
initialize
   "Initialize a newly created instance. This method must answer the receiver."
partner := nil.
   me := nil.
   sema := Semaphore new.
   ^self!
----- Method: ShootoutPair>>me (in category 'accessing') -----
me
   ^me!
----- Method: ShootoutPair>>me: (in category 'accessing') -----
me: anObject
   me := anObject!
----- Method: ShootoutPair>>partner (in category 'accessing') -----
partner
   ^partner!
----- Method: ShootoutPair>>partner: (in category 'accessing') -----
partner: anObject
   partner := anObject!
----- Method: ShootoutPair>>release (in category 'initialize-release') -----
release
partner:=nil.!
----- Method: ShootoutPair>>signal (in category 'initialize-release') -----
signal
   sema signal!
----- Method: ShootoutPair>>wait (in category 'initialize-release') -----
wait
   sema wait!
Object subclass: #ShootoutTests
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'CogBenchmarks-Shootout'!
----- Method: ShootoutTests class>>arg (in category 'platform') -----
arg
    3 to: 5 do:
    	[:i|
    	(SmalltalkImage current getSystemAttribute: i) ifNotNil:
    		[:aString|
    		aString asInteger ifNotNil:
    			[:arg| ^arg]]].
    ^nil!
----- Method: ShootoutTests class>>binarytrees (in category 'benchmark scripts') -----
binarytrees
    self binarytrees: self arg to: self stdout.
    ^''!
----- Method: ShootoutTests class>>binarytrees:to: (in category 'benchmarking') -----
binarytrees: n to: output
    | minDepth maxDepth stretchDepth check longLivedTree iterations |
    minDepth := 4.
    maxDepth := minDepth + 2 max: n.
    stretchDepth := maxDepth + 1.
check := (ShootoutTreeNode bottomUpTree: 0 depth: stretchDepth) itemCheck.
    output
    	nextPutAll: 'stretch tree of depth '; print: stretchDepth; tab;
    	nextPutAll: ' check: '; print: check; nl.
longLivedTree := ShootoutTreeNode bottomUpTree: 0 depth: maxDepth.
    minDepth to: maxDepth by: 2 do: [:depth|
    	iterations := 1 bitShift: maxDepth - depth + minDepth.
check := 0.
    	1 to: iterations do: [:i|
    		check := check + (ShootoutTreeNode bottomUpTree: i depth: depth) itemCheck.
    		check := check + (ShootoutTreeNode bottomUpTree: -1*i depth: depth) itemCheck
    		].
    	output
    		print:  (2*iterations); tab;
    		nextPutAll: ' trees of depth '; print: depth; tab;
    		nextPutAll: ' check: '; print: check; nl
    	].
output
    	nextPutAll: 'long lived tree of depth '; print: maxDepth; tab;
    	nextPutAll: ' check: '; print: longLivedTree itemCheck; nl!
----- Method: ShootoutTests class>>chameneosredux2 (in category 'benchmark scripts') -----
chameneosredux2
    self chameneosredux: self arg to: self stdout.
    ^''!
----- Method: ShootoutTests class>>chameneosredux:to: (in category 'benchmarking') -----
chameneosredux: arg to: aStream
   ShootoutMall runBenchMark: arg on: aStream!
----- Method: ShootoutTests class>>collectReferenceTimes (in category 'benchmark scripts') -----
collectReferenceTimes
    "Run the benchmarks 3 times and take their average, e.g. suitable
     for filling in values for referenceTimesForClosureInterpreter"
"ShootoutTests collectReferenceTimes"
    | n refs |
    Transcript clear.
    n := 3.
    refs := (1 to: n) collect: [:i| ShootoutTests runAllToInternalStream].
    ^{	refs.
    	(1 to: refs first size) collect:
    		[:i|
    		((refs inject: 0 into: [:sum :ref| (ref at: i) + sum]) / n) rounded] }!
----- Method: ShootoutTests class>>nbody (in category 'benchmark scripts') -----
nbody
    self nbody: self arg to: self stdout!
----- Method: ShootoutTests class>>nbody:to: (in category 'benchmarking') -----
nbody: count to: output
    | bodies |
    bodies := ShootoutNBodySystem new initialize.
output print: bodies energy digits: 9; cr.
    count timesRepeat: [bodies after: 0.01].
    output print: bodies energy digits: 9; cr.
    ^''!
----- Method: ShootoutTests class>>profileAll (in category 'profiling') -----
profileAll
    "self profileAll"
    | stream |
    stream := DummyStream new.
    self nbody: 200000 "20000000" to: stream.
    self binarytrees: 15 to: stream.
    self chameneosredux: 260000 to: stream.
    self threadring: 10000000 to: stream!
----- Method: ShootoutTests class>>referenceArgs (in category 'benchmark scripts') -----
referenceArgs
    ^self referenceTimesAndArgsForClosureInterpreter collect: [:ea| ea last]!
----- Method: ShootoutTests class>>referenceTimesAndArgsForClosureInterpreter (in category 'benchmark scripts') -----
referenceTimesAndArgsForClosureInterpreter
     "Interpreter + Closures VM (Mac Cocoa 5.7b3 27-Aug-10 >7BCAB029-A835-4D12-946D-4AB7083D2955< VMMaker versionString 4.4.9)
      on Eliot's 2012 vintage 2.2GHz Intel (quad) Core i7 MacBook Pro"
    ^Dictionary new
    	at: #nbody				put: #(40903	2000000);
    	at: #binarytrees		put: #(30573	17);
    	at: #chameneosredux	put: #(30722	2000000);
    	at: #threadring			put: #(9148		30000000);
    	yourself!
----- Method: ShootoutTests class>>referenceTimesForClosureInterpreter (in category 'benchmark scripts') -----
referenceTimesForClosureInterpreter
    ^self referenceTimesAndArgsForClosureInterpreter collect: [:ea| ea first]!
----- Method: ShootoutTests class>>report:time:reference:on: (in category 'reporting') -----
report: name time: millisecs reference: reference on: aStream
    aStream
    	cr;
    	nextPutAll: name; cr;
    	nextPutAll: ' took '; print: millisecs / 1000.0; nextPutAll: ' seconds'; cr; flush;
    	nextPutAll: 'ratio: '; print: ((millisecs / reference) roundTo: 0.001);
    	nextPutAll: '   % change: '; print: ((millisecs - reference * 100 / reference) roundTo: 0.01); nextPut: $%;
    	cr; flush!
----- Method: ShootoutTests class>>runAllToDummyStream (in category 'benchmark scripts') -----
runAllToDummyStream
    "Transcript clear.
     self runAllToDummyStream"
    ^self runAllToDummyStreamVs: self referenceTimesForClosureInterpreter!
----- Method: ShootoutTests class>>runAllToDummyStreamVs: (in category 'benchmark scripts') -----
runAllToDummyStreamVs: referenceTimes
    "Transcript clear.
     self runAllToDummyStreamVs: self referenceTimesForClosureInterpreter"
    "Transcript clear.
     self runAllToDummyStreamVs: self referenceTimesForSqueakVM"
    ^self runAllToDummyStreamVs: referenceTimes reportTo: Transcript!
----- Method: ShootoutTests class>>runAllToDummyStreamVs:reportTo: (in category 'benchmark scripts') -----
runAllToDummyStreamVs: referenceTimes reportTo: aStream
    "Transcript clear.
     self runAllToDummyStreamVs: self referenceTimesForClosureInterpreter"
    "Transcript clear.
     self runAllToDummyStreamVs: self referenceTimesForSqueakVM"
    | times ratios geometricMean |
    times := Array new writeStream.
    ratios := Array new writeStream.
    (self standardSuiteTo: DummyStream basicNew) do:
    	[:block | | benchmark reference t |
    	benchmark := (self selectorForSimpleBlock: block) copyUpTo: $:.
    	reference := referenceTimes at: benchmark asSymbol.
    	Smalltalk garbageCollect.
    	times nextPut: (t := Time millisecondsToRun: block).
    	ratios nextPut: t asFloat / reference.
    	self report: block decompile printString time: t reference: reference on: aStream].
    geometricMean := (ratios contents inject: 1 into: [:m :n| m * n]) raisedTo: 1 / ratios position.
    aStream
    	nextPutAll: 'geometric mean '; print: (geometricMean roundTo: 0.001);
    	nextPutAll: '   average speedup '; print: ((geometricMean - 1 * 100) roundTo: 0.01); nextPut: $%; cr; cr; flush.
    ^times contents!
----- Method: ShootoutTests class>>runAllToInternalStream (in category 'benchmark scripts') -----
runAllToInternalStream
    "Transcript clear.
     self runAllToInternalStream"
    ^self runAllToInternalStreamVs: self referenceTimesForClosureInterpreter!
----- Method: ShootoutTests class>>runAllToInternalStreamVs: (in category 'benchmark scripts') -----
runAllToInternalStreamVs: referenceTimes
    "Transcript clear.
     self runAllToInternalStreamVs: self referenceTimesForClosureInterpreter"
    "Transcript clear.
     self runAllToInternalStreamVs: self referenceTimesForSqueakVM"
    | times ratios geometricMean |
    times := Array new writeStream.
    ratios := Array new writeStream.
    (self standardSuiteTo: (ByteString new: 10000) writeStream) do:
    	[:block | | benchmark reference t |
    	benchmark := (self selectorForSimpleBlock: block) copyUpTo: $:.
    	reference := referenceTimes at: benchmark asSymbol.
    	Smalltalk garbageCollect.
    	times nextPut: (t := Time millisecondsToRun: block).
    	ratios nextPut: t asFloat / reference.
    	self report: block decompile printString time: t reference: reference on: Transcript].
    geometricMean := (ratios contents inject: 1 into: [:m :n| m * n]) raisedTo: 1 / ratios position.
    Transcript
    	nextPutAll: 'geometric mean '; print: (geometricMean roundTo: 0.001);
    	nextPutAll: '   average speedup '; print: ((geometricMean - 1 * 100) roundTo: 0.01); nextPut: $%; cr; cr; flush.
    ^times contents!
----- Method: ShootoutTests class>>runAllToTranscript (in category 'benchmark scripts') -----
runAllToTranscript
    "Transcript clear.
     self runAllToTranscript"
    ^self runAllToTranscriptVs: self referenceTimesForClosureInterpreter!
----- Method: ShootoutTests class>>runAllToTranscriptVs: (in category 'benchmark scripts') -----
runAllToTranscriptVs: referenceTimes
    "Transcript clear.
     self runAllToTranscriptVs: self referenceTimesForClosureInterpreter"
    "Transcript clear.
     self runAllToTranscriptVs: self referenceTimesForSqueakVM"
    | times ratios geometricMean |
    times := Array new writeStream.
    ratios := Array new writeStream.
    (self standardSuiteTo: Transcript) do:
    	[:block | | benchmark reference t |
    	benchmark := (self selectorForSimpleBlock: block) copyUpTo: $:.
    	reference := referenceTimes at: benchmark asSymbol.
    	Smalltalk garbageCollect.
    	times nextPut: (t := Time millisecondsToRun: block).
    	ratios nextPut: t asFloat / reference.
    	self report: block decompile printString time: t reference: reference on: Transcript].
    geometricMean := (ratios contents inject: 1 into: [:m :n| m * n]) raisedTo: 1 / ratios position.
    Transcript
    	nextPutAll: 'geometric mean '; print: (geometricMean roundTo: 0.001);
    	nextPutAll: '   average speedup '; print: ((geometricMean - 1 * 100) roundTo: 0.01); nextPut: $%; cr; cr; flush.
    ^times contents!
----- Method: ShootoutTests class>>selectorForSimpleBlock: (in category 'benchmark scripts') -----
selectorForSimpleBlock: aBlock
    | is |
    is := InstructionStream on: aBlock method.
    is pc: aBlock startpc.
    is scanFor:
    	[:x| | selectorOrScanner |
    	(selectorOrScanner := is selectorToSendOrSelf) ~~ is ifTrue:
    		[^selectorOrScanner].
    	false].
    ^nil!
----- Method: ShootoutTests class>>standardSuiteTo: (in category 'benchmark scripts') -----
standardSuiteTo: aStream
    "revised up from
    	{ [self nbody: 200000 to: stream].
    	   [self binarytrees: 15 to: stream].
    	   [self chameneosredux: 260000 to: stream].
    	   [self threadring: 10000000 to: stream] }
     on 6/15/2014"
    | reference nbodyCount binaryTreeDepth chameneosCount threadringCount |
    reference := self referenceTimesAndArgsForClosureInterpreter.
    nbodyCount := (reference at: #nbody) last.
    binaryTreeDepth := (reference at: #binarytrees) last.
    chameneosCount := (reference at: #chameneosredux) last.
    threadringCount := (reference at: #threadring) last.
    ^{ [self nbody: nbodyCount to: aStream].
         [self binarytrees: binaryTreeDepth to: aStream].
         [self chameneosredux: chameneosCount to: aStream].
         [self threadring: threadringCount to: aStream] }!
----- Method: ShootoutTests class>>stdin (in category 'platform') -----
stdin
   ^StandardFileStream stdIn!
----- Method: ShootoutTests class>>stdout (in category 'platform') -----
stdout
   ^StandardFileStream stdout!
----- Method: ShootoutTests class>>threadRing:output: (in category 'benchmarking') -----
threadRing: aSemaphore output: output
   | first last |
   503 to: 1 by: -1 do: [:i|
      first := ShootoutThread named: i next: first done: aSemaphore output: output.
      last isNil ifTrue: [ last := first ].
   ].
   last nextThread: first.
   ^first !
----- Method: ShootoutTests class>>threadring (in category 'benchmark scripts') -----
threadring
  self threadring: self arg to: self stdout.
   ^''!
----- Method: ShootoutTests class>>threadring:to: (in category 'benchmarking') -----
threadring: arg to: output
   | done |
   (self threadRing: (done := Semaphore new) output: output) takeToken: arg.
   done wait!
Object subclass: #ShootoutThread
    instanceVariableNames: 'name nextThread token semaphore done output'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'CogBenchmarks-Shootout'!
----- Method: ShootoutThread class>>named:next:done:output: (in category 'instance creation') -----
named: anInteger next: aThread done: aSemaphore output: aStream
   ^self new name: anInteger; nextThread: aThread; done: aSemaphore; output: aStream; fork !
----- Method: ShootoutThread class>>new (in category 'instance creation') -----
new
   ^self basicNew semaphore: Semaphore new !
----- Method: ShootoutThread>>done: (in category 'accessing') -----
done: aSemaphore
   done := aSemaphore !
----- Method: ShootoutThread>>fork (in category 'accessing') -----
fork
   [ self run ] fork !
----- Method: ShootoutThread>>name: (in category 'accessing') -----
name: anInteger
   name := anInteger !
----- Method: ShootoutThread>>nextThread: (in category 'accessing') -----
nextThread: aThread
   nextThread := aThread !
----- Method: ShootoutThread>>output: (in category 'accessing') -----
output: anObject
    "Set the value of output"
output := anObject!
----- Method: ShootoutThread>>run (in category 'accessing') -----
run
   [ self tokenNotDone ] whileTrue: [ nextThread takeToken: token - 1 ].
   output print: name.
   output name = 'stdout'
    ifTrue: [output nl]
    ifFalse: [output cr; flush].
   done signal !
----- Method: ShootoutThread>>semaphore: (in category 'accessing') -----
semaphore: aSemaphore
   semaphore := aSemaphore !
----- Method: ShootoutThread>>takeToken: (in category 'accessing') -----
takeToken: x
   token := x.
   semaphore signal !
----- Method: ShootoutThread>>tokenNotDone (in category 'accessing') -----
tokenNotDone
   semaphore wait.
   ^token > 0 !
Object subclass: #ShootoutTreeNode
    instanceVariableNames: 'left right item'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'CogBenchmarks-Shootout'!
----- Method: ShootoutTreeNode class>>bottomUpTree:depth: (in category 'instance creation') -----
bottomUpTree: anItem depth: anInteger
    ^(anInteger > 0)
    	ifTrue: [
    		self
    			left: (self bottomUpTree: 2*anItem - 1 depth: anInteger - 1)
    			right: (self bottomUpTree: 2*anItem depth: anInteger - 1) 
    			item: anItem
    		]
    	ifFalse: [self left: nil right: nil item: anItem]!
----- Method: ShootoutTreeNode class>>left:right:item: (in category 'instance creation') -----
left: leftChild right: rightChild item: anItem
    ^(super new) left: leftChild right: rightChild item: anItem!
----- Method: ShootoutTreeNode>>itemCheck (in category 'accessing') -----
itemCheck
    ^left isNil
    	ifTrue: [item] ifFalse: [item + (left itemCheck - right itemCheck)]!
----- Method: ShootoutTreeNode>>left:right:item: (in category 'initialize-release') -----
left: leftChild right: rightChild item: anItem
    left := leftChild.
    right := rightChild.
    item := anItem!
----- Method: DummyStream>>cr (in category '*CogBenchmarks-Shootout-platform') -----
cr!
----- Method: DummyStream>>nl (in category '*CogBenchmarks-Shootout-platform') -----
nl
    "do nothing"!
----- Method: DummyStream>>print:digits: (in category '*CogBenchmarks-Shootout-platform') -----
print: number digits: decimalPlaces
    "do nothing"!
----- Method: DummyStream>>print:paddedTo: (in category '*CogBenchmarks-Shootout-platform') -----
print: number paddedTo: width
    "do nothing"!
----- Method: DummyStream>>space (in category '*CogBenchmarks-Shootout-platform') -----
space!
----- Method: DummyStream>>tab (in category '*CogBenchmarks-Shootout-platform') -----
tab!
OrderedCollection subclass: #DBPlan
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'CogBenchmarks-DeltaBlue'!
!DBPlan commentStamp: '<historical>' prior: 0!
A Plan is an ordered list of constraints to be executed in sequence to resatisfy all currently satisfiable constraints in the face of one or more changing inputs.!
----- Method: DBPlan>>execute (in category 'planning') -----
execute
    "Execute my constraints in order."
self do: [: c | c execute].!
----- Method: Stream>>nl (in category '*CogBenchmarks-Shootout-platform') -----
nl
   self nextPut: Character lf!
----- Method: Stream>>print:digits: (in category '*CogBenchmarks-Shootout-platform') -----
print: number digits: decimalPlaces
   | precision rounded |
   decimalPlaces <= 0 ifTrue: [^ number rounded printString].
   precision := Utilities floatPrecisionForDecimalPlaces: decimalPlaces.
   rounded := number roundTo: precision.
   self nextPutAll: 
      ((rounded asScaledDecimal: decimalPlaces) printString copyUpTo: $s)!
----- Method: Stream>>print:paddedTo: (in category '*CogBenchmarks-Shootout-platform') -----
print: number paddedTo: width
   self nextPutAll: (number printStringLength: width padded: false)!

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

[Vm-dev] VM Maker: CogBenchmarks-eem.1.mcz