[Vm-dev] VM Maker: Cog-eem.203.mcz
commits at source.squeak.org
commits at source.squeak.org
Wed Sep 10 01:04:00 UTC 2014
Eliot Miranda uploaded a new version of Cog to project VM Maker:
http://source.squeak.org/VMMaker/Cog-eem.203.mcz
==================== Summary ====================
Name: Cog-eem.203
Author: eem
Time: 9 September 2014, 6:03:43.192 pm
UUID: 02fc7421-8e8a-44a7-b3c4-afabcae96867
Ancestors: Cog-eem.202
Merge with Cog.pharo-EstebanLorenzano.201.
Move the Spur bootstrap prototypes to their own
hierarchy. Remove the benchmarks; these are now in
CogBenchmarks.
=============== Diff against Cog-eem.202 ===============
Item was changed:
- SystemOrganization addCategory: #'Cog-Benchmarks-DeltaBlue'!
- SystemOrganization addCategory: #'Cog-Benchmarks-Richards'!
- SystemOrganization addCategory: #'Cog-Benchmarks-SMark'!
- SystemOrganization addCategory: #'Cog-Benchmarks-Shootout'!
SystemOrganization addCategory: #'Cog-Bootstrapping'!
SystemOrganization addCategory: #'Cog-Morphing Bytecode Set'!
SystemOrganization addCategory: #'Cog-ProcessorPlugins'!
SystemOrganization addCategory: #'Cog-Processors'!
SystemOrganization addCategory: #'Cog-Processors-Tests'!
SystemOrganization addCategory: #'Cog-Scripting'!
SystemOrganization addCategory: #'Cog-Scripts'!
SystemOrganization addCategory: #'Cog-Tests'!
Item was added:
+ ----- Method: Behavior>>BehaviorPROTOTYPEinstSize (in category '*Cog-method prototypes') -----
+ BehaviorPROTOTYPEinstSize
+ "Answer the number of named instance variables
+ (as opposed to indexed variables) of the receiver.
+ Above Cog Spur the class format is
+ <5 bits inst spec><16 bits inst size>"
+ ^format bitAnd: 16rFFFF!
Item was added:
+ ----- Method: Behavior>>BehaviorPROTOTYPEinstSpec (in category '*Cog-method prototypes') -----
+ BehaviorPROTOTYPEinstSpec
+ "Answer the instance specification part of the format that defines what kind of object
+ an instance of the receiver is. The formats are
+ 0 = 0 sized objects (UndefinedObject True False et al)
+ 1 = non-indexable objects with inst vars (Point et al)
+ 2 = indexable objects with no inst vars (Array et al)
+ 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
+ 4 = weak indexable objects with inst vars (WeakArray et al)
+ 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
+ 6 = unused
+ 7 = immediates (SmallInteger, Character)
+ 8 = unused
+ 9 = 64-bit indexable
+ 10-11 = 32-bit indexable (Bitmap)
+ 12-15 = 16-bit indexable
+ 16-23 = 8-bit indexable
+ 24-31 = compiled methods (CompiledMethod)"
+ ^(format bitShift: -16) bitAnd: 16r1F!
Item was added:
+ ----- Method: BlockClosure>>BlockClosurePHAROPROTOTYPEsimulateValueWithArguments:caller: (in category '*Cog-method prototypes') -----
+ BlockClosurePHAROPROTOTYPEsimulateValueWithArguments: anArray caller: aContext
+ "Simulate the valueWithArguments: primitive. Fail if anArray is not an array of the right arity."
+ | newContext sz |
+ newContext := (Context newForMethod: outerContext method)
+ setSender: aContext
+ receiver: outerContext receiver
+ method: outerContext method
+ closure: self
+ startpc: startpc.
+ ((newContext objectClass: anArray) ~~ Array
+ or: [numArgs ~= anArray size]) ifTrue:
+ [^Context primitiveFailTokenFor: nil].
+ sz := self basicSize.
+ newContext stackp: sz + numArgs.
+ 1 to: numArgs do:
+ [:i| newContext at: i put: (anArray at: i)].
+ 1 to: sz do:
+ [:i| newContext at: i + numArgs put: (self at: i)].
+ ^newContext!
Item was added:
+ ----- Method: ClassDescription>>ClassDescriptionPROTOTYPEupdateMethodBindingsTo: (in category '*Cog-method prototypes squeak') -----
+ ClassDescriptionPROTOTYPEupdateMethodBindingsTo: aBinding
+ "ClassBuilder support for maintaining valid method bindings."
+ methodDict do: [:method| method methodClassAssociation: aBinding]!
Item was added:
+ ----- Method: Context>>ContextPROTOTYPEdoPrimitive:method:receiver:args: (in category '*Cog-method prototypes') -----
+ ContextPROTOTYPEdoPrimitive: primitiveIndex method: meth receiver: aReceiver args: arguments
+ "Simulate a primitive method whose index is primitiveIndex. The simulated receiver and
+ arguments are given as arguments to this message. If successful, push result and return
+ resuming context, else ^ {errCode, PrimitiveFailToken}. Any primitive which provokes
+ execution needs to be intercepted and simulated to avoid execution running away."
+
+ | value |
+ "Judicious use of primitive 19 (a null primitive that doesn't do anything) prevents
+ the debugger from entering various run-away activities such as spawning a new
+ process, etc. Injudicious use results in the debugger not being able to debug
+ interesting code, such as the debugger itself. hence use primitive 19 with care :-)"
+ "SystemNavigation new browseAllSelect: [:m| m primitive = 19]"
+ primitiveIndex = 19 ifTrue:
+ [ Smalltalk tools debugger
+ openContext: self
+ label:'Code simulation error'
+ contents: nil].
+
+ ((primitiveIndex between: 201 and: 222)
+ and: [aReceiver class includesBehavior: BlockClosure]) ifTrue:
+ [((primitiveIndex between: 201 and: 205) "BlockClosure>>value[:value:...]"
+ or: [primitiveIndex between: 221 and: 222]) ifTrue: "BlockClosure>>valueNoContextSwitch[:]"
+ [^aReceiver simulateValueWithArguments: arguments caller: self].
+ primitiveIndex = 206 ifTrue: "BlockClosure>>valueWithArguments:"
+ [^aReceiver simulateValueWithArguments: arguments first caller: self]].
+
+ primitiveIndex = 83 ifTrue: "afr 9/11/1998 19:50" "Object>>perform:[with:...]"
+ [^self send: arguments first to: aReceiver with: arguments allButFirst super: false].
+ primitiveIndex = 84 ifTrue: "afr 9/11/1998 19:50 & eem 8/18/2009 17:04" "Object>>perform:withArguments:"
+ [^self send: arguments first to: aReceiver with: (arguments at: 2) lookupIn: (self objectClass: aReceiver)].
+ primitiveIndex = 100 ifTrue: "eem 8/18/2009 16:57" "Object>>perform:withArguments:inSuperclass:"
+ [^self send: arguments first to: aReceiver with: (arguments at: 2) lookupIn: (arguments at: 3)].
+
+ "Mutex>>primitiveEnterCriticalSection
+ Mutex>>primitiveTestAndSetOwnershipOfCriticalSection"
+ (primitiveIndex = 186 or: [primitiveIndex = 187]) ifTrue:
+ [| active effective |
+ active := Processor activeProcess.
+ effective := active effectiveProcess.
+ "active == effective"
+ value := primitiveIndex = 186
+ ifTrue: [aReceiver primitiveEnterCriticalSectionOnBehalfOf: effective]
+ ifFalse: [aReceiver primitiveTestAndSetOwnershipOfCriticalSectionOnBehalfOf: effective].
+ ^(self isPrimFailToken: value)
+ ifTrue: [value]
+ ifFalse: [self push: value]].
+
+ primitiveIndex = 188 ifTrue: "eem 5/27/2008 11:10 Object>>withArgs:executeMethod:"
+ [^Context
+ sender: self
+ receiver: aReceiver
+ method: (arguments at: 2)
+ arguments: (arguments at: 1)].
+
+ "Closure primitives"
+ (primitiveIndex = 200 and: [self == aReceiver]) ifTrue:
+ "ContextPart>>closureCopy:copiedValues:; simulated to get startpc right"
+ [^self push: (BlockClosure
+ outerContext: aReceiver
+ startpc: pc + 2
+ numArgs: arguments first
+ copiedValues: arguments last)].
+
+ primitiveIndex = 118 ifTrue: "tryPrimitive:withArgs:; avoid recursing in the VM"
+ [(arguments size = 2
+ and: [arguments first isInteger
+ and: [(self objectClass: arguments last) == Array]]) ifFalse:
+ [^Context primitiveFailTokenFor: nil].
+ ^self doPrimitive: arguments first method: meth receiver: aReceiver args: arguments last].
+
+ value := primitiveIndex = 120 "FFI method"
+ ifTrue: [(meth literalAt: 1) tryInvokeWithArguments: arguments]
+ ifFalse:
+ [primitiveIndex = 117 "named primitives"
+ ifTrue: [self tryNamedPrimitiveIn: meth for: aReceiver withArgs: arguments]
+ ifFalse: [aReceiver tryPrimitive: primitiveIndex withArgs: arguments]].
+
+ ^(self isPrimFailToken: value)
+ ifTrue: [value]
+ ifFalse: [self push: value]!
Item was added:
+ ----- Method: Context>>ContextPROTOTYPEfailPrimitiveWith: (in category '*Cog-method prototypes') -----
+ ContextPROTOTYPEfailPrimitiveWith: maybePrimFailToken
+ "The receiver is a freshly-created context on a primitive method. Skip the callPrimitive:
+ bytecode and store the primitive fail code if there is one and the method consumes it."
+ self skipCallPrimitive.
+ ((self isPrimFailToken: maybePrimFailToken)
+ and: [method encoderClass isStoreAt: pc in: method]) ifTrue:
+ [self at: stackp put: maybePrimFailToken last]!
Item was added:
+ ----- Method: Context>>ContextPROTOTYPEisPrimFailToken: (in category '*Cog-method prototypes') -----
+ ContextPROTOTYPEisPrimFailToken: anObject
+ ^ anObject class == Array
+ and: [anObject size = 2
+ and: [anObject first == PrimitiveFailToken]]!
Item was removed:
- Object subclass: #DBAbstractConstraint
- instanceVariableNames: 'strength'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Cog-Benchmarks-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>!
Item was removed:
- ----- Method: DBAbstractConstraint>>addConstraint (in category 'adding') -----
- addConstraint
- "Activate this constraint and attempt to satisfy it."
-
- self addToGraph.
- DBPlanner current incrementalAdd: self.!
Item was removed:
- ----- Method: DBAbstractConstraint>>addToGraph (in category 'adding') -----
- addToGraph
- "Add myself to the constraint graph."
-
- self subclassResponsibility!
Item was removed:
- ----- 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!
Item was removed:
- ----- 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.!
Item was removed:
- ----- Method: DBAbstractConstraint>>execute (in category 'planning') -----
- execute
- "Enforce this constraint. Assume that it is satisfied."
-
- self subclassResponsibility!
Item was removed:
- ----- 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!
Item was removed:
- ----- 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!
Item was removed:
- ----- 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!
Item was removed:
- ----- Method: DBAbstractConstraint>>isSatisfied (in category 'testing') -----
- isSatisfied
- "Answer true if this constraint is satisfied in the current solution."
-
- self subclassResponsibility!
Item was removed:
- ----- 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.!
Item was removed:
- ----- Method: DBAbstractConstraint>>markUnsatisfied (in category 'planning') -----
- markUnsatisfied
- "Record the fact that I am unsatisfied."
-
- self subclassResponsibility!
Item was removed:
- ----- Method: DBAbstractConstraint>>output (in category 'planning') -----
- output
- "Answer my current output variable. Raise an error if I am not
- currently satisfied."
-
- self subclassResponsibility!
Item was removed:
- ----- Method: DBAbstractConstraint>>printOn: (in category 'printing') -----
- printOn: aStream
-
- self shortPrintOn: aStream!
Item was removed:
- ----- 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!
Item was removed:
- ----- Method: DBAbstractConstraint>>removeFromGraph (in category 'adding') -----
- removeFromGraph
- "Remove myself from the constraint graph."
-
- self subclassResponsibility!
Item was removed:
- ----- 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!
Item was removed:
- ----- Method: DBAbstractConstraint>>shortPrintOn: (in category 'printing') -----
- shortPrintOn: aStream
-
- aStream nextPutAll: self class name, '(', self printString, ')'.!
Item was removed:
- ----- Method: DBAbstractConstraint>>strength (in category 'accessing') -----
- strength
- ^ strength!
Item was removed:
- ----- Method: DBAbstractConstraint>>strength: (in category 'accessing') -----
- strength: anObject
- strength := anObject!
Item was removed:
- DBAbstractConstraint subclass: #DBBinaryConstraint
- instanceVariableNames: 'direction v1 v2'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Cog-Benchmarks-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)!
Item was removed:
- ----- 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!
Item was removed:
- ----- Method: DBBinaryConstraint>>addToGraph (in category 'adding') -----
- addToGraph
- "Add myself to the constraint graph."
-
- v1 addConstraint: self.
- v2 addConstraint: self.
- direction := nil.!
Item was removed:
- ----- 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 ]]. !
Item was removed:
- ----- Method: DBBinaryConstraint>>execute (in category 'planning') -----
- execute
- "Enforce this constraint. Assume that it is satisfied."
-
- self subclassResponsibility!
Item was removed:
- ----- 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 ].!
Item was removed:
- ----- Method: DBBinaryConstraint>>isSatisfied (in category 'testing') -----
- isSatisfied
- "Answer true if this constraint is satisfied in the current solution."
-
- ^ direction notNil!
Item was removed:
- ----- Method: DBBinaryConstraint>>markUnsatisfied (in category 'planning') -----
- markUnsatisfied
- "Record the fact that I am unsatisfied."
-
- direction := nil.!
Item was removed:
- ----- Method: DBBinaryConstraint>>output (in category 'planning') -----
- output
- "Answer my current output variable."
-
- ^ direction == #forward
- ifTrue: [ v2 ]
- ifFalse: [ v1 ]!
Item was removed:
- ----- 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"!
Item was removed:
- ----- 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.!
Item was removed:
- ----- 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.!
Item was removed:
- DBUnaryConstraint subclass: #DBEditConstraint
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Cog-Benchmarks-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."!
Item was removed:
- ----- Method: DBEditConstraint>>execute (in category 'planning') -----
- execute
- "Edit constraints do nothing."!
Item was removed:
- ----- Method: DBEditConstraint>>isInput (in category 'testing') -----
- isInput
- "I indicate that a variable is to be changed by imperative code."
-
- ^true!
Item was removed:
- DBBinaryConstraint subclass: #DBEqualityConstraint
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Cog-Benchmarks-DeltaBlue'!
-
- !DBEqualityConstraint commentStamp: '<historical>' prior: 0!
- I constrain two variables to have the same value: "v1 = v2".!
Item was removed:
- ----- 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].!
Item was removed:
- OrderedCollection subclass: #DBPlan
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Cog-Benchmarks-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.!
Item was removed:
- ----- Method: DBPlan>>execute (in category 'planning') -----
- execute
- "Execute my constraints in order."
-
- self do: [: c | c execute].!
Item was removed:
- Object subclass: #DBPlanner
- instanceVariableNames: 'currentMark'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Cog-Benchmarks-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'!
Item was removed:
- ----- Method: DBPlanner class>>current (in category 'accessing') -----
- current
- ^ currentPlanner!
Item was removed:
- ----- Method: DBPlanner class>>new (in category 'instance creation') -----
- new
- ^ currentPlanner := super new!
Item was removed:
- ----- 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]].!
Item was removed:
- ----- 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!
Item was removed:
- ----- 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.!
Item was removed:
- ----- 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]].!
Item was removed:
- ----- 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!
Item was removed:
- ----- 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!
Item was removed:
- ----- 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].!
Item was removed:
- ----- 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].!
Item was removed:
- ----- Method: DBPlanner>>initialize (in category 'initialize') -----
- initialize
-
- super initialize.
-
- currentMark := 1.!
Item was removed:
- ----- 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!
Item was removed:
- ----- 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!
Item was removed:
- ----- 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].!
Item was removed:
- ----- 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!
Item was removed:
- DBBinaryConstraint subclass: #DBScaleConstraint
- instanceVariableNames: 'offset scale'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Cog-Benchmarks-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>!
Item was removed:
- ----- 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!
Item was removed:
- ----- Method: DBScaleConstraint>>addToGraph (in category 'adding') -----
- addToGraph
- "Add myself to the constraint graph."
-
- super addToGraph.
- scale addConstraint: self.
- offset addConstraint: self.
- !
Item was removed:
- ----- 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].!
Item was removed:
- ----- 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].!
Item was removed:
- ----- 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"!
Item was removed:
- ----- 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].
- !
Item was removed:
- ----- 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.!
Item was removed:
- DBUnaryConstraint subclass: #DBStayConstraint
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Cog-Benchmarks-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."!
Item was removed:
- ----- Method: DBStayConstraint>>execute (in category 'planning') -----
- execute
- "Stay constraints do nothing."!
Item was removed:
- Object subclass: #DBStrength
- instanceVariableNames: 'symbolicValue arithmeticValue'
- classVariableNames: 'AbsoluteStrongest AbsoluteWeakest Required StrengthConstants StrengthTable'
- poolDictionaries: ''
- category: 'Cog-Benchmarks-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>!
Item was removed:
- ----- Method: DBStrength class>>absoluteStrongest (in category 'constants') -----
- absoluteStrongest
-
- ^AbsoluteStrongest!
Item was removed:
- ----- Method: DBStrength class>>absoluteWeakest (in category 'constants') -----
- absoluteWeakest
-
- ^AbsoluteWeakest!
Item was removed:
- ----- 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.!
Item was removed:
- ----- Method: DBStrength class>>of: (in category 'instance creation') -----
- of: aSymbol
- "Answer an instance with the specified strength."
-
- ^ StrengthConstants at: aSymbol!
Item was removed:
- ----- Method: DBStrength class>>required (in category 'constants') -----
- required
-
- ^Required!
Item was removed:
- ----- Method: DBStrength>>arithmeticValue (in category 'private') -----
- arithmeticValue
- "Answer my arithmetic value. Used for comparisons. Note that
- STRONGER constraints have SMALLER arithmetic values."
-
- ^arithmeticValue!
Item was removed:
- ----- Method: DBStrength>>initializeWith: (in category 'private') -----
- initializeWith: symVal
- "Record my symbolic value and reset my arithmetic value."
-
- symbolicValue := symVal.
- arithmeticValue := StrengthTable at: symbolicValue.!
Item was removed:
- ----- Method: DBStrength>>printOn: (in category 'printing') -----
- printOn: aStream
- "Append a string which represents my strength onto aStream."
-
- aStream nextPutAll: '%', symbolicValue, '%'.!
Item was removed:
- ----- Method: DBStrength>>sameAs: (in category 'comparing') -----
- sameAs: aStrength
- "Answer true if I am the same strength as the given Strength."
-
- ^ arithmeticValue = aStrength arithmeticValue!
Item was removed:
- ----- Method: DBStrength>>stronger: (in category 'comparing') -----
- stronger: aStrength
- "Answer true if I am stronger than the given Strength."
-
- ^ arithmeticValue < aStrength arithmeticValue!
Item was removed:
- ----- Method: DBStrength>>strongest: (in category 'max / min') -----
- strongest: aStrength
- "Answer the stronger of myself and aStrength."
-
- ^ (aStrength stronger: self)
- ifTrue: [aStrength]
- ifFalse: [self]!
Item was removed:
- ----- Method: DBStrength>>weaker: (in category 'comparing') -----
- weaker: aStrength
- "Answer true if I am weaker than the given Strength."
-
- ^ arithmeticValue > aStrength arithmeticValue!
Item was removed:
- ----- Method: DBStrength>>weakest: (in category 'max / min') -----
- weakest: aStrength
- "Answer the weaker of myself and aStrength."
-
- ^ (aStrength weaker: self)
- ifTrue: [aStrength]
- ifFalse: [self].!
Item was removed:
- DBAbstractConstraint subclass: #DBUnaryConstraint
- instanceVariableNames: 'output satisfied'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Cog-Benchmarks-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>!
Item was removed:
- ----- 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!
Item was removed:
- ----- Method: DBUnaryConstraint>>addToGraph (in category 'adding') -----
- addToGraph
- "Add myself to the constraint graph."
-
- output addConstraint: self.
- satisfied := false.!
Item was removed:
- ----- 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].!
Item was removed:
- ----- Method: DBUnaryConstraint>>execute (in category 'planning') -----
- execute
- "Enforce this constraint. Assume that it is satisfied."
-
- self subclassResponsibility!
Item was removed:
- ----- Method: DBUnaryConstraint>>inputsDo: (in category 'planning') -----
- inputsDo: aBlock
- "I have no input variables."!
Item was removed:
- ----- Method: DBUnaryConstraint>>isSatisfied (in category 'testing') -----
- isSatisfied
- "Answer true if this constraint is satisfied in the current solution."
-
- ^satisfied!
Item was removed:
- ----- Method: DBUnaryConstraint>>markUnsatisfied (in category 'planning') -----
- markUnsatisfied
- "Record the fact that I am unsatisfied."
-
- satisfied := false.!
Item was removed:
- ----- Method: DBUnaryConstraint>>output (in category 'planning') -----
- output
- "Answer my current output variable."
-
- ^ output!
Item was removed:
- ----- 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"!
Item was removed:
- ----- Method: DBUnaryConstraint>>removeFromGraph (in category 'adding') -----
- removeFromGraph
- "Remove myself from the constraint graph."
-
- output ifNotNil: [ :out | out removeConstraint: self].
- satisfied := false.!
Item was removed:
- ----- 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.!
Item was removed:
- Object subclass: #DBVariable
- instanceVariableNames: 'constraints determinedBy mark stay value walkStrength'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Cog-Benchmarks-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>!
Item was removed:
- ----- Method: DBVariable class>>value: (in category 'instance creation') -----
- value: aValue
-
- ^self new value: aValue!
Item was removed:
- ----- 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.!
Item was removed:
- ----- Method: DBVariable>>constraints (in category 'accessing') -----
- constraints
- ^ constraints!
Item was removed:
- ----- Method: DBVariable>>determinedBy (in category 'accessing') -----
- determinedBy
- ^ determinedBy!
Item was removed:
- ----- Method: DBVariable>>determinedBy: (in category 'accessing') -----
- determinedBy: anObject
- determinedBy := anObject!
Item was removed:
- ----- Method: DBVariable>>initialize (in category 'initialize') -----
- initialize
-
- super initialize.
-
- value := 0.
- constraints := OrderedCollection new: 2.
- determinedBy := nil.
- walkStrength := DBStrength absoluteWeakest.
- stay := true.
- mark := 0.!
Item was removed:
- ----- 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.!
Item was removed:
- ----- Method: DBVariable>>mark (in category 'accessing') -----
- mark
- ^ mark!
Item was removed:
- ----- Method: DBVariable>>mark: (in category 'accessing') -----
- mark: anObject
- mark := anObject!
Item was removed:
- ----- Method: DBVariable>>printOn: (in category 'printing') -----
- printOn: aStream
-
- self shortPrintOn: aStream!
Item was removed:
- ----- 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].!
Item was removed:
- ----- 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.!
Item was removed:
- ----- 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.!
Item was removed:
- ----- 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.!
Item was removed:
- ----- Method: DBVariable>>stay (in category 'accessing') -----
- stay
- ^ stay!
Item was removed:
- ----- Method: DBVariable>>stay: (in category 'accessing') -----
- stay: anObject
- stay := anObject!
Item was removed:
- ----- Method: DBVariable>>value (in category 'accessing') -----
- value
- ^ value!
Item was removed:
- ----- Method: DBVariable>>value: (in category 'accessing') -----
- value: anObject
- value := anObject!
Item was removed:
- ----- Method: DBVariable>>walkStrength (in category 'accessing') -----
- walkStrength
- ^ walkStrength!
Item was removed:
- ----- Method: DBVariable>>walkStrength: (in category 'accessing') -----
- walkStrength: anObject
- walkStrength := anObject!
Item was removed:
- ----- Method: DummyStream>>cr (in category '*Cog-Benchmarks-Shootout-platform') -----
- cr!
Item was removed:
- ----- Method: DummyStream>>nl (in category '*Cog-Benchmarks-Shootout-platform') -----
- nl
- "do nothing"!
Item was removed:
- ----- Method: DummyStream>>print:digits: (in category '*Cog-Benchmarks-Shootout-platform') -----
- print: number digits: decimalPlaces
- "do nothing"!
Item was removed:
- ----- Method: DummyStream>>print:paddedTo: (in category '*Cog-Benchmarks-Shootout-platform') -----
- print: number paddedTo: width
- "do nothing"!
Item was removed:
- ----- Method: DummyStream>>space (in category '*Cog-Benchmarks-Shootout-platform') -----
- space!
Item was removed:
- ----- Method: DummyStream>>tab (in category '*Cog-Benchmarks-Shootout-platform') -----
- tab!
Item was removed:
- SMarkHarness subclass: #ReBenchHarness
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Cog-Benchmarks-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!
Item was removed:
- ----- Method: ReBenchHarness class>>defaultArgumentParser (in category 'helper') -----
- defaultArgumentParser
- ^ ReBenchHarnessArgumentParser!
Item was removed:
- ----- Method: ReBenchHarness class>>defaultReporter (in category 'defaults') -----
- defaultReporter
- ^ ReBenchReporter!
Item was removed:
- ----- Method: ReBenchHarness class>>defaultRunner (in category 'defaults') -----
- defaultRunner
- ^ SMarkWeakScalingRunner!
Item was removed:
- ----- 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.
- !
Item was removed:
- ----- 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!
Item was removed:
- ----- Method: ReBenchHarness class>>usageReporter: (in category 'helper') -----
- usageReporter: usage
- "Will rely on default, which is good for ReBench, so do not advertise option."
- ^ usage!
Item was removed:
- ----- Method: ReBenchHarness class>>usageRunner: (in category 'helper') -----
- usageRunner: usage
- "Will rely on default, which is good for ReBench, so do not advertise option."
- ^ usage!
Item was removed:
- SMarkHarnessArgumentParser subclass: #ReBenchHarnessArgumentParser
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Cog-Benchmarks-SMark'!
Item was removed:
- ----- 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.
- ]
- ]
- ].!
Item was removed:
- ----- Method: ReBenchHarnessArgumentParser>>determineReporter (in category 'argument parsing') -----
- determineReporter
- reporter := harness defaultReporter new.!
Item was removed:
- ----- Method: ReBenchHarnessArgumentParser>>determineRunner (in category 'argument parsing') -----
- determineRunner
- runner := harness defaultRunner new.!
Item was removed:
- ----- Method: ReBenchHarnessArgumentParser>>instructRunner (in category 'helper') -----
- instructRunner
- super instructRunner.
-
- runner iterations: runner class defaultNumberOfIterations.
- runner innerIterations: iterations.!
Item was removed:
- SMarkSimpleStatisticsReporter subclass: #ReBenchReporter
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Cog-Benchmarks-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.!
Item was removed:
- ----- Method: ReBenchReporter>>benchmarkHeader: (in category 'as yet unclassified') -----
- benchmarkHeader: aName
- ^ self!
Item was removed:
- RichObject subclass: #RichDeviceTaskDataRecord
- instanceVariableNames: 'pending'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Cog-Benchmarks-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.
- !
Item was removed:
- ----- Method: RichDeviceTaskDataRecord>>pending (in category 'accessing') -----
- pending
- ^ pending!
Item was removed:
- ----- Method: RichDeviceTaskDataRecord>>pending: (in category 'accessing') -----
- pending: anObject
- pending := anObject!
Item was removed:
- RichObject subclass: #RichHandlerTaskDataRecord
- instanceVariableNames: 'workIn deviceIn'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Cog-Benchmarks-Richards'!
-
- !RichHandlerTaskDataRecord commentStamp: '<historical>' prior: 0!
- A task that manipulates work packets and then suspends itself.!
Item was removed:
- ----- Method: RichHandlerTaskDataRecord>>deviceIn (in category 'accessing') -----
- deviceIn
- ^ deviceIn!
Item was removed:
- ----- Method: RichHandlerTaskDataRecord>>deviceIn: (in category 'accessing') -----
- deviceIn: anObject
- deviceIn := anObject!
Item was removed:
- ----- Method: RichHandlerTaskDataRecord>>deviceInAdd: (in category 'accessing') -----
- deviceInAdd: packet
- deviceIn := self append: packet head: deviceIn!
Item was removed:
- ----- Method: RichHandlerTaskDataRecord>>workIn (in category 'accessing') -----
- workIn
- ^ workIn!
Item was removed:
- ----- Method: RichHandlerTaskDataRecord>>workIn: (in category 'accessing') -----
- workIn: anObject
- workIn := anObject!
Item was removed:
- ----- Method: RichHandlerTaskDataRecord>>workInAdd: (in category 'accessing') -----
- workInAdd: packet
- workIn := self append: packet head: workIn!
Item was removed:
- RichObject subclass: #RichIdleTaskDataRecord
- instanceVariableNames: 'control count'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Cog-Benchmarks-Richards'!
-
- !RichIdleTaskDataRecord commentStamp: '<historical>' prior: 0!
- An idle task doesn't do any work itself but cycles control between the two device tasks.!
Item was removed:
- ----- Method: RichIdleTaskDataRecord>>control (in category 'accessing') -----
- control
- ^ control!
Item was removed:
- ----- Method: RichIdleTaskDataRecord>>control: (in category 'accessing') -----
- control: anObject
- control := anObject!
Item was removed:
- ----- Method: RichIdleTaskDataRecord>>count (in category 'accessing') -----
- count
- ^ count!
Item was removed:
- ----- Method: RichIdleTaskDataRecord>>count: (in category 'accessing') -----
- count: anObject
- count := anObject!
Item was removed:
- ----- Method: RichIdleTaskDataRecord>>initialize (in category 'initialize') -----
- initialize
- control := 1.
- count := 10000!
Item was removed:
- Object subclass: #RichObject
- instanceVariableNames: ''
- classVariableNames: 'DeviceA DeviceB DevicePacketKind HandlerA HandlerB Idler WorkPacketKind Worker'
- poolDictionaries: ''
- category: 'Cog-Benchmarks-Richards'!
-
- !RichObject commentStamp: '<historical>' prior: 0!
- This class mostly adds some constants that are used in the Richards benchmarks.!
Item was removed:
- ----- 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!
Item was removed:
- ----- 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!
Item was removed:
- RichObject subclass: #RichPacket
- instanceVariableNames: 'data datum identity kind link'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Cog-Benchmarks-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.!
Item was removed:
- ----- Method: RichPacket class>>create:identity:kind: (in category 'instance creation') -----
- create: link identity: identity kind: kind
- ^ self new
- link: link
- identity: identity
- kind: kind!
Item was removed:
- ----- Method: RichPacket>>data (in category 'accessing') -----
- data
- ^ data!
Item was removed:
- ----- Method: RichPacket>>datum (in category 'accessing') -----
- datum
- ^ datum!
Item was removed:
- ----- Method: RichPacket>>datum: (in category 'accessing') -----
- datum: anObject
- datum := anObject!
Item was removed:
- ----- Method: RichPacket>>identity (in category 'accessing') -----
- identity
- ^ identity!
Item was removed:
- ----- Method: RichPacket>>identity: (in category 'accessing') -----
- identity: anObject
- identity := anObject!
Item was removed:
- ----- Method: RichPacket>>kind (in category 'accessing') -----
- kind
- ^ kind!
Item was removed:
- ----- Method: RichPacket>>link (in category 'accessing') -----
- link
- ^ link!
Item was removed:
- ----- Method: RichPacket>>link: (in category 'accessing') -----
- link: anObject
- link := anObject!
Item was removed:
- ----- 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!
Item was removed:
- RichObject subclass: #RichRunner
- instanceVariableNames: 'taskList currentTask currentTaskIdentity taskTable queuePacketCount holdCount'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Cog-Benchmarks-Richards'!
-
- !RichRunner commentStamp: '<historical>' prior: 0!
- Richards simulates the task dispatcher of an operating system.!
Item was removed:
- ----- Method: RichRunner class>>start (in category 'starting') -----
- start
- "RichardsBenchmark start"
-
- ^self new start!
Item was removed:
- ----- 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!
Item was removed:
- ----- 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!
Item was removed:
- ----- 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!
Item was removed:
- ----- Method: RichRunner>>createPacket:identity:kind: (in category 'creation') -----
- createPacket: link identity: identity kind: kind
- ^ RichPacket
- create: link
- identity: identity
- kind: kind!
Item was removed:
- ----- 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!
Item was removed:
- ----- 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!
Item was removed:
- ----- Method: RichRunner>>findTask: (in category 'private') -----
- findTask: identity
- | t |
- t := taskTable at: identity.
- t ifNil: [self error: 'findTask failed'].
- ^ t!
Item was removed:
- ----- Method: RichRunner>>holdSelf (in category 'private') -----
- holdSelf
- holdCount := holdCount + 1.
- currentTask taskHolding: true.
- ^ currentTask link!
Item was removed:
- ----- Method: RichRunner>>initScheduler (in category 'private') -----
- initScheduler
- queuePacketCount := holdCount := 0.
- taskTable := Array new: 6.
- taskList := nil!
Item was removed:
- ----- 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!
Item was removed:
- ----- 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 ]!
Item was removed:
- ----- 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]]!
Item was removed:
- ----- 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'].
- !
Item was removed:
- ----- Method: RichRunner>>wait (in category 'private') -----
- wait
- currentTask taskWaiting: true.
- ^ currentTask!
Item was removed:
- RichTaskState subclass: #RichTaskControlBlock
- instanceVariableNames: 'link identity priority input state function handle'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Cog-Benchmarks-Richards'!
-
- !RichTaskControlBlock commentStamp: '<historical>' prior: 0!
- A task control block manages a task and the queue of work packages associated with it.!
Item was removed:
- ----- 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!
Item was removed:
- ----- 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!
Item was removed:
- ----- Method: RichTaskControlBlock>>identity (in category 'accessing') -----
- identity
- ^ identity!
Item was removed:
- ----- Method: RichTaskControlBlock>>link (in category 'accessing') -----
- link
- ^ link!
Item was removed:
- ----- 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!
Item was removed:
- ----- Method: RichTaskControlBlock>>priority (in category 'accessing') -----
- priority
- ^ priority!
Item was removed:
- ----- 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!
Item was removed:
- RichObject subclass: #RichTaskState
- instanceVariableNames: 'packetPendingIV taskHolding taskWaiting'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Cog-Benchmarks-Richards'!
-
- !RichTaskState commentStamp: '<historical>' prior: 0!
- Abstract task that manipulates work packets.!
Item was removed:
- ----- Method: RichTaskState class>>packetPending (in category 'instance creation') -----
- packetPending
- ^super new packetPending!
Item was removed:
- ----- Method: RichTaskState class>>running (in category 'instance creation') -----
- running
- ^super new running!
Item was removed:
- ----- Method: RichTaskState class>>waiting (in category 'instance creation') -----
- waiting
- ^super new waiting!
Item was removed:
- ----- Method: RichTaskState class>>waitingWithPacket (in category 'instance creation') -----
- waitingWithPacket
- ^super new waitingWithPacket!
Item was removed:
- ----- Method: RichTaskState>>isPacketPending (in category 'testing') -----
- isPacketPending
- ^packetPendingIV!
Item was removed:
- ----- Method: RichTaskState>>isRunning (in category 'testing') -----
- isRunning
- ^packetPendingIV not and: [taskWaiting not and: [taskHolding not]]!
Item was removed:
- ----- Method: RichTaskState>>isTaskHolding (in category 'testing') -----
- isTaskHolding
- ^taskHolding!
Item was removed:
- ----- Method: RichTaskState>>isTaskHoldingOrWaiting (in category 'testing') -----
- isTaskHoldingOrWaiting
- ^taskHolding or: [packetPendingIV not and: [taskWaiting]]!
Item was removed:
- ----- Method: RichTaskState>>isTaskWaiting (in category 'testing') -----
- isTaskWaiting
- ^taskWaiting!
Item was removed:
- ----- Method: RichTaskState>>isWaiting (in category 'testing') -----
- isWaiting
- ^packetPendingIV not and: [taskWaiting and: [taskHolding not]]!
Item was removed:
- ----- Method: RichTaskState>>isWaitingWithPacket (in category 'testing') -----
- isWaitingWithPacket
- ^packetPendingIV and: [taskWaiting and: [taskHolding not]]!
Item was removed:
- ----- Method: RichTaskState>>packetPending (in category 'initialize') -----
- packetPending
- packetPendingIV := true.
- taskWaiting := false.
- taskHolding := false!
Item was removed:
- ----- Method: RichTaskState>>running (in category 'initialize') -----
- running
- packetPendingIV := taskWaiting := taskHolding := false!
Item was removed:
- ----- Method: RichTaskState>>taskHolding: (in category 'accessing') -----
- taskHolding: anObject
- ^ taskHolding := anObject!
Item was removed:
- ----- Method: RichTaskState>>taskWaiting: (in category 'accessing') -----
- taskWaiting: anObject
- ^ taskWaiting := anObject!
Item was removed:
- ----- Method: RichTaskState>>waiting (in category 'initialize') -----
- waiting
- packetPendingIV := taskHolding := false.
- taskWaiting := true!
Item was removed:
- ----- Method: RichTaskState>>waitingWithPacket (in category 'initialize') -----
- waitingWithPacket
- taskHolding := false.
- taskWaiting := packetPendingIV := true!
Item was removed:
- RichObject subclass: #RichWorkerTaskDataRecord
- instanceVariableNames: 'destination count'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Cog-Benchmarks-Richards'!
-
- !RichWorkerTaskDataRecord commentStamp: '<historical>' prior: 0!
- A task that manipulates work packets.!
Item was removed:
- ----- Method: RichWorkerTaskDataRecord>>count (in category 'accessing') -----
- count
- ^ count!
Item was removed:
- ----- Method: RichWorkerTaskDataRecord>>count: (in category 'accessing') -----
- count: anObject
- count := anObject!
Item was removed:
- ----- Method: RichWorkerTaskDataRecord>>destination (in category 'accessing') -----
- destination
- ^ destination!
Item was removed:
- ----- Method: RichWorkerTaskDataRecord>>destination: (in category 'accessing') -----
- destination: anObject
- destination := anObject!
Item was removed:
- ----- Method: RichWorkerTaskDataRecord>>initialize (in category 'as yet unclassified') -----
- initialize
- destination := HandlerA.
- count := 0 !
Item was removed:
- SMarkRunner subclass: #SMarkAutosizeRunner
- instanceVariableNames: 'targetTime innerLoopIterations'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Cog-Benchmarks-SMark'!
Item was removed:
- ----- 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!
Item was removed:
- ----- Method: SMarkAutosizeRunner>>initialize (in category 'initialization') -----
- initialize
- super initialize.
- targetTime := self class defaultTargetTime.!
Item was removed:
- ----- 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.!
Item was removed:
- ----- 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 !
Item was removed:
- ----- Method: SMarkAutosizeRunner>>targetTime (in category 'accessing') -----
- targetTime
- "Target time in milliseconds"
- ^ targetTime!
Item was removed:
- ----- Method: SMarkAutosizeRunner>>targetTime: (in category 'accessing') -----
- targetTime: anIntInMilliseconds
- "Target time in milliseconds"
- targetTime := anIntInMilliseconds!
Item was removed:
- ----- 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!
Item was removed:
- SMarkRunner subclass: #SMarkCogRunner
- instanceVariableNames: 'warmingUp'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Cog-Benchmarks-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.!
Item was removed:
- ----- Method: SMarkCogRunner>>initialize (in category 'initialization') -----
- initialize
- super initialize.
- warmingUp := false.!
Item was removed:
- ----- 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.!
Item was removed:
- ----- 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.
- ].!
Item was removed:
- SMarkSuite subclass: #SMarkDeltaBlue
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Cog-Benchmarks-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'.!
Item was removed:
- ----- Method: SMarkDeltaBlue>>benchDeltaBlue (in category 'benchmarking') -----
- benchDeltaBlue
- "This the combined benchmark."
-
- | n |
-
- n := self problemSize.
-
- DBStrength initialize.
-
- self doChain: n.
- self doProjection: n!
Item was removed:
- ----- Method: SMarkDeltaBlue>>defaultProblemSize (in category 'defaults') -----
- defaultProblemSize
- ^ 20000!
Item was removed:
- ----- 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!
Item was removed:
- ----- 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!!!!']].!
Item was removed:
- ----- 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!
Item was removed:
- Object subclass: #SMarkHarness
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Cog-Benchmarks-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}!
Item was removed:
- ----- Method: SMarkHarness class>>defaultArgumentParser (in category 'helper') -----
- defaultArgumentParser
- ^ SMarkHarnessArgumentParser!
Item was removed:
- ----- Method: SMarkHarness class>>defaultOutputDestination (in category 'defaults') -----
- defaultOutputDestination
- ^ Smalltalk at: #ScriptConsole
- ifAbsent: [SMarkReporter defaultOutputDestination]!
Item was removed:
- ----- Method: SMarkHarness class>>defaultReporter (in category 'defaults') -----
- defaultReporter
- ^ SMarkReporter defaultReporter!
Item was removed:
- ----- Method: SMarkHarness class>>defaultRunner (in category 'defaults') -----
- defaultRunner
- ^ SMarkSuite defaultRunner!
Item was removed:
- ----- 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.!
Item was removed:
- ----- 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. !
Item was removed:
- ----- Method: SMarkHarness class>>parseArguments: (in category 'helper') -----
- parseArguments: arguments
- | parser |
- parser := self defaultArgumentParser new.
- parser harness: self.
- ^ parser parse: arguments.!
Item was removed:
- ----- 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. !
Item was removed:
- ----- Method: SMarkHarness class>>shouldShowUsage: (in category 'helper') -----
- shouldShowUsage: arguments
-
- arguments size < 2 ifTrue: [^ true ].
-
- ^ arguments anySatisfy: [:elem | (elem = '--help') or: [elem = '-?'] ]. !
Item was removed:
- ----- 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.!
Item was removed:
- ----- 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.
- !
Item was removed:
- ----- 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!
Item was removed:
- ----- 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.
- !
Item was removed:
- ----- Method: SMarkHarness class>>usageRunner: (in category 'helper') -----
- usageRunner: usage
- ^ usage, ' runner optional, a SMarkRunner class that executes the benchmarks', String crlf.!
Item was removed:
- ----- 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.
- ].
- ].
-
- ^ ''.!
Item was removed:
- Object subclass: #SMarkHarnessArgumentParser
- instanceVariableNames: 'runner reporter suiteOrBenchmark iterations processes problemSize i current numParams currentObj arguments suite specificBenchmark suiteClass harness'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Cog-Benchmarks-SMark'!
Item was removed:
- ----- 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.!
Item was removed:
- ----- 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.
- ]
- ]
- ].!
Item was removed:
- ----- 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.
- ]
- ].!
Item was removed:
- ----- 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].
- ]
- ].!
Item was removed:
- ----- Method: SMarkHarnessArgumentParser>>determineSuiteOrBenchmark (in category 'argument parsing') -----
- determineSuiteOrBenchmark
- self parseBenchmarkOrSuite: current.!
Item was removed:
- ----- Method: SMarkHarnessArgumentParser>>harness: (in category 'accessing') -----
- harness: aHarness
- harness := aHarness!
Item was removed:
- ----- 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.!
Item was removed:
- ----- 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}!
Item was removed:
- ----- 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 }
- !
Item was removed:
- SMarkRunner subclass: #SMarkProfileRunner
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Cog-Benchmarks-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.!
Item was removed:
- ----- 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!
Item was removed:
- ----- 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!
Item was removed:
- ----- Method: SMarkProfileRunner>>execute (in category 'profiling') -----
- execute
- "run all benchmnarks in a benchmark suite "
- [ suite run ] timeProfile!
Item was removed:
- ----- Method: SMarkProfileRunner>>execute: (in category 'profiling') -----
- execute: aSelector
-
- [ self performBenchmark: aSelector ] timeProfile!
Item was removed:
- ----- Method: SMarkProfileRunner>>initialize (in category 'initialization') -----
- initialize
- super initialize.
- numIterations := 1.!
Item was removed:
- ----- Method: SMarkProfileRunner>>performBenchmark: (in category 'benchmarks') -----
- performBenchmark: aSelector
- currentBenchmark := aSelector.
-
- 1 to: numIterations do: [:i|
- suite runBenchmark: aSelector ].
-
- currentBenchmark := nil.!
Item was removed:
- ----- Method: SMarkProfileRunner>>timedBenchmarkExecution: (in category 'benchmarks') -----
- timedBenchmarkExecution: aSelector
- suite perform: aSelector!
Item was removed:
- Object subclass: #SMarkReporter
- instanceVariableNames: 'runner stream'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Cog-Benchmarks-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!
Item was removed:
- ----- Method: SMarkReporter class>>defaultOutputDestination (in category 'defaults') -----
- defaultOutputDestination
- ^ ScriptConsole!
Item was removed:
- ----- Method: SMarkReporter class>>defaultReporter (in category 'defaults') -----
- defaultReporter
- ^ SMarkSimpleStatisticsReporter!
Item was removed:
- ----- Method: SMarkReporter class>>reportFor: (in category 'reporting') -----
- reportFor: aRunner
- self reportFor: aRunner on: self defaultOutputDestination.!
Item was removed:
- ----- 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.!
Item was removed:
- ----- Method: SMarkReporter>>benchmarkFooter: (in category 'reporting') -----
- benchmarkFooter: aName
- stream cr.!
Item was removed:
- ----- Method: SMarkReporter>>benchmarkHeader: (in category 'reporting') -----
- benchmarkHeader: aName
- stream << 'Benchmark ' << (aName asString); cr.!
Item was removed:
- ----- Method: SMarkReporter>>footer (in category 'reporting') -----
- footer
- "No output at the moment"
- ^ self!
Item was removed:
- ----- Method: SMarkReporter>>header (in category 'reporting') -----
- header
- | suiteName |
- suiteName := runner suite class name asString.
- stream << 'Report for: ' << suiteName; cr.!
Item was removed:
- ----- Method: SMarkReporter>>initialize (in category 'initialization') -----
- initialize
- super initialize.
- stream := self class defaultOutputDestination.!
Item was removed:
- ----- Method: SMarkReporter>>outputStream: (in category 'accessing') -----
- outputStream: aStream
- stream := aStream !
Item was removed:
- ----- 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!
Item was removed:
- ----- 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.]]!
Item was removed:
- ----- Method: SMarkReporter>>runner: (in category 'accessing') -----
- runner: aRunner
- runner := aRunner.!
Item was removed:
- Object subclass: #SMarkResult
- instanceVariableNames: 'time benchName suite criteria'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Cog-Benchmarks-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.!
Item was removed:
- ----- Method: SMarkResult>>benchmarkName (in category 'accessing') -----
- benchmarkName
- ^ benchName!
Item was removed:
- ----- Method: SMarkResult>>benchmarkName: (in category 'accessing') -----
- benchmarkName: aString
- benchName := aString!
Item was removed:
- ----- Method: SMarkResult>>criteria (in category 'accessing') -----
- criteria
- ^ criteria!
Item was removed:
- ----- Method: SMarkResult>>criteria: (in category 'accessing') -----
- criteria: aCollectionOfTimers
- criteria := aCollectionOfTimers!
Item was removed:
- ----- Method: SMarkResult>>suite (in category 'accessing') -----
- suite
- ^ suite!
Item was removed:
- ----- Method: SMarkResult>>suite: (in category 'accessing') -----
- suite: aBenchmarkSuite
- suite := aBenchmarkSuite!
Item was removed:
- ----- Method: SMarkResult>>total (in category 'accessing') -----
- total
- ^ time!
Item was removed:
- ----- Method: SMarkResult>>total: (in category 'accessing') -----
- total: aTime
- time := aTime!
Item was removed:
- SMarkSuite subclass: #SMarkRichards
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Cog-Benchmarks-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'.!
Item was removed:
- ----- Method: SMarkRichards>>benchRichards (in category 'benchs') -----
- benchRichards
-
- RichObject initialize.
- self problemSize timesRepeat: [ RichRunner start ]!
Item was removed:
- ----- Method: SMarkRichards>>defaultProblemSize (in category 'benchs') -----
- defaultProblemSize
- ^ 50!
Item was removed:
- ----- 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!
Item was removed:
- Object subclass: #SMarkRunner
- instanceVariableNames: 'numIterations suite runner results currentBenchmark timers problemSize numProcesses'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Cog-Benchmarks-SMark'!
Item was removed:
- ----- Method: SMarkRunner class>>defaultNumberOfIterations (in category 'defaults') -----
- defaultNumberOfIterations
- ^ 1!
Item was removed:
- ----- Method: SMarkRunner class>>defaultNumberOfProcesses (in category 'defaults') -----
- defaultNumberOfProcesses
- ^ 1!
Item was removed:
- ----- Method: SMarkRunner class>>defaultTimer (in category 'defaults') -----
- defaultTimer
- ^ SMarkTimer!
Item was removed:
- ----- Method: SMarkRunner class>>execute: (in category 'benchmarking') -----
- execute: aSuite
- ^ self execute: aSuite with: 1.!
Item was removed:
- ----- 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!
Item was removed:
- ----- 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.!
Item was removed:
- ----- Method: SMarkRunner>>execute (in category 'execution') -----
- execute
- suite run.
- self runBaseBenchmark.
- ^ results
- !
Item was removed:
- ----- Method: SMarkRunner>>initialize (in category 'initialization') -----
- initialize
- super initialize.
- numIterations := self class defaultNumberOfIterations.
- numProcesses := self class defaultNumberOfProcesses.
- results := Dictionary new.!
Item was removed:
- ----- Method: SMarkRunner>>iterations (in category 'accessing') -----
- iterations
- ^ numIterations!
Item was removed:
- ----- Method: SMarkRunner>>iterations: (in category 'accessing') -----
- iterations: anInteger
- numIterations := anInteger!
Item was removed:
- ----- 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)!
Item was removed:
- ----- Method: SMarkRunner>>printOn: (in category 'printing') -----
- printOn: aStream
- ^ self reportOn: aStream.!
Item was removed:
- ----- Method: SMarkRunner>>problemSize (in category 'accessing') -----
- problemSize
- <omniUnenforced> "Hint for the OMOP that it is part of the meta infrastructure"
- ^ problemSize!
Item was removed:
- ----- 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!
Item was removed:
- ----- 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!
Item was removed:
- ----- 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!
Item was removed:
- ----- 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.!
Item was removed:
- ----- Method: SMarkRunner>>report (in category 'accessing') -----
- report
- SMarkReporter defaultReporter reportFor: self.
- !
Item was removed:
- ----- 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.
- !
Item was removed:
- ----- Method: SMarkRunner>>reportOn: (in category 'reporting') -----
- reportOn: aStream
- SMarkReporter defaultReporter reportFor: self on: aStream
- !
Item was removed:
- ----- Method: SMarkRunner>>results (in category 'accessing') -----
- results
- ^ results!
Item was removed:
- ----- 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.!
Item was removed:
- ----- Method: SMarkRunner>>suite (in category 'accessing') -----
- suite
- ^ suite!
Item was removed:
- ----- Method: SMarkRunner>>suite: (in category 'accessing') -----
- suite: aBenchmarkSuite
- suite := aBenchmarkSuite.
- suite runner: self.!
Item was removed:
- ----- 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!
Item was removed:
- SMarkReporter subclass: #SMarkSimpleStatisticsReporter
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Cog-Benchmarks-SMark'!
Item was removed:
- ----- 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)!
Item was removed:
- ----- Method: SMarkSimpleStatisticsReporter>>gaussianConfidenceFactor (in category 'statistics') -----
- gaussianConfidenceFactor
- "used for large probe counts >= 30"
- "1 ~ 68.27%"
- "1.644853626951 ~ 90%"
- "2 ~ 95.45%"
- ^ 1.644853626951!
Item was removed:
- ----- 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.
- ].!
Item was removed:
- ----- 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.!
Item was removed:
- ----- Method: SMarkSimpleStatisticsReporter>>resultsFor:from: (in category 'helper') -----
- resultsFor: aCriterion from: aListOfResults
- ^aListOfResults collect: [:result | (result criteria at: aCriterion) totalTime]
- !
Item was removed:
- ----- Method: SMarkSimpleStatisticsReporter>>significantDigits: (in category 'statistics') -----
- significantDigits: confidenceVariance
- confidenceVariance = 0
- ifTrue: [ ^ 2].
-
- confidenceVariance >= 10
- ifTrue: [ ^ 0].
-
- ^ 1 - (confidenceVariance log floor)!
Item was removed:
- ----- 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.
- !
Item was removed:
- ----- Method: SMarkSimpleStatisticsReporter>>totalResultsFor: (in category 'helper') -----
- totalResultsFor: aListOfResults
- ^aListOfResults collect: [:timer | timer total]
- !
Item was removed:
- Object subclass: #SMarkSuite
- instanceVariableNames: 'runner selectedBenchmarks'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Cog-Benchmarks-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
- !
Item was removed:
- ----- Method: SMarkSuite class>>defaultProblemSize (in category 'defaults') -----
- defaultProblemSize
- ^ nil!
Item was removed:
- ----- Method: SMarkSuite class>>defaultRunner (in category 'defaults') -----
- defaultRunner
- ^ self onCog: [SMarkCogRunner]
- else: [SMarkRunner]!
Item was removed:
- ----- 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!
Item was removed:
- ----- Method: SMarkSuite class>>onCog:else: (in category 'platform support') -----
- onCog: cogSpecificBlock else: general
- ^ (Smalltalk vm isRunningCogit)
- ifTrue: [cogSpecificBlock value]
- ifFalse: [general value]!
Item was removed:
- ----- Method: SMarkSuite class>>profile: (in category 'profiling') -----
- profile: aSelector
- ^ self profileRunner
- execute: self new selector: aSelector.!
Item was removed:
- ----- Method: SMarkSuite class>>profile:iterations: (in category 'profiling') -----
- profile: aSelector iterations: nIterations
- ^ self profileRunner
- execute: self new selector: aSelector iterations: nIterations.!
Item was removed:
- ----- Method: SMarkSuite class>>profileAll (in category 'profiling') -----
- profileAll
- ^ self profileRunner
- execute: self new.!
Item was removed:
- ----- Method: SMarkSuite class>>profileRunner (in category 'profiling') -----
- profileRunner
- ^ SMarkProfileRunner!
Item was removed:
- ----- Method: SMarkSuite class>>run (in category 'benchmarking') -----
- run
- "Execute the suite one time."
- ^ self defaultRunner execute: self new.!
Item was removed:
- ----- Method: SMarkSuite class>>run: (in category 'benchmarking') -----
- run: nIterations
- "Execute the suite a given number of iterations."
-
- ^ self defaultRunner execute: self new with: nIterations.!
Item was removed:
- ----- 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)!
Item was removed:
- ----- 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!
Item was removed:
- ----- 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
- !
Item was removed:
- ----- 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 ] ]!
Item was removed:
- ----- Method: SMarkSuite>>performCustomSelector:with: (in category 'benchmarking') -----
- performCustomSelector: aSelector with: aPrefix
- | customSelector |
- customSelector := (aPrefix, aSelector capitalized) asSymbol.
- (self respondsTo: customSelector) ifTrue: [
- self perform: customSelector].!
Item was removed:
- ----- 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!
Item was removed:
- ----- 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.!
Item was removed:
- ----- 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 ]
- ].
- !
Item was removed:
- ----- 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]!
Item was removed:
- ----- Method: SMarkSuite>>runOnly: (in category 'benchmarking') -----
- runOnly: aSymbol
- selectedBenchmarks := IdentitySet newFrom: { aSymbol }.!
Item was removed:
- ----- Method: SMarkSuite>>runner (in category 'accessing') -----
- runner
- ^ runner!
Item was removed:
- ----- Method: SMarkSuite>>runner: (in category 'accessing') -----
- runner: aRunner
- runner := aRunner.!
Item was removed:
- ----- Method: SMarkSuite>>selectedBenchmarks (in category 'benchmarking') -----
- selectedBenchmarks
- ^ selectedBenchmarks!
Item was removed:
- ----- Method: SMarkSuite>>setUp (in category 'running') -----
- setUp
- "It is the subclass' responsibility to set up the necessary environment for a benchmark"
- ^ self!
Item was removed:
- ----- 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!
Item was removed:
- ----- Method: SMarkSuite>>tearDown (in category 'running') -----
- tearDown
- "It is the subclass' responsibility to clean up the environment after a benchmark"
- ^ self!
Item was removed:
- Object subclass: #SMarkTimer
- instanceVariableNames: 'startTime elapsedTime name'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Cog-Benchmarks-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.!
Item was removed:
- ----- Method: SMarkTimer class>>new: (in category 'instance creation') -----
- new: aName
- | timer |
-
- timer := super new.
- timer name: aName.
-
- ^timer!
Item was removed:
- ----- Method: SMarkTimer>>currentMillis (in category 'timing') -----
- currentMillis
-
- ^ Time millisecondClockValue!
Item was removed:
- ----- Method: SMarkTimer>>initialize (in category 'initialization') -----
- initialize
- super initialize.
- elapsedTime := 0!
Item was removed:
- ----- Method: SMarkTimer>>name (in category 'accessing') -----
- name
- ^name!
Item was removed:
- ----- Method: SMarkTimer>>name: (in category 'accessing') -----
- name: aString
- name := aString !
Item was removed:
- ----- Method: SMarkTimer>>reset (in category 'timing') -----
- reset
- startTime := 0.
- elapsedTime := 0.!
Item was removed:
- ----- Method: SMarkTimer>>start (in category 'timing') -----
- start
- startTime := self currentMillis.!
Item was removed:
- ----- Method: SMarkTimer>>stop (in category 'timing') -----
- stop
- | elapsedInThisPeriod current |
- current := self currentMillis.
-
- elapsedInThisPeriod := Time milliseconds: current since: startTime.
-
- elapsedTime := elapsedTime + elapsedInThisPeriod.!
Item was removed:
- ----- Method: SMarkTimer>>totalTime (in category 'accessing') -----
- totalTime
- ^elapsedTime!
Item was removed:
- Object subclass: #SMarkTransporter
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Cog-Benchmarks-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.
- !
Item was removed:
- ----- Method: SMarkTransporter class>>transportersForFileOutMenu (in category 'transporter') -----
- transportersForFileOutMenu
- ^ { (Smalltalk at: #Transporter ifAbsent: [^#()])
- forPackage: (PackageInfo named: 'SMark') }!
Item was removed:
- SMarkRunner subclass: #SMarkWeakScalingRunner
- instanceVariableNames: 'numInnerIterations runningProcesses completionSignal runningProcessesMtx'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Cog-Benchmarks-SMark'!
Item was removed:
- ----- Method: SMarkWeakScalingRunner class>>defaultNumberOfInnerIterations (in category 'defaults') -----
- defaultNumberOfInnerIterations
- "The number of iterations of the inner loop
- in which the benchmark is executed."
- ^ 1!
Item was removed:
- ----- 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.
- !
Item was removed:
- ----- Method: SMarkWeakScalingRunner>>executorCompleted (in category 'benchmarking') -----
- executorCompleted
- runningProcessesMtx critical: [
- runningProcesses := runningProcesses - 1.
- (runningProcesses == 0) ifTrue: [
- completionSignal signal.
- ]
- ]!
Item was removed:
- ----- Method: SMarkWeakScalingRunner>>initialize (in category 'initialization') -----
- initialize
- super initialize.
- numProcesses := self class defaultNumberOfProcesses.
- numInnerIterations := self class defaultNumberOfInnerIterations.
- !
Item was removed:
- ----- Method: SMarkWeakScalingRunner>>innerIterations (in category 'benchmarking') -----
- innerIterations
- "The number of inner iterations the benchmark is executed inside a processes"
- ^ numInnerIterations!
Item was removed:
- ----- Method: SMarkWeakScalingRunner>>innerIterations: (in category 'benchmarking') -----
- innerIterations: anInteger
- "The number of inner iterations the benchmark is executed inside a processes"
- numInnerIterations := anInteger!
Item was removed:
- ----- Method: SMarkWeakScalingRunner>>processes (in category 'benchmarking') -----
- processes
- ^ numProcesses!
Item was removed:
- ----- Method: SMarkWeakScalingRunner>>processes: (in category 'benchmarking') -----
- processes: anInteger
- numProcesses := anInteger!
Item was removed:
- ----- Method: SMarkWeakScalingRunner>>reportConfiguration: (in category 'reporting') -----
- reportConfiguration: aStream
- super reportConfiguration: aStream.
- aStream << ('inner iterations: ', numInnerIterations asString); cr.!
Item was removed:
- ----- 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!
Item was removed:
- Object subclass: #SMarkWeakScalingRunnerExecutor
- instanceVariableNames: 'numInnerIterations benchmarkSelector suite runner'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Cog-Benchmarks-SMark'!
Item was removed:
- ----- 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)!
Item was removed:
- ----- Method: SMarkWeakScalingRunnerExecutor>>benchmarkSelector: (in category 'accessing') -----
- benchmarkSelector: aSelector
- benchmarkSelector := aSelector!
Item was removed:
- ----- Method: SMarkWeakScalingRunnerExecutor>>innerIterations: (in category 'accessing') -----
- innerIterations: anInt
- numInnerIterations := anInt!
Item was removed:
- ----- Method: SMarkWeakScalingRunnerExecutor>>run (in category 'benchmarking') -----
- run
- 1 to: numInnerIterations do: [:i |
- suite perform: benchmarkSelector.].
-
- runner executorCompleted.!
Item was removed:
- ----- Method: SMarkWeakScalingRunnerExecutor>>runner: (in category 'accessing') -----
- runner: aRunner
- runner := aRunner!
Item was removed:
- ----- Method: SMarkWeakScalingRunnerExecutor>>suite: (in category 'accessing') -----
- suite: aSuite
- suite := aSuite!
Item was removed:
- Object subclass: #ShootoutBody
- instanceVariableNames: 'x y z vx vy vz mass'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Cog-Benchmarks-Shootout'!
Item was removed:
- ----- Method: ShootoutBody class>>daysPerYear (in category 'constants') -----
- daysPerYear
- ^365.24!
Item was removed:
- ----- 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!
Item was removed:
- ----- 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!
Item was removed:
- ----- Method: ShootoutBody class>>pi (in category 'constants') -----
- pi
- ^3.141592653589793!
Item was removed:
- ----- 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!
Item was removed:
- ----- Method: ShootoutBody class>>solarMass (in category 'constants') -----
- solarMass
- ^4.0 * self pi * self pi!
Item was removed:
- ----- 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!
Item was removed:
- ----- 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!
Item was removed:
- ----- 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!
Item was removed:
- ----- 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!
Item was removed:
- ----- 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)!
Item was removed:
- ----- 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)!
Item was removed:
- ----- Method: ShootoutBody>>kineticEnergy (in category 'nbody') -----
- kineticEnergy
- ^0.5 * mass * ((vx * vx) + (vy * vy) + (vz * vz))!
Item was removed:
- ----- Method: ShootoutBody>>mass (in category 'accessing') -----
- mass
- ^mass!
Item was removed:
- ----- 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!
Item was removed:
- ----- Method: ShootoutBody>>positionAfter: (in category 'nbody') -----
- positionAfter: dt
- x := x + (dt * vx).
- y := y + (dt * vy).
- z := z + (dt * vz)!
Item was removed:
- ----- 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!
Item was removed:
- ----- Method: ShootoutBody>>x (in category 'accessing') -----
- x
- ^x!
Item was removed:
- ----- 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!
Item was removed:
- ----- Method: ShootoutBody>>y (in category 'accessing') -----
- y
- ^y!
Item was removed:
- ----- Method: ShootoutBody>>z (in category 'accessing') -----
- z
- ^z!
Item was removed:
- Object subclass: #ShootoutChameneosColour
- instanceVariableNames: 'color'
- classVariableNames: 'Blue Red Yellow'
- poolDictionaries: ''
- category: 'Cog-Benchmarks-Shootout'!
Item was removed:
- ----- Method: ShootoutChameneosColour class>>blue (in category 'accessing') -----
- blue
- ^Blue!
Item was removed:
- ----- Method: ShootoutChameneosColour class>>blue: (in category 'accessing') -----
- blue: anObject
- Blue := anObject!
Item was removed:
- ----- Method: ShootoutChameneosColour class>>createBlue (in category 'initialize-release') -----
- createBlue
- "comment stating purpose of message"
-
- ^super new color: #blue!
Item was removed:
- ----- Method: ShootoutChameneosColour class>>createRed (in category 'initialize-release') -----
- createRed
- "comment stating purpose of message"
-
- ^super new color: #red!
Item was removed:
- ----- Method: ShootoutChameneosColour class>>createYellow (in category 'initialize-release') -----
- createYellow
- "comment stating purpose of message"
-
- ^super new color: #yellow!
Item was removed:
- ----- 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!
Item was removed:
- ----- Method: ShootoutChameneosColour class>>initialize (in category 'initialize-release') -----
- initialize
- "self initialize"
-
- Red := self createRed.
- Blue := self createBlue.
- Yellow := self createYellow!
Item was removed:
- ----- Method: ShootoutChameneosColour class>>red (in category 'accessing') -----
- red
- ^Red!
Item was removed:
- ----- Method: ShootoutChameneosColour class>>red: (in category 'accessing') -----
- red: anObject
- Red := anObject!
Item was removed:
- ----- Method: ShootoutChameneosColour class>>yellow (in category 'accessing') -----
- yellow
- ^Yellow!
Item was removed:
- ----- Method: ShootoutChameneosColour class>>yellow: (in category 'accessing') -----
- yellow: anObject
- Yellow := anObject!
Item was removed:
- ----- Method: ShootoutChameneosColour>>color (in category 'accessing') -----
- color
- ^color!
Item was removed:
- ----- Method: ShootoutChameneosColour>>color: (in category 'accessing') -----
- color: aColor
- color := aColor!
Item was removed:
- ----- 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]!
Item was removed:
- ----- Method: ShootoutChameneosColour>>hasSameColorAs: (in category 'testing') -----
- hasSameColorAs: aChameneos
- ^self color == aChameneos color!
Item was removed:
- ----- Method: ShootoutChameneosColour>>isBlue (in category 'testing') -----
- isBlue
- ^self == self class blue!
Item was removed:
- ----- Method: ShootoutChameneosColour>>isRed (in category 'testing') -----
- isRed
- ^self == self class red!
Item was removed:
- ----- Method: ShootoutChameneosColour>>isYellow (in category 'testing') -----
- isYellow
- ^self == self class yellow!
Item was removed:
- ----- Method: ShootoutChameneosColour>>printOn: (in category 'printing') -----
- printOn: aStream
- aStream nextPutAll: self color!
Item was removed:
- Object subclass: #ShootoutCreature
- instanceVariableNames: 'creatureName colour selfMet creaturesMet'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Cog-Benchmarks-Shootout'!
Item was removed:
- ----- Method: ShootoutCreature class>>withName:colour: (in category 'initialize-release') -----
- withName: aName colour: aColour
- ^(ShootoutCreature new initialize)
- name: aName;
- colour: aColour!
Item was removed:
- ----- Method: ShootoutCreature>>colour (in category 'accessing') -----
- colour
- ^colour!
Item was removed:
- ----- Method: ShootoutCreature>>colour: (in category 'accessing') -----
- colour: anObject
- colour := anObject!
Item was removed:
- ----- Method: ShootoutCreature>>creaturesMet (in category 'accessing') -----
- creaturesMet
- ^creaturesMet!
Item was removed:
- ----- Method: ShootoutCreature>>creaturesMet: (in category 'accessing') -----
- creaturesMet: anObject
- creaturesMet := anObject!
Item was removed:
- ----- Method: ShootoutCreature>>initialize (in category 'initialize-release') -----
- initialize
- selfMet := 0.
- creaturesMet := 0!
Item was removed:
- ----- Method: ShootoutCreature>>name (in category 'accessing') -----
- name
- ^creatureName!
Item was removed:
- ----- Method: ShootoutCreature>>name: (in category 'accessing') -----
- name: anObject
- creatureName := anObject!
Item was removed:
- ----- Method: ShootoutCreature>>selfMet (in category 'accessing') -----
- selfMet
- ^selfMet!
Item was removed:
- ----- Method: ShootoutCreature>>selfMet: (in category 'accessing') -----
- selfMet: anObject
- ^selfMet := anObject!
Item was removed:
- ----- 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!
Item was removed:
- Object subclass: #ShootoutMall
- instanceVariableNames: 'guard maxRendezvous open process queue cache pairCache'
- classVariableNames: 'Units'
- poolDictionaries: ''
- category: 'Cog-Benchmarks-Shootout'!
Item was removed:
- ----- Method: ShootoutMall class>>createAllowing: (in category 'initialize-release') -----
- createAllowing: maxRendezvous
- "Private"
-
- ^self basicNew initialize maxRendezvous: maxRendezvous!
Item was removed:
- ----- 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]!
Item was removed:
- ----- 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!
Item was removed:
- ----- Method: ShootoutMall class>>generateReportForColours:printOn: (in category 'printing') -----
- generateReportForColours: colours printOn: stream
- stream space.
- colours do: [:colour | colour printOn: stream] separatedBy: [stream space].
- ^stream!
Item was removed:
- ----- Method: ShootoutMall class>>initialize (in category 'initialize-release') -----
- initialize
- "self initialize"
-
- Units := #('zero' 'one' 'two' 'three' 'four' 'five' 'six' 'seven' 'eight' 'nine')!
Item was removed:
- ----- Method: ShootoutMall class>>new (in category 'initialize-release') -----
- new
- ^self shouldNotImplement!
Item was removed:
- ----- 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]!
Item was removed:
- ----- 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!
Item was removed:
- ----- 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!
Item was removed:
- ----- Method: ShootoutMall class>>units (in category 'accessing') -----
- units
- ^Units!
Item was removed:
- ----- Method: ShootoutMall class>>waitForClosingOfMall:withCreatures:usingGuard: (in category 'private') -----
- waitForClosingOfMall: aMall withCreatures: creatures usingGuard: guard
- creatures size timesRepeat: [guard wait].
- aMall close!
Item was removed:
- ----- Method: ShootoutMall>>close (in category 'controlling') -----
- close
- open := false!
Item was removed:
- ----- 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]!
Item was removed:
- ----- Method: ShootoutMall>>maxRendezvous: (in category 'accessing') -----
- maxRendezvous: max
- maxRendezvous := max!
Item was removed:
- ----- Method: ShootoutMall>>obtainPair (in category 'private') -----
- obtainPair
- ^cache removeFirst!
Item was removed:
- ----- 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!
Item was removed:
- ----- Method: ShootoutMall>>releasePair: (in category 'private') -----
- releasePair: pair
- pair release.
- cache addFirst: pair!
Item was removed:
- ----- Method: ShootoutMall>>run (in category 'initialize-release') -----
- run
- open := true.
- process ifNil:
- [process := [self processVisitors] newProcess.
- process priority: Processor userBackgroundPriority -1 ].
- process resume!
Item was removed:
- ----- Method: ShootoutMall>>setPartnersOn:and: (in category 'private') -----
- setPartnersOn: first and: second
- first partner: second me.
- second partner: first me.
- !
Item was removed:
- ----- Method: ShootoutMall>>shutdown (in category 'private') -----
- shutdown
- [queue isEmpty] whileFalse: [queue next signal].
- process terminate.
- process := nil!
Item was removed:
- ----- 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!
Item was removed:
- Object subclass: #ShootoutNBodySystem
- instanceVariableNames: 'bodies'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Cog-Benchmarks-Shootout'!
Item was removed:
- ----- 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]!
Item was removed:
- ----- 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!
Item was removed:
- ----- 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])!
Item was removed:
- Object subclass: #ShootoutPair
- instanceVariableNames: 'partner me sema'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Cog-Benchmarks-Shootout'!
Item was removed:
- ----- Method: ShootoutPair class>>new (in category 'instance creation') -----
- new
- "Answer a newly created and initialized instance."
- ^super new initialize.!
Item was removed:
- ----- Method: ShootoutPair class>>with: (in category 'instance creation') -----
- with: me
- "Answer a newly created and initialized instance."
- self halt.
- ^super new initialize me: me!
Item was removed:
- ----- 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!
Item was removed:
- ----- Method: ShootoutPair>>me (in category 'accessing') -----
- me
- ^me!
Item was removed:
- ----- Method: ShootoutPair>>me: (in category 'accessing') -----
- me: anObject
- me := anObject!
Item was removed:
- ----- Method: ShootoutPair>>partner (in category 'accessing') -----
- partner
- ^partner!
Item was removed:
- ----- Method: ShootoutPair>>partner: (in category 'accessing') -----
- partner: anObject
- partner := anObject!
Item was removed:
- ----- Method: ShootoutPair>>release (in category 'initialize-release') -----
- release
- partner:=nil.!
Item was removed:
- ----- Method: ShootoutPair>>signal (in category 'initialize-release') -----
- signal
- sema signal!
Item was removed:
- ----- Method: ShootoutPair>>wait (in category 'initialize-release') -----
- wait
- sema wait!
Item was removed:
- Object subclass: #ShootoutTests
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Cog-Benchmarks-Shootout'!
Item was removed:
- ----- 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!
Item was removed:
- ----- Method: ShootoutTests class>>binarytrees (in category 'benchmark scripts') -----
- binarytrees
- self binarytrees: self arg to: self stdout.
- ^''!
Item was removed:
- ----- 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!
Item was removed:
- ----- Method: ShootoutTests class>>chameneosredux2 (in category 'benchmark scripts') -----
- chameneosredux2
- self chameneosredux: self arg to: self stdout.
- ^''!
Item was removed:
- ----- Method: ShootoutTests class>>chameneosredux:to: (in category 'benchmarking') -----
- chameneosredux: arg to: aStream
- ShootoutMall runBenchMark: arg on: aStream!
Item was removed:
- ----- 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] }!
Item was removed:
- ----- Method: ShootoutTests class>>nbody (in category 'benchmark scripts') -----
- nbody
- self nbody: self arg to: self stdout!
Item was removed:
- ----- 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.
- ^''!
Item was removed:
- ----- 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!
Item was removed:
- ----- Method: ShootoutTests class>>referenceArgs (in category 'benchmark scripts') -----
- referenceArgs
- ^self referenceTimesAndArgsForClosureInterpreter collect: [:ea| ea last]!
Item was removed:
- ----- 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!
Item was removed:
- ----- Method: ShootoutTests class>>referenceTimesForClosureInterpreter (in category 'benchmark scripts') -----
- referenceTimesForClosureInterpreter
- ^self referenceTimesAndArgsForClosureInterpreter collect: [:ea| ea first]!
Item was removed:
- ----- 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!
Item was removed:
- ----- Method: ShootoutTests class>>runAllToDummyStream (in category 'benchmark scripts') -----
- runAllToDummyStream
- "Transcript clear.
- self runAllToDummyStream"
- ^self runAllToDummyStreamVs: self referenceTimesForClosureInterpreter!
Item was removed:
- ----- 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!
Item was removed:
- ----- 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!
Item was removed:
- ----- Method: ShootoutTests class>>runAllToInternalStream (in category 'benchmark scripts') -----
- runAllToInternalStream
- "Transcript clear.
- self runAllToInternalStream"
- ^self runAllToInternalStreamVs: self referenceTimesForClosureInterpreter!
Item was removed:
- ----- 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!
Item was removed:
- ----- Method: ShootoutTests class>>runAllToTranscript (in category 'benchmark scripts') -----
- runAllToTranscript
- "Transcript clear.
- self runAllToTranscript"
- ^self runAllToTranscriptVs: self referenceTimesForClosureInterpreter!
Item was removed:
- ----- 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!
Item was removed:
- ----- 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!
Item was removed:
- ----- 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] }!
Item was removed:
- ----- Method: ShootoutTests class>>stdin (in category 'platform') -----
- stdin
- ^StandardFileStream stdIn!
Item was removed:
- ----- Method: ShootoutTests class>>stdout (in category 'platform') -----
- stdout
- ^StandardFileStream stdout!
Item was removed:
- ----- 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 !
Item was removed:
- ----- Method: ShootoutTests class>>threadring (in category 'benchmark scripts') -----
- threadring
- self threadring: self arg to: self stdout.
- ^''!
Item was removed:
- ----- Method: ShootoutTests class>>threadring:to: (in category 'benchmarking') -----
- threadring: arg to: output
- | done |
- (self threadRing: (done := Semaphore new) output: output) takeToken: arg.
- done wait!
Item was removed:
- Object subclass: #ShootoutThread
- instanceVariableNames: 'name nextThread token semaphore done output'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Cog-Benchmarks-Shootout'!
Item was removed:
- ----- 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 !
Item was removed:
- ----- Method: ShootoutThread class>>new (in category 'instance creation') -----
- new
- ^self basicNew semaphore: Semaphore new !
Item was removed:
- ----- Method: ShootoutThread>>done: (in category 'accessing') -----
- done: aSemaphore
- done := aSemaphore !
Item was removed:
- ----- Method: ShootoutThread>>fork (in category 'accessing') -----
- fork
- [ self run ] fork !
Item was removed:
- ----- Method: ShootoutThread>>name: (in category 'accessing') -----
- name: anInteger
- name := anInteger !
Item was removed:
- ----- Method: ShootoutThread>>nextThread: (in category 'accessing') -----
- nextThread: aThread
- nextThread := aThread !
Item was removed:
- ----- Method: ShootoutThread>>output: (in category 'accessing') -----
- output: anObject
- "Set the value of output"
-
- output := anObject!
Item was removed:
- ----- 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 !
Item was removed:
- ----- Method: ShootoutThread>>semaphore: (in category 'accessing') -----
- semaphore: aSemaphore
- semaphore := aSemaphore !
Item was removed:
- ----- Method: ShootoutThread>>takeToken: (in category 'accessing') -----
- takeToken: x
- token := x.
- semaphore signal !
Item was removed:
- ----- Method: ShootoutThread>>tokenNotDone (in category 'accessing') -----
- tokenNotDone
- semaphore wait.
- ^token > 0 !
Item was removed:
- Object subclass: #ShootoutTreeNode
- instanceVariableNames: 'left right item'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Cog-Benchmarks-Shootout'!
Item was removed:
- ----- 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]!
Item was removed:
- ----- Method: ShootoutTreeNode class>>left:right:item: (in category 'instance creation') -----
- left: leftChild right: rightChild item: anItem
- ^(super new) left: leftChild right: rightChild item: anItem!
Item was removed:
- ----- Method: ShootoutTreeNode>>itemCheck (in category 'accessing') -----
- itemCheck
- ^left isNil
- ifTrue: [item] ifFalse: [item + (left itemCheck - right itemCheck)]!
Item was removed:
- ----- Method: ShootoutTreeNode>>left:right:item: (in category 'initialize-release') -----
- left: leftChild right: rightChild item: anItem
- left := leftChild.
- right := rightChild.
- item := anItem!
Item was removed:
- ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEallInstances (in category 'method prototypes') -----
- BehaviorPROTOTYPEallInstances
- "Answer all instances of the receiver."
- <primitive: 177>
- "The primitive can fail because memory is low. If so, fall back on the old
- enumeration code, which gives the system a chance to GC and/or grow.
- Because aBlock might change the class of inst (for example, using become:),
- it is essential to compute next before aBlock value: inst."
- | inst insts next |
- insts := WriteStream on: (Array new: 64).
- inst := self someInstance.
- [inst == nil] whileFalse:
- [next := inst nextInstance.
- (inst == insts or: [inst == insts originalContents]) ifFalse: [insts nextPut: inst].
- inst := next].
- ^insts contents!
Item was removed:
- ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEallInstancesDo: (in category 'method prototypes') -----
- BehaviorPROTOTYPEallInstancesDo: aBlock
- "Evaluate aBlock with each of the current instances of the receiver."
- | instances inst next |
- instances := self allInstancesOrNil.
- instances ifNotNil:
- [instances do: aBlock.
- ^self].
- "allInstancesOrNil can fail because memory is low. If so, fall back on the old
- enumeration code. Because aBlock might change the class of inst (for example,
- using become:), it is essential to compute next before aBlock value: inst."
- inst := self someInstance.
- [inst == nil] whileFalse:
- [next := inst nextInstance.
- aBlock value: inst.
- inst := next]!
Item was removed:
- ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEallInstancesOrNil (in category 'method prototypes') -----
- BehaviorPROTOTYPEallInstancesOrNil
- "Answer all instances of the receiver, or nil if the primitive
- fails, which it may be due to being out of memory."
- <primitive: 177>
- ^nil!
Item was removed:
- ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEbasicIdentityHash (in category 'method prototypes pharo') -----
- BehaviorPROTOTYPEbasicIdentityHash
- "Answer a SmallInteger whose value is related to the receiver's identity.
- Behavior implements identityHash to allow the VM to use an object representation which
- does not include a direct reference to an object's class in an object. If the VM is using
- this implementation then classes are held in a class table and instances contain the index
- of their class in the table. A class's class table index is its identityHash so that an instance
- can be created without searching the table for a class's index. The VM uses this primitive
- to enter the class into the class table, assigning its identityHash with an as yet unused
- class table index. If this primitive fails it means that the class table is full. In Spur as of
- 2014 there are 22 bits of classTable index and 22 bits of identityHash per object.
-
- Primitive. Essential. Do not override. See Object documentation whatIsAPrimitive."
-
- <primitive: 175>
- self primitiveFailed!
Item was removed:
- ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEbasicNew (in category 'method prototypes') -----
- BehaviorPROTOTYPEbasicNew
- "Primitive. Answer an instance of the receiver (which is a class) with no
- indexable variables. Fail if the class is indexable. Essential. See Object
- documentation whatIsAPrimitive.
-
- If the primitive fails because space is low then the scavenger will run
- before the method is activated. Check that space was low and retry
- via handleFailingBasicNew if so."
-
- <primitive: 70 error: ec>
- ec == #'insufficient object memory' ifTrue:
- [^self handleFailingBasicNew].
- self isVariable ifTrue: [^self basicNew: 0].
- self primitiveFailed!
Item was removed:
- ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEbasicNew: (in category 'method prototypes') -----
- BehaviorPROTOTYPEbasicNew: sizeRequested
- "Primitive. Answer an instance of this class with the number of indexable
- variables specified by the argument, sizeRequested. Fail if this class is not
- indexable or if the argument is not a positive Integer, or if there is not
- enough memory available. Essential. See Object documentation whatIsAPrimitive.
-
- If the primitive fails because space is low then the scavenger will run before the
- method is activated. Check args and retry via handleFailingBasicNew: if they're OK."
-
- <primitive: 71 error: ec>
- ec == #'insufficient object memory' ifTrue:
- [^self handleFailingBasicNew: sizeRequested].
- self isVariable ifFalse:
- [self error: self printString, ' cannot have variable sized instances'].
- self primitiveFailed!
Item was removed:
- ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEbyteSizeOfInstance (in category 'method prototypes') -----
- BehaviorPROTOTYPEbyteSizeOfInstance
- "Answer the total memory size of an instance of the receiver."
-
- <primitive: 181 error: ec>
- self isVariable ifTrue:
- [^self byteSizeOfInstanceOfSize: 0].
- self primitiveFailed!
Item was removed:
- ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEbyteSizeOfInstanceOfSize: (in category 'method prototypes') -----
- BehaviorPROTOTYPEbyteSizeOfInstanceOfSize: basicSize
- "Answer the total memory size of an instance of the receiver
- with the given number of indexable instance variables."
-
- <primitive: 181 error: ec>
- self isVariable
- ifTrue: "If the primitive overflowed answer a close approximation"
- [(basicSize isInteger
- and: [basicSize >= 16r1000000]) ifTrue:
- [^2 * (self byteSizeOfInstanceOfSize: basicSize + 1 // 2)
- - (self byteSizeOfInstanceOfSize: 0)]]
- ifFalse:
- [basicSize = 0 ifTrue:
- [^self byteSizeOfInstance]].
- self primitiveFailed!
Item was removed:
- ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEelementSize (in category 'method prototypes') -----
- BehaviorPROTOTYPEelementSize
- "Answer the size in bytes of an element in the receiver. The formats are
- 0 = 0 sized objects (UndefinedObject True False et al)
- 1 = non-indexable objects with inst vars (Point et al)
- 2 = indexable objects with no inst vars (Array et al)
- 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
- 4 = weak indexable objects with inst vars (WeakArray et al)
- 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
- 6 = unused
- 7 = immediates (SmallInteger, Character)
- 8 = unused
- 9 = 64-bit indexable
- 10-11 = 32-bit indexable (Bitmap)
- 12-15 = 16-bit indexable
- 16-23 = 8-bit indexable
- 24-31 = compiled methods (CompiledMethod)"
- | instSpec |
- instSpec := self instSpec.
- instSpec < 9 ifTrue: [^Smalltalk wordSize].
- instSpec >= 16 ifTrue: [^1].
- instSpec >= 12 ifTrue: [^2].
- instSpec >= 10 ifTrue: [^4].
- ^8!
Item was removed:
- ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEhandleFailingBasicNew (in category 'method prototypes') -----
- BehaviorPROTOTYPEhandleFailingBasicNew
- "handleFailingBasicNew gets sent after basicNew has failed and allowed
- a scavenging garbage collection to occur. The scavenging collection
- will have happened as the VM is activating the (failing) basicNew. If
- handleFailingBasicNew fails then the scavenge failed to reclaim sufficient
- space and a global garbage collection is required. Retry after garbage
- collecting and growing memory if necessary.
-
- Primitive. Answer an instance of this class with the number of indexable
- variables specified by the argument, sizeRequested. Fail if this class is not
- indexable or if the argument is not a positive Integer, or if there is not
- enough memory available. Essential. See Object documentation whatIsAPrimitive."
-
- <primitive: 70>
- Smalltalk garbageCollect < 1048576 ifTrue:
- [Smalltalk growMemoryByAtLeast: 1048576].
- ^self handleFailingFailingBasicNew "retry after global garbage collect"!
Item was removed:
- ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEhandleFailingBasicNew: (in category 'method prototypes') -----
- BehaviorPROTOTYPEhandleFailingBasicNew: sizeRequested
- "handleFailingBasicNew: gets sent after basicNew: has failed and allowed
- a scavenging garbage collection to occur. The scavenging collection
- will have happened as the VM is activating the (failing) basicNew:. If
- handleFailingBasicNew: fails then the scavenge failed to reclaim sufficient
- space and a global garbage collection is required. Retry after garbage
- collecting and growing memory if necessary.
-
- Primitive. Answer an instance of this class with the number of indexable
- variables specified by the argument, sizeRequested. Fail if this class is not
- indexable or if the argument is not a positive Integer, or if there is not
- enough memory available. Essential. See Object documentation whatIsAPrimitive."
-
- <primitive: 71>
- | bytesRequested |
- bytesRequested := self byteSizeOfInstanceOfSize: sizeRequested.
- Smalltalk garbageCollect < bytesRequested ifTrue:
- [Smalltalk growMemoryByAtLeast: bytesRequested].
- "retry after global garbage collect and possible grow"
- ^self handleFailingFailingBasicNew: sizeRequested!
Item was removed:
- ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEhandleFailingFailingBasicNew (in category 'method prototypes') -----
- BehaviorPROTOTYPEhandleFailingFailingBasicNew
- "This basicNew gets sent after handleFailingBasicNew: has done a full
- garbage collection and possibly grown memory. If this basicNew fails
- then the system really is low on space, so raise the OutOfMemory signal.
-
- Primitive. Answer an instance of this class with the number of indexable
- variables specified by the argument, sizeRequested. Fail if this class is not
- indexable or if the argument is not a positive Integer, or if there is not
- enough memory available. Essential. See Object documentation whatIsAPrimitive."
-
- <primitive: 70>
- "space must be low"
- OutOfMemory signal.
- ^self basicNew "retry if user proceeds"!
Item was removed:
- ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEhandleFailingFailingBasicNew: (in category 'method prototypes') -----
- BehaviorPROTOTYPEhandleFailingFailingBasicNew: sizeRequested
- "This basicNew: gets sent after handleFailingBasicNew: has done a full
- garbage collection and possibly grown memory. If this basicNew: fails
- then the system really is low on space, so raise the OutOfMemory signal.
-
- Primitive. Answer an instance of this class with the number of indexable
- variables specified by the argument, sizeRequested. Fail if this class is not
- indexable or if the argument is not a positive Integer, or if there is not
- enough memory available. Essential. See Object documentation whatIsAPrimitive."
-
- <primitive: 71>
- "space must be low."
- OutOfMemory signal.
- ^self basicNew: sizeRequested "retry if user proceeds"!
Item was removed:
- ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEidentityHash (in category 'method prototypes squeak') -----
- BehaviorPROTOTYPEidentityHash
- "Answer a SmallInteger whose value is related to the receiver's identity.
- Behavior implements identityHash to allow the VM to use an object representation which
- does not include a direct reference to an object's class in an object. If the VM is using
- this implementation then classes are held in a class table and instances contain the index
- of their class in the table. A class's class table index is its identityHash so that an instance
- can be created without searching the table for a class's index. The VM uses this primitive
- to enter the class into the class table, assigning its identityHash with an as yet unused
- class table index. If this primitive fails it means that the class table is full. In Spur as of
- 2014 there are 22 bits of classTable index and 22 bits of identityHash per object.
-
- Primitive. Essential. Do not override. See Object documentation whatIsAPrimitive."
-
- <primitive: 175>
- self primitiveFailed!
Item was removed:
- ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEindexIfCompact (in category 'method prototypes') -----
- BehaviorPROTOTYPEindexIfCompact
- "Backward compatibility with the Squeak V3 object format.
- Spur does not have a distinction between compact and non-compact classes."
- ^0!
Item was removed:
- ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEinstSize (in category 'method prototypes') -----
- BehaviorPROTOTYPEinstSize
- "Answer the number of named instance variables
- (as opposed to indexed variables) of the receiver.
- Above Cog Spur the class format is
- <5 bits inst spec><16 bits inst size>"
- ^format bitAnd: 16rFFFF!
Item was removed:
- ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEinstSpec (in category 'method prototypes') -----
- BehaviorPROTOTYPEinstSpec
- "Answer the instance specification part of the format that defines what kind of object
- an instance of the receiver is. The formats are
- 0 = 0 sized objects (UndefinedObject True False et al)
- 1 = non-indexable objects with inst vars (Point et al)
- 2 = indexable objects with no inst vars (Array et al)
- 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
- 4 = weak indexable objects with inst vars (WeakArray et al)
- 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
- 6 = unused
- 7 = immediates (SmallInteger, Character)
- 8 = unused
- 9 = 64-bit indexable
- 10-11 = 32-bit indexable (Bitmap)
- 12-15 = 16-bit indexable
- 16-23 = 8-bit indexable
- 24-31 = compiled methods (CompiledMethod)"
- ^(format bitShift: -16) bitAnd: 16r1F!
Item was removed:
- ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEisBits (in category 'method prototypes') -----
- BehaviorPROTOTYPEisBits
- "Answer whether the receiver contains just bits (not pointers).
- Above Cog Spur the class format is
- <5 bits inst spec><16 bits inst size>
- where the 5-bit inst spec is
- 0 = 0 sized objects (UndefinedObject True False et al)
- 1 = non-indexable objects with inst vars (Point et al)
- 2 = indexable objects with no inst vars (Array et al)
- 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
- 4 = weak indexable objects with inst vars (WeakArray et al)
- 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
- 6 = unused
- 7 = immediates (SmallInteger, Character)
- 8 = unused
- 9 = 64-bit indexable
- 10-11 = 32-bit indexable (Bitmap)
- 12-15 = 16-bit indexable
- 16-23 = 8-bit indexable
- 24-31 = compiled methods (CompiledMethod)"
- ^self instSpec >= 7!
Item was removed:
- ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEisBytes (in category 'method prototypes') -----
- BehaviorPROTOTYPEisBytes
- "Answer whether the receiver has 8-bit instance variables.
- Above Cog Spur the class format is
- <5 bits inst spec><16 bits inst size>
- where the 5-bit inst spec is
- 0 = 0 sized objects (UndefinedObject True False et al)
- 1 = non-indexable objects with inst vars (Point et al)
- 2 = indexable objects with no inst vars (Array et al)
- 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
- 4 = weak indexable objects with inst vars (WeakArray et al)
- 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
- 6 = unused
- 7 = immediates (SmallInteger, Character)
- 8 = unused
- 9 = 64-bit indexable
- 10-11 = 32-bit indexable (Bitmap)
- 12-15 = 16-bit indexable
- 16-23 = 8-bit indexable
- 24-31 = compiled methods (CompiledMethod)"
- ^self instSpec >= 16!
Item was removed:
- ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEisEphemeronClass (in category 'method prototypes') -----
- BehaviorPROTOTYPEisEphemeronClass
- "Answer whether the receiver has ephemeral instance variables. The garbage collector will
- fire (queue for finalization) any ephemeron whose first instance variable is not referenced
- other than from the transitive closure of references from ephemerons. Hence referring to
- an object from the first inst var of an ephemeron will cause the ephemeron to fire when
- the rest of the system does not refer to the object and that object is ready to be collected.
- Since references from the remaining inst vars of an ephemeron will not prevent the ephemeron
- from firing, ephemerons may act as the associations in weak dictionaries such that the value
- (e.g. properties attached to the key) will not prevent firing when the key is no longer referenced
- other than from ephemerons. Ephemerons can therefore be used to implement instance-based
- pre-mortem finalization."
- ^self instSpec = 5!
Item was removed:
- ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEisImmediateClass (in category 'method prototypes') -----
- BehaviorPROTOTYPEisImmediateClass
- "Answer whether the receiver has immediate instances. Immediate instances
- store their value in their object pointer, not in an object body. Hence immediates
- take no space and are immutable. The immediates are distinguished by tag bits
- in the pointer. They include SmallIntegers and Characters. Hence in the 32-bit
- system SmallIntegers are 31-bit signed integers and Characters are 30-bit
- unsigned character codes."
- ^self instSpec = 7!
Item was removed:
- ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEisVariable (in category 'method prototypes') -----
- BehaviorPROTOTYPEisVariable
- "Answer whether the receiver has indexable variables.
- Above Cog Spur the class format is
- <5 bits inst spec><16 bits inst size>
- where the 5-bit inst spec is
- 0 = 0 sized objects (UndefinedObject True False et al)
- 1 = non-indexable objects with inst vars (Point et al)
- 2 = indexable objects with no inst vars (Array et al)
- 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
- 4 = weak indexable objects with inst vars (WeakArray et al)
- 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
- 6 = unused
- 7 = immediates (SmallInteger, Character)
- 8 = unused
- 9 = 64-bit indexable
- 10-11 = 32-bit indexable (Bitmap)
- 12-15 = 16-bit indexable
- 16-23 = 8-bit indexable
- 24-31 = compiled methods (CompiledMethod)"
- | instSpec |
- instSpec := self instSpec.
- ^instSpec >= 2 and: [instSpec <= 4 or: [instSpec >= 9]]!
Item was removed:
- ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEkindOfSubclass (in category 'method prototypes') -----
- BehaviorPROTOTYPEkindOfSubclass
- "Answer a String that is the keyword that describes the receiver's kind of subclass,
- either a regular subclass, a variableSubclass, a variableByteSubclass,
- a variableWordSubclass, a weakSubclass, an ephemeronSubclass or an immediateSubclass.
- c.f. typeOfClass"
- ^self isVariable
- ifTrue:
- [self isBits
- ifTrue:
- [self isBytes
- ifTrue: [' variableByteSubclass: ']
- ifFalse: [' variableWordSubclass: ']]
- ifFalse:
- [self isWeak
- ifTrue: [' weakSubclass: ']
- ifFalse: [' variableSubclass: ']]]
- ifFalse:
- [self isImmediateClass
- ifTrue: [' immediateSubclass: ']
- ifFalse:
- [self isEphemeronClass
- ifTrue: [' ephemeronSubclass: ']
- ifFalse: [' subclass: ']]]!
Item was removed:
- ----- Method: SpurBootstrap class>>BehaviorPROTOTYPElargeIdentityHash (in category 'method prototypes pharo') -----
- BehaviorPROTOTYPElargeIdentityHash
- "Answer a SmallInteger whose value is related to the receiver's identity.
- Behavior implements identityHash to allow the VM to use an object representation which
- does not include a direct reference to an object's class in an object. If the VM is using
- this implementation then classes are held in a class table and instances contain the index
- of their class in the table. A class's class table index is its identityHash so that an instance
- can be created without searching the table for a class's index. The VM uses this primitive
- to enter the class into the class table, assigning its identityHash with an as yet unused
- class table index. If this primitive fails it means that the class table is full. In Spur as of
- 2014 there are 22 bits of classTable index and 22 bits of identityHash per object."
-
- <primitive: 175>
- self primitiveFailed!
Item was removed:
- ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEshouldNotBeRedefined (in category 'method prototypes') -----
- BehaviorPROTOTYPEshouldNotBeRedefined
- "Answer if the receiver should not be redefined.
- The assumption is that classes in Smalltalk specialObjects and
- instance-specific Behaviors should not be redefined"
-
- ^(Smalltalk specialObjectsArray
- identityIndexOf: self
- ifAbsent: [(self isKindOf: self) ifTrue: [1] ifFalse: [0]]) ~= 0!
Item was removed:
- ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEtypeOfClass (in category 'method prototypes') -----
- BehaviorPROTOTYPEtypeOfClass
- "Answer a symbol uniquely describing the type of the receiver. c.f. kindOfSubclass"
- self isBytes ifTrue:
- [^self instSpec = CompiledMethod instSpec
- ifTrue: [#compiledMethod] "Very special!!"
- ifFalse: [#bytes]].
- (self isWords and: [self isPointers not]) ifTrue:
- [^self instSpec = SmallInteger instSpec
- ifTrue: [#immediate] "Very special!!"
- ifFalse: [#words]].
- self isWeak ifTrue: [^#weak].
- self isVariable ifTrue: [^#variable].
- self isEphemeronClass ifTrue: [^#ephemeron].
- ^#normal!
Item was removed:
- ----- Method: SpurBootstrap class>>BlockClosurePROTOTYPEsimulateValueWithArguments:caller: (in category 'method prototypes') -----
- BlockClosurePROTOTYPEsimulateValueWithArguments: anArray caller: aContext
- <indirect>!
Item was removed:
- ----- Method: SpurBootstrap class>>BytecodeEncoderPROTOTYPEcomputeMethodHeaderForNumArgs:numTemps:numLits:primitive: (in category 'method prototypes') -----
- BytecodeEncoderPROTOTYPEcomputeMethodHeaderForNumArgs: numArgs numTemps: numTemps numLits: numLits primitive: primitiveIndex
- numArgs > 15 ifTrue:
- [^self error: 'Cannot compile -- too many arguments'].
- numTemps > 63 ifTrue:
- [^self error: 'Cannot compile -- too many temporary variables'].
- numLits > 65535 ifTrue:
- [^self error: 'Cannot compile -- too many literals'].
- ^(CompiledMethod headerFlagForEncoder: self)
- + (numArgs bitShift: 24)
- + (numTemps bitShift: 18)
- "+ (largeBit bitShift: 17)" "largeBit gets filled in later"
- + (primitiveIndex > 0 ifTrue: [1 bitShift: 16] ifFalse: [0])
- + numLits!
Item was removed:
- ----- Method: SpurBootstrap class>>BytecodeEncoderPROTOTYPEsizeCallPrimitive: (in category 'method prototypes') -----
- BytecodeEncoderPROTOTYPEsizeCallPrimitive: primitiveIndex
- ^self sizeOpcodeSelector: #genCallPrimitive: withArguments: {primitiveIndex}!
Item was removed:
- ----- Method: SpurBootstrap class>>CharacterPROTOTYPEDollarEquals: (in category 'method prototypes') -----
- CharacterPROTOTYPEDollarEquals: aCharacter
- "Primitive. Answer if the receiver and the argument are the
- same object (have the same object pointer). Optional. See
- Object documentation whatIsAPrimitive."
- <primitive: 110>
- ^self == aCharacter!
Item was removed:
- ----- Method: SpurBootstrap class>>CharacterPROTOTYPEasInteger (in category 'method prototypes') -----
- CharacterPROTOTYPEasInteger
- "Answer the receiver's character code."
- <primitive: 171>
- ^self primitiveFailed!
Item was removed:
- ----- Method: SpurBootstrap class>>CharacterPROTOTYPEasciiValue (in category 'method prototypes') -----
- CharacterPROTOTYPEasciiValue
- "Answer the receiver's character code.
- This will be ascii for characters with value <= 127,
- and Unicode for those with higher values."
- <primitive: 171>
- ^self primitiveFailed!
Item was removed:
- ----- Method: SpurBootstrap class>>CharacterPROTOTYPEclone (in category 'method prototypes squeak') -----
- CharacterPROTOTYPEclone
- "Answer the receiver, because Characters are unique."
- ^self!
Item was removed:
- ----- Method: SpurBootstrap class>>CharacterPROTOTYPEcodePoint (in category 'method prototypes pharo') -----
- CharacterPROTOTYPEcodePoint
- "Just for ANSI Compliance"
- ^self!
Item was removed:
- ----- Method: SpurBootstrap class>>CharacterPROTOTYPEcopy (in category 'method prototypes') -----
- CharacterPROTOTYPEcopy
- "Answer the receiver, because Characters are unique."
- ^self!
Item was removed:
- ----- Method: SpurBootstrap class>>CharacterPROTOTYPEdeepCopy (in category 'method prototypes') -----
- CharacterPROTOTYPEdeepCopy
- "Answer the receiver, because Characters are unique."
- ^self!
Item was removed:
- ----- Method: SpurBootstrap class>>CharacterPROTOTYPEhash (in category 'method prototypes') -----
- CharacterPROTOTYPEhash
- "Hash is reimplemented because = is implemented.
- Answer the receiver's character code."
- <primitive: 171>
- ^self primitiveFailed!
Item was removed:
- ----- Method: SpurBootstrap class>>CharacterPROTOTYPEidentityHash (in category 'method prototypes') -----
- CharacterPROTOTYPEidentityHash
- "Answer the receiver's character code."
- <primitive: 171>
- ^self primitiveFailed!
Item was removed:
- ----- Method: SpurBootstrap class>>CharacterPROTOTYPEsetValue: (in category 'method prototypes pharo') -----
- CharacterPROTOTYPEsetValue: newValue
- self error: 'Characters are immutable'!
Item was removed:
- ----- Method: SpurBootstrap class>>CharacterPROTOTYPEshallowCopy (in category 'method prototypes') -----
- CharacterPROTOTYPEshallowCopy
- "Answer the receiver, because Characters are unique."
- ^self!
Item was removed:
- ----- Method: SpurBootstrap class>>CharacterPROTOTYPEshouldBePrintedAsLiteral (in category 'method prototypes squeak 4.3') -----
- CharacterPROTOTYPEshouldBePrintedAsLiteral
-
- ^(self asInteger between: 33 and: 255) and: [self asInteger ~= 127]!
Item was removed:
- ----- Method: SpurBootstrap class>>CharacterPROTOTYPEveryDeepCopyWith: (in category 'method prototypes') -----
- CharacterPROTOTYPEveryDeepCopyWith: deepCopier
- "Answer the receiver, because Characters are unique."
- ^self!
Item was removed:
- ----- Method: SpurBootstrap class>>CharacterclassPROTOTYPEdigitValue: (in category 'method prototypes') -----
- CharacterclassPROTOTYPEdigitValue: x
- "Answer the Character whose digit value is x. For example,
- answer $9 for x=9, $0 for x=0, $A for x=10, $Z for x=35."
-
- | n |
- n := x asInteger.
- ^self value: (n < 10 ifTrue: [n + 48] ifFalse: [n + 55])!
Item was removed:
- ----- Method: SpurBootstrap class>>CharacterclassPROTOTYPEinitialize (in category 'method prototypes') -----
- CharacterclassPROTOTYPEinitialize
- "Create the DigitsValues table."
- "Character initialize"
- self initializeDigitValues!
Item was removed:
- ----- Method: SpurBootstrap class>>CharacterclassPROTOTYPEvalue: (in category 'method prototypes') -----
- CharacterclassPROTOTYPEvalue: anInteger
- "Answer the Character whose value is anInteger."
- <primitive: 170>
- ^self primitiveFailed!
Item was removed:
- ----- Method: SpurBootstrap class>>ClassBuilderPROTOTYPEcomputeFormat:instSize:forSuper:ccIndex: (in category 'method prototypes') -----
- ClassBuilderPROTOTYPEcomputeFormat: type instSize: newInstSize forSuper: newSuper ccIndex: ccIndex
- "Compute the new format for making oldClass a subclass of newSuper.
- Answer the format or nil if there is any problem."
- | instSize isVar isWords isPointers isWeak |
- type == #compiledMethod ifTrue:
- [newInstSize > 0 ifTrue:
- [self error: 'A compiled method class cannot have named instance variables'.
- ^nil].
- ^CompiledMethod format].
- instSize := newInstSize + (newSuper ifNil:[0] ifNotNil:[newSuper instSize]).
- instSize > 65535 ifTrue:
- [self error: 'Class has too many instance variables (', instSize printString,')'.
- ^nil].
- type == #normal ifTrue:[isVar := isWeak := false. isWords := isPointers := true].
- type == #bytes ifTrue:[isVar := true. isWords := isPointers := isWeak := false].
- type == #words ifTrue:[isVar := isWords := true. isPointers := isWeak := false].
- type == #variable ifTrue:[isVar := isPointers := isWords := true. isWeak := false].
- type == #weak ifTrue:[isVar := isWeak := isWords := isPointers := true].
- type == #ephemeron ifTrue:[isVar := false. isWeak := isWords := isPointers := true].
- type == #immediate ifTrue:[isVar := isWeak := isPointers := false. isWords := true].
- (isPointers not and: [instSize > 0]) ifTrue:
- [self error: 'A non-pointer class cannot have named instance variables'.
- ^nil].
- ^self format: instSize variable: isVar words: isWords pointers: isPointers weak: isWeak!
Item was removed:
- ----- Method: SpurBootstrap class>>ClassBuilderPROTOTYPEformat:variable:words:pointers:weak: (in category 'method prototypes') -----
- ClassBuilderPROTOTYPEformat: nInstVars variable: isVar words: is32BitWords pointers: isPointers weak: isWeak
- "Compute the format for the given instance specfication.
- Above Cog Spur the class format is
- <5 bits inst spec><16 bits inst size>
- where the 5-bit inst spec is
- 0 = 0 sized objects (UndefinedObject True False et al)
- 1 = non-indexable objects with inst vars (Point et al)
- 2 = indexable objects with no inst vars (Array et al)
- 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
- 4 = weak indexable objects with inst vars (WeakArray et al)
- 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
- 6 = unused
- 7 = immediates (SmallInteger, Character)
- 8 = unused
- 9 = reserved for 64-bit indexable
- 10-11 = 32-bit indexable (Bitmap)
- 12-15 = 16-bit indexable
- 16-23 = 8-bit indexable
- 24-31 = compiled methods (CompiledMethod)"
- | instSpec |
- instSpec := isWeak
- ifTrue:
- [isVar
- ifTrue: [4]
- ifFalse: [5]]
- ifFalse:
- [isPointers
- ifTrue:
- [isVar
- ifTrue: [nInstVars > 0 ifTrue: [3] ifFalse: [2]]
- ifFalse: [nInstVars > 0 ifTrue: [1] ifFalse: [0]]]
- ifFalse:
- [isVar
- ifTrue: [is32BitWords ifTrue: [10] ifFalse: [16]]
- ifFalse: [7]]].
- ^(instSpec bitShift: 16) + nInstVars!
Item was removed:
- ----- Method: SpurBootstrap class>>ClassBuilderPROTOTYPEsuperclass:immediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'method prototypes') -----
- ClassBuilderPROTOTYPEsuperclass: aClass
- immediateSubclass: t instanceVariableNames: f
- classVariableNames: d poolDictionaries: s category: cat
- "This is the standard initialization message for creating a
- new immediate class as a subclass of an existing class."
- | env |
- aClass instSize > 0
- ifTrue: [^self error: 'cannot make an immediate subclass of a class with named fields'].
- aClass isVariable
- ifTrue: [^self error: 'cannot make an immediate subclass of a class with indexed instance variables'].
- aClass isPointers
- ifFalse: [^self error: 'cannot make an immediate subclass of a class without pointer fields'].
- "Cope with pre-environment and environment versions. Simplify asap."
- env := (Smalltalk classNamed: #EnvironmentRequest)
- ifNil: [aClass environment]
- ifNotNil: [:erc| erc signal ifNil: [aClass environment]].
- ^self
- name: t
- inEnvironment: env
- subclassOf: aClass
- type: #immediate
- instanceVariableNames: f
- classVariableNames: d
- poolDictionaries: s
- category: cat!
Item was removed:
- ----- Method: SpurBootstrap class>>ClassBuilderPROTOTYPEupdate:to: (in category 'method prototypes') -----
- ClassBuilderPROTOTYPEupdate: oldClass to: newClass
- "Convert oldClass, all its instances and possibly its meta class into newClass,
- instances of newClass and possibly its meta class. The process is surprisingly
- simple in its implementation and surprisingly complex in its nuances and potentially
- bad side effects.
- We can rely on two assumptions (which are critical):
- #1: The method #updateInstancesFrom: will not create any lasting pointers to
- 'old' instances ('old' is quote on quote since #updateInstancesFrom: will do
- a become of the old vs. the new instances and therefore it will not create
- pointers to *new* instances before the #become: which are *old* afterwards)
- #2: The non-preemptive execution of the critical piece of code guarantees that
- nobody can get a hold by 'other means' (such as process interruption and
- reflection) on the old instances.
- Given the above two, we know that after #updateInstancesFrom: there are no pointers
- to any old instances. After the forwarding become there will be no pointers to the old
- class or meta class either.
- Andreas Raab, 2/27/2003 23:42"
- | meta |
- meta := oldClass isMeta.
- "Note: Everything from here on will run without the ability to get interrupted
- to prevent any other process to create new instances of the old class."
- ["Note: The following removal may look somewhat obscure and needs an explanation.
- When we mutate the class hierarchy we create new classes for any existing subclass.
- So it may look as if we don't have to remove the old class from its superclass. However,
- at the top of the hierarchy (the first class we reshape) that superclass itself is not newly
- created so therefore it will hold both the oldClass and newClass in its (obsolete or not)
- subclasses. Since the #become: below will transparently replace the pointers to oldClass
- with newClass the superclass would have newClass in its subclasses TWICE. With rather
- unclear effects if we consider that we may convert the meta-class hierarchy itself (which
- is derived from the non-meta class hierarchy).
- Due to this problem ALL classes are removed from their superclass just prior to converting
- them. Here, breaking the superclass/subclass invariant really doesn't matter since we will
- effectively remove the oldClass (becomeForward:) just a few lines below."
-
- oldClass superclass removeSubclass: oldClass.
- oldClass superclass removeObsoleteSubclass: oldClass.
-
- "make sure that the VM cache is clean"
- oldClass methodDict do: [:cm | cm flushCache].
-
- "Convert the instances of oldClass into instances of newClass"
- newClass updateInstancesFrom: oldClass.
-
- meta
- ifTrue:
- [oldClass becomeForward: newClass.
- oldClass updateMethodBindingsTo: oldClass binding]
- ifFalse:
- [{oldClass. oldClass class} elementsForwardIdentityTo: {newClass. newClass class}.
- oldClass updateMethodBindingsTo: oldClass binding.
- oldClass class updateMethodBindingsTo: oldClass class binding].
-
- "eem 5/31/2014 07:22 At this point there used to be a garbage collect whose purpose was
- to ensure no old instances existed after the becomeForward:. Without the GC it was possible
- to resurrect old instances using e.g. allInstancesDo:. This was because the becomeForward:
- updated references from the old objects to new objects but didn't destroy the old objects.
- But as of late 2013/early 2014 becomeForward: has been modified to free all the old objects."]
- valueUnpreemptively!
Item was removed:
- ----- Method: SpurBootstrap class>>ClassDescriptionPROTOTYPEupdateMethodBindingsTo: (in category 'method prototypes squeak') -----
- ClassDescriptionPROTOTYPEupdateMethodBindingsTo: aBinding
- "ClassBuilder support for maintaining valid method bindings."
- methodDict do: [:method| method methodClassAssociation: aBinding]!
Item was removed:
- ----- Method: SpurBootstrap class>>ClassPROTOTYPEimmediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'method prototypes squeak') -----
- ClassPROTOTYPEimmediateSubclass: t instanceVariableNames: f classVariableNames: d poolDictionaries: s category: cat
- "This is the standard initialization message for creating a new
- immediate class as a subclass of an existing class (the receiver)."
- ^ClassBuilder new
- superclass: self
- immediateSubclass: t
- instanceVariableNames: f
- classVariableNames: d
- poolDictionaries: s
- category: cat!
Item was removed:
- ----- Method: SpurBootstrap class>>CompiledMethodPROTOTYPEencoderClass (in category 'method prototypes squeak 4.3') -----
- CompiledMethodPROTOTYPEencoderClass
- <indirect>!
Item was removed:
- ----- Method: SpurBootstrap class>>CompiledMethodPROTOTYPEnumLiterals (in category 'method prototypes') -----
- CompiledMethodPROTOTYPEnumLiterals
- "Answer the number of literals used by the receiver."
- ^self header bitAnd: 65535!
Item was removed:
- ----- Method: SpurBootstrap class>>CompiledMethodPROTOTYPEprimitive (in category 'method prototypes') -----
- CompiledMethodPROTOTYPEprimitive
- "Answer the primitive index associated with the receiver.
- Zero indicates that this is not a primitive method."
- | initialPC |
- ^(self header anyMask: 65536) "Is the hasPrimitive? flag set?"
- ifTrue: [(self at: (initialPC := self initialPC) + 1) + ((self at: initialPC + 2) bitShift: 8)]
- ifFalse: [0]!
Item was removed:
- ----- Method: SpurBootstrap class>>CompiledMethodclassPROTOTYPEhandleFailingFailingNewMethod:header: (in category 'method prototypes') -----
- CompiledMethodclassPROTOTYPEhandleFailingFailingNewMethod: numberOfBytes header: headerWord
- "This newMethod:header: gets sent after handleFailingBasicNew: has done a full
- garbage collection and possibly grown memory. If this basicNew: fails then the
- system really is low on space, so raise the OutOfMemory signal.
-
- Primitive. Answer an instance of this class with the number of indexable variables
- specified by the argument, headerWord, and the number of bytecodes specified
- by numberOfBytes. Fail if this if the arguments are not Integers, or if numberOfBytes
- is negative, or if the receiver is not a CompiledMethod class, or if there is not enough
- memory available. Essential. See Object documentation whatIsAPrimitive."
-
- <primitive: 79>
- "space must be low."
- OutOfMemory signal.
- "retry if user proceeds"
- ^self newMethod: numberOfBytes header: headerWord!
Item was removed:
- ----- Method: SpurBootstrap class>>CompiledMethodclassPROTOTYPEhandleFailingNewMethod:header: (in category 'method prototypes') -----
- CompiledMethodclassPROTOTYPEhandleFailingNewMethod: numberOfBytes header: headerWord
- "This newMethod:header: gets sent after newMethod:header: has failed
- and allowed a scavenging garbage collection to occur. The scavenging
- collection will have happened as the VM is activating the (failing) basicNew:.
- If handleFailingBasicNew: fails then the scavenge failed to reclaim sufficient
- space and a global garbage collection is required. Retry after garbage
- collecting and growing memory if necessary.
-
- Primitive. Answer an instance of this class with the number of indexable variables
- specified by the argument, headerWord, and the number of bytecodes specified
- by numberOfBytes. Fail if this if the arguments are not Integers, or if numberOfBytes
- is negative, or if the receiver is not a CompiledMethod class, or if there is not enough
- memory available. Essential. See Object documentation whatIsAPrimitive."
-
- <primitive: 79>
- | bytesRequested |
- bytesRequested := (headerWord bitAnd: 16rFFFF) + 1 * Smalltalk wordSize + numberOfBytes + 16.
- Smalltalk garbageCollect < bytesRequested ifTrue:
- [Smalltalk growMemoryByAtLeast: bytesRequested].
- "retry after global garbage collect and possible grow"
- ^self handleFailingFailingNewMethod: numberOfBytes header: headerWord!
Item was removed:
- ----- Method: SpurBootstrap class>>CompiledMethodclassPROTOTYPEheaderFlagForEncoder: (in category 'method prototypes') -----
- CompiledMethodclassPROTOTYPEheaderFlagForEncoder: anEncoder
- <indirect>!
Item was removed:
- ----- Method: SpurBootstrap class>>CompiledMethodclassPROTOTYPEinitialize (in category 'method prototypes') -----
- CompiledMethodclassPROTOTYPEinitialize "CompiledMethod initialize"
- <indirect>!
Item was removed:
- ----- Method: SpurBootstrap class>>CompiledMethodclassPROTOTYPEinstallPrimaryBytecodeSet: (in category 'method prototypes') -----
- CompiledMethodclassPROTOTYPEinstallPrimaryBytecodeSet: aBytecodeEncoderSubclass
- <indirect>!
Item was removed:
- ----- Method: SpurBootstrap class>>CompiledMethodclassPROTOTYPEinstallSecondaryBytecodeSet: (in category 'method prototypes') -----
- CompiledMethodclassPROTOTYPEinstallSecondaryBytecodeSet: aBytecodeEncoderSubclass
- <indirect>!
Item was removed:
- ----- Method: SpurBootstrap class>>CompiledMethodclassPROTOTYPEnewBytes:trailerBytes:nArgs:nTemps:nStack:nLits:primitive: (in category 'method prototypes') -----
- CompiledMethodclassPROTOTYPEnewBytes: numberOfBytes trailerBytes: trailer nArgs: nArgs nTemps: nTemps nStack: stackSize nLits: nLits primitive: primitiveIndex
- "Since this method refers to ClassVariables things are easier if it lives in the actual class."
-
- <indirect>!
Item was removed:
- ----- Method: SpurBootstrap class>>CompiledMethodclassPROTOTYPEnewBytes:trailerBytes:nArgs:nTemps:nStack:nLits:primitive:flag: (in category 'method prototypes') -----
- CompiledMethodclassPROTOTYPEnewBytes: numberOfBytes trailerBytes: trailer nArgs: nArgs nTemps: nTemps nStack: stackSize nLits: nLits primitive: primitiveIndex flag: flag
- "Since this method refers to ClassVariables things are easier if it lives in the actual class."
-
- <indirect>!
Item was removed:
- ----- Method: SpurBootstrap class>>CompiledMethodclassPROTOTYPEnewMethod:header: (in category 'method prototypes') -----
- CompiledMethodclassPROTOTYPEnewMethod: numberOfBytes header: headerWord
- "Primitive. Answer an instance of me. The number of literals (and other
- information) is specified by the headerWord (see my class comment).
- The first argument specifies the number of fields for bytecodes in the
- method. Fail if either argument is not a SmallInteger, or if numberOfBytes
- is negative, or if memory is low. Once the header of a method is set by
- this primitive, it cannot be changed to change the number of literals.
- Essential. See Object documentation whatIsAPrimitive."
-
- <primitive: 79 error: ec>
- ec == #'insufficient object memory' ifTrue:
- [^self handleFailingNewMethod: numberOfBytes header: headerWord].
- ^self primitiveFailed!
Item was removed:
- ----- Method: SpurBootstrap class>>CompiledMethodclassPROTOTYPEtoReturnConstant:trailerBytes: (in category 'method prototypes') -----
- CompiledMethodclassPROTOTYPEtoReturnConstant: index trailerBytes: trailer
- "Answer an instance of me that is a quick return of the constant
- indexed in (true false nil -1 0 1 2)."
-
- ^self newBytes: 3 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 256 + index!
Item was removed:
- ----- Method: SpurBootstrap class>>CompiledMethodclassPROTOTYPEtoReturnField:trailerBytes: (in category 'method prototypes') -----
- CompiledMethodclassPROTOTYPEtoReturnField: field trailerBytes: trailer
- "Answer an instance of me that is a quick return of the instance variable
- indexed by the argument, field."
-
- ^self newBytes: 3 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 264 + field!
Item was removed:
- ----- Method: SpurBootstrap class>>CompiledMethodclassPROTOTYPEtoReturnSelfTrailerBytes: (in category 'method prototypes') -----
- CompiledMethodclassPROTOTYPEtoReturnSelfTrailerBytes: trailer
- "Answer an instance of me that is a quick return of the instance (^self)."
-
- ^self newBytes: 3 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 256!
Item was removed:
- ----- Method: SpurBootstrap class>>ContextPartPROTOTYPEactivateReturn:value: (in category 'method prototypes') -----
- ContextPartPROTOTYPEactivateReturn: aContext value: value
- "Activate 'aContext return: value' in place of self, so execution will return to aContext's sender"
-
- ^MethodContext
- sender: self
- receiver: aContext
- method: MethodContext theReturnMethod
- arguments: {value}!
Item was removed:
- ----- Method: SpurBootstrap class>>ContextPartPROTOTYPEdoPrimitive:method:receiver:args: (in category 'method prototypes') -----
- ContextPartPROTOTYPEdoPrimitive: primitiveIndex method: meth receiver: receiver args: arguments
- <indirect>!
Item was removed:
- ----- Method: SpurBootstrap class>>ContextPartPROTOTYPEisPrimFailToken: (in category 'method prototypes') -----
- ContextPartPROTOTYPEisPrimFailToken: anObject
- <indirect>!
Item was removed:
- ----- Method: SpurBootstrap class>>ContextPartPROTOTYPEsend:to:with:lookupIn: (in category 'method prototypes') -----
- ContextPartPROTOTYPEsend: selector to: rcvr with: arguments lookupIn: lookupClass
- "Simulate the action of sending a message with selector and arguments
- to rcvr. The argument, lookupClass, is the class in which to lookup the
- message. This is the receiver's class for normal messages, but for super
- messages it will be some specific class related to the source method."
-
- | meth primIndex val ctxt |
- (meth := lookupClass lookupSelector: selector) ifNil:
- [^self send: #doesNotUnderstand:
- to: rcvr
- with: {Message selector: selector arguments: arguments}
- lookupIn: lookupClass].
- (primIndex := meth primitive) > 0 ifTrue:
- [val := self doPrimitive: primIndex method: meth receiver: rcvr args: arguments.
- (self isPrimFailToken: val) ifFalse:
- [^val]].
- (selector == #doesNotUnderstand: and: [lookupClass == ProtoObject]) ifTrue:
- [^self error: 'Simulated message ', arguments first selector, ' not understood'].
- ctxt := MethodContext sender: self receiver: rcvr method: meth arguments: arguments.
- primIndex > 0 ifTrue:
- [ctxt failPrimitiveWith: val].
- ^ctxt!
Item was removed:
- ----- Method: SpurBootstrap class>>ContextPartPROTOTYPEsend:to:with:super: (in category 'method prototypes') -----
- ContextPartPROTOTYPEsend: selector to: rcvr with: arguments super: superFlag
- "Simulate the action of sending a message with selector arguments
- to rcvr. The argument, superFlag, tells whether the receiver of the
- message was specified with 'super' in the source method."
-
- ^self send: selector
- to: rcvr
- with: arguments
- lookupIn: (superFlag
- ifTrue: [self method methodClassAssociation value superclass]
- ifFalse: [self objectClass: rcvr])!
Item was removed:
- ----- Method: SpurBootstrap class>>ContextPartPROTOTYPEtryNamedPrimitiveIn:for:withArgs: (in category 'method prototypes') -----
- ContextPartPROTOTYPEtryNamedPrimitiveIn: aCompiledMethod for: aReceiver withArgs: arguments
- "Invoke the named primitive for aCompiledMethod, answering its result, or,
- if the primiitve fails, answering the error code."
- <primitive: 218 error: ec>
- ec ifNotNil:
- ["If ec is an integer other than -1 there was a problem with primitive 218,
- not with the external primitive itself. -1 indicates a generic failure (where
- ec should be nil) but ec = nil means primitive 218 is not implemented. So
- interpret -1 to mean the external primitive failed with a nil error code."
- ec isInteger ifTrue:
- [ec = -1
- ifTrue: [ec := nil]
- ifFalse: [self primitiveFailed]]].
- ^self class primitiveFailTokenFor: ec!
Item was removed:
- ----- Method: SpurBootstrap class>>ContextclassPROTOTYPEallInstances (in category 'method prototypes pharo') -----
- ContextclassPROTOTYPEallInstances
- "Answer all instances of the receiver."
- <primitive: 177>
- "The primitive can fail because memory is low. If so, fall back on the old
- enumeration code, which gives the system a chance to GC and/or grow.
- Because aBlock might change the class of inst (for example, using become:),
- it is essential to compute next before aBlock value: inst.
- Only count until thisContext since this context has been created only to
- compute the existing instances."
- | inst insts next |
- insts := WriteStream on: (Array new: 64).
- inst := self someInstance.
- [inst == thisContext or: [inst == nil]] whileFalse:
- [next := inst nextInstance.
- insts nextPut: inst.
- inst := next].
- ^insts contents!
Item was removed:
- ----- Method: SpurBootstrap class>>ContextclassPROTOTYPEallInstancesDo: (in category 'method prototypes pharo') -----
- ContextclassPROTOTYPEallInstancesDo: aBlock
- "Evaluate aBlock with each of the current instances of the receiver."
- | instances inst next |
- instances := self allInstancesOrNil.
- instances ifNotNil:
- [instances do: aBlock.
- ^self].
- "allInstancesOrNil can fail because memory is low. If so, fall back on the old
- enumeration code. Because aBlock might change the class of inst (for example,
- using become:), it is essential to compute next before aBlock value: inst.
- Only count until thisContext since evaluation of aBlock will create new contexts."
- inst := self someInstance.
- [inst == thisContext or: [inst == nil]] whileFalse:
- [next := inst nextInstance.
- aBlock value: inst.
- inst := next]!
Item was removed:
- ----- Method: SpurBootstrap class>>DecompilerPROTOTYPEdecompile:in:method:using: (in category 'method prototypes squeak 4.3') -----
- DecompilerPROTOTYPEdecompile: aSelector in: aClass method: aMethod using: aConstructor
- <indirect>!
Item was removed:
- ----- Method: SpurBootstrap class>>EncoderForV3PROTOTYPEcomputeMethodHeaderForNumArgs:numTemps:numLits:primitive: (in category 'method prototypes') -----
- EncoderForV3PROTOTYPEcomputeMethodHeaderForNumArgs: numArgs numTemps: numTemps numLits: numLits primitive: primitiveIndex
- <remove>!
Item was removed:
- ----- Method: SpurBootstrap class>>EncoderForV3PlusClosuresPROTOTYPEgenCallPrimitive: (in category 'method prototypes') -----
- EncoderForV3PlusClosuresPROTOTYPEgenCallPrimitive: primitiveIndex
- "Since this method has inst var refs the prototype must live in the actual class."
-
- <indirect>!
Item was removed:
- ----- Method: SpurBootstrap class>>EncoderForV3PlusClosuresclassPROTOTYPEbytecodeSize: (in category 'method prototypes') -----
- EncoderForV3PlusClosuresclassPROTOTYPEbytecodeSize: bytecode
- "Answer the number of bytes in the bytecode."
- bytecode <= 125 ifTrue:
- [^1].
- bytecode >= 176 ifTrue:
- [^1].
- bytecode >= 160 ifTrue: "long jumps"
- [^2].
- bytecode >= 144 ifTrue: "short jumps"
- [^1].
- "extensions"
- bytecode >= 128 ifTrue:
- [^#(2 2 2 2 3 2 2 1 1 1 2 3 3 3 3 4) at: bytecode - 127].
- ^nil!
Item was removed:
- ----- Method: SpurBootstrap class>>EncoderForV3PlusClosuresclassPROTOTYPEcallPrimitiveCode (in category 'method prototypes') -----
- EncoderForV3PlusClosuresclassPROTOTYPEcallPrimitiveCode
- "139 11101111 iiiiiiii jjjjjjjj Call Primitive #iiiiiiii + (jjjjjjjj * 256)"
- ^139!
Item was removed:
- ----- Method: SpurBootstrap class>>InstructionClientPROTOTYPEcallPrimitive: (in category 'method prototypes') -----
- InstructionClientPROTOTYPEcallPrimitive: pimIndex
- "V3PlusClosures: 139 10001011 iiiiiiii jjjjjjjj Call Primitive #iiiiiiii + (jjjjjjjj * 256)
- NewsqueakV4: 249 11111001 iiiiiiii jjjjjjjj Call Primitive #iiiiiiii + (jjjjjjjj * 256)
- SistaV1: 248 11111000 iiiiiiii mjjjjjjj Call Primitive #iiiiiiii + ( jjjjjjj * 256)
- m=1 means inlined primitive, no hard return after execution."!
Item was removed:
- ----- Method: SpurBootstrap class>>InstructionPrinterPROTOTYPEcallPrimitive: (in category 'method prototypes') -----
- InstructionPrinterPROTOTYPEcallPrimitive: index
- "Print the callPrimitive."
-
- self print: 'callPrimtive: ' , index printString!
Item was removed:
- ----- Method: SpurBootstrap class>>InstructionStreamPROTOTYPEinterpretExtension:in:for: (in category 'method prototypes squeak 4.3') -----
- InstructionStreamPROTOTYPEinterpretExtension: offset in: method for: client
- ^self interpretV3ClosuresExtension: offset in: method for: client!
Item was removed:
- ----- Method: SpurBootstrap class>>InstructionStreamPROTOTYPEinterpretV3ClosuresExtension:in:for: (in category 'method prototypes') -----
- InstructionStreamPROTOTYPEinterpretV3ClosuresExtension: offset in: method for: client
- "Since this method has inst var refs the prototype must live in the actual class."
-
- <indirect>!
Item was removed:
- ----- Method: SpurBootstrap class>>InstructionStreamPROTOTYPEnextPc: (in category 'method prototypes squeak 4.3') -----
- InstructionStreamPROTOTYPEnextPc: currentByte
- <indirect>!
Item was removed:
- ----- Method: SpurBootstrap class>>InstructionStreamPROTOTYPEskipCallPrimitive (in category 'method prototypes squeak 4.3') -----
- InstructionStreamPROTOTYPEskipCallPrimitive
- <indirect>!
Item was removed:
- ----- Method: SpurBootstrap class>>IntegerclassPROTOTYPEinitialize (in category 'method prototypes squeak') -----
- IntegerclassPROTOTYPEinitialize
- "Integer initialize"
- self initializeLowBitPerByteTable!
Item was removed:
- ----- Method: SpurBootstrap class>>MCClassDefinitionPROTOTYPEkindOfSubclass (in category 'method prototypes squeak 4.3') -----
- MCClassDefinitionPROTOTYPEkindOfSubclass
- <indirect>!
Item was removed:
- ----- Method: SpurBootstrap class>>MCMethodDefinitionPROTOTYPEinitializeWithClassName:classIsMeta:selector:category:timeStamp:source: (in category 'method prototypes squeak 4.3') -----
- MCMethodDefinitionPROTOTYPEinitializeWithClassName: classString classIsMeta: metaBoolean selector: selectorString category: catString timeStamp: timeString source: sourceString
- <indirect>!
Item was removed:
- ----- Method: SpurBootstrap class>>MethodContextPROTOTYPEfailPrimitiveWith: (in category 'method prototypes') -----
- MethodContextPROTOTYPEfailPrimitiveWith: maybePrimFailToken
- <indirect>!
Item was removed:
- ----- Method: SpurBootstrap class>>MethodContextclassPROTOTYPEallInstances (in category 'method prototypes squeak') -----
- MethodContextclassPROTOTYPEallInstances
- "Answer all instances of the receiver."
- <primitive: 177>
- "The primitive can fail because memory is low. If so, fall back on the old
- enumeration code, which gives the system a chance to GC and/or grow.
- Because aBlock might change the class of inst (for example, using become:),
- it is essential to compute next before aBlock value: inst.
- Only count until thisContext since this context has been created only to
- compute the existing instances."
- | inst insts next |
- insts := WriteStream on: (Array new: 64).
- inst := self someInstance.
- [inst == thisContext or: [inst == nil]] whileFalse:
- [next := inst nextInstance.
- insts nextPut: inst.
- inst := next].
- ^insts contents!
Item was removed:
- ----- Method: SpurBootstrap class>>MethodContextclassPROTOTYPEallInstancesDo: (in category 'method prototypes squeak') -----
- MethodContextclassPROTOTYPEallInstancesDo: aBlock
- "Evaluate aBlock with each of the current instances of the receiver."
- | instances inst next |
- instances := self allInstancesOrNil.
- instances ifNotNil:
- [instances do: aBlock.
- ^self].
- "allInstancesOrNil can fail because memory is low. If so, fall back on the old
- enumeration code. Because aBlock might change the class of inst (for example,
- using become:), it is essential to compute next before aBlock value: inst.
- Only count until thisContext since evaluation of aBlock will create new contexts."
- inst := self someInstance.
- [inst == thisContext or: [inst == nil]] whileFalse:
- [next := inst nextInstance.
- aBlock value: inst.
- inst := next]!
Item was removed:
- ----- Method: SpurBootstrap class>>MethodNodeOLDSQUEAKPROTOTYPEgenerate: (in category 'method prototypes') -----
- MethodNodeOLDSQUEAKPROTOTYPEgenerate: trailer
- "The receiver is the root of a parse tree. Answer a CompiledMethod.
- The argument, trailer, is arbitrary but is typically either the reference
- to the source code that is stored with every CompiledMethod, or an
- encoding of the method's temporary names."
-
- ^self generate: trailer using: CompiledMethod!
Item was removed:
- ----- Method: SpurBootstrap class>>MethodNodePROTOTYPEgenerate:using: (in category 'method prototypes') -----
- MethodNodePROTOTYPEgenerate: trailer using: aCompiledMethodClass
- "Since this method has inst var refs the prototype must live in the actual class."
-
- <indirect>!
Item was removed:
- ----- Method: SpurBootstrap class>>ProtoObjectPROTOTYPEidentityHash (in category 'method prototypes pharo') -----
- ProtoObjectPROTOTYPEidentityHash
- "Answer a SmallInteger whose value is related to the receiver's identity.
- This method must not be overridden, except by SmallInteger. As of
- 2014, the 32-bit Spur VM has 22 bits of hash and 31-bit SmallIntegers
- (30 bits + 1 sign bit). Shifting by 8 will not create large integers.
-
- Do not override."
-
- ^self basicIdentityHash bitShift: 8!
Item was removed:
- ----- Method: SpurBootstrap class>>ProtoObjectPROTOTYPEscaledIdentityHash (in category 'method prototypes squeak') -----
- ProtoObjectPROTOTYPEscaledIdentityHash
- "For identityHash values returned by primitive 75, answer
- such values times 2^8. Otherwise, match the existing
- identityHash implementation"
-
- ^self identityHash * 256 "bitShift: 8"!
Item was removed:
- ----- Method: SpurBootstrap class>>SlotClassBuilderPROTOTYPEcomputeFormat:instSize:forSuper:ccIndex: (in category 'method prototypes pharo') -----
- SlotClassBuilderPROTOTYPEcomputeFormat: type instSize: newInstSize forSuper: newSuper ccIndex: ccIndex
- "Compute the new format for making oldClass a subclass of newSuper.
- Answer the format or nil if there is any problem."
- | instSize isVar isWords isPointers isWeak |
- type == #compiledMethod ifTrue:
- [newInstSize > 0 ifTrue:
- [self error: 'A compiled method class cannot have named instance variables'.
- ^nil].
- ^CompiledMethod format].
- instSize := newInstSize + (newSuper ifNil:[0] ifNotNil:[newSuper instSize]).
- instSize > 65535 ifTrue:
- [self error: 'Class has too many instance variables (', instSize printString,')'.
- ^nil].
- type == #normal ifTrue:[isVar := isWeak := false. isWords := isPointers := true].
- type == #bytes ifTrue:[isVar := true. isWords := isPointers := isWeak := false].
- type == #words ifTrue:[isVar := isWords := true. isPointers := isWeak := false].
- type == #variable ifTrue:[isVar := isPointers := isWords := true. isWeak := false].
- type == #weak ifTrue:[isVar := isWeak := isWords := isPointers := true].
- type == #ephemeron ifTrue:[isVar := false. isWeak := isWords := isPointers := true].
- type == #immediate ifTrue:[isVar := isWeak := isPointers := false. isWords := true].
- (isPointers not and: [instSize > 0]) ifTrue:
- [self error: 'A non-pointer class cannot have named instance variables'.
- ^nil].
- ^self format: instSize variable: isVar words: isWords pointers: isPointers weak: isWeak!
Item was removed:
- ----- Method: SpurBootstrap class>>SlotClassBuilderPROTOTYPEformat:variable:words:pointers:weak: (in category 'method prototypes pharo') -----
- SlotClassBuilderPROTOTYPEformat: nInstVars variable: isVar words: isWords pointers: isPointers weak: isWeak
- "Compute the format for the given instance specfication.
- Above Cog Spur the class format is
- <5 bits inst spec><16 bits inst size>
- where the 5-bit inst spec is
- 0 = 0 sized objects (UndefinedObject True False et al)
- 1 = non-indexable objects with inst vars (Point et al)
- 2 = indexable objects with no inst vars (Array et al)
- 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
- 4 = weak indexable objects with inst vars (WeakArray et al)
- 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
- 6 = unused
- 7 = immediates (SmallInteger, Character)
- 8 = unused
- 9 = reserved for 64-bit indexable
- 10-11 = 32-bit indexable (Bitmap)
- 12-15 = 16-bit indexable
- 16-23 = 8-bit indexable
- 24-31 = compiled methods (CompiledMethod)"
- | instSpec |
- instSpec := isWeak
- ifTrue:
- [isVar
- ifTrue: [4]
- ifFalse: [5]]
- ifFalse:
- [isPointers
- ifTrue:
- [isVar
- ifTrue: [nInstVars > 0 ifTrue: [3] ifFalse: [2]]
- ifFalse: [nInstVars > 0 ifTrue: [1] ifFalse: [0]]]
- ifFalse:
- [isVar
- ifTrue: [isWords ifTrue: [12] ifFalse: [16]]
- ifFalse: [7]]].
- ^(instSpec bitShift: 16) + nInstVars!
Item was removed:
- ----- Method: SpurBootstrap class>>SlotClassBuilderPROTOTYPEsuperclass:immediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'method prototypes pharo') -----
- SlotClassBuilderPROTOTYPEsuperclass: aClass
- immediateSubclass: t instanceVariableNames: f
- classVariableNames: d poolDictionaries: s category: cat
- "This is the standard initialization message for creating a
- new immediate class as a subclass of an existing class."
- | env |
- aClass instSize > 0
- ifTrue: [^self error: 'cannot make an immediate subclass of a class with named fields'].
- aClass isVariable
- ifTrue: [^self error: 'cannot make an immediate subclass of a class with indexed instance variables'].
- aClass isPointers
- ifFalse: [^self error: 'cannot make an immediate subclass of a class without pointer fields'].
- "Cope with pre-environment and environment versions. Simplify asap."
- env := (Smalltalk classNamed: #EnvironmentRequest)
- ifNil: [aClass environment]
- ifNotNil: [:erc| erc signal ifNil: [aClass environment]].
- ^self
- name: t
- inEnvironment: env
- subclassOf: aClass
- type: #immediate
- instanceVariableNames: f
- classVariableNames: d
- poolDictionaries: s
- category: cat!
Item was removed:
- ----- Method: SpurBootstrap class>>SlotClassBuilderPROTOTYPEupdate:to: (in category 'method prototypes pharo') -----
- SlotClassBuilderPROTOTYPEupdate: oldClass to: newClass
- "Convert oldClass, all its instances and possibly its meta class into newClass,
- instances of newClass and possibly its meta class. The process is surprisingly
- simple in its implementation and surprisingly complex in its nuances and potentially
- bad side effects.
- We can rely on two assumptions (which are critical):
- #1: The method #updateInstancesFrom: will not create any lasting pointers to
- 'old' instances ('old' is quote on quote since #updateInstancesFrom: will do
- a become of the old vs. the new instances and therefore it will not create
- pointers to *new* instances before the #become: which are *old* afterwards)
- #2: The non-preemptive execution of the critical piece of code guarantees that
- nobody can get a hold by 'other means' (such as process interruption and
- reflection) on the old instances.
- Given the above two, we know that after #updateInstancesFrom: there are no pointers
- to any old instances. After the forwarding become there will be no pointers to the old
- class or meta class either.
- Andreas Raab, 2/27/2003 23:42"
- | meta |
- meta := oldClass isMeta.
- "Note: Everything from here on will run without the ability to get interrupted
- to prevent any other process to create new instances of the old class."
- ["Note: The following removal may look somewhat obscure and needs an explanation.
- When we mutate the class hierarchy we create new classes for any existing subclass.
- So it may look as if we don't have to remove the old class from its superclass. However,
- at the top of the hierarchy (the first class we reshape) that superclass itself is not newly
- created so therefore it will hold both the oldClass and newClass in its (obsolete or not)
- subclasses. Since the #become: below will transparently replace the pointers to oldClass
- with newClass the superclass would have newClass in its subclasses TWICE. With rather
- unclear effects if we consider that we may convert the meta-class hierarchy itself (which
- is derived from the non-meta class hierarchy).
- Due to this problem ALL classes are removed from their superclass just prior to converting
- them. Here, breaking the superclass/subclass invariant really doesn't matter since we will
- effectively remove the oldClass (becomeForward:) just a few lines below."
-
- oldClass superclass removeSubclass: oldClass.
- oldClass superclass removeObsoleteSubclass: oldClass.
-
- "make sure that the VM cache is clean"
- oldClass methodDict do: [:cm | cm flushCache].
-
- "Convert the instances of oldClass into instances of newClass"
- newClass updateInstancesFrom: oldClass.
-
- meta
- ifTrue:
- [oldClass becomeForward: newClass.
- oldClass updateMethodBindingsTo: oldClass binding]
- ifFalse:
- [{oldClass. oldClass class} elementsForwardIdentityTo: {newClass. newClass class}.
- oldClass updateMethodBindingsTo: oldClass binding.
- oldClass class updateMethodBindingsTo: oldClass class binding].
-
- "eem 5/31/2014 07:22 At this point there used to be a garbage collect whose purpose was
- to ensure no old instances existed after the becomeForward:. Without the GC it was possible
- to resurrect old instances using e.g. allInstancesDo:. This was because the becomeForward:
- updated references from the old objects to new objects but didn't destroy the old objects.
- But as of late 2013/early 2014 becomeForward: has been modified to free all the old objects."]
- valueUnpreemptively!
Item was removed:
- ----- Method: SpurBootstrap class>>SmallIntegerPROTOTYPEasCharacter (in category 'method prototypes') -----
- SmallIntegerPROTOTYPEasCharacter
- <primitive: 170>
- ^self primitiveFailed!
Item was removed:
- ----- Method: SpurBootstrap class>>SmalltalkImagePROTOTYPEcompactClassesArray (in category 'method prototypes') -----
- SmalltalkImagePROTOTYPEcompactClassesArray
- "Smalltalk compactClassesArray"
- "Backward-compatibility support. Spur does not have compact classes."
- ^{}!
Item was removed:
- ----- Method: SpurBootstrap class>>SmalltalkImagePROTOTYPEgrowMemoryByAtLeast: (in category 'method prototypes') -----
- SmalltalkImagePROTOTYPEgrowMemoryByAtLeast: numBytes
- "Grow memory by at least the requested number of bytes.
- Primitive. Essential. Fail if no memory is available."
- <primitive: 180>
- (numBytes isInteger and: [numBytes > 0]) ifTrue:
- [OutOfMemory signal].
- ^self primitiveFailed!
Item was removed:
- ----- Method: SpurBootstrap class>>SmalltalkImagePROTOTYPEmaxIdentityHash (in category 'method prototypes') -----
- SmalltalkImagePROTOTYPEmaxIdentityHash
- "Answer the maximum identityHash value supported by the VM."
- <primitive: 176>
- ^self primitiveFailed!
Item was removed:
- ----- Method: SpurBootstrap class>>SmalltalkImagePROTOTYPEnewSpecialObjectsArray (in category 'method prototypes pharo') -----
- SmalltalkImagePROTOTYPEnewSpecialObjectsArray
- "Smalltalk recreateSpecialObjectsArray"
-
- "To external package developers:
- **** DO NOT OVERRIDE THIS METHOD. *****
- If you are writing a plugin and need additional special object(s) for your own use,
- use addGCRoot() function and use own, separate special objects registry "
-
- "The Special Objects Array is an array of objects used by the Squeak virtual machine.
- Its contents are critical and accesses to it by the VM are unchecked, so don't even
- think of playing here unless you know what you are doing."
- | newArray |
- newArray := Array new: 60.
- "Nil false and true get used throughout the interpreter"
- newArray at: 1 put: nil.
- newArray at: 2 put: false.
- newArray at: 3 put: true.
- "This association holds the active process (a ProcessScheduler)"
- newArray at: 4 put: (self globals associationAt: #Processor).
- "Numerous classes below used for type checking and instantiation"
- newArray at: 5 put: Bitmap.
- newArray at: 6 put: SmallInteger.
- newArray at: 7 put: ByteString.
- newArray at: 8 put: Array.
- newArray at: 9 put: Smalltalk.
- newArray at: 10 put: Float.
- newArray at: 11 put: (self globals at: #MethodContext ifAbsent: [self globals at: #Context]).
- newArray at: 12 put: nil. "was BlockContext."
- newArray at: 13 put: Point.
- newArray at: 14 put: LargePositiveInteger.
- newArray at: 15 put: Display.
- newArray at: 16 put: Message.
- newArray at: 17 put: CompiledMethod.
- newArray at: 18 put: ((self primitiveGetSpecialObjectsArray at: 18) ifNil: [Semaphore new]). "low space Semaphore"
- newArray at: 19 put: Semaphore.
- newArray at: 20 put: Character.
- newArray at: 21 put: #doesNotUnderstand:.
- newArray at: 22 put: #cannotReturn:.
- newArray at: 23 put: nil. "This is the process signalling low space."
- "An array of the 32 selectors that are compiled as special bytecodes,
- paired alternately with the number of arguments each takes."
- newArray at: 24 put: #( #+ 1 #- 1 #< 1 #> 1 #<= 1 #>= 1 #= 1 #~= 1
- #* 1 #/ 1 #\\ 1 #@ 1 #bitShift: 1 #// 1 #bitAnd: 1 #bitOr: 1
- #at: 1 #at:put: 2 #size 0 #next 0 #nextPut: 1 #atEnd 0 #== 1 #class 0
- #blockCopy: 1 #value 0 #value: 1 #do: 1 #new 0 #new: 1 #x 0 #y 0 ).
- "An array of the 255 Characters in ascii order.
- Cog inlines table into machine code at: prim so do not regenerate it.
- This is nil in Spur, which has immediate Characters."
- newArray at: 25 put: (self primitiveGetSpecialObjectsArray at: 25).
- newArray at: 26 put: #mustBeBoolean.
- newArray at: 27 put: ByteArray.
- newArray at: 28 put: Process.
- "An array of up to 31 classes whose instances will have compact headers; an empty array in Spur"
- newArray at: 29 put: self compactClassesArray.
- newArray at: 30 put: ((self primitiveGetSpecialObjectsArray at: 30) ifNil: [Semaphore new]). "delay Semaphore"
- newArray at: 31 put: ((self primitiveGetSpecialObjectsArray at: 31) ifNil: [Semaphore new]). "user interrupt Semaphore"
- "Entries 32 - 34 unreferenced. Previously these contained prototype instances to be copied for fast initialization"
- newArray at: 32 put: nil. "was the prototype Float"
- newArray at: 33 put: nil. "was the prototype 4-byte LargePositiveInteger"
- newArray at: 34 put: nil. "was the prototype Point"
- newArray at: 35 put: #cannotInterpret:.
- newArray at: 36 put: nil. "was the prototype MethodContext"
- newArray at: 37 put: BlockClosure.
- newArray at: 38 put: nil. "was the prototype BlockContext"
- "array of objects referred to by external code"
- newArray at: 39 put: (self primitiveGetSpecialObjectsArray at: 39). "external semaphores"
- newArray at: 40 put: nil. "Reserved for Mutex in Cog VMs"
- newArray at: 41 put: ((self primitiveGetSpecialObjectsArray at: 41) ifNil: [LinkedList new]). "Reserved for a LinkedList instance for overlapped calls in CogMT"
- newArray at: 42 put: ((self primitiveGetSpecialObjectsArray at: 42) ifNil: [Semaphore new]). "finalization Semaphore"
- newArray at: 43 put: LargeNegativeInteger.
- "External objects for callout.
- Note: Written so that one can actually completely remove the FFI."
- newArray at: 44 put: (self at: #ExternalAddress ifAbsent: []).
- newArray at: 45 put: (self at: #ExternalStructure ifAbsent: []).
- newArray at: 46 put: (self at: #ExternalData ifAbsent: []).
- newArray at: 47 put: (self at: #ExternalFunction ifAbsent: []).
- newArray at: 48 put: (self at: #ExternalLibrary ifAbsent: []).
- newArray at: 49 put: #aboutToReturn:through:.
- newArray at: 50 put: #run:with:in:.
- "51 reserved for immutability message"
- newArray at: 51 put: #attemptToAssign:withIndex:.
- newArray at: 52 put: #(nil "nil => generic error" #'bad receiver'
- #'bad argument' #'bad index'
- #'bad number of arguments'
- #'inappropriate operation' #'unsupported operation'
- #'no modification' #'insufficient object memory'
- #'insufficient C memory' #'not found' #'bad method'
- #'internal error in named primitive machinery'
- #'object may move' #'resource limit exceeded'
- #'object is pinned' #'primitive write beyond end of object').
- "53 to 55 are for Alien"
- newArray at: 53 put: (self at: #Alien ifAbsent: []).
- newArray at: 54 put: #invokeCallbackContext::. "use invokeCallback:stack:registers:jmpbuf: for old Alien callbacks."
- newArray at: 55 put: (self at: #UnsafeAlien ifAbsent: []).
-
- "Used to be WeakFinalizationList for WeakFinalizationList hasNewFinalization, obsoleted by ephemeron support."
- newArray at: 56 put: nil.
-
- "reserved for foreign callback process"
- newArray at: 57 put: (self primitiveGetSpecialObjectsArray at: 57 ifAbsent: []).
-
- newArray at: 58 put: #unusedBytecode.
- "59 reserved for Sista counter tripped message"
- newArray at: 59 put: #conditionalBranchCounterTrippedOn:.
- "60 reserved for Sista class trap message"
- newArray at: 60 put: #classTrapFor:.
-
- ^newArray!
Item was removed:
- ----- Method: SpurBootstrap class>>SmalltalkImagePROTOTYPErecreateSpecialObjectsArray (in category 'method prototypes squeak') -----
- SmalltalkImagePROTOTYPErecreateSpecialObjectsArray
- "Smalltalk recreateSpecialObjectsArray"
-
- "To external package developers:
- **** DO NOT OVERRIDE THIS METHOD. *****
- If you are writing a plugin and need additional special object(s) for your own use,
- use addGCRoot() function and use own, separate special objects registry "
-
- "The Special Objects Array is an array of objects used by the Squeak virtual machine.
- Its contents are critical and accesses to it by the VM are unchecked, so don't even
- think of playing here unless you know what you are doing."
- | newArray |
- newArray := Array new: 60.
- "Nil false and true get used throughout the interpreter"
- newArray at: 1 put: nil.
- newArray at: 2 put: false.
- newArray at: 3 put: true.
- "This association holds the active process (a ProcessScheduler)"
- newArray at: 4 put: (self specialObjectsArray at: 4) "(self bindingOf: #Processor) but it answers an Alias".
- "Numerous classes below used for type checking and instantiation"
- newArray at: 5 put: Bitmap.
- newArray at: 6 put: SmallInteger.
- newArray at: 7 put: ByteString.
- newArray at: 8 put: Array.
- newArray at: 9 put: Smalltalk.
- newArray at: 10 put: Float.
- newArray at: 11 put: (self globals at: #MethodContext ifAbsent: [self globals at: #Context]).
- newArray at: 12 put: nil. "was BlockContext."
- newArray at: 13 put: Point.
- newArray at: 14 put: LargePositiveInteger.
- newArray at: 15 put: Display.
- newArray at: 16 put: Message.
- newArray at: 17 put: CompiledMethod.
- newArray at: 18 put: ((self specialObjectsArray at: 18) ifNil: [Semaphore new]). "low space Semaphore"
- newArray at: 19 put: Semaphore.
- newArray at: 20 put: Character.
- newArray at: 21 put: #doesNotUnderstand:.
- newArray at: 22 put: #cannotReturn:.
- newArray at: 23 put: nil. "This is the process signalling low space."
- "An array of the 32 selectors that are compiled as special bytecodes,
- paired alternately with the number of arguments each takes."
- newArray at: 24 put: #( #+ 1 #- 1 #< 1 #> 1 #<= 1 #>= 1 #= 1 #~= 1
- #* 1 #/ 1 #\\ 1 #@ 1 #bitShift: 1 #// 1 #bitAnd: 1 #bitOr: 1
- #at: 1 #at:put: 2 #size 0 #next 0 #nextPut: 1 #atEnd 0 #== 1 #class 0
- #blockCopy: 1 #value 0 #value: 1 #do: 1 #new 0 #new: 1 #x 0 #y 0 ).
- "An array of the 255 Characters in ascii order.
- Cog inlines table into machine code at: prim so do not regenerate it.
- This is nil in Spur, which has immediate Characters."
- newArray at: 25 put: (self specialObjectsArray at: 25).
- newArray at: 26 put: #mustBeBoolean.
- newArray at: 27 put: ByteArray.
- newArray at: 28 put: Process.
- "An array of up to 31 classes whose instances will have compact headers; an empty array in Spur"
- newArray at: 29 put: self compactClassesArray.
- newArray at: 30 put: ((self specialObjectsArray at: 30) ifNil: [Semaphore new]). "delay Semaphore"
- newArray at: 31 put: ((self specialObjectsArray at: 31) ifNil: [Semaphore new]). "user interrupt Semaphore"
- "Entries 32 - 34 unreferenced. Previously these contained prototype instances to be copied for fast initialization"
- newArray at: 32 put: nil. "was the prototype Float"
- newArray at: 33 put: nil. "was the prototype 4-byte LargePositiveInteger"
- newArray at: 34 put: nil. "was the prototype Point"
- newArray at: 35 put: #cannotInterpret:.
- newArray at: 36 put: nil. "was the prototype MethodContext"
- newArray at: 37 put: BlockClosure.
- newArray at: 38 put: nil. "was the prototype BlockContext"
- "array of objects referred to by external code"
- newArray at: 39 put: (self specialObjectsArray at: 39). "external semaphores"
- newArray at: 40 put: nil. "Reserved for Mutex in Cog VMs"
- newArray at: 41 put: ((self specialObjectsArray at: 41) ifNil: [LinkedList new]). "Reserved for a LinkedList instance for overlapped calls in CogMT"
- newArray at: 42 put: ((self specialObjectsArray at: 42) ifNil: [Semaphore new]). "finalization Semaphore"
- newArray at: 43 put: LargeNegativeInteger.
- "External objects for callout.
- Note: Written so that one can actually completely remove the FFI."
- newArray at: 44 put: (self at: #ExternalAddress ifAbsent: []).
- newArray at: 45 put: (self at: #ExternalStructure ifAbsent: []).
- newArray at: 46 put: (self at: #ExternalData ifAbsent: []).
- newArray at: 47 put: (self at: #ExternalFunction ifAbsent: []).
- newArray at: 48 put: (self at: #ExternalLibrary ifAbsent: []).
- newArray at: 49 put: #aboutToReturn:through:.
- newArray at: 50 put: #run:with:in:.
- "51 reserved for immutability message"
- newArray at: 51 put: #attemptToAssign:withIndex:.
- newArray at: 52 put: #(nil "nil => generic error" #'bad receiver'
- #'bad argument' #'bad index'
- #'bad number of arguments'
- #'inappropriate operation' #'unsupported operation'
- #'no modification' #'insufficient object memory'
- #'insufficient C memory' #'not found' #'bad method'
- #'internal error in named primitive machinery'
- #'object may move' #'resource limit exceeded'
- #'object is pinned' #'primitive write beyond end of object').
- "53 to 55 are for Alien"
- newArray at: 53 put: (self at: #Alien ifAbsent: []).
- newArray at: 54 put: #invokeCallbackContext::. "use invokeCallback:stack:registers:jmpbuf: for old Alien callbacks."
- newArray at: 55 put: (self at: #UnsafeAlien ifAbsent: []).
-
- "Used to be WeakFinalizationList for WeakFinalizationList hasNewFinalization, obsoleted by ephemeron support."
- newArray at: 56 put: nil.
-
- "reserved for foreign callback process"
- newArray at: 57 put: (self specialObjectsArray at: 57 ifAbsent: []).
-
- newArray at: 58 put: #unusedBytecode.
- "59 reserved for Sista counter tripped message"
- newArray at: 59 put: #conditionalBranchCounterTrippedOn:.
- "60 reserved for Sista class trap message"
- newArray at: 60 put: #classTrapFor:.
-
- "Now replace the interpreter's reference in one atomic operation"
- self specialObjectsArray becomeForward: newArray!
Item was removed:
- ----- Method: SpurBootstrap class>>SmalltalkImagePROTOTYPEsetGCParameters (in category 'method prototypes squeak') -----
- SmalltalkImagePROTOTYPEsetGCParameters
- "Adjust the VM's default GC parameters to avoid too much tenuring.
- Maybe this should be left to the VM?"
-
- | proportion edenSize survivorSize averageObjectSize numObjects |
- proportion := 0.9. "tenure when 90% of pastSpace is full"
- edenSize := SmalltalkImage current vmParameterAt: 44.
- survivorSize := edenSize / 5.0. "David's paper uses 140Kb eden + 2 x 28kb survivor spaces; Spur uses the same ratios :-)"
- averageObjectSize := 8 * self wordSize. "a good approximation"
- numObjects := (proportion * survivorSize / averageObjectSize) rounded.
- SmalltalkImage current vmParameterAt: 6 put: numObjects "tenure when more than this many objects survive the GC"!
Item was removed:
- ----- Method: SpurBootstrap class>>SpaceTallyPROTOTYPEspaceForInstancesOf: (in category 'method prototypes') -----
- SpaceTallyPROTOTYPEspaceForInstancesOf: aClass
- "Answer a pair of the number of bytes consumed by all instances of the
- given class, including their object headers, and the number of instances."
-
- | instances total |
- instances := aClass allInstances.
- instances isEmpty ifTrue: [^#(0 0)].
- total := 0.
- aClass isVariable
- ifTrue:
- [instances do:
- [:i| total := total + (aClass byteSizeOfInstanceOfSize: i basicSize)]]
- ifFalse:
- [total := instances size * aClass byteSizeOfInstance].
- ^{ total. instances size }!
Item was removed:
- ----- Method: SpurBootstrap class>>SystemDictionaryPROTOTYPEgrowMemoryByAtLeast: (in category 'method prototypes') -----
- SystemDictionaryPROTOTYPEgrowMemoryByAtLeast: numBytes
- "Grow memory by at least the requested number of bytes.
- Primitive. Fail if no memory is available. Essential."
- <primitive: 180>
- ^(numBytes isInteger and: [numBytes > 0])
- ifTrue: [OutOfMemory signal]
- ifFalse: [self primitiveFailed]!
Item was removed:
- ----- Method: SpurBootstrap class>>SystemDictionaryPROTOTYPEmaxIdentityHash (in category 'method prototypes') -----
- SystemDictionaryPROTOTYPEmaxIdentityHash
- "Answer the maximum identityHash value supported by the VM."
- <primitive: 176>
- ^self primitiveFailed!
Item was removed:
- ----- Method: SpurBootstrap class>>SystemDictionaryPROTOTYPEsetGCParameters (in category 'method prototypes squeak') -----
- SystemDictionaryPROTOTYPEsetGCParameters
- "Adjust the VM's default GC parameters to avoid too much tenuring.
- Maybe this should be left to the VM?"
-
- | proportion edenSize survivorSize averageObjectSize numObjects |
- proportion := 0.9. "tenure when 90% of pastSpace is full"
- edenSize := SmalltalkImage current vmParameterAt: 44.
- survivorSize := edenSize / 5.0. "David's paper uses 140Kb eden + 2 x 28kb survivor spaces; Spur uses the same ratios :-)"
- averageObjectSize := 8 * self wordSize. "a good approximation"
- numObjects := (proportion * survivorSize / averageObjectSize) rounded.
- SmalltalkImage current vmParameterAt: 6 put: numObjects "tenure when more than this many objects survive the GC"!
Item was removed:
- ----- Method: SpurBootstrap class>>SystemNavigationPROTOTYPEallObjects (in category 'method prototypes') -----
- SystemNavigationPROTOTYPEallObjects
- "Answer an Array of all objects in the system. Fail if
- there isn't enough memory to instantiate the result."
- <primitive: 178>
- ^self primitiveFailed!
Item was removed:
- ----- Method: SpurBootstrap class>>SystemNavigationPROTOTYPEallObjectsDo: (in category 'method prototypes') -----
- SystemNavigationPROTOTYPEallObjectsDo: aBlock
- "Evaluate the argument, aBlock, for each object in the system, excluding immediates
- such as SmallInteger and Character."
- self allObjectsOrNil
- ifNotNil: [:allObjects| allObjects do: aBlock]
- ifNil:
- ["Fall back on the old single object primitive code. With closures, this needs
- to use an end marker (lastObject) since activation of the block will create
- new contexts and cause an infinite loop. The lastObject must be created
- before calling someObject, so that the VM can settle the enumeration (e.g.
- by flushing new space) as a side effect of someObject"
- | object lastObject |
- lastObject := Object new.
- object := self someObject.
- [lastObject == object or: [0 == object]] whileFalse:
- [aBlock value: object.
- object := object nextObject]]!
Item was removed:
- ----- Method: SpurBootstrap class>>SystemNavigationPROTOTYPEallObjectsOrNil (in category 'method prototypes') -----
- SystemNavigationPROTOTYPEallObjectsOrNil
- "Answer an Array of all objects in the system. Fail if there isn't
- enough memory to instantiate the result and answer nil."
- <primitive: 178>
- ^nil!
Item was removed:
- ----- Method: SpurBootstrap class>>TraitBehaviorPROTOTYPEallInstances (in category 'method prototypes pharo') -----
- TraitBehaviorPROTOTYPEallInstances
- "Answer all instances of the receiver."
- self error: 'Traits does not have instances.'!
Item was removed:
- ----- Method: SpurBootstrap class>>TraitBehaviorPROTOTYPEallInstancesDo: (in category 'method prototypes pharo') -----
- TraitBehaviorPROTOTYPEallInstancesDo: aBlock
- "Evaluate aBlock with each of the current instances of the receiver."
- self error: 'Traits does not have instances.'!
Item was removed:
- ----- Method: SpurBootstrap class>>TraitBehaviorPROTOTYPEinstSpec (in category 'method prototypes pharo') -----
- TraitBehaviorPROTOTYPEinstSpec
- "Answer the instance specification part of the format that defines what kind of object
- an instance of the receiver is. The formats are
- 0 = 0 sized objects (UndefinedObject True False et al)
- 1 = non-indexable objects with inst vars (Point et al)
- 2 = indexable objects with no inst vars (Array et al)
- 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
- 4 = weak indexable objects with inst vars (WeakArray et al)
- 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
- 6 = unused
- 7 = immediates (SmallInteger, Character)
- 8 = unused
- 9 = 64-bit indexable
- 10-11 = 32-bit indexable (Bitmap)
- 12-15 = 16-bit indexable
- 16-23 = 8-bit indexable
- 24-31 = compiled methods (CompiledMethod)"
- ^(format bitShift: -16) bitAnd: 16r1F!
Item was removed:
- ----- Method: SpurBootstrap class>>TraitBehaviorPROTOTYPEisBits (in category 'method prototypes pharo') -----
- TraitBehaviorPROTOTYPEisBits
- "Answer whether the receiver contains just bits (not pointers).
- Above Cog Spur the class format is
- <5 bits inst spec><16 bits inst size>
- where the 5-bit inst spec is
- 0 = 0 sized objects (UndefinedObject True False et al)
- 1 = non-indexable objects with inst vars (Point et al)
- 2 = indexable objects with no inst vars (Array et al)
- 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
- 4 = weak indexable objects with inst vars (WeakArray et al)
- 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
- 6 = unused
- 7 = immediates (SmallInteger, Character)
- 8 = unused
- 9 = 64-bit indexable
- 10-11 = 32-bit indexable (Bitmap)
- 12-15 = 16-bit indexable
- 16-23 = 8-bit indexable
- 24-31 = compiled methods (CompiledMethod)"
- ^self instSpec >= 7!
Item was removed:
- ----- Method: SpurBootstrap class>>TraitBehaviorPROTOTYPEisBytes (in category 'method prototypes pharo') -----
- TraitBehaviorPROTOTYPEisBytes
- "Answer whether the receiver has 8-bit instance variables.
- Above Cog Spur the class format is
- <5 bits inst spec><16 bits inst size>
- where the 5-bit inst spec is
- 0 = 0 sized objects (UndefinedObject True False et al)
- 1 = non-indexable objects with inst vars (Point et al)
- 2 = indexable objects with no inst vars (Array et al)
- 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
- 4 = weak indexable objects with inst vars (WeakArray et al)
- 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
- 6 = unused
- 7 = immediates (SmallInteger, Character)
- 8 = unused
- 9 = 64-bit indexable
- 10-11 = 32-bit indexable (Bitmap)
- 12-15 = 16-bit indexable
- 16-23 = 8-bit indexable
- 24-31 = compiled methods (CompiledMethod)"
- ^self instSpec >= 16!
Item was removed:
- ----- Method: SpurBootstrap class>>TraitBehaviorPROTOTYPEisEphemeronClass (in category 'method prototypes pharo') -----
- TraitBehaviorPROTOTYPEisEphemeronClass
- "Answer whether the receiver has ephemeral instance variables. The garbage collector will
- fire (queue for finalization) any ephemeron whose first instance variable is not referenced
- other than from the transitive closure of references from ephemerons. Hence referring to
- an object from the first inst var of an ephemeron will cause the ephemeron to fire when
- the rest of the system does not refer to the object and that object is ready to be collected.
- Since references from the remaining inst vars of an ephemeron will not prevent the ephemeron
- from firing, ephemerons may act as the associations in weak dictionaries such that the value
- (e.g. properties attached to the key) will not prevent firing when the key is no longer referenced
- other than from ephemerons. Ephemerons can therefore be used to implement instance-based
- pre-mortem finalization."
- ^self instSpec = 5!
Item was removed:
- ----- Method: SpurBootstrap class>>TraitBehaviorPROTOTYPEisImmediateClass (in category 'method prototypes pharo') -----
- TraitBehaviorPROTOTYPEisImmediateClass
- "Answer whether the receiver has immediate instances. Immediate instances
- store their value in their object pointer, not in an object body. Hence immediates
- take no space and are immutable. The immediates are distinguished by tag bits
- in the pointer. They include SmallIntegers and Characters. Hence in the 32-bit
- system SmallIntegers are 31-bit signed integers and Characters are 30-bit
- unsigned character codes."
- ^self instSpec = 7!
Item was removed:
- ----- Method: SpurBootstrap class>>TraitBehaviorPROTOTYPEisVariable (in category 'method prototypes pharo') -----
- TraitBehaviorPROTOTYPEisVariable
- "Answer whether the receiver has indexable variables.
- Above Cog Spur the class format is
- <5 bits inst spec><16 bits inst size>
- where the 5-bit inst spec is
- 0 = 0 sized objects (UndefinedObject True False et al)
- 1 = non-indexable objects with inst vars (Point et al)
- 2 = indexable objects with no inst vars (Array et al)
- 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
- 4 = weak indexable objects with inst vars (WeakArray et al)
- 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
- 6 = unused
- 7 = immediates (SmallInteger, Character)
- 8 = unused
- 9 = 64-bit indexable
- 10-11 = 32-bit indexable (Bitmap)
- 12-15 = 16-bit indexable
- 16-23 = 8-bit indexable
- 24-31 = compiled methods (CompiledMethod)"
- | instSpec |
- instSpec := self instSpec.
- ^instSpec >= 2 and: [instSpec <= 4 or: [instSpec >= 9]]!
Item was removed:
- ----- Method: SpurBootstrap class>>TraitBehaviorPROTOTYPEkindOfSubclass (in category 'method prototypes pharo') -----
- TraitBehaviorPROTOTYPEkindOfSubclass
- "Answer a String that is the keyword that describes the receiver's kind of subclass,
- either a regular subclass, a variableSubclass, a variableByteSubclass,
- a variableWordSubclass, a weakSubclass, an ephemeronSubclass or an immediateSubclass.
- c.f. typeOfClass"
- ^self isVariable
- ifTrue:
- [self isBits
- ifTrue:
- [self isBytes
- ifTrue: [' variableByteSubclass: ']
- ifFalse: [' variableWordSubclass: ']]
- ifFalse:
- [self isWeak
- ifTrue: [' weakSubclass: ']
- ifFalse: [' variableSubclass: ']]]
- ifFalse:
- [self isImmediateClass
- ifTrue: [' immediateSubclass: ']
- ifFalse:
- [self isEphemeronClass
- ifTrue: [' ephemeronSubclass: ']
- ifFalse: [' subclass: ']]]!
Item was removed:
- ----- Method: SpurBootstrap class>>VirtualMachinePROTOTYPEsetGCParameters (in category 'method prototypes pharo') -----
- VirtualMachinePROTOTYPEsetGCParameters
- "Adjust the VM's default GC parameters to avoid too much tenuring.
- Maybe this should be left to the VM?"
-
- | proportion edenSize survivorSize averageObjectSize numObjects |
- proportion := 0.9. "tenure when 90% of pastSpace is full"
- edenSize := self parameterAt: 44.
- survivorSize := edenSize / 5.0. "David's paper uses 140Kb eden + 2 x 28kb survivor spaces; Spur uses the same ratios :-)"
- averageObjectSize := 8 * self wordSize. "a good approximation"
- numObjects := (proportion * survivorSize / averageObjectSize) rounded.
- self tenuringThreshold: numObjects "tenure when more than this many objects survive the GC"!
Item was removed:
- ----- Method: SpurBootstrap class>>WideStringPROTOTYPEat: (in category 'method prototypes') -----
- WideStringPROTOTYPEat: index
- "Answer the Character stored in the field of the receiver indexed by the
- argument. Primitive. Fail if the index argument is not an Integer or is out
- of bounds. Essential. See Object documentation whatIsAPrimitive."
-
- <primitive: 63>
- ^index isInteger
- ifTrue:
- [self errorSubscriptBounds: index]
- ifFalse:
- [index isNumber
- ifTrue: [self at: index asInteger]
- ifFalse: [self errorNonIntegerIndex]]!
Item was removed:
- ----- Method: SpurBootstrap class>>WideStringPROTOTYPEat:put: (in category 'method prototypes') -----
- WideStringPROTOTYPEat: index put: aCharacter
- "Store the Character into the field of the receiver indicated by the index.
- Primitive. Fail if the index is not an Integer or is out of bounds, or if the
- argument is not a Character. Essential. See Object documentation whatIsAPrimitive."
-
- <primitive: 64>
- ^aCharacter isCharacter
- ifTrue:
- [index isInteger
- ifTrue: [self errorSubscriptBounds: index]
- ifFalse: [self errorNonIntegerIndex]]
- ifFalse:
- [self errorImproperStore]!
Item was changed:
----- Method: SpurBootstrap class>>bootstrapPharoImage: (in category 'utilities') -----
bootstrapPharoImage: imageFileBaseName
+ | oldCompilerClass |
+
+ oldCompilerClass := SmalltalkImage compilerClass.
+ [
+ SmalltalkImage compilerClass: Compiler.
+ self bootstrapImage: imageFileBaseName type: 'pharo' ]
+ ensure: [ SmalltalkImage compilerClass: oldCompilerClass ].
+ !
- self bootstrapImage: imageFileBaseName type: 'pharo'!
Item was changed:
----- Method: SpurBootstrap class>>isolatedPrototypes (in category 'utilities') -----
isolatedPrototypes
"SpurBootstrap isolatedPrototypes"
| prototypes |
prototypes := (self systemNavigation allMethodsSelect:
[:m| m selector includesSubString: 'PROTOTYPE'])
collect: [:mr| mr compiledMethod].
^prototypes select:
[:m|
+ (m methodClass includesBehavior: SpurBootstrapPrototypes)
- m methodClass == self class
ifTrue:
[(m pragmaAt: #indirect) notNil
and: [prototypes noneSatisfy:
[:p|
p selector == m selector
and: [p methodClass ~~ m methodClass]]]]
ifFalse:
[prototypes noneSatisfy:
[:p|
p selector == m selector
+ and: [(p methodClass includesBehavior: SpurBootstrapPrototypes)
- and: [p methodClass == self class
and: [(p pragmaAt: #indirect) notNil]]]]]!
Item was added:
+ ----- Method: SpurBootstrap>>allMethodPrototypes (in category 'method prototypes') -----
+ allMethodPrototypes
+ "Answer all prototype selectors, including those marked <remove>"
+ ^(imageTypes
+ inject: (IdentitySet withAll: SpurBootstrapPrototypes new allMethodPrototypes)
+ into: [:allPrototypes :type | | prototypes |
+ prototypes := (SpurBootstrapPrototypes prototypesFor: type) allMethodPrototypes.
+ allPrototypes
+ removeAllSuchThat: [:existing| prototypes anySatisfy: [:new| existing selector == new selector]];
+ addAll: prototypes;
+ yourself])
+ asArray sort: [:ma :mb| ma selector <= mb selector]!
Item was removed:
- ----- Method: SpurBootstrap>>allPrototypeSelectors (in category 'method prototypes') -----
- allPrototypeSelectors
- "Answer all prototype selectors, including those marked <remove>"
- ^imageTypes
- inject: (SpurBootstrap class organization listAtCategoryNamed: #'method prototypes')
- into: [:prototypes :type|
- prototypes, (SpurBootstrap class organization listAtCategoryNamed: #'method prototypes ', type)]!
Item was changed:
----- Method: SpurBootstrap>>fileOutPrototypesFor: (in category 'public access') -----
fileOutPrototypesFor: imageTypeOrArrayOfTypes
"SpurBootstrap new fileOutPrototypesFor: 'squeak'"
| internalStream |
imageTypes := imageTypeOrArrayOfTypes isString
ifTrue: [{imageTypeOrArrayOfTypes}]
ifFalse: [imageTypeOrArrayOfTypes asArray].
internalStream := WriteStream on: (String new: 1000).
internalStream header; timeStamp.
self prototypeClassNameMetaSelectorMethodDo:
+ [:className :isMeta :selector :method| | classNameString class category preamble source |
- [:className :isMeta :selector :method| | class category preamble source |
class := Smalltalk classNamed: className.
+ isMeta
+ ifTrue: [class := class class. classNameString := className, ' class']
+ ifFalse: [classNameString := className].
- isMeta ifTrue: [class := class class].
(method pragmaAt: #remove)
ifNil:
+ [category := (class ifNotNil: [class organization categoryOfElement: selector]) ifNil:
- [category := (class organization categoryOfElement: selector) ifNil:
[self class categoryForClass: className meta: isMeta selector: selector].
+ preamble := classNameString, ' methodsFor: ' , category asString printString, ' stamp: ''', method timeStamp, ''''.
- preamble := class name, ' methodsFor: ' , category asString printString, ' stamp: ''', method timeStamp, ''''.
internalStream nextPut: $!!; nextChunkPut: preamble; cr.
source := method getSourceFromFile asString.
source := source copyFrom: (source indexOfSubCollection: 'PROTOTYPE') + 9 to: source size.
(self selectorForPrototypeMethod: method) isBinary ifTrue:
[source := (self selectorForPrototypeMethod: method), (source copyFrom: (source indexOf: Character space) to: source size)].
internalStream nextChunkPut: source; space; nextPut: $!!; cr; cr]
ifNotNil:
+ [source := classNameString, ' removeSelector: ', selector storeString.
- [source := class name, ' removeSelector: ', selector storeString.
internalStream nextChunkPut: source; cr; cr]].
internalStream trailer.
FileStream
writeSourceCodeFrom: internalStream
+ baseName: ('SpurBootstrapPrototypes-', (imageTypes fold: [:a :b| a, '-', b]) replaceAll: Character space with: $_)
- baseName: 'SpurBootstrapPrototypes'
isSt: true
useHtml: false!
Item was changed:
----- Method: SpurBootstrap>>findRequiredGlobals (in category 'bootstrap image') -----
findRequiredGlobals
"Look for the necessary gobal bindings in the prototype methods in the old image.
This has to be done early by sending bindingOf: to Smalltalk. Collect the class
hierarchy of all prototypes that access inst vars (non-local prototypes) to check
their shapes. Also find out Metaclass, needed for identifying classes."
| globals ourMethodClasses classVars bindingOfSym |
globals := Set new.
ourMethodClasses := Set new.
classVars := Dictionary new.
self prototypeClassNameMetaSelectorMethodDo:
[:c :m :s :method| | allNonMetaSupers |
(Smalltalk classNamed: c) ifNotNil:
+ [:nonMetaClass|
- [ :nonMetaClass|
allNonMetaSupers := nonMetaClass withAllSuperclasses.
+ (method methodClass includesBehavior: SpurBootstrapPrototypes) ifFalse:
+ [ourMethodClasses addAll: allNonMetaSupers.
+ globals addAll: (allNonMetaSupers collect: [:sc| sc binding])].
- method methodClass ~= SpurBootstrap class ifTrue:
- [ourMethodClasses addAll: allNonMetaSupers].
- globals addAll: (allNonMetaSupers collect: [:sc| sc binding]).
method literals do:
[:l|
+ (l isVariableBinding
+ and: [l key isSymbol
+ and: [SpurBootstrapPrototypes noneSatisfy: [:sbpc| sbpc name == l key]]]) ifTrue:
- (l isVariableBinding and: [l key isSymbol]) ifTrue:
[(Smalltalk bindingOf: l key) == l
ifTrue: [globals add: l]
ifFalse:
[self assert: (nonMetaClass bindingOf: l key) == l.
classVars at: l put: nonMetaClass]]]]].
globals add: Compiler binding. "For potential reshaping in checkReshapeOf:"
bindingOfSym := self findSymbol: #bindingOf:.
self withExecutableInterpreter: oldInterpreter
do: [| toBeAdded |
globals do:
[:global| | bindingOop |
+ (self findSymbol: global key) ifNotNil:
+ [:symbolOop|
+ bindingOop := self interpreter: oldInterpreter
+ object: (oldHeap splObj: 8) "Smalltalk"
+ perform: bindingOfSym
+ withArguments: {self findSymbol: global key}.
+ bindingOop ~= oldHeap nilObject ifTrue:
+ [literalMap at: global put: bindingOop]]].
- bindingOop := self interpreter: oldInterpreter
- object: (oldHeap splObj: 8) "Smalltalk"
- perform: bindingOfSym
- withArguments: {self findSymbol: global key}.
- bindingOop ~= oldHeap nilObject ifTrue:
- [literalMap at: global put: bindingOop]].
toBeAdded := Dictionary new.
classVars keysAndValuesDo:
[:var :class| | val |
(self findSymbol: var key) "New class inst vars may not yet be interned."
ifNil: [toBeAdded at: var put: class]
ifNotNil:
[:varName|
val := self interpreter: oldInterpreter
object: (self oldClassOopFor: class)
perform: bindingOfSym
withArguments: {varName}.
val ~= oldHeap nilObject
ifTrue: [literalMap at: var put: val]
ifFalse: [toBeAdded at: var put: class]]].
"May have to redefine to add missing inst vars and/or add any missing class vars."
self checkReshapeOf: ourMethodClasses.
self addMissingClassVars: toBeAdded]!
Item was changed:
----- Method: SpurBootstrap>>prototypeClassNameMetaSelectorMethodDo: (in category 'method prototypes') -----
prototypeClassNameMetaSelectorMethodDo: quaternaryBlock
"Evaluate aBlock with class name, class is meta, method and selector.
For now find methods in class-side category #'method prototypes'.
Scheme could be extended to have different protocols for different
Squeak/Pharo versions."
+ self allMethodPrototypes do:
+ [:method| | className isMeta |
- self allPrototypeSelectors do:
- [:protoSelector| | method className isMeta |
- method := SpurBootstrap class >> protoSelector.
className := self classNameForPrototypeMethod: method.
(isMeta := className endsWith: 'class') ifTrue:
[className := (className allButLast: 5) asSymbol].
(method pragmaAt: #indirect) ifNotNil:
[method := (isMeta
ifTrue: [(Smalltalk classNamed: className) class]
+ ifFalse: [Smalltalk classNamed: className]) >> method selector].
- ifFalse: [Smalltalk classNamed: className]) >> protoSelector].
quaternaryBlock
value: className
value: isMeta
value: (self selectorForPrototypeMethod: method)
value: method]!
Item was added:
+ SpurBootstrapPrototypes subclass: #SpurBootstrapPharoPrototypes
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Cog-Bootstrapping'!
Item was added:
+ ----- Method: SpurBootstrapPharoPrototypes class>>imageType (in category 'accessing') -----
+ imageType
+ ^ 'pharo'!
Item was added:
+ ----- Method: SpurBootstrapPharoPrototypes>>BehaviorPROTOTYPEbasicIdentityHash (in category 'method prototypes') -----
+ BehaviorPROTOTYPEbasicIdentityHash
+ "Answer a SmallInteger whose value is related to the receiver's identity.
+ Behavior implements identityHash to allow the VM to use an object representation which
+ does not include a direct reference to an object's class in an object. If the VM is using
+ this implementation then classes are held in a class table and instances contain the index
+ of their class in the table. A class's class table index is its identityHash so that an instance
+ can be created without searching the table for a class's index. The VM uses this primitive
+ to enter the class into the class table, assigning its identityHash with an as yet unused
+ class table index. If this primitive fails it means that the class table is full. In Spur as of
+ 2014 there are 22 bits of classTable index and 22 bits of identityHash per object.
+
+ Primitive. Essential. Do not override. See Object documentation whatIsAPrimitive."
+
+ <primitive: 175>
+ self primitiveFailed!
Item was added:
+ ----- Method: SpurBootstrapPharoPrototypes>>BehaviorPROTOTYPElargeIdentityHash (in category 'method prototypes') -----
+ BehaviorPROTOTYPElargeIdentityHash
+ "Answer a SmallInteger whose value is related to the receiver's identity.
+ Behavior implements identityHash to allow the VM to use an object representation which
+ does not include a direct reference to an object's class in an object. If the VM is using
+ this implementation then classes are held in a class table and instances contain the index
+ of their class in the table. A class's class table index is its identityHash so that an instance
+ can be created without searching the table for a class's index. The VM uses this primitive
+ to enter the class into the class table, assigning its identityHash with an as yet unused
+ class table index. If this primitive fails it means that the class table is full. In Spur as of
+ 2014 there are 22 bits of classTable index and 22 bits of identityHash per object."
+
+ <primitive: 175>
+ self primitiveFailed!
Item was added:
+ ----- Method: SpurBootstrapPharoPrototypes>>BlockClosurePHAROPROTOTYPEsimulateValueWithArguments:caller: (in category 'method prototypes') -----
+ BlockClosurePHAROPROTOTYPEsimulateValueWithArguments: anArray caller: aContext
+ <indirect>!
Item was added:
+ ----- Method: SpurBootstrapPharoPrototypes>>CharacterPROTOTYPEcodePoint (in category 'method prototypes') -----
+ CharacterPROTOTYPEcodePoint
+ "Just for ANSI Compliance"
+ ^self!
Item was added:
+ ----- Method: SpurBootstrapPharoPrototypes>>CharacterPROTOTYPEsetValue: (in category 'method prototypes') -----
+ CharacterPROTOTYPEsetValue: newValue
+ self error: 'Characters are immutable'!
Item was added:
+ ----- Method: SpurBootstrapPharoPrototypes>>ContextPROTOTYPEdoPrimitive:method:receiver:args: (in category 'method prototypes') -----
+ ContextPROTOTYPEdoPrimitive: primitiveIndex method: meth receiver: aReceiver args: arguments
+ <indirect>!
Item was added:
+ ----- Method: SpurBootstrapPharoPrototypes>>ContextPROTOTYPEfailPrimitiveWith: (in category 'method prototypes') -----
+ ContextPROTOTYPEfailPrimitiveWith: maybePrimFailToken
+ <indirect>!
Item was added:
+ ----- Method: SpurBootstrapPharoPrototypes>>ContextPROTOTYPEisPrimFailToken: (in category 'method prototypes') -----
+ ContextPROTOTYPEisPrimFailToken: anObject
+ <indirect>
+ !
Item was added:
+ ----- Method: SpurBootstrapPharoPrototypes>>ContextPROTOTYPEsend:to:with:lookupIn: (in category 'method prototypes') -----
+ ContextPROTOTYPEsend: selector to: rcvr with: arguments lookupIn: lookupClass
+ "Simulate the action of sending a message with selector and arguments
+ to rcvr. The argument, lookupClass, is the class in which to lookup the
+ message. This is the receiver's class for normal messages, but for super
+ messages it will be some specific class related to the source method."
+
+ | meth primIndex val ctxt |
+ (meth := lookupClass lookupSelector: selector) ifNil:
+ [^self send: #doesNotUnderstand:
+ to: rcvr
+ with: {Message selector: selector arguments: arguments}
+ lookupIn: lookupClass].
+ (primIndex := meth primitive) > 0 ifTrue:
+ [val := self doPrimitive: primIndex method: meth receiver: rcvr args: arguments.
+ (self isPrimFailToken: val) ifFalse:
+ [^val]].
+ (selector == #doesNotUnderstand: and: [lookupClass == ProtoObject]) ifTrue:
+ [^self error: 'Simulated message ', arguments first selector, ' not understood'].
+ ctxt := Context sender: self receiver: rcvr method: meth arguments: arguments.
+ primIndex > 0 ifTrue:
+ [ctxt failPrimitiveWith: val].
+ ^ctxt!
Item was added:
+ ----- Method: SpurBootstrapPharoPrototypes>>ContextclassPROTOTYPEallInstances (in category 'method prototypes') -----
+ ContextclassPROTOTYPEallInstances
+ "Answer all instances of the receiver."
+ <primitive: 177>
+ "The primitive can fail because memory is low. If so, fall back on the old
+ enumeration code, which gives the system a chance to GC and/or grow.
+ Because aBlock might change the class of inst (for example, using become:),
+ it is essential to compute next before aBlock value: inst.
+ Only count until thisContext since this context has been created only to
+ compute the existing instances."
+ | inst insts next |
+ insts := WriteStream on: (Array new: 64).
+ inst := self someInstance.
+ [inst == thisContext or: [inst == nil]] whileFalse:
+ [next := inst nextInstance.
+ insts nextPut: inst.
+ inst := next].
+ ^insts contents!
Item was added:
+ ----- Method: SpurBootstrapPharoPrototypes>>ContextclassPROTOTYPEallInstancesDo: (in category 'method prototypes') -----
+ ContextclassPROTOTYPEallInstancesDo: aBlock
+ "Evaluate aBlock with each of the current instances of the receiver."
+ | instances inst next |
+ instances := self allInstancesOrNil.
+ instances ifNotNil:
+ [instances do: aBlock.
+ ^self].
+ "allInstancesOrNil can fail because memory is low. If so, fall back on the old
+ enumeration code. Because aBlock might change the class of inst (for example,
+ using become:), it is essential to compute next before aBlock value: inst.
+ Only count until thisContext since evaluation of aBlock will create new contexts."
+ inst := self someInstance.
+ [inst == thisContext or: [inst == nil]] whileFalse:
+ [next := inst nextInstance.
+ aBlock value: inst.
+ inst := next]!
Item was added:
+ ----- Method: SpurBootstrapPharoPrototypes>>ProtoObjectPROTOTYPEidentityHash (in category 'method prototypes') -----
+ ProtoObjectPROTOTYPEidentityHash
+ "Answer a SmallInteger whose value is related to the receiver's identity.
+ This method must not be overridden, except by SmallInteger. As of
+ 2014, the 32-bit Spur VM has 22 bits of hash and 31-bit SmallIntegers
+ (30 bits + 1 sign bit). Shifting by 8 will not create large integers.
+
+ Do not override."
+
+ ^self basicIdentityHash bitShift: 8!
Item was added:
+ ----- Method: SpurBootstrapPharoPrototypes>>SlotClassBuilderPROTOTYPEcomputeFormat:instSize:forSuper:ccIndex: (in category 'method prototypes') -----
+ SlotClassBuilderPROTOTYPEcomputeFormat: type instSize: newInstSize forSuper: newSuper ccIndex: ccIndex
+ "Compute the new format for making oldClass a subclass of newSuper.
+ Answer the format or nil if there is any problem."
+ | instSize isVar isWords isPointers isWeak |
+ type == #compiledMethod ifTrue:
+ [newInstSize > 0 ifTrue:
+ [self error: 'A compiled method class cannot have named instance variables'.
+ ^nil].
+ ^CompiledMethod format].
+ instSize := newInstSize + (newSuper ifNil:[0] ifNotNil:[newSuper instSize]).
+ instSize > 65535 ifTrue:
+ [self error: 'Class has too many instance variables (', instSize printString,')'.
+ ^nil].
+ type == #normal ifTrue:[isVar := isWeak := false. isWords := isPointers := true].
+ type == #bytes ifTrue:[isVar := true. isWords := isPointers := isWeak := false].
+ type == #words ifTrue:[isVar := isWords := true. isPointers := isWeak := false].
+ type == #variable ifTrue:[isVar := isPointers := isWords := true. isWeak := false].
+ type == #weak ifTrue:[isVar := isWeak := isWords := isPointers := true].
+ type == #ephemeron ifTrue:[isVar := false. isWeak := isWords := isPointers := true].
+ type == #immediate ifTrue:[isVar := isWeak := isPointers := false. isWords := true].
+ (isPointers not and: [instSize > 0]) ifTrue:
+ [self error: 'A non-pointer class cannot have named instance variables'.
+ ^nil].
+ ^self format: instSize variable: isVar words: isWords pointers: isPointers weak: isWeak!
Item was added:
+ ----- Method: SpurBootstrapPharoPrototypes>>SlotClassBuilderPROTOTYPEformat:variable:words:pointers:weak: (in category 'method prototypes') -----
+ SlotClassBuilderPROTOTYPEformat: nInstVars variable: isVar words: isWords pointers: isPointers weak: isWeak
+ "Compute the format for the given instance specfication.
+ Above Cog Spur the class format is
+ <5 bits inst spec><16 bits inst size>
+ where the 5-bit inst spec is
+ 0 = 0 sized objects (UndefinedObject True False et al)
+ 1 = non-indexable objects with inst vars (Point et al)
+ 2 = indexable objects with no inst vars (Array et al)
+ 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
+ 4 = weak indexable objects with inst vars (WeakArray et al)
+ 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
+ 6 = unused
+ 7 = immediates (SmallInteger, Character)
+ 8 = unused
+ 9 = reserved for 64-bit indexable
+ 10-11 = 32-bit indexable (Bitmap)
+ 12-15 = 16-bit indexable
+ 16-23 = 8-bit indexable
+ 24-31 = compiled methods (CompiledMethod)"
+ | instSpec |
+ instSpec := isWeak
+ ifTrue:
+ [isVar
+ ifTrue: [4]
+ ifFalse: [5]]
+ ifFalse:
+ [isPointers
+ ifTrue:
+ [isVar
+ ifTrue: [nInstVars > 0 ifTrue: [3] ifFalse: [2]]
+ ifFalse: [nInstVars > 0 ifTrue: [1] ifFalse: [0]]]
+ ifFalse:
+ [isVar
+ ifTrue: [isWords ifTrue: [12] ifFalse: [16]]
+ ifFalse: [7]]].
+ ^(instSpec bitShift: 16) + nInstVars!
Item was added:
+ ----- Method: SpurBootstrapPharoPrototypes>>SlotClassBuilderPROTOTYPEsuperclass:immediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'method prototypes') -----
+ SlotClassBuilderPROTOTYPEsuperclass: aClass
+ immediateSubclass: t instanceVariableNames: f
+ classVariableNames: d poolDictionaries: s category: cat
+ "This is the standard initialization message for creating a
+ new immediate class as a subclass of an existing class."
+ | env |
+ aClass instSize > 0
+ ifTrue: [^self error: 'cannot make an immediate subclass of a class with named fields'].
+ aClass isVariable
+ ifTrue: [^self error: 'cannot make an immediate subclass of a class with indexed instance variables'].
+ aClass isPointers
+ ifFalse: [^self error: 'cannot make an immediate subclass of a class without pointer fields'].
+ "Cope with pre-environment and environment versions. Simplify asap."
+ env := (Smalltalk classNamed: #EnvironmentRequest)
+ ifNil: [aClass environment]
+ ifNotNil: [:erc| erc signal ifNil: [aClass environment]].
+ ^self
+ name: t
+ inEnvironment: env
+ subclassOf: aClass
+ type: #immediate
+ instanceVariableNames: f
+ classVariableNames: d
+ poolDictionaries: s
+ category: cat!
Item was added:
+ ----- Method: SpurBootstrapPharoPrototypes>>SlotClassBuilderPROTOTYPEupdate:to: (in category 'method prototypes') -----
+ SlotClassBuilderPROTOTYPEupdate: oldClass to: newClass
+ "Convert oldClass, all its instances and possibly its meta class into newClass,
+ instances of newClass and possibly its meta class. The process is surprisingly
+ simple in its implementation and surprisingly complex in its nuances and potentially
+ bad side effects.
+ We can rely on two assumptions (which are critical):
+ #1: The method #updateInstancesFrom: will not create any lasting pointers to
+ 'old' instances ('old' is quote on quote since #updateInstancesFrom: will do
+ a become of the old vs. the new instances and therefore it will not create
+ pointers to *new* instances before the #become: which are *old* afterwards)
+ #2: The non-preemptive execution of the critical piece of code guarantees that
+ nobody can get a hold by 'other means' (such as process interruption and
+ reflection) on the old instances.
+ Given the above two, we know that after #updateInstancesFrom: there are no pointers
+ to any old instances. After the forwarding become there will be no pointers to the old
+ class or meta class either.
+ Andreas Raab, 2/27/2003 23:42"
+ | meta |
+ meta := oldClass isMeta.
+ "Note: Everything from here on will run without the ability to get interrupted
+ to prevent any other process to create new instances of the old class."
+ ["Note: The following removal may look somewhat obscure and needs an explanation.
+ When we mutate the class hierarchy we create new classes for any existing subclass.
+ So it may look as if we don't have to remove the old class from its superclass. However,
+ at the top of the hierarchy (the first class we reshape) that superclass itself is not newly
+ created so therefore it will hold both the oldClass and newClass in its (obsolete or not)
+ subclasses. Since the #become: below will transparently replace the pointers to oldClass
+ with newClass the superclass would have newClass in its subclasses TWICE. With rather
+ unclear effects if we consider that we may convert the meta-class hierarchy itself (which
+ is derived from the non-meta class hierarchy).
+ Due to this problem ALL classes are removed from their superclass just prior to converting
+ them. Here, breaking the superclass/subclass invariant really doesn't matter since we will
+ effectively remove the oldClass (becomeForward:) just a few lines below."
+
+ oldClass superclass removeSubclass: oldClass.
+ oldClass superclass removeObsoleteSubclass: oldClass.
+
+ "make sure that the VM cache is clean"
+ oldClass methodDict do: [:cm | cm flushCache].
+
+ "Convert the instances of oldClass into instances of newClass"
+ newClass updateInstancesFrom: oldClass.
+
+ meta
+ ifTrue:
+ [oldClass becomeForward: newClass.
+ oldClass updateMethodBindingsTo: oldClass binding]
+ ifFalse:
+ [{oldClass. oldClass class} elementsForwardIdentityTo: {newClass. newClass class}.
+ oldClass updateMethodBindingsTo: oldClass binding.
+ oldClass class updateMethodBindingsTo: oldClass class binding].
+
+ "eem 5/31/2014 07:22 At this point there used to be a garbage collect whose purpose was
+ to ensure no old instances existed after the becomeForward:. Without the GC it was possible
+ to resurrect old instances using e.g. allInstancesDo:. This was because the becomeForward:
+ updated references from the old objects to new objects but didn't destroy the old objects.
+ But as of late 2013/early 2014 becomeForward: has been modified to free all the old objects."]
+ valueUnpreemptively!
Item was added:
+ ----- Method: SpurBootstrapPharoPrototypes>>SmalltalkImagePROTOTYPEnewSpecialObjectsArray (in category 'method prototypes') -----
+ SmalltalkImagePROTOTYPEnewSpecialObjectsArray
+ "Smalltalk recreateSpecialObjectsArray"
+
+ "To external package developers:
+ **** DO NOT OVERRIDE THIS METHOD. *****
+ If you are writing a plugin and need additional special object(s) for your own use,
+ use addGCRoot() function and use own, separate special objects registry "
+
+ "The Special Objects Array is an array of objects used by the Squeak virtual machine.
+ Its contents are critical and accesses to it by the VM are unchecked, so don't even
+ think of playing here unless you know what you are doing."
+ | newArray |
+ newArray := Array new: 60.
+ "Nil false and true get used throughout the interpreter"
+ newArray at: 1 put: nil.
+ newArray at: 2 put: false.
+ newArray at: 3 put: true.
+ "This association holds the active process (a ProcessScheduler)"
+ newArray at: 4 put: (self globals associationAt: #Processor).
+ "Numerous classes below used for type checking and instantiation"
+ newArray at: 5 put: Bitmap.
+ newArray at: 6 put: SmallInteger.
+ newArray at: 7 put: ByteString.
+ newArray at: 8 put: Array.
+ newArray at: 9 put: Smalltalk.
+ newArray at: 10 put: Float.
+ newArray at: 11 put: (self globals at: #MethodContext ifAbsent: [self globals at: #Context]).
+ newArray at: 12 put: nil. "was BlockContext."
+ newArray at: 13 put: Point.
+ newArray at: 14 put: LargePositiveInteger.
+ newArray at: 15 put: Display.
+ newArray at: 16 put: Message.
+ newArray at: 17 put: CompiledMethod.
+ newArray at: 18 put: ((self primitiveGetSpecialObjectsArray at: 18) ifNil: [Semaphore new]). "low space Semaphore"
+ newArray at: 19 put: Semaphore.
+ newArray at: 20 put: Character.
+ newArray at: 21 put: #doesNotUnderstand:.
+ newArray at: 22 put: #cannotReturn:.
+ newArray at: 23 put: nil. "This is the process signalling low space."
+ "An array of the 32 selectors that are compiled as special bytecodes,
+ paired alternately with the number of arguments each takes."
+ newArray at: 24 put: #( #+ 1 #- 1 #< 1 #> 1 #<= 1 #>= 1 #= 1 #~= 1
+ #* 1 #/ 1 #\\ 1 #@ 1 #bitShift: 1 #// 1 #bitAnd: 1 #bitOr: 1
+ #at: 1 #at:put: 2 #size 0 #next 0 #nextPut: 1 #atEnd 0 #== 1 #class 0
+ #blockCopy: 1 #value 0 #value: 1 #do: 1 #new 0 #new: 1 #x 0 #y 0 ).
+ "An array of the 255 Characters in ascii order.
+ Cog inlines table into machine code at: prim so do not regenerate it.
+ This is nil in Spur, which has immediate Characters."
+ newArray at: 25 put: (self primitiveGetSpecialObjectsArray at: 25).
+ newArray at: 26 put: #mustBeBoolean.
+ newArray at: 27 put: ByteArray.
+ newArray at: 28 put: Process.
+ "An array of up to 31 classes whose instances will have compact headers; an empty array in Spur"
+ newArray at: 29 put: self compactClassesArray.
+ newArray at: 30 put: ((self primitiveGetSpecialObjectsArray at: 30) ifNil: [Semaphore new]). "delay Semaphore"
+ newArray at: 31 put: ((self primitiveGetSpecialObjectsArray at: 31) ifNil: [Semaphore new]). "user interrupt Semaphore"
+ "Entries 32 - 34 unreferenced. Previously these contained prototype instances to be copied for fast initialization"
+ newArray at: 32 put: nil. "was the prototype Float"
+ newArray at: 33 put: nil. "was the prototype 4-byte LargePositiveInteger"
+ newArray at: 34 put: nil. "was the prototype Point"
+ newArray at: 35 put: #cannotInterpret:.
+ newArray at: 36 put: nil. "was the prototype MethodContext"
+ newArray at: 37 put: BlockClosure.
+ newArray at: 38 put: nil. "was the prototype BlockContext"
+ "array of objects referred to by external code"
+ newArray at: 39 put: (self primitiveGetSpecialObjectsArray at: 39). "external semaphores"
+ newArray at: 40 put: nil. "Reserved for Mutex in Cog VMs"
+ newArray at: 41 put: ((self primitiveGetSpecialObjectsArray at: 41) ifNil: [LinkedList new]). "Reserved for a LinkedList instance for overlapped calls in CogMT"
+ newArray at: 42 put: ((self primitiveGetSpecialObjectsArray at: 42) ifNil: [Semaphore new]). "finalization Semaphore"
+ newArray at: 43 put: LargeNegativeInteger.
+ "External objects for callout.
+ Note: Written so that one can actually completely remove the FFI."
+ newArray at: 44 put: (self at: #ExternalAddress ifAbsent: []).
+ newArray at: 45 put: (self at: #ExternalStructure ifAbsent: []).
+ newArray at: 46 put: (self at: #ExternalData ifAbsent: []).
+ newArray at: 47 put: (self at: #ExternalFunction ifAbsent: []).
+ newArray at: 48 put: (self at: #ExternalLibrary ifAbsent: []).
+ newArray at: 49 put: #aboutToReturn:through:.
+ newArray at: 50 put: #run:with:in:.
+ "51 reserved for immutability message"
+ newArray at: 51 put: #attemptToAssign:withIndex:.
+ newArray at: 52 put: #(nil "nil => generic error" #'bad receiver'
+ #'bad argument' #'bad index'
+ #'bad number of arguments'
+ #'inappropriate operation' #'unsupported operation'
+ #'no modification' #'insufficient object memory'
+ #'insufficient C memory' #'not found' #'bad method'
+ #'internal error in named primitive machinery'
+ #'object may move' #'resource limit exceeded'
+ #'object is pinned' #'primitive write beyond end of object').
+ "53 to 55 are for Alien"
+ newArray at: 53 put: (self at: #Alien ifAbsent: []).
+ newArray at: 54 put: #invokeCallbackContext::. "use invokeCallback:stack:registers:jmpbuf: for old Alien callbacks."
+ newArray at: 55 put: (self at: #UnsafeAlien ifAbsent: []).
+
+ "Used to be WeakFinalizationList for WeakFinalizationList hasNewFinalization, obsoleted by ephemeron support."
+ newArray at: 56 put: nil.
+
+ "reserved for foreign callback process"
+ newArray at: 57 put: (self primitiveGetSpecialObjectsArray at: 57 ifAbsent: []).
+
+ newArray at: 58 put: #unusedBytecode.
+ "59 reserved for Sista counter tripped message"
+ newArray at: 59 put: #conditionalBranchCounterTrippedOn:.
+ "60 reserved for Sista class trap message"
+ newArray at: 60 put: #classTrapFor:.
+
+ ^newArray!
Item was added:
+ ----- Method: SpurBootstrapPharoPrototypes>>TraitBehaviorPROTOTYPEallInstances (in category 'method prototypes') -----
+ TraitBehaviorPROTOTYPEallInstances
+ "Answer all instances of the receiver."
+ self error: 'Traits does not have instances.'!
Item was added:
+ ----- Method: SpurBootstrapPharoPrototypes>>TraitBehaviorPROTOTYPEallInstancesDo: (in category 'method prototypes') -----
+ TraitBehaviorPROTOTYPEallInstancesDo: aBlock
+ "Evaluate aBlock with each of the current instances of the receiver."
+ self error: 'Traits does not have instances.'!
Item was added:
+ ----- Method: SpurBootstrapPharoPrototypes>>TraitBehaviorPROTOTYPEinstSpec (in category 'method prototypes') -----
+ TraitBehaviorPROTOTYPEinstSpec
+ "Answer the instance specification part of the format that defines what kind of object
+ an instance of the receiver is. The formats are
+ 0 = 0 sized objects (UndefinedObject True False et al)
+ 1 = non-indexable objects with inst vars (Point et al)
+ 2 = indexable objects with no inst vars (Array et al)
+ 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
+ 4 = weak indexable objects with inst vars (WeakArray et al)
+ 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
+ 6 = unused
+ 7 = immediates (SmallInteger, Character)
+ 8 = unused
+ 9 = 64-bit indexable
+ 10-11 = 32-bit indexable (Bitmap)
+ 12-15 = 16-bit indexable
+ 16-23 = 8-bit indexable
+ 24-31 = compiled methods (CompiledMethod)"
+ ^(self format bitShift: -16) bitAnd: 16r1F!
Item was added:
+ ----- Method: SpurBootstrapPharoPrototypes>>TraitBehaviorPROTOTYPEisBits (in category 'method prototypes') -----
+ TraitBehaviorPROTOTYPEisBits
+ "Answer whether the receiver contains just bits (not pointers).
+ Above Cog Spur the class format is
+ <5 bits inst spec><16 bits inst size>
+ where the 5-bit inst spec is
+ 0 = 0 sized objects (UndefinedObject True False et al)
+ 1 = non-indexable objects with inst vars (Point et al)
+ 2 = indexable objects with no inst vars (Array et al)
+ 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
+ 4 = weak indexable objects with inst vars (WeakArray et al)
+ 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
+ 6 = unused
+ 7 = immediates (SmallInteger, Character)
+ 8 = unused
+ 9 = 64-bit indexable
+ 10-11 = 32-bit indexable (Bitmap)
+ 12-15 = 16-bit indexable
+ 16-23 = 8-bit indexable
+ 24-31 = compiled methods (CompiledMethod)"
+ ^self instSpec >= 7!
Item was added:
+ ----- Method: SpurBootstrapPharoPrototypes>>TraitBehaviorPROTOTYPEisBytes (in category 'method prototypes') -----
+ TraitBehaviorPROTOTYPEisBytes
+ "Answer whether the receiver has 8-bit instance variables.
+ Above Cog Spur the class format is
+ <5 bits inst spec><16 bits inst size>
+ where the 5-bit inst spec is
+ 0 = 0 sized objects (UndefinedObject True False et al)
+ 1 = non-indexable objects with inst vars (Point et al)
+ 2 = indexable objects with no inst vars (Array et al)
+ 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
+ 4 = weak indexable objects with inst vars (WeakArray et al)
+ 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
+ 6 = unused
+ 7 = immediates (SmallInteger, Character)
+ 8 = unused
+ 9 = 64-bit indexable
+ 10-11 = 32-bit indexable (Bitmap)
+ 12-15 = 16-bit indexable
+ 16-23 = 8-bit indexable
+ 24-31 = compiled methods (CompiledMethod)"
+ ^self instSpec >= 16!
Item was added:
+ ----- Method: SpurBootstrapPharoPrototypes>>TraitBehaviorPROTOTYPEisEphemeronClass (in category 'method prototypes') -----
+ TraitBehaviorPROTOTYPEisEphemeronClass
+ "Answer whether the receiver has ephemeral instance variables. The garbage collector will
+ fire (queue for finalization) any ephemeron whose first instance variable is not referenced
+ other than from the transitive closure of references from ephemerons. Hence referring to
+ an object from the first inst var of an ephemeron will cause the ephemeron to fire when
+ the rest of the system does not refer to the object and that object is ready to be collected.
+ Since references from the remaining inst vars of an ephemeron will not prevent the ephemeron
+ from firing, ephemerons may act as the associations in weak dictionaries such that the value
+ (e.g. properties attached to the key) will not prevent firing when the key is no longer referenced
+ other than from ephemerons. Ephemerons can therefore be used to implement instance-based
+ pre-mortem finalization."
+ ^self instSpec = 5!
Item was added:
+ ----- Method: SpurBootstrapPharoPrototypes>>TraitBehaviorPROTOTYPEisImmediateClass (in category 'method prototypes') -----
+ TraitBehaviorPROTOTYPEisImmediateClass
+ "Answer whether the receiver has immediate instances. Immediate instances
+ store their value in their object pointer, not in an object body. Hence immediates
+ take no space and are immutable. The immediates are distinguished by tag bits
+ in the pointer. They include SmallIntegers and Characters. Hence in the 32-bit
+ system SmallIntegers are 31-bit signed integers and Characters are 30-bit
+ unsigned character codes."
+ ^self instSpec = 7!
Item was added:
+ ----- Method: SpurBootstrapPharoPrototypes>>TraitBehaviorPROTOTYPEisVariable (in category 'method prototypes') -----
+ TraitBehaviorPROTOTYPEisVariable
+ "Answer whether the receiver has indexable variables.
+ Above Cog Spur the class format is
+ <5 bits inst spec><16 bits inst size>
+ where the 5-bit inst spec is
+ 0 = 0 sized objects (UndefinedObject True False et al)
+ 1 = non-indexable objects with inst vars (Point et al)
+ 2 = indexable objects with no inst vars (Array et al)
+ 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
+ 4 = weak indexable objects with inst vars (WeakArray et al)
+ 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
+ 6 = unused
+ 7 = immediates (SmallInteger, Character)
+ 8 = unused
+ 9 = 64-bit indexable
+ 10-11 = 32-bit indexable (Bitmap)
+ 12-15 = 16-bit indexable
+ 16-23 = 8-bit indexable
+ 24-31 = compiled methods (CompiledMethod)"
+ | instSpec |
+ instSpec := self instSpec.
+ ^instSpec >= 2 and: [instSpec <= 4 or: [instSpec >= 9]]!
Item was added:
+ ----- Method: SpurBootstrapPharoPrototypes>>TraitBehaviorPROTOTYPEkindOfSubclass (in category 'method prototypes') -----
+ TraitBehaviorPROTOTYPEkindOfSubclass
+ "Answer a String that is the keyword that describes the receiver's kind of subclass,
+ either a regular subclass, a variableSubclass, a variableByteSubclass,
+ a variableWordSubclass, a weakSubclass, an ephemeronSubclass or an immediateSubclass.
+ c.f. typeOfClass"
+ ^self isVariable
+ ifTrue:
+ [self isBits
+ ifTrue:
+ [self isBytes
+ ifTrue: [' variableByteSubclass: ']
+ ifFalse: [' variableWordSubclass: ']]
+ ifFalse:
+ [self isWeak
+ ifTrue: [' weakSubclass: ']
+ ifFalse: [' variableSubclass: ']]]
+ ifFalse:
+ [self isImmediateClass
+ ifTrue: [' immediateSubclass: ']
+ ifFalse:
+ [self isEphemeronClass
+ ifTrue: [' ephemeronSubclass: ']
+ ifFalse: [' subclass: ']]]!
Item was added:
+ ----- Method: SpurBootstrapPharoPrototypes>>VirtualMachinePROTOTYPEsetGCParameters (in category 'method prototypes') -----
+ VirtualMachinePROTOTYPEsetGCParameters
+ "Adjust the VM's default GC parameters to avoid too much tenuring.
+ Maybe this should be left to the VM?"
+
+ | proportion edenSize survivorSize averageObjectSize numObjects |
+ proportion := 0.9. "tenure when 90% of pastSpace is full"
+ edenSize := self parameterAt: 44.
+ survivorSize := edenSize / 5.0. "David's paper uses 140Kb eden + 2 x 28kb survivor spaces; Spur uses the same ratios :-)"
+ averageObjectSize := 8 * self wordSize. "a good approximation"
+ numObjects := (proportion * survivorSize / averageObjectSize) rounded.
+ self tenuringThreshold: numObjects "tenure when more than this many objects survive the GC"!
Item was added:
+ Object subclass: #SpurBootstrapPrototypes
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Cog-Bootstrapping'!
Item was added:
+ ----- Method: SpurBootstrapPrototypes class>>imageType (in category 'accessing') -----
+ imageType
+ ^ self subclassResponsibility!
Item was added:
+ ----- Method: SpurBootstrapPrototypes class>>prototypesFor: (in category 'instance creation') -----
+ prototypesFor: type
+ ^ (self allSubclasses
+ detect: [ :aClass | aClass imageType = type ])
+ new
+ !
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEallInstances (in category 'method prototypes') -----
+ BehaviorPROTOTYPEallInstances
+ "Answer all instances of the receiver."
+ <primitive: 177>
+ "The primitive can fail because memory is low. If so, fall back on the old
+ enumeration code, which gives the system a chance to GC and/or grow.
+ Because aBlock might change the class of inst (for example, using become:),
+ it is essential to compute next before aBlock value: inst."
+ | inst insts next |
+ insts := WriteStream on: (Array new: 64).
+ inst := self someInstance.
+ [inst == nil] whileFalse:
+ [next := inst nextInstance.
+ (inst == insts or: [inst == insts originalContents]) ifFalse: [insts nextPut: inst].
+ inst := next].
+ ^insts contents!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEallInstancesDo: (in category 'method prototypes') -----
+ BehaviorPROTOTYPEallInstancesDo: aBlock
+ "Evaluate aBlock with each of the current instances of the receiver."
+ | instances inst next |
+ instances := self allInstancesOrNil.
+ instances ifNotNil:
+ [instances do: aBlock.
+ ^self].
+ "allInstancesOrNil can fail because memory is low. If so, fall back on the old
+ enumeration code. Because aBlock might change the class of inst (for example,
+ using become:), it is essential to compute next before aBlock value: inst."
+ inst := self someInstance.
+ [inst == nil] whileFalse:
+ [next := inst nextInstance.
+ aBlock value: inst.
+ inst := next]!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEallInstancesOrNil (in category 'method prototypes') -----
+ BehaviorPROTOTYPEallInstancesOrNil
+ "Answer all instances of the receiver, or nil if the primitive
+ fails, which it may be due to being out of memory."
+ <primitive: 177>
+ ^nil!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEbasicNew (in category 'method prototypes') -----
+ BehaviorPROTOTYPEbasicNew
+ "Primitive. Answer an instance of the receiver (which is a class) with no
+ indexable variables. Fail if the class is indexable. Essential. See Object
+ documentation whatIsAPrimitive.
+
+ If the primitive fails because space is low then the scavenger will run
+ before the method is activated. Check that space was low and retry
+ via handleFailingBasicNew if so."
+
+ <primitive: 70 error: ec>
+ ec == #'insufficient object memory' ifTrue:
+ [^self handleFailingBasicNew].
+ self isVariable ifTrue: [^self basicNew: 0].
+ self primitiveFailed!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEbasicNew: (in category 'method prototypes') -----
+ BehaviorPROTOTYPEbasicNew: sizeRequested
+ "Primitive. Answer an instance of this class with the number of indexable
+ variables specified by the argument, sizeRequested. Fail if this class is not
+ indexable or if the argument is not a positive Integer, or if there is not
+ enough memory available. Essential. See Object documentation whatIsAPrimitive.
+
+ If the primitive fails because space is low then the scavenger will run before the
+ method is activated. Check args and retry via handleFailingBasicNew: if they're OK."
+
+ <primitive: 71 error: ec>
+ ec == #'insufficient object memory' ifTrue:
+ [^self handleFailingBasicNew: sizeRequested].
+ self isVariable ifFalse:
+ [self error: self printString, ' cannot have variable sized instances'].
+ self primitiveFailed!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEbyteSizeOfInstance (in category 'method prototypes') -----
+ BehaviorPROTOTYPEbyteSizeOfInstance
+ "Answer the total memory size of an instance of the receiver."
+
+ <primitive: 181 error: ec>
+ self isVariable ifTrue:
+ [^self byteSizeOfInstanceOfSize: 0].
+ self primitiveFailed!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEbyteSizeOfInstanceOfSize: (in category 'method prototypes') -----
+ BehaviorPROTOTYPEbyteSizeOfInstanceOfSize: basicSize
+ "Answer the total memory size of an instance of the receiver
+ with the given number of indexable instance variables."
+
+ <primitive: 181 error: ec>
+ self isVariable
+ ifTrue: "If the primitive overflowed answer a close approximation"
+ [(basicSize isInteger
+ and: [basicSize >= 16r1000000]) ifTrue:
+ [^2 * (self byteSizeOfInstanceOfSize: basicSize + 1 // 2)
+ - (self byteSizeOfInstanceOfSize: 0)]]
+ ifFalse:
+ [basicSize = 0 ifTrue:
+ [^self byteSizeOfInstance]].
+ self primitiveFailed!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEelementSize (in category 'method prototypes') -----
+ BehaviorPROTOTYPEelementSize
+ "Answer the size in bytes of an element in the receiver. The formats are
+ 0 = 0 sized objects (UndefinedObject True False et al)
+ 1 = non-indexable objects with inst vars (Point et al)
+ 2 = indexable objects with no inst vars (Array et al)
+ 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
+ 4 = weak indexable objects with inst vars (WeakArray et al)
+ 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
+ 6 = unused
+ 7 = immediates (SmallInteger, Character)
+ 8 = unused
+ 9 = 64-bit indexable
+ 10-11 = 32-bit indexable (Bitmap)
+ 12-15 = 16-bit indexable
+ 16-23 = 8-bit indexable
+ 24-31 = compiled methods (CompiledMethod)"
+ | instSpec |
+ instSpec := self instSpec.
+ instSpec < 9 ifTrue: [^Smalltalk wordSize].
+ instSpec >= 16 ifTrue: [^1].
+ instSpec >= 12 ifTrue: [^2].
+ instSpec >= 10 ifTrue: [^4].
+ ^8!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEhandleFailingBasicNew (in category 'method prototypes') -----
+ BehaviorPROTOTYPEhandleFailingBasicNew
+ "handleFailingBasicNew gets sent after basicNew has failed and allowed
+ a scavenging garbage collection to occur. The scavenging collection
+ will have happened as the VM is activating the (failing) basicNew. If
+ handleFailingBasicNew fails then the scavenge failed to reclaim sufficient
+ space and a global garbage collection is required. Retry after garbage
+ collecting and growing memory if necessary.
+
+ Primitive. Answer an instance of this class with the number of indexable
+ variables specified by the argument, sizeRequested. Fail if this class is not
+ indexable or if the argument is not a positive Integer, or if there is not
+ enough memory available. Essential. See Object documentation whatIsAPrimitive."
+
+ <primitive: 70>
+ Smalltalk garbageCollect < 1048576 ifTrue:
+ [Smalltalk growMemoryByAtLeast: 1048576].
+ ^self handleFailingFailingBasicNew "retry after global garbage collect"!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEhandleFailingBasicNew: (in category 'method prototypes') -----
+ BehaviorPROTOTYPEhandleFailingBasicNew: sizeRequested
+ "handleFailingBasicNew: gets sent after basicNew: has failed and allowed
+ a scavenging garbage collection to occur. The scavenging collection
+ will have happened as the VM is activating the (failing) basicNew:. If
+ handleFailingBasicNew: fails then the scavenge failed to reclaim sufficient
+ space and a global garbage collection is required. Retry after garbage
+ collecting and growing memory if necessary.
+
+ Primitive. Answer an instance of this class with the number of indexable
+ variables specified by the argument, sizeRequested. Fail if this class is not
+ indexable or if the argument is not a positive Integer, or if there is not
+ enough memory available. Essential. See Object documentation whatIsAPrimitive."
+
+ <primitive: 71>
+ | bytesRequested |
+ bytesRequested := self byteSizeOfInstanceOfSize: sizeRequested.
+ Smalltalk garbageCollect < bytesRequested ifTrue:
+ [Smalltalk growMemoryByAtLeast: bytesRequested].
+ "retry after global garbage collect and possible grow"
+ ^self handleFailingFailingBasicNew: sizeRequested!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEhandleFailingFailingBasicNew (in category 'method prototypes') -----
+ BehaviorPROTOTYPEhandleFailingFailingBasicNew
+ "This basicNew gets sent after handleFailingBasicNew: has done a full
+ garbage collection and possibly grown memory. If this basicNew fails
+ then the system really is low on space, so raise the OutOfMemory signal.
+
+ Primitive. Answer an instance of this class with the number of indexable
+ variables specified by the argument, sizeRequested. Fail if this class is not
+ indexable or if the argument is not a positive Integer, or if there is not
+ enough memory available. Essential. See Object documentation whatIsAPrimitive."
+
+ <primitive: 70>
+ "space must be low"
+ OutOfMemory signal.
+ ^self basicNew "retry if user proceeds"!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEhandleFailingFailingBasicNew: (in category 'method prototypes') -----
+ BehaviorPROTOTYPEhandleFailingFailingBasicNew: sizeRequested
+ "This basicNew: gets sent after handleFailingBasicNew: has done a full
+ garbage collection and possibly grown memory. If this basicNew: fails
+ then the system really is low on space, so raise the OutOfMemory signal.
+
+ Primitive. Answer an instance of this class with the number of indexable
+ variables specified by the argument, sizeRequested. Fail if this class is not
+ indexable or if the argument is not a positive Integer, or if there is not
+ enough memory available. Essential. See Object documentation whatIsAPrimitive."
+
+ <primitive: 71>
+ "space must be low."
+ OutOfMemory signal.
+ ^self basicNew: sizeRequested "retry if user proceeds"!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEindexIfCompact (in category 'method prototypes') -----
+ BehaviorPROTOTYPEindexIfCompact
+ "Backward compatibility with the Squeak V3 object format.
+ Spur does not have a distinction between compact and non-compact classes."
+ ^0!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEinstSize (in category 'method prototypes') -----
+ BehaviorPROTOTYPEinstSize
+ <indirect>!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEinstSpec (in category 'method prototypes') -----
+ BehaviorPROTOTYPEinstSpec
+ <indirect>!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEisBits (in category 'method prototypes') -----
+ BehaviorPROTOTYPEisBits
+ "Answer whether the receiver contains just bits (not pointers).
+ Above Cog Spur the class format is
+ <5 bits inst spec><16 bits inst size>
+ where the 5-bit inst spec is
+ 0 = 0 sized objects (UndefinedObject True False et al)
+ 1 = non-indexable objects with inst vars (Point et al)
+ 2 = indexable objects with no inst vars (Array et al)
+ 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
+ 4 = weak indexable objects with inst vars (WeakArray et al)
+ 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
+ 6 = unused
+ 7 = immediates (SmallInteger, Character)
+ 8 = unused
+ 9 = 64-bit indexable
+ 10-11 = 32-bit indexable (Bitmap)
+ 12-15 = 16-bit indexable
+ 16-23 = 8-bit indexable
+ 24-31 = compiled methods (CompiledMethod)"
+ ^self instSpec >= 7!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEisBytes (in category 'method prototypes') -----
+ BehaviorPROTOTYPEisBytes
+ "Answer whether the receiver has 8-bit instance variables.
+ Above Cog Spur the class format is
+ <5 bits inst spec><16 bits inst size>
+ where the 5-bit inst spec is
+ 0 = 0 sized objects (UndefinedObject True False et al)
+ 1 = non-indexable objects with inst vars (Point et al)
+ 2 = indexable objects with no inst vars (Array et al)
+ 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
+ 4 = weak indexable objects with inst vars (WeakArray et al)
+ 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
+ 6 = unused
+ 7 = immediates (SmallInteger, Character)
+ 8 = unused
+ 9 = 64-bit indexable
+ 10-11 = 32-bit indexable (Bitmap)
+ 12-15 = 16-bit indexable
+ 16-23 = 8-bit indexable
+ 24-31 = compiled methods (CompiledMethod)"
+ ^self instSpec >= 16!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEisEphemeronClass (in category 'method prototypes') -----
+ BehaviorPROTOTYPEisEphemeronClass
+ "Answer whether the receiver has ephemeral instance variables. The garbage collector will
+ fire (queue for finalization) any ephemeron whose first instance variable is not referenced
+ other than from the transitive closure of references from ephemerons. Hence referring to
+ an object from the first inst var of an ephemeron will cause the ephemeron to fire when
+ the rest of the system does not refer to the object and that object is ready to be collected.
+ Since references from the remaining inst vars of an ephemeron will not prevent the ephemeron
+ from firing, ephemerons may act as the associations in weak dictionaries such that the value
+ (e.g. properties attached to the key) will not prevent firing when the key is no longer referenced
+ other than from ephemerons. Ephemerons can therefore be used to implement instance-based
+ pre-mortem finalization."
+ ^self instSpec = 5!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEisImmediateClass (in category 'method prototypes') -----
+ BehaviorPROTOTYPEisImmediateClass
+ "Answer whether the receiver has immediate instances. Immediate instances
+ store their value in their object pointer, not in an object body. Hence immediates
+ take no space and are immutable. The immediates are distinguished by tag bits
+ in the pointer. They include SmallIntegers and Characters. Hence in the 32-bit
+ system SmallIntegers are 31-bit signed integers and Characters are 30-bit
+ unsigned character codes."
+ ^self instSpec = 7!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEisVariable (in category 'method prototypes') -----
+ BehaviorPROTOTYPEisVariable
+ "Answer whether the receiver has indexable variables.
+ Above Cog Spur the class format is
+ <5 bits inst spec><16 bits inst size>
+ where the 5-bit inst spec is
+ 0 = 0 sized objects (UndefinedObject True False et al)
+ 1 = non-indexable objects with inst vars (Point et al)
+ 2 = indexable objects with no inst vars (Array et al)
+ 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
+ 4 = weak indexable objects with inst vars (WeakArray et al)
+ 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
+ 6 = unused
+ 7 = immediates (SmallInteger, Character)
+ 8 = unused
+ 9 = 64-bit indexable
+ 10-11 = 32-bit indexable (Bitmap)
+ 12-15 = 16-bit indexable
+ 16-23 = 8-bit indexable
+ 24-31 = compiled methods (CompiledMethod)"
+ | instSpec |
+ instSpec := self instSpec.
+ ^instSpec >= 2 and: [instSpec <= 4 or: [instSpec >= 9]]!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEkindOfSubclass (in category 'method prototypes') -----
+ BehaviorPROTOTYPEkindOfSubclass
+ "Answer a String that is the keyword that describes the receiver's kind of subclass,
+ either a regular subclass, a variableSubclass, a variableByteSubclass,
+ a variableWordSubclass, a weakSubclass, an ephemeronSubclass or an immediateSubclass.
+ c.f. typeOfClass"
+ ^self isVariable
+ ifTrue:
+ [self isBits
+ ifTrue:
+ [self isBytes
+ ifTrue: [' variableByteSubclass: ']
+ ifFalse: [' variableWordSubclass: ']]
+ ifFalse:
+ [self isWeak
+ ifTrue: [' weakSubclass: ']
+ ifFalse: [' variableSubclass: ']]]
+ ifFalse:
+ [self isImmediateClass
+ ifTrue: [' immediateSubclass: ']
+ ifFalse:
+ [self isEphemeronClass
+ ifTrue: [' ephemeronSubclass: ']
+ ifFalse: [' subclass: ']]]!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEshouldNotBeRedefined (in category 'method prototypes') -----
+ BehaviorPROTOTYPEshouldNotBeRedefined
+ "Answer if the receiver should not be redefined.
+ The assumption is that classes in Smalltalk specialObjects and
+ instance-specific Behaviors should not be redefined"
+
+ ^(Smalltalk specialObjectsArray
+ identityIndexOf: self
+ ifAbsent: [(self isKindOf: self) ifTrue: [1] ifFalse: [0]]) ~= 0!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEtypeOfClass (in category 'method prototypes') -----
+ BehaviorPROTOTYPEtypeOfClass
+ "Answer a symbol uniquely describing the type of the receiver. c.f. kindOfSubclass"
+ self isBytes ifTrue:
+ [^self instSpec = CompiledMethod instSpec
+ ifTrue: [#compiledMethod] "Very special!!"
+ ifFalse: [#bytes]].
+ (self isWords and: [self isPointers not]) ifTrue:
+ [^self instSpec = SmallInteger instSpec
+ ifTrue: [#immediate] "Very special!!"
+ ifFalse: [#words]].
+ self isWeak ifTrue: [^#weak].
+ self isVariable ifTrue: [^#variable].
+ self isEphemeronClass ifTrue: [^#ephemeron].
+ ^#normal!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>BytecodeEncoderPROTOTYPEcomputeMethodHeaderForNumArgs:numTemps:numLits:primitive: (in category 'method prototypes') -----
+ BytecodeEncoderPROTOTYPEcomputeMethodHeaderForNumArgs: numArgs numTemps: numTemps numLits: numLits primitive: primitiveIndex
+ numArgs > 15 ifTrue:
+ [^self error: 'Cannot compile -- too many arguments'].
+ numTemps > 63 ifTrue:
+ [^self error: 'Cannot compile -- too many temporary variables'].
+ numLits > 65535 ifTrue:
+ [^self error: 'Cannot compile -- too many literals'].
+ ^(CompiledMethod headerFlagForEncoder: self)
+ + (numArgs bitShift: 24)
+ + (numTemps bitShift: 18)
+ "+ (largeBit bitShift: 17)" "largeBit gets filled in later"
+ + (primitiveIndex > 0 ifTrue: [1 bitShift: 16] ifFalse: [0])
+ + numLits!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>BytecodeEncoderPROTOTYPEsizeCallPrimitive: (in category 'method prototypes') -----
+ BytecodeEncoderPROTOTYPEsizeCallPrimitive: primitiveIndex
+ ^self sizeOpcodeSelector: #genCallPrimitive: withArguments: {primitiveIndex}!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>CharacterPROTOTYPEDollarEquals: (in category 'method prototypes') -----
+ CharacterPROTOTYPEDollarEquals: aCharacter
+ "Primitive. Answer if the receiver and the argument are the
+ same object (have the same object pointer). Optional. See
+ Object documentation whatIsAPrimitive."
+ <primitive: 110>
+ ^self == aCharacter!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>CharacterPROTOTYPEasInteger (in category 'method prototypes') -----
+ CharacterPROTOTYPEasInteger
+ "Answer the receiver's character code."
+ <primitive: 171>
+ ^self primitiveFailed!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>CharacterPROTOTYPEasciiValue (in category 'method prototypes') -----
+ CharacterPROTOTYPEasciiValue
+ "Answer the receiver's character code.
+ This will be ascii for characters with value <= 127,
+ and Unicode for those with higher values."
+ <primitive: 171>
+ ^self primitiveFailed!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>CharacterPROTOTYPEcopy (in category 'method prototypes') -----
+ CharacterPROTOTYPEcopy
+ "Answer the receiver, because Characters are unique."
+ ^self!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>CharacterPROTOTYPEdeepCopy (in category 'method prototypes') -----
+ CharacterPROTOTYPEdeepCopy
+ "Answer the receiver, because Characters are unique."
+ ^self!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>CharacterPROTOTYPEhash (in category 'method prototypes') -----
+ CharacterPROTOTYPEhash
+ "Hash is reimplemented because = is implemented.
+ Answer the receiver's character code."
+ <primitive: 171>
+ ^self primitiveFailed!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>CharacterPROTOTYPEidentityHash (in category 'method prototypes') -----
+ CharacterPROTOTYPEidentityHash
+ "Answer the receiver's character code."
+ <primitive: 171>
+ ^self primitiveFailed!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>CharacterPROTOTYPEshallowCopy (in category 'method prototypes') -----
+ CharacterPROTOTYPEshallowCopy
+ "Answer the receiver, because Characters are unique."
+ ^self!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>CharacterPROTOTYPEveryDeepCopyWith: (in category 'method prototypes') -----
+ CharacterPROTOTYPEveryDeepCopyWith: deepCopier
+ "Answer the receiver, because Characters are unique."
+ ^self!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>CharacterclassPROTOTYPEdigitValue: (in category 'method prototypes') -----
+ CharacterclassPROTOTYPEdigitValue: x
+ "Answer the Character whose digit value is x. For example,
+ answer $9 for x=9, $0 for x=0, $A for x=10, $Z for x=35."
+
+ | n |
+ n := x asInteger.
+ ^self value: (n < 10 ifTrue: [n + 48] ifFalse: [n + 55])!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>CharacterclassPROTOTYPEinitialize (in category 'method prototypes') -----
+ CharacterclassPROTOTYPEinitialize
+ "Create the DigitsValues table."
+ "Character initialize"
+ self initializeDigitValues!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>CharacterclassPROTOTYPEvalue: (in category 'method prototypes') -----
+ CharacterclassPROTOTYPEvalue: anInteger
+ "Answer the Character whose value is anInteger."
+ <primitive: 170>
+ ^self primitiveFailed!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>ClassBuilderPROTOTYPEcomputeFormat:instSize:forSuper:ccIndex: (in category 'method prototypes') -----
+ ClassBuilderPROTOTYPEcomputeFormat: type instSize: newInstSize forSuper: newSuper ccIndex: ccIndex
+ "Compute the new format for making oldClass a subclass of newSuper.
+ Answer the format or nil if there is any problem."
+ | instSize isVar isWords isPointers isWeak |
+ type == #compiledMethod ifTrue:
+ [newInstSize > 0 ifTrue:
+ [self error: 'A compiled method class cannot have named instance variables'.
+ ^nil].
+ ^CompiledMethod format].
+ instSize := newInstSize + (newSuper ifNil:[0] ifNotNil:[newSuper instSize]).
+ instSize > 65535 ifTrue:
+ [self error: 'Class has too many instance variables (', instSize printString,')'.
+ ^nil].
+ type == #normal ifTrue:[isVar := isWeak := false. isWords := isPointers := true].
+ type == #bytes ifTrue:[isVar := true. isWords := isPointers := isWeak := false].
+ type == #words ifTrue:[isVar := isWords := true. isPointers := isWeak := false].
+ type == #variable ifTrue:[isVar := isPointers := isWords := true. isWeak := false].
+ type == #weak ifTrue:[isVar := isWeak := isWords := isPointers := true].
+ type == #ephemeron ifTrue:[isVar := false. isWeak := isWords := isPointers := true].
+ type == #immediate ifTrue:[isVar := isWeak := isPointers := false. isWords := true].
+ (isPointers not and: [instSize > 0]) ifTrue:
+ [self error: 'A non-pointer class cannot have named instance variables'.
+ ^nil].
+ ^self format: instSize variable: isVar words: isWords pointers: isPointers weak: isWeak!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>ClassBuilderPROTOTYPEformat:variable:words:pointers:weak: (in category 'method prototypes') -----
+ ClassBuilderPROTOTYPEformat: nInstVars variable: isVar words: is32BitWords pointers: isPointers weak: isWeak
+ "Compute the format for the given instance specfication.
+ Above Cog Spur the class format is
+ <5 bits inst spec><16 bits inst size>
+ where the 5-bit inst spec is
+ 0 = 0 sized objects (UndefinedObject True False et al)
+ 1 = non-indexable objects with inst vars (Point et al)
+ 2 = indexable objects with no inst vars (Array et al)
+ 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
+ 4 = weak indexable objects with inst vars (WeakArray et al)
+ 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
+ 6 = unused
+ 7 = immediates (SmallInteger, Character)
+ 8 = unused
+ 9 = reserved for 64-bit indexable
+ 10-11 = 32-bit indexable (Bitmap)
+ 12-15 = 16-bit indexable
+ 16-23 = 8-bit indexable
+ 24-31 = compiled methods (CompiledMethod)"
+ | instSpec |
+ instSpec := isWeak
+ ifTrue:
+ [isVar
+ ifTrue: [4]
+ ifFalse: [5]]
+ ifFalse:
+ [isPointers
+ ifTrue:
+ [isVar
+ ifTrue: [nInstVars > 0 ifTrue: [3] ifFalse: [2]]
+ ifFalse: [nInstVars > 0 ifTrue: [1] ifFalse: [0]]]
+ ifFalse:
+ [isVar
+ ifTrue: [is32BitWords ifTrue: [10] ifFalse: [16]]
+ ifFalse: [7]]].
+ ^(instSpec bitShift: 16) + nInstVars!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>ClassBuilderPROTOTYPEsuperclass:immediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'method prototypes') -----
+ ClassBuilderPROTOTYPEsuperclass: aClass
+ immediateSubclass: t instanceVariableNames: f
+ classVariableNames: d poolDictionaries: s category: cat
+ "This is the standard initialization message for creating a
+ new immediate class as a subclass of an existing class."
+ | env |
+ aClass instSize > 0
+ ifTrue: [^self error: 'cannot make an immediate subclass of a class with named fields'].
+ aClass isVariable
+ ifTrue: [^self error: 'cannot make an immediate subclass of a class with indexed instance variables'].
+ aClass isPointers
+ ifFalse: [^self error: 'cannot make an immediate subclass of a class without pointer fields'].
+ "Cope with pre-environment and environment versions. Simplify asap."
+ env := (Smalltalk classNamed: #EnvironmentRequest)
+ ifNil: [aClass environment]
+ ifNotNil: [:erc| erc signal ifNil: [aClass environment]].
+ ^self
+ name: t
+ inEnvironment: env
+ subclassOf: aClass
+ type: #immediate
+ instanceVariableNames: f
+ classVariableNames: d
+ poolDictionaries: s
+ category: cat!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>ClassBuilderPROTOTYPEupdate:to: (in category 'method prototypes') -----
+ ClassBuilderPROTOTYPEupdate: oldClass to: newClass
+ "Convert oldClass, all its instances and possibly its meta class into newClass,
+ instances of newClass and possibly its meta class. The process is surprisingly
+ simple in its implementation and surprisingly complex in its nuances and potentially
+ bad side effects.
+ We can rely on two assumptions (which are critical):
+ #1: The method #updateInstancesFrom: will not create any lasting pointers to
+ 'old' instances ('old' is quote on quote since #updateInstancesFrom: will do
+ a become of the old vs. the new instances and therefore it will not create
+ pointers to *new* instances before the #become: which are *old* afterwards)
+ #2: The non-preemptive execution of the critical piece of code guarantees that
+ nobody can get a hold by 'other means' (such as process interruption and
+ reflection) on the old instances.
+ Given the above two, we know that after #updateInstancesFrom: there are no pointers
+ to any old instances. After the forwarding become there will be no pointers to the old
+ class or meta class either.
+ Andreas Raab, 2/27/2003 23:42"
+ | meta |
+ meta := oldClass isMeta.
+ "Note: Everything from here on will run without the ability to get interrupted
+ to prevent any other process to create new instances of the old class."
+ ["Note: The following removal may look somewhat obscure and needs an explanation.
+ When we mutate the class hierarchy we create new classes for any existing subclass.
+ So it may look as if we don't have to remove the old class from its superclass. However,
+ at the top of the hierarchy (the first class we reshape) that superclass itself is not newly
+ created so therefore it will hold both the oldClass and newClass in its (obsolete or not)
+ subclasses. Since the #become: below will transparently replace the pointers to oldClass
+ with newClass the superclass would have newClass in its subclasses TWICE. With rather
+ unclear effects if we consider that we may convert the meta-class hierarchy itself (which
+ is derived from the non-meta class hierarchy).
+ Due to this problem ALL classes are removed from their superclass just prior to converting
+ them. Here, breaking the superclass/subclass invariant really doesn't matter since we will
+ effectively remove the oldClass (becomeForward:) just a few lines below."
+
+ oldClass superclass removeSubclass: oldClass.
+ oldClass superclass removeObsoleteSubclass: oldClass.
+
+ "make sure that the VM cache is clean"
+ oldClass methodDict do: [:cm | cm flushCache].
+
+ "Convert the instances of oldClass into instances of newClass"
+ newClass updateInstancesFrom: oldClass.
+
+ meta
+ ifTrue:
+ [oldClass becomeForward: newClass.
+ oldClass updateMethodBindingsTo: oldClass binding]
+ ifFalse:
+ [{oldClass. oldClass class} elementsForwardIdentityTo: {newClass. newClass class}.
+ oldClass updateMethodBindingsTo: oldClass binding.
+ oldClass class updateMethodBindingsTo: oldClass class binding].
+
+ "eem 5/31/2014 07:22 At this point there used to be a garbage collect whose purpose was
+ to ensure no old instances existed after the becomeForward:. Without the GC it was possible
+ to resurrect old instances using e.g. allInstancesDo:. This was because the becomeForward:
+ updated references from the old objects to new objects but didn't destroy the old objects.
+ But as of late 2013/early 2014 becomeForward: has been modified to free all the old objects."]
+ valueUnpreemptively!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>CompiledMethodPROTOTYPEnumLiterals (in category 'method prototypes') -----
+ CompiledMethodPROTOTYPEnumLiterals
+ "Answer the number of literals used by the receiver."
+ ^self header bitAnd: 65535!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>CompiledMethodPROTOTYPEprimitive (in category 'method prototypes') -----
+ CompiledMethodPROTOTYPEprimitive
+ "Answer the primitive index associated with the receiver.
+ Zero indicates that this is not a primitive method."
+ | initialPC |
+ ^(self header anyMask: 65536) "Is the hasPrimitive? flag set?"
+ ifTrue: [(self at: (initialPC := self initialPC) + 1) + ((self at: initialPC + 2) bitShift: 8)]
+ ifFalse: [0]!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEhandleFailingFailingNewMethod:header: (in category 'method prototypes') -----
+ CompiledMethodclassPROTOTYPEhandleFailingFailingNewMethod: numberOfBytes header: headerWord
+ "This newMethod:header: gets sent after handleFailingBasicNew: has done a full
+ garbage collection and possibly grown memory. If this basicNew: fails then the
+ system really is low on space, so raise the OutOfMemory signal.
+
+ Primitive. Answer an instance of this class with the number of indexable variables
+ specified by the argument, headerWord, and the number of bytecodes specified
+ by numberOfBytes. Fail if this if the arguments are not Integers, or if numberOfBytes
+ is negative, or if the receiver is not a CompiledMethod class, or if there is not enough
+ memory available. Essential. See Object documentation whatIsAPrimitive."
+
+ <primitive: 79>
+ "space must be low."
+ OutOfMemory signal.
+ "retry if user proceeds"
+ ^self newMethod: numberOfBytes header: headerWord!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEhandleFailingNewMethod:header: (in category 'method prototypes') -----
+ CompiledMethodclassPROTOTYPEhandleFailingNewMethod: numberOfBytes header: headerWord
+ "This newMethod:header: gets sent after newMethod:header: has failed
+ and allowed a scavenging garbage collection to occur. The scavenging
+ collection will have happened as the VM is activating the (failing) basicNew:.
+ If handleFailingBasicNew: fails then the scavenge failed to reclaim sufficient
+ space and a global garbage collection is required. Retry after garbage
+ collecting and growing memory if necessary.
+
+ Primitive. Answer an instance of this class with the number of indexable variables
+ specified by the argument, headerWord, and the number of bytecodes specified
+ by numberOfBytes. Fail if this if the arguments are not Integers, or if numberOfBytes
+ is negative, or if the receiver is not a CompiledMethod class, or if there is not enough
+ memory available. Essential. See Object documentation whatIsAPrimitive."
+
+ <primitive: 79>
+ | bytesRequested |
+ bytesRequested := (headerWord bitAnd: 16rFFFF) + 1 * Smalltalk wordSize + numberOfBytes + 16.
+ Smalltalk garbageCollect < bytesRequested ifTrue:
+ [Smalltalk growMemoryByAtLeast: bytesRequested].
+ "retry after global garbage collect and possible grow"
+ ^self handleFailingFailingNewMethod: numberOfBytes header: headerWord!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEheaderFlagForEncoder: (in category 'method prototypes') -----
+ CompiledMethodclassPROTOTYPEheaderFlagForEncoder: anEncoder
+ <indirect>!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEinitialize (in category 'method prototypes') -----
+ CompiledMethodclassPROTOTYPEinitialize "CompiledMethod initialize"
+ <indirect>!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEinstallPrimaryBytecodeSet: (in category 'method prototypes') -----
+ CompiledMethodclassPROTOTYPEinstallPrimaryBytecodeSet: aBytecodeEncoderSubclass
+ <indirect>!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEinstallSecondaryBytecodeSet: (in category 'method prototypes') -----
+ CompiledMethodclassPROTOTYPEinstallSecondaryBytecodeSet: aBytecodeEncoderSubclass
+ <indirect>!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEnewBytes:trailerBytes:nArgs:nTemps:nStack:nLits:primitive: (in category 'method prototypes') -----
+ CompiledMethodclassPROTOTYPEnewBytes: numberOfBytes trailerBytes: trailer nArgs: nArgs nTemps: nTemps nStack: stackSize nLits: nLits primitive: primitiveIndex
+ "Since this method refers to ClassVariables things are easier if it lives in the actual class."
+
+ <indirect>!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEnewBytes:trailerBytes:nArgs:nTemps:nStack:nLits:primitive:flag: (in category 'method prototypes') -----
+ CompiledMethodclassPROTOTYPEnewBytes: numberOfBytes trailerBytes: trailer nArgs: nArgs nTemps: nTemps nStack: stackSize nLits: nLits primitive: primitiveIndex flag: flag
+ "Since this method refers to ClassVariables things are easier if it lives in the actual class."
+
+ <indirect>!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEnewMethod:header: (in category 'method prototypes') -----
+ CompiledMethodclassPROTOTYPEnewMethod: numberOfBytes header: headerWord
+ "Primitive. Answer an instance of me. The number of literals (and other
+ information) is specified by the headerWord (see my class comment).
+ The first argument specifies the number of fields for bytecodes in the
+ method. Fail if either argument is not a SmallInteger, or if numberOfBytes
+ is negative, or if memory is low. Once the header of a method is set by
+ this primitive, it cannot be changed to change the number of literals.
+ Essential. See Object documentation whatIsAPrimitive."
+
+ <primitive: 79 error: ec>
+ ec == #'insufficient object memory' ifTrue:
+ [^self handleFailingNewMethod: numberOfBytes header: headerWord].
+ ^self primitiveFailed!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEtoReturnConstant:trailerBytes: (in category 'method prototypes') -----
+ CompiledMethodclassPROTOTYPEtoReturnConstant: index trailerBytes: trailer
+ "Answer an instance of me that is a quick return of the constant
+ indexed in (true false nil -1 0 1 2)."
+
+ ^self newBytes: 3 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 256 + index!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEtoReturnField:trailerBytes: (in category 'method prototypes') -----
+ CompiledMethodclassPROTOTYPEtoReturnField: field trailerBytes: trailer
+ "Answer an instance of me that is a quick return of the instance variable
+ indexed by the argument, field."
+
+ ^self newBytes: 3 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 264 + field!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEtoReturnSelfTrailerBytes: (in category 'method prototypes') -----
+ CompiledMethodclassPROTOTYPEtoReturnSelfTrailerBytes: trailer
+ "Answer an instance of me that is a quick return of the instance (^self)."
+
+ ^self newBytes: 3 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 256!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>EncoderForV3PROTOTYPEcomputeMethodHeaderForNumArgs:numTemps:numLits:primitive: (in category 'method prototypes') -----
+ EncoderForV3PROTOTYPEcomputeMethodHeaderForNumArgs: numArgs numTemps: numTemps numLits: numLits primitive: primitiveIndex
+ <remove>!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>EncoderForV3PlusClosuresPROTOTYPEgenCallPrimitive: (in category 'method prototypes') -----
+ EncoderForV3PlusClosuresPROTOTYPEgenCallPrimitive: primitiveIndex
+ "Since this method has inst var refs the prototype must live in the actual class."
+
+ <indirect>!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>EncoderForV3PlusClosuresclassPROTOTYPEbytecodeSize: (in category 'method prototypes') -----
+ EncoderForV3PlusClosuresclassPROTOTYPEbytecodeSize: bytecode
+ "Answer the number of bytes in the bytecode."
+ bytecode <= 125 ifTrue:
+ [^1].
+ bytecode >= 176 ifTrue:
+ [^1].
+ bytecode >= 160 ifTrue: "long jumps"
+ [^2].
+ bytecode >= 144 ifTrue: "short jumps"
+ [^1].
+ "extensions"
+ bytecode >= 128 ifTrue:
+ [^#(2 2 2 2 3 2 2 1 1 1 2 3 3 3 3 4) at: bytecode - 127].
+ ^nil!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>EncoderForV3PlusClosuresclassPROTOTYPEcallPrimitiveCode (in category 'method prototypes') -----
+ EncoderForV3PlusClosuresclassPROTOTYPEcallPrimitiveCode
+ "139 11101111 iiiiiiii jjjjjjjj Call Primitive #iiiiiiii + (jjjjjjjj * 256)"
+ ^139!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>InstructionClientPROTOTYPEcallPrimitive: (in category 'method prototypes') -----
+ InstructionClientPROTOTYPEcallPrimitive: pimIndex
+ "V3PlusClosures: 139 10001011 iiiiiiii jjjjjjjj Call Primitive #iiiiiiii + (jjjjjjjj * 256)
+ NewsqueakV4: 249 11111001 iiiiiiii jjjjjjjj Call Primitive #iiiiiiii + (jjjjjjjj * 256)
+ SistaV1: 248 11111000 iiiiiiii mjjjjjjj Call Primitive #iiiiiiii + ( jjjjjjj * 256)
+ m=1 means inlined primitive, no hard return after execution."!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>InstructionPrinterPROTOTYPEcallPrimitive: (in category 'method prototypes') -----
+ InstructionPrinterPROTOTYPEcallPrimitive: index
+ "Print the callPrimitive."
+
+ self print: 'callPrimtive: ' , index printString!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>InstructionStreamPROTOTYPEinterpretV3ClosuresExtension:in:for: (in category 'method prototypes') -----
+ InstructionStreamPROTOTYPEinterpretV3ClosuresExtension: offset in: method for: client
+ "Since this method has inst var refs the prototype must live in the actual class."
+
+ <indirect>!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>MethodNodeOLDSQUEAKPROTOTYPEgenerate: (in category 'method prototypes') -----
+ MethodNodeOLDSQUEAKPROTOTYPEgenerate: trailer
+ "The receiver is the root of a parse tree. Answer a CompiledMethod.
+ The argument, trailer, is arbitrary but is typically either the reference
+ to the source code that is stored with every CompiledMethod, or an
+ encoding of the method's temporary names."
+
+ ^self generate: trailer using: CompiledMethod!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>MethodNodePROTOTYPEgenerate:using: (in category 'method prototypes') -----
+ MethodNodePROTOTYPEgenerate: trailer using: aCompiledMethodClass
+ "Since this method has inst var refs the prototype must live in the actual class."
+
+ <indirect>!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>SmallIntegerPROTOTYPEasCharacter (in category 'method prototypes') -----
+ SmallIntegerPROTOTYPEasCharacter
+ <primitive: 170>
+ ^self primitiveFailed!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>SmalltalkImagePROTOTYPEcompactClassesArray (in category 'method prototypes') -----
+ SmalltalkImagePROTOTYPEcompactClassesArray
+ "Smalltalk compactClassesArray"
+ "Backward-compatibility support. Spur does not have compact classes."
+ ^{}!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>SmalltalkImagePROTOTYPEgrowMemoryByAtLeast: (in category 'method prototypes') -----
+ SmalltalkImagePROTOTYPEgrowMemoryByAtLeast: numBytes
+ "Grow memory by at least the requested number of bytes.
+ Primitive. Essential. Fail if no memory is available."
+ <primitive: 180>
+ (numBytes isInteger and: [numBytes > 0]) ifTrue:
+ [OutOfMemory signal].
+ ^self primitiveFailed!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>SmalltalkImagePROTOTYPEmaxIdentityHash (in category 'method prototypes') -----
+ SmalltalkImagePROTOTYPEmaxIdentityHash
+ "Answer the maximum identityHash value supported by the VM."
+ <primitive: 176>
+ ^self primitiveFailed!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>SpaceTallyPROTOTYPEspaceForInstancesOf: (in category 'method prototypes') -----
+ SpaceTallyPROTOTYPEspaceForInstancesOf: aClass
+ "Answer a pair of the number of bytes consumed by all instances of the
+ given class, including their object headers, and the number of instances."
+
+ | instances total |
+ instances := aClass allInstances.
+ instances isEmpty ifTrue: [^#(0 0)].
+ total := 0.
+ aClass isVariable
+ ifTrue:
+ [instances do:
+ [:i| total := total + (aClass byteSizeOfInstanceOfSize: i basicSize)]]
+ ifFalse:
+ [total := instances size * aClass byteSizeOfInstance].
+ ^{ total. instances size }!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>SystemDictionaryPROTOTYPEgrowMemoryByAtLeast: (in category 'method prototypes') -----
+ SystemDictionaryPROTOTYPEgrowMemoryByAtLeast: numBytes
+ "Grow memory by at least the requested number of bytes.
+ Primitive. Fail if no memory is available. Essential."
+ <primitive: 180>
+ ^(numBytes isInteger and: [numBytes > 0])
+ ifTrue: [OutOfMemory signal]
+ ifFalse: [self primitiveFailed]!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>SystemDictionaryPROTOTYPEmaxIdentityHash (in category 'method prototypes') -----
+ SystemDictionaryPROTOTYPEmaxIdentityHash
+ "Answer the maximum identityHash value supported by the VM."
+ <primitive: 176>
+ ^self primitiveFailed!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>SystemNavigationPROTOTYPEallObjects (in category 'method prototypes') -----
+ SystemNavigationPROTOTYPEallObjects
+ "Answer an Array of all objects in the system. Fail if
+ there isn't enough memory to instantiate the result."
+ <primitive: 178>
+ ^self primitiveFailed!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>SystemNavigationPROTOTYPEallObjectsDo: (in category 'method prototypes') -----
+ SystemNavigationPROTOTYPEallObjectsDo: aBlock
+ "Evaluate the argument, aBlock, for each object in the system, excluding immediates
+ such as SmallInteger and Character."
+ self allObjectsOrNil
+ ifNotNil: [:allObjects| allObjects do: aBlock]
+ ifNil:
+ ["Fall back on the old single object primitive code. With closures, this needs
+ to use an end marker (lastObject) since activation of the block will create
+ new contexts and cause an infinite loop. The lastObject must be created
+ before calling someObject, so that the VM can settle the enumeration (e.g.
+ by flushing new space) as a side effect of someObject"
+ | object lastObject |
+ lastObject := Object new.
+ object := self someObject.
+ [lastObject == object or: [0 == object]] whileFalse:
+ [aBlock value: object.
+ object := object nextObject]]!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>SystemNavigationPROTOTYPEallObjectsOrNil (in category 'method prototypes') -----
+ SystemNavigationPROTOTYPEallObjectsOrNil
+ "Answer an Array of all objects in the system. Fail if there isn't
+ enough memory to instantiate the result and answer nil."
+ <primitive: 178>
+ ^nil!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>WideStringPROTOTYPEat: (in category 'method prototypes') -----
+ WideStringPROTOTYPEat: index
+ "Answer the Character stored in the field of the receiver indexed by the
+ argument. Primitive. Fail if the index argument is not an Integer or is out
+ of bounds. Essential. See Object documentation whatIsAPrimitive."
+
+ <primitive: 63>
+ ^index isInteger
+ ifTrue:
+ [self errorSubscriptBounds: index]
+ ifFalse:
+ [index isNumber
+ ifTrue: [self at: index asInteger]
+ ifFalse: [self errorNonIntegerIndex]]!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>WideStringPROTOTYPEat:put: (in category 'method prototypes') -----
+ WideStringPROTOTYPEat: index put: aCharacter
+ "Store the Character into the field of the receiver indicated by the index.
+ Primitive. Fail if the index is not an Integer or is out of bounds, or if the
+ argument is not a Character. Essential. See Object documentation whatIsAPrimitive."
+
+ <primitive: 64>
+ ^aCharacter isCharacter
+ ifTrue:
+ [index isInteger
+ ifTrue: [self errorSubscriptBounds: index]
+ ifFalse: [self errorNonIntegerIndex]]
+ ifFalse:
+ [self errorImproperStore]!
Item was added:
+ ----- Method: SpurBootstrapPrototypes>>allMethodPrototypes (in category 'accessing') -----
+ allMethodPrototypes
+ ^[self class allMethods "Pharo"
+ select: [ :each | each category = 'method prototypes' ]]
+ on: MessageNotUnderstood
+ do: [:ex|
+ ex message selector == #allMethods
+ ifTrue:
+ [self class selectors "Squeak"
+ collect: [:s| self class >> s]
+ thenSelect: [:m| m protocol = 'method prototypes']]
+ ifFalse:
+ [ex pass]]!
Item was added:
+ SpurBootstrapPrototypes subclass: #SpurBootstrapSqueak43Prototypes
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Cog-Bootstrapping'!
Item was added:
+ ----- Method: SpurBootstrapSqueak43Prototypes class>>imageType (in category 'accessing') -----
+ imageType
+ ^ 'squeak 4.3'!
Item was added:
+ ----- Method: SpurBootstrapSqueak43Prototypes>>BlockClosurePROTOTYPEsimulateValueWithArguments:caller: (in category 'method prototypes') -----
+ BlockClosurePROTOTYPEsimulateValueWithArguments: anArray caller: aContext
+ <indirect>!
Item was added:
+ ----- Method: SpurBootstrapSqueak43Prototypes>>CharacterPROTOTYPEshouldBePrintedAsLiteral (in category 'method prototypes') -----
+ CharacterPROTOTYPEshouldBePrintedAsLiteral
+
+ ^(self asInteger between: 33 and: 255) and: [self asInteger ~= 127]!
Item was added:
+ ----- Method: SpurBootstrapSqueak43Prototypes>>CompiledMethodPROTOTYPEencoderClass (in category 'method prototypes') -----
+ CompiledMethodPROTOTYPEencoderClass
+ <indirect>!
Item was added:
+ ----- Method: SpurBootstrapSqueak43Prototypes>>DecompilerPROTOTYPEdecompile:in:method:using: (in category 'method prototypes') -----
+ DecompilerPROTOTYPEdecompile: aSelector in: aClass method: aMethod using: aConstructor
+ <indirect>!
Item was added:
+ ----- Method: SpurBootstrapSqueak43Prototypes>>InstructionStreamPROTOTYPEinterpretExtension:in:for: (in category 'method prototypes') -----
+ InstructionStreamPROTOTYPEinterpretExtension: offset in: method for: client
+ ^self interpretV3ClosuresExtension: offset in: method for: client!
Item was added:
+ ----- Method: SpurBootstrapSqueak43Prototypes>>InstructionStreamPROTOTYPEnextPc: (in category 'method prototypes') -----
+ InstructionStreamPROTOTYPEnextPc: currentByte
+ <indirect>!
Item was added:
+ ----- Method: SpurBootstrapSqueak43Prototypes>>InstructionStreamPROTOTYPEskipCallPrimitive (in category 'method prototypes') -----
+ InstructionStreamPROTOTYPEskipCallPrimitive
+ <indirect>!
Item was added:
+ ----- Method: SpurBootstrapSqueak43Prototypes>>MCClassDefinitionPROTOTYPEkindOfSubclass (in category 'method prototypes') -----
+ MCClassDefinitionPROTOTYPEkindOfSubclass
+ <indirect>!
Item was added:
+ ----- Method: SpurBootstrapSqueak43Prototypes>>MCMethodDefinitionPROTOTYPEinitializeWithClassName:classIsMeta:selector:category:timeStamp:source: (in category 'method prototypes') -----
+ MCMethodDefinitionPROTOTYPEinitializeWithClassName: classString
+ classIsMeta: metaBoolean
+ selector: selectorString
+ category: catString
+ timeStamp: timeString
+ source: sourceString
+ <indirect>!
Item was added:
+ SpurBootstrapPrototypes subclass: #SpurBootstrapSqueakPrototypes
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Cog-Bootstrapping'!
Item was added:
+ ----- Method: SpurBootstrapSqueakPrototypes class>>imageType (in category 'accessing') -----
+ imageType
+ ^ 'squeak'!
Item was added:
+ ----- Method: SpurBootstrapSqueakPrototypes>>BehaviorPROTOTYPEidentityHash (in category 'method prototypes') -----
+ BehaviorPROTOTYPEidentityHash
+ "Answer a SmallInteger whose value is related to the receiver's identity.
+ Behavior implements identityHash to allow the VM to use an object representation which
+ does not include a direct reference to an object's class in an object. If the VM is using
+ this implementation then classes are held in a class table and instances contain the index
+ of their class in the table. A class's class table index is its identityHash so that an instance
+ can be created without searching the table for a class's index. The VM uses this primitive
+ to enter the class into the class table, assigning its identityHash with an as yet unused
+ class table index. If this primitive fails it means that the class table is full. In Spur as of
+ 2014 there are 22 bits of classTable index and 22 bits of identityHash per object.
+
+ Primitive. Essential. Do not override. See Object documentation whatIsAPrimitive."
+
+ <primitive: 175>
+ self primitiveFailed!
Item was added:
+ ----- Method: SpurBootstrapSqueakPrototypes>>BlockClosurePROTOTYPEsimulateValueWithArguments:caller: (in category 'method prototypes') -----
+ BlockClosurePROTOTYPEsimulateValueWithArguments: anArray caller: aContext
+ <indirect>!
Item was added:
+ ----- Method: SpurBootstrapSqueakPrototypes>>CharacterPROTOTYPEclone (in category 'method prototypes') -----
+ CharacterPROTOTYPEclone
+ "Answer the receiver, because Characters are unique."
+ ^self!
Item was added:
+ ----- Method: SpurBootstrapSqueakPrototypes>>ClassDescriptionPROTOTYPEupdateMethodBindingsTo: (in category 'method prototypes') -----
+ ClassDescriptionPROTOTYPEupdateMethodBindingsTo: aBinding
+ <indirect>!
Item was added:
+ ----- Method: SpurBootstrapSqueakPrototypes>>ClassPROTOTYPEimmediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'method prototypes') -----
+ ClassPROTOTYPEimmediateSubclass: t instanceVariableNames: f classVariableNames: d poolDictionaries: s category: cat
+ "This is the standard initialization message for creating a new
+ immediate class as a subclass of an existing class (the receiver)."
+ ^ClassBuilder new
+ superclass: self
+ immediateSubclass: t
+ instanceVariableNames: f
+ classVariableNames: d
+ poolDictionaries: s
+ category: cat!
Item was added:
+ ----- Method: SpurBootstrapSqueakPrototypes>>ContextPartPROTOTYPEactivateReturn:value: (in category 'method prototypes') -----
+ ContextPartPROTOTYPEactivateReturn: aContext value: value
+ "Activate 'aContext return: value' in place of self, so execution will return to aContext's sender"
+
+ ^MethodContext
+ sender: self
+ receiver: aContext
+ method: MethodContext theReturnMethod
+ arguments: {value}!
Item was added:
+ ----- Method: SpurBootstrapSqueakPrototypes>>ContextPartPROTOTYPEdoPrimitive:method:receiver:args: (in category 'method prototypes') -----
+ ContextPartPROTOTYPEdoPrimitive: primitiveIndex method: meth receiver: receiver args: arguments
+ <indirect>!
Item was added:
+ ----- Method: SpurBootstrapSqueakPrototypes>>ContextPartPROTOTYPEisPrimFailToken: (in category 'method prototypes') -----
+ ContextPartPROTOTYPEisPrimFailToken: anObject
+ <indirect>!
Item was added:
+ ----- Method: SpurBootstrapSqueakPrototypes>>ContextPartPROTOTYPEsend:to:with:lookupIn: (in category 'method prototypes') -----
+ ContextPartPROTOTYPEsend: selector to: rcvr with: arguments lookupIn: lookupClass
+ "Simulate the action of sending a message with selector and arguments
+ to rcvr. The argument, lookupClass, is the class in which to lookup the
+ message. This is the receiver's class for normal messages, but for super
+ messages it will be some specific class related to the source method."
+
+ | meth primIndex val ctxt |
+ (meth := lookupClass lookupSelector: selector) ifNil:
+ [^self send: #doesNotUnderstand:
+ to: rcvr
+ with: {Message selector: selector arguments: arguments}
+ lookupIn: lookupClass].
+ (primIndex := meth primitive) > 0 ifTrue:
+ [val := self doPrimitive: primIndex method: meth receiver: rcvr args: arguments.
+ (self isPrimFailToken: val) ifFalse:
+ [^val]].
+ (selector == #doesNotUnderstand: and: [lookupClass == ProtoObject]) ifTrue:
+ [^self error: 'Simulated message ', arguments first selector, ' not understood'].
+ ctxt := MethodContext sender: self receiver: rcvr method: meth arguments: arguments.
+ primIndex > 0 ifTrue:
+ [ctxt failPrimitiveWith: val].
+ ^ctxt!
Item was added:
+ ----- Method: SpurBootstrapSqueakPrototypes>>ContextPartPROTOTYPEsend:to:with:super: (in category 'method prototypes') -----
+ ContextPartPROTOTYPEsend: selector to: rcvr with: arguments super: superFlag
+ "Simulate the action of sending a message with selector arguments
+ to rcvr. The argument, superFlag, tells whether the receiver of the
+ message was specified with 'super' in the source method."
+
+ ^self send: selector
+ to: rcvr
+ with: arguments
+ lookupIn: (superFlag
+ ifTrue: [self method methodClassAssociation value superclass]
+ ifFalse: [self objectClass: rcvr])!
Item was added:
+ ----- Method: SpurBootstrapSqueakPrototypes>>ContextPartPROTOTYPEtryNamedPrimitiveIn:for:withArgs: (in category 'method prototypes') -----
+ ContextPartPROTOTYPEtryNamedPrimitiveIn: aCompiledMethod for: aReceiver withArgs: arguments
+ "Invoke the named primitive for aCompiledMethod, answering its result, or,
+ if the primiitve fails, answering the error code."
+ <primitive: 218 error: ec>
+ ec ifNotNil:
+ ["If ec is an integer other than -1 there was a problem with primitive 218,
+ not with the external primitive itself. -1 indicates a generic failure (where
+ ec should be nil) but ec = nil means primitive 218 is not implemented. So
+ interpret -1 to mean the external primitive failed with a nil error code."
+ ec isInteger ifTrue:
+ [ec = -1
+ ifTrue: [ec := nil]
+ ifFalse: [self primitiveFailed]]].
+ ^self class primitiveFailTokenFor: ec!
Item was added:
+ ----- Method: SpurBootstrapSqueakPrototypes>>IntegerclassPROTOTYPEinitialize (in category 'method prototypes') -----
+ IntegerclassPROTOTYPEinitialize
+ "Integer initialize"
+ self initializeLowBitPerByteTable!
Item was added:
+ ----- Method: SpurBootstrapSqueakPrototypes>>MethodContextPROTOTYPEfailPrimitiveWith: (in category 'method prototypes') -----
+ MethodContextPROTOTYPEfailPrimitiveWith: maybePrimFailToken
+ <indirect>!
Item was added:
+ ----- Method: SpurBootstrapSqueakPrototypes>>MethodContextclassPROTOTYPEallInstances (in category 'method prototypes') -----
+ MethodContextclassPROTOTYPEallInstances
+ "Answer all instances of the receiver."
+ <primitive: 177>
+ "The primitive can fail because memory is low. If so, fall back on the old
+ enumeration code, which gives the system a chance to GC and/or grow.
+ Because aBlock might change the class of inst (for example, using become:),
+ it is essential to compute next before aBlock value: inst.
+ Only count until thisContext since this context has been created only to
+ compute the existing instances."
+ | inst insts next |
+ insts := WriteStream on: (Array new: 64).
+ inst := self someInstance.
+ [inst == thisContext or: [inst == nil]] whileFalse:
+ [next := inst nextInstance.
+ insts nextPut: inst.
+ inst := next].
+ ^insts contents!
Item was added:
+ ----- Method: SpurBootstrapSqueakPrototypes>>MethodContextclassPROTOTYPEallInstancesDo: (in category 'method prototypes') -----
+ MethodContextclassPROTOTYPEallInstancesDo: aBlock
+ "Evaluate aBlock with each of the current instances of the receiver."
+ | instances inst next |
+ instances := self allInstancesOrNil.
+ instances ifNotNil:
+ [instances do: aBlock.
+ ^self].
+ "allInstancesOrNil can fail because memory is low. If so, fall back on the old
+ enumeration code. Because aBlock might change the class of inst (for example,
+ using become:), it is essential to compute next before aBlock value: inst.
+ Only count until thisContext since evaluation of aBlock will create new contexts."
+ inst := self someInstance.
+ [inst == thisContext or: [inst == nil]] whileFalse:
+ [next := inst nextInstance.
+ aBlock value: inst.
+ inst := next]!
Item was added:
+ ----- Method: SpurBootstrapSqueakPrototypes>>ProtoObjectPROTOTYPEscaledIdentityHash (in category 'method prototypes') -----
+ ProtoObjectPROTOTYPEscaledIdentityHash
+ "For identityHash values returned by primitive 75, answer
+ such values times 2^8. Otherwise, match the existing
+ identityHash implementation"
+
+ ^self identityHash * 256 "bitShift: 8"!
Item was added:
+ ----- Method: SpurBootstrapSqueakPrototypes>>SmalltalkImagePROTOTYPErecreateSpecialObjectsArray (in category 'method prototypes') -----
+ SmalltalkImagePROTOTYPErecreateSpecialObjectsArray
+ "Smalltalk recreateSpecialObjectsArray"
+
+ "To external package developers:
+ **** DO NOT OVERRIDE THIS METHOD. *****
+ If you are writing a plugin and need additional special object(s) for your own use,
+ use addGCRoot() function and use own, separate special objects registry "
+
+ "The Special Objects Array is an array of objects used by the Squeak virtual machine.
+ Its contents are critical and accesses to it by the VM are unchecked, so don't even
+ think of playing here unless you know what you are doing."
+ | newArray |
+ newArray := Array new: 60.
+ "Nil false and true get used throughout the interpreter"
+ newArray at: 1 put: nil.
+ newArray at: 2 put: false.
+ newArray at: 3 put: true.
+ "This association holds the active process (a ProcessScheduler)"
+ newArray at: 4 put: (self specialObjectsArray at: 4) "(self bindingOf: #Processor) but it answers an Alias".
+ "Numerous classes below used for type checking and instantiation"
+ newArray at: 5 put: Bitmap.
+ newArray at: 6 put: SmallInteger.
+ newArray at: 7 put: ByteString.
+ newArray at: 8 put: Array.
+ newArray at: 9 put: Smalltalk.
+ newArray at: 10 put: Float.
+ newArray at: 11 put: (self globals at: #MethodContext ifAbsent: [self globals at: #Context]).
+ newArray at: 12 put: nil. "was BlockContext."
+ newArray at: 13 put: Point.
+ newArray at: 14 put: LargePositiveInteger.
+ newArray at: 15 put: Display.
+ newArray at: 16 put: Message.
+ newArray at: 17 put: CompiledMethod.
+ newArray at: 18 put: ((self specialObjectsArray at: 18) ifNil: [Semaphore new]). "low space Semaphore"
+ newArray at: 19 put: Semaphore.
+ newArray at: 20 put: Character.
+ newArray at: 21 put: #doesNotUnderstand:.
+ newArray at: 22 put: #cannotReturn:.
+ newArray at: 23 put: nil. "This is the process signalling low space."
+ "An array of the 32 selectors that are compiled as special bytecodes,
+ paired alternately with the number of arguments each takes."
+ newArray at: 24 put: #( #+ 1 #- 1 #< 1 #> 1 #<= 1 #>= 1 #= 1 #~= 1
+ #* 1 #/ 1 #\\ 1 #@ 1 #bitShift: 1 #// 1 #bitAnd: 1 #bitOr: 1
+ #at: 1 #at:put: 2 #size 0 #next 0 #nextPut: 1 #atEnd 0 #== 1 #class 0
+ #blockCopy: 1 #value 0 #value: 1 #do: 1 #new 0 #new: 1 #x 0 #y 0 ).
+ "An array of the 255 Characters in ascii order.
+ Cog inlines table into machine code at: prim so do not regenerate it.
+ This is nil in Spur, which has immediate Characters."
+ newArray at: 25 put: (self specialObjectsArray at: 25).
+ newArray at: 26 put: #mustBeBoolean.
+ newArray at: 27 put: ByteArray.
+ newArray at: 28 put: Process.
+ "An array of up to 31 classes whose instances will have compact headers; an empty array in Spur"
+ newArray at: 29 put: self compactClassesArray.
+ newArray at: 30 put: ((self specialObjectsArray at: 30) ifNil: [Semaphore new]). "delay Semaphore"
+ newArray at: 31 put: ((self specialObjectsArray at: 31) ifNil: [Semaphore new]). "user interrupt Semaphore"
+ "Entries 32 - 34 unreferenced. Previously these contained prototype instances to be copied for fast initialization"
+ newArray at: 32 put: nil. "was the prototype Float"
+ newArray at: 33 put: nil. "was the prototype 4-byte LargePositiveInteger"
+ newArray at: 34 put: nil. "was the prototype Point"
+ newArray at: 35 put: #cannotInterpret:.
+ newArray at: 36 put: nil. "was the prototype MethodContext"
+ newArray at: 37 put: BlockClosure.
+ newArray at: 38 put: nil. "was the prototype BlockContext"
+ "array of objects referred to by external code"
+ newArray at: 39 put: (self specialObjectsArray at: 39). "external semaphores"
+ newArray at: 40 put: nil. "Reserved for Mutex in Cog VMs"
+ newArray at: 41 put: ((self specialObjectsArray at: 41) ifNil: [LinkedList new]). "Reserved for a LinkedList instance for overlapped calls in CogMT"
+ newArray at: 42 put: ((self specialObjectsArray at: 42) ifNil: [Semaphore new]). "finalization Semaphore"
+ newArray at: 43 put: LargeNegativeInteger.
+ "External objects for callout.
+ Note: Written so that one can actually completely remove the FFI."
+ newArray at: 44 put: (self at: #ExternalAddress ifAbsent: []).
+ newArray at: 45 put: (self at: #ExternalStructure ifAbsent: []).
+ newArray at: 46 put: (self at: #ExternalData ifAbsent: []).
+ newArray at: 47 put: (self at: #ExternalFunction ifAbsent: []).
+ newArray at: 48 put: (self at: #ExternalLibrary ifAbsent: []).
+ newArray at: 49 put: #aboutToReturn:through:.
+ newArray at: 50 put: #run:with:in:.
+ "51 reserved for immutability message"
+ newArray at: 51 put: #attemptToAssign:withIndex:.
+ newArray at: 52 put: #(nil "nil => generic error" #'bad receiver'
+ #'bad argument' #'bad index'
+ #'bad number of arguments'
+ #'inappropriate operation' #'unsupported operation'
+ #'no modification' #'insufficient object memory'
+ #'insufficient C memory' #'not found' #'bad method'
+ #'internal error in named primitive machinery'
+ #'object may move' #'resource limit exceeded'
+ #'object is pinned' #'primitive write beyond end of object').
+ "53 to 55 are for Alien"
+ newArray at: 53 put: (self at: #Alien ifAbsent: []).
+ newArray at: 54 put: #invokeCallbackContext::. "use invokeCallback:stack:registers:jmpbuf: for old Alien callbacks."
+ newArray at: 55 put: (self at: #UnsafeAlien ifAbsent: []).
+
+ "Used to be WeakFinalizationList for WeakFinalizationList hasNewFinalization, obsoleted by ephemeron support."
+ newArray at: 56 put: nil.
+
+ "reserved for foreign callback process"
+ newArray at: 57 put: (self specialObjectsArray at: 57 ifAbsent: []).
+
+ newArray at: 58 put: #unusedBytecode.
+ "59 reserved for Sista counter tripped message"
+ newArray at: 59 put: #conditionalBranchCounterTrippedOn:.
+ "60 reserved for Sista class trap message"
+ newArray at: 60 put: #classTrapFor:.
+
+ "Now replace the interpreter's reference in one atomic operation"
+ self specialObjectsArray becomeForward: newArray!
Item was added:
+ ----- Method: SpurBootstrapSqueakPrototypes>>SmalltalkImagePROTOTYPEsetGCParameters (in category 'method prototypes') -----
+ SmalltalkImagePROTOTYPEsetGCParameters
+ "Adjust the VM's default GC parameters to avoid too much tenuring.
+ Maybe this should be left to the VM?"
+
+ | proportion edenSize survivorSize averageObjectSize numObjects |
+ proportion := 0.9. "tenure when 90% of pastSpace is full"
+ edenSize := SmalltalkImage current vmParameterAt: 44.
+ survivorSize := edenSize / 5.0. "David's paper uses 140Kb eden + 2 x 28kb survivor spaces; Spur uses the same ratios :-)"
+ averageObjectSize := 8 * self wordSize. "a good approximation"
+ numObjects := (proportion * survivorSize / averageObjectSize) rounded.
+ SmalltalkImage current vmParameterAt: 6 put: numObjects "tenure when more than this many objects survive the GC"!
Item was added:
+ ----- Method: SpurBootstrapSqueakPrototypes>>SystemDictionaryPROTOTYPEsetGCParameters (in category 'method prototypes') -----
+ SystemDictionaryPROTOTYPEsetGCParameters
+ "Adjust the VM's default GC parameters to avoid too much tenuring.
+ Maybe this should be left to the VM?"
+
+ | proportion edenSize survivorSize averageObjectSize numObjects |
+ proportion := 0.9. "tenure when 90% of pastSpace is full"
+ edenSize := SmalltalkImage current vmParameterAt: 44.
+ survivorSize := edenSize / 5.0. "David's paper uses 140Kb eden + 2 x 28kb survivor spaces; Spur uses the same ratios :-)"
+ averageObjectSize := 8 * self wordSize. "a good approximation"
+ numObjects := (proportion * survivorSize / averageObjectSize) rounded.
+ SmalltalkImage current vmParameterAt: 6 put: numObjects "tenure when more than this many objects survive the GC"!
Item was removed:
- ----- Method: Stream>>nl (in category '*Cog-Benchmarks-Shootout-platform') -----
- nl
- self nextPut: Character lf!
Item was removed:
- ----- Method: Stream>>print:digits: (in category '*Cog-Benchmarks-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)!
Item was removed:
- ----- Method: Stream>>print:paddedTo: (in category '*Cog-Benchmarks-Shootout-platform') -----
- print: number paddedTo: width
- self nextPutAll: (number printStringLength: width padded: false)!
More information about the Vm-dev
mailing list