VM Maker: VMMaker.oscog-eem.728.mcz

 
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]!