[Vm-dev] VM Maker: VMMaker.oscog-eem.728.mcz

[commits at source.squeak.org]

Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.728.mcz

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

Name: VMMaker.oscog-eem.728
Author: eem
Time: 21 May 2014, 11:01:45.177 am
UUID: 706ecf52-7165-4829-bfb3-8a9ac4f29216
Ancestors: VMMaker.oscog-eem.727

Spur:
Implement memory shrinkage.
Check free space around SpurSegmentManager
prepareForSnapshot & postSnapshot.

=============== Diff against VMMaker.oscog-eem.727 ===============

Item was changed:
  ----- Method: SpurMemoryManager>>garbageCollectForSnapshot (in category 'snapshot') -----
  garbageCollectForSnapshot
  	self flushNewSpace. "There is no place to put newSpace in the snapshot file."
  	self fullGC.
+ 	segmentManager prepareForSnapshot.
+ 	self checkFreeSpace!
- 	segmentManager prepareForSnapshot!

Item was added:
+ ----- Method: SpurMemoryManager>>setLastSegment: (in category 'growing/shrinking memory') -----
+ setLastSegment: segInfo
+ 	"Update after removing a segment.
+ 	 Here we cut back endOfMemory if required."
+ 	<var: #segInfo type: #'SpurSegmentInfo *'>
+ 	| currentEnd |
+ 	<var: #currentEnd type: #usqInt>
+ 	currentEnd := segInfo segLimit - self bridgeSize.
+ 	currentEnd <= endOfMemory ifTrue:
+ 		[endOfMemory := currentEnd.
+ 		 freeOldSpaceStart > currentEnd ifTrue:
+ 			[freeOldSpaceStart :=currentEnd]]!

Item was changed:
  ----- Method: SpurMemoryManager>>shrinkObjectMemory: (in category 'growing/shrinking memory') -----
+ shrinkObjectMemory: delta
- shrinkObjectMemory: delta 
  	"Attempt to shrink the object memory by the given delta amount."
+ 	<doNotGenerate>
+ 	segmentManager shrinkObjectMemory: delta!
- 	self cCode: [self print: 'shrinkObjectMemory: shouldBeImplemented'; cr]
- 		inSmalltalk: [self shouldBeImplemented]!

Item was changed:
  ----- Method: SpurMemoryManager>>sqAllocateMemorySegmentOfSize:Above:AllocatedSizeInto: (in category 'simulation only') -----
  sqAllocateMemorySegmentOfSize: segmentSize Above: minAddress AllocatedSizeInto: allocSizePtrOrBlock
  	<doNotGenerate>
  	"Simulate heap growth by growing memory by segmentSize + a delta.
  	 To test bridges alternate the delta between 0 bytes and 1M bytes
  	 depending on the number of segments.
  	 The delta will be the distance between segments to be bridged."
  	| delta newMemory start |
  	delta := segmentManager numSegments odd ifTrue: [1024 * 1024] ifFalse: [0].
+ 	"A previous shrink may have freed up memory.  Don't bother to grow if there's already room."
+ 	segmentManager lastSegment segLimit + segmentSize + delta <= (memory size * 4) ifTrue:
+ 		[allocSizePtrOrBlock value: segmentSize.
+ 		 ^minAddress + delta].
  	start := memory size * 4 + delta.
  	newMemory := memory class new: memory size + (segmentSize + delta / 4).
  	newMemory replaceFrom: 1 to: memory size with: memory startingAt: 1.
  	memory := newMemory.
  	allocSizePtrOrBlock value: segmentSize.
  	^start!

Item was added:
+ ----- Method: SpurMemoryManager>>sqDeallocateMemorySegmentAt:ofSize: (in category 'simulation only') -----
+ sqDeallocateMemorySegmentAt: startAddress ofSize: ammount
+ 	"This is a nop in the simulator."
+ 	<doNotGenerate>!

Item was added:
+ ----- Method: SpurSegmentManager>>findEmptySegNearestInSizeTo: (in category 'growing/shrinking memory') -----
+ findEmptySegNearestInSizeTo: size
+ 	| seg best delta |
+ 	<var: #seg type: #'SegmentInfo *'>
+ 	best := nil.
+ 	delta := size.
+ 	0 to: numSegments - 1 do:
+ 		[:i|
+ 		seg := self addressOf: (segments at: i).
+ 		(self isEmptySegment: seg) ifTrue:
+ 			[best
+ 				ifNil: [best := seg]
+ 				ifNotNil:
+ 					[(size >= (seg segSize * 0.75)
+ 					 and: [(seg segSize - size) abs < delta]) ifTrue:
+ 						[best := seg. delta := (seg segSize - size) abs]]]].
+ 	^best!

Item was added:
+ ----- Method: SpurSegmentManager>>indexOfSegment: (in category 'growing/shrinking memory') -----
+ indexOfSegment: seg
+ 	<var: #seg type: #'SegmentInfo *'>
+ 	0 to: numSegments - 1 do:
+ 		[:i|
+ 		seg segStart = (segments at: i) segStart ifTrue:
+ 			[^i]].
+ 	self error: 'segment not found'!

Item was added:
+ ----- Method: SpurSegmentManager>>isEmptySegment: (in category 'growing/shrinking memory') -----
+ isEmptySegment: seg
+ 	<var: #seg type: #'SegmentInfo *'>
+ 	| firstObj |
+ 	firstObj := manager objectStartingAt: seg segStart.
+ 	^(manager isFreeObject: firstObj)
+ 	  and: [(manager addressAfter: firstObj) = (seg segLimit - manager bridgeSize)]!

Item was added:
+ ----- Method: SpurSegmentManager>>lastSegment (in category 'accessing') -----
+ lastSegment
+ 	^segments at: numSegments - 1!

Item was changed:
  ----- Method: SpurSegmentManager>>postSnapshot (in category 'snapshot') -----
  postSnapshot
  	"Restore all shortened segments to their proper size, re-freeing the trailing space."
  	<inline: false>
  	| seg |
  	<var: #seg type: #'SpurSegmentInfo *'>
  	"Set endOfMemory first, to avoid assert fails in freeChunkWithBytes:at:."
  	seg := self addressOf: (segments at: numSegments - 1).
  	seg lastFreeObject
  		ifNil: [self assert: manager endOfMemory = (seg segLimit - manager bridgeSize)]
  		ifNotNil: [manager setEndOfMemory: seg savedSegSize + seg segStart - manager bridgeSize].
  
  	numSegments - 1 to: 0 by: -1 do:
  		[:i|
  		 seg := self addressOf: (segments at: i).
  		 seg lastFreeObject ifNotNil:
  			[:freeChunk| | address |
  			address := seg segLimit - manager bridgeSize.
  			seg segSize: seg savedSegSize.
  			self bridgeFrom: seg
  				to: (i < (numSegments - 1) ifTrue: [self addressOf: (segments at: i + 1)]).
  			manager
  				addFreeChunkWithBytes: seg segLimit - address - manager bridgeSize
+ 				at: address]]..
+ 	manager checkFreeSpace!
- 				at: address]]!

Item was added:
+ ----- Method: SpurSegmentManager>>removeSegment: (in category 'growing/shrinking memory') -----
+ removeSegment: emptySeg
+ 	<var: #emptySeg type: #'SpurSegmentInfo *'>
+ 	| i |
+ 	i := self indexOfSegment: emptySeg.
+ 	self assert: i > 0.
+ 
+ 	manager sqDeallocateMemorySegmentAt: emptySeg segStart ofSize: emptySeg segSize.
+ 
+ 	i to: numSegments - 1 do:
+ 		[:j| segments at: j put: (segments at: j + 1)].
+ 	self cCode: [] inSmalltalk: [segments at: numSegments - 1 put: SpurSegmentInfo new].
+ 	numSegments := numSegments - 1.
+ 
+ 	self bridgeFrom: (self addressOf: (segments at: i - 1))
+ 		to: (i <= (numSegments - 1) ifTrue: [self addressOf: (segments at: i)]).
+ 
+ 	manager setLastSegment: (self addressOf: (segments at: numSegments - 1))!

Item was added:
+ ----- Method: SpurSegmentManager>>shrinkObjectMemory: (in category 'growing/shrinking memory') -----
+ shrinkObjectMemory: delta
+ 	| shrinkage emptySeg |
+ 	<var: #emptySeg type: #'SegmentInfo *'>
+ 	shrinkage := delta.
+ 	[emptySeg := self findEmptySegNearestInSizeTo: shrinkage.
+ 	 emptySeg notNil] whileTrue:
+ 		[shrinkage := shrinkage - emptySeg segSize.
+ 		 manager detachFreeObject: (manager objectStartingAt: emptySeg segStart).
+ 		 self removeSegment: emptySeg]!