[squeak-dev] The Trunk: System.spur-dtl.672.mcz

commits at source.squeak.org commits at source.squeak.org
Mon Jul 7 12:53:00 UTC 2014


Eliot Miranda uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System.spur-dtl.672.mcz

==================== Summary ====================

Name: System.spur-dtl.672
Author: eem
Time: 3 July 2014, 7:25:41.94 am
UUID: c3c31cd5-8d13-4f3b-aeb7-ac795e5ad660
Ancestors: System-dtl.672

System-dtl.672 patched for Spur by SpurBootstrapMonticelloPackagePatcher Cog-eem.163

Provide DateAndTme>>floor so that ObjectHistoryMark does not need to use instVarAt:put: to obtain a time stamp with whole seconds. This protects for future changes to DateAndTime that may not rely on an instance variable named #nanos.

=============== Diff against System-dtl.672 ===============

Item was changed:
  ----- Method: SmalltalkImage>>compactClassesArray (in category 'special objects') -----
  compactClassesArray
  	"Smalltalk compactClassesArray"
+ 	"Backward-compatibility support.  Spur does not have compact classes."
+ 	^{}!
- 	"Return the array of 31 classes whose instances may be
- 	represented compactly"
- 	^ self specialObjectsArray at: 29!

Item was added:
+ ----- Method: SmalltalkImage>>growMemoryByAtLeast: (in category 'as yet unclassified') -----
+ growMemoryByAtLeast: 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: SmalltalkImage>>maxIdentityHash (in category 'as yet unclassified') -----
+ maxIdentityHash
+ 	"Answer the maximum identityHash value supported by the VM."
+ 	<primitive: 176>
+ 	^self primitiveFailed!

Item was changed:
  ----- Method: SmalltalkImage>>setGCParameters (in category 'snapshot and quit') -----
  setGCParameters
+ 	"Adjust the VM's default GC parameters to avoid too much tenuring.
+ 	 Maybe this should be left to the VM?"
- 	"Adjust the VM's default GC parameters to avoid premature tenuring."
  
+ 	| 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"!
- 	self vmParameterAt: 5 put: 4000.  "do an incremental GC after this many allocations"
- 	self vmParameterAt: 6 put: 2000.  "tenure when more than this many objects survive the GC"
- !

Item was changed:
  ----- Method: SpaceTally>>spaceForInstancesOf: (in category 'instance size') -----
  spaceForInstancesOf: 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."
- 	"Answer 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)].
- 	| smallHeaderSize instVarBytes isVariable bytesPerElement  total lastInstance instance instanceCount |
- 	instance := aClass someInstance ifNil: [ ^#(0 0) ].	
- 	smallHeaderSize := aClass isCompact ifTrue: [ 4 ] ifFalse: [ 8 ].
- 	instVarBytes := aClass instSize * 4.
- 	isVariable := aClass isVariable.
- 	bytesPerElement := isVariable
- 		ifFalse: [ 0 ]
- 		ifTrue: [ aClass isBytes ifTrue: [ 1 ] ifFalse: [ 4 ] ].
  	total := 0.
+ 	aClass isVariable
+ 		ifTrue:
+ 			[instances do:
+ 				[:i| total := total + (aClass byteSizeOfInstanceOfSize: i basicSize)]]
+ 		ifFalse:
+ 			[total := instances size * aClass byteSizeOfInstance].
+ 	^{ total. instances size }!
- 	instanceCount := 0.
- 	"A modified version of #allInstancesDo: is inlined here. It avoids an infinite loop when another process is creating new instances of aClass."
- 	self flag: #allInstancesDo:.
- 	lastInstance :=
- 		aClass == CompiledMethod "CompiledMethod has special format, see its class comment"
- 			ifTrue: [aClass new]
- 			ifFalse: [aClass basicNew].
- 	[ instance == lastInstance ] whileFalse: [
- 		| contentBytes headerBytes |
- 		contentBytes := instVarBytes + (isVariable
- 			ifFalse: [ 0 ]
- 			ifTrue: [ instance basicSize * bytesPerElement ]).
- 		headerBytes := contentBytes > 255
- 			ifTrue: [ 12 ]
- 			ifFalse: [ smallHeaderSize ].
- 		total := total + headerBytes + (contentBytes roundUpTo: 4).
- 		instanceCount := instanceCount + 1.
- 		instance := instance nextInstance ].
- 	^{ total. instanceCount }!

Item was added:
+ ----- Method: SystemDictionary>>growMemoryByAtLeast: (in category 'as yet unclassified') -----
+ growMemoryByAtLeast: 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: SystemDictionary>>maxIdentityHash (in category 'as yet unclassified') -----
+ maxIdentityHash
+ 	"Answer the maximum identityHash value supported by the VM."
+ 	<primitive: 176>
+ 	^self primitiveFailed!

Item was added:
+ ----- Method: SystemDictionary>>setGCParameters (in category 'as yet unclassified') -----
+ setGCParameters
+ 	"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: SystemNavigation>>allObjects (in category 'as yet unclassified') -----
+ allObjects
+ 	"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 changed:
  ----- Method: SystemNavigation>>allObjectsDo: (in category 'query') -----
  allObjectsDo: 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]]!
- 	"Evaluate the argument, aBlock, for each object in the system 
- 	excluding SmallIntegers. With closures, this needs to use an end
- 	marker (lastObject) since activation of the block will create new 
- 	contexts and cause an infinite loop."
- 	| object lastObject |
- 	object := self someObject.
- 	lastObject := Object new.
- 	[lastObject == object or: [0 == object]]
- 		whileFalse: [aBlock value: object.
- 			object := object nextObject]!

Item was added:
+ ----- Method: SystemNavigation>>allObjectsOrNil (in category 'as yet unclassified') -----
+ allObjectsOrNil
+ 	"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!



More information about the Squeak-dev mailing list