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

commits at source.squeak.org commits at source.squeak.org
Tue Nov 12 19:47:55 UTC 2013 

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

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

Name: VMMaker.oscog-eem.507
Author: eem
Time: 12 November 2013, 11:45:01.849 am
UUID: 0cc40be1-4ec6-4be1-823f-4d7ed85aed05
Ancestors: VMMaker.oscog-eem.506

Keep bridges marked in notePinned:, called in fUOASACFS.

Support growth in sufficientSpaceAfterGC:.

Add a segLimit accessor to simplify segment code.

Add Integer>>asUnsignedLong for simulation.

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

Item was added:
+ ----- Method: Integer>>asUnsignedLong (in category '*VMMaker-interpreter simulator') -----
+ asUnsignedLong
+ 	self assert: self >= 0.
+ 	^self!

Item was changed:
  ----- Method: Spur32BitCoMemoryManager>>assimilateNewSegment: (in category 'growing/shrinking memory') -----
  assimilateNewSegment: segInfo
  	"Update after adding a segment.
  	 Here we make sure the new segment is not executable."
  	<var: #segInfo type: #'SpurSegmentInfo *'>
+ 	coInterpreter sqMakeMemoryNotExecutableFrom: segInfo segStart To: segInfo segLimit!
- 	coInterpreter
- 		sqMakeMemoryNotExecutableFrom: segInfo segStart
- 		To: segInfo segStart + segInfo segSize!

Item was changed:
  ----- Method: SpurMemoryManager>>assimilateNewSegment: (in category 'growing/shrinking memory') -----
  assimilateNewSegment: segInfo
  	"Update after adding a segment.
  	 Here we set freeOldSpaceStart & endOfMemory if required."
  	<var: #segInfo type: #'SpurSegmentInfo *'>
  	segInfo segStart >= endOfMemory ifTrue:
  		[freeOldSpaceStart :=
+ 		 endOfMemory := segInfo segLimit - self bridgeSize]!
- 		 endOfMemory := segInfo segStart + segInfo segSize - self bridgeSize]!

Item was changed:
  ----- Method: SpurMemoryManager>>freeUnmarkedObjectsAndSortAndCoalesceFreeSpace (in category 'gc - global') -----
  freeUnmarkedObjectsAndSortAndCoalesceFreeSpace
  	"Sweep all of old space, freeing unmarked objects, coalescing free chunks, and sorting free space.
  
  	 Small free chunks are sorted in address order on each small list head.  Large free chunks
  	 are sorted on the sortedFreeChunks list.  Record as many of the highest objects as there
  	 is room for in highestObjects, a circular buffer, for the use of exactFitCompact.  Use
  	 unused eden space for highestObjects.  If highestObjects does not wrap, store 0
  	 at highestObjects last.  Record the lowest free object in firstFreeChunk.  Let the
  	 segmentManager mark which segments contain pinned objects via notePinned:."
  
  	| lastLargeFree lastHighest highestObjectsWraps sortedFreeChunks |
  	<var: #lastHighest type: #usqInt>
  	self checkFreeSpace.
  	scavenger forgetUnmarkedRememberedObjects.
  	segmentManager prepareForGlobalSweep."for notePinned:"
  	"for sorting free space throw away the list heads, rebuilding them for small free chunks below."
  	self resetFreeListHeads.
  	highestObjects initializeStart: freeStart limit: scavenger eden limit.
  	lastHighest := highestObjects last "a.k.a. freeStart - wordSize".
  	highestObjectsWraps := 0.
  	self assert: highestObjects limit - highestObjects start // self wordSize >= 1024.
  	firstFreeChunk := sortedFreeChunks := lastLargeFree := 0.
  	"Note that if we were truly striving for performance we could split the scan into
  	 two phases, one up to the first free object and one after, which would remove
  	 the need to test firstFreeChunk when filling highestObjects."
  	self allOldSpaceEntitiesForCoalescingDo:
  		[:o|
  		(self isMarked: o)
  			ifTrue: "forwarders should have been followed in markAndTrace:"
  				[self assert: (self isForwarded: o) not.
+ 				 self setIsMarkedOf: o to: false. "this will unmark bridges. undo the damage in notePinned:"
- 				 self setIsMarkedOf: o to: false.
  				 (self isPinned: o) ifTrue:
  					[segmentManager notePinned: o].
  				 firstFreeChunk ~= 0 ifTrue:
  					[false "conceptually...: "
  						ifTrue: [highestObjects addLast: o]
  						ifFalse: "but we inline so we can use the local lastHighest"
  							[(lastHighest := lastHighest + self wordSize) >= highestObjects limit ifTrue:
  								[highestObjectsWraps := highestObjectsWraps + 1].
  							 self longAt: lastHighest put: o]]]
  			ifFalse: "unmarked; two cases, an unreachable object or a free chunk."
  				[| here next |
  				 self assert: (self isRemembered: o) not. "scavenger should have cleared this above"
  				 here := o.
  				 next := self objectAfter: here limit: endOfMemory.
  				 (self isMarked: next) ifFalse: "coalescing; rare case"
  					[self assert: (self isRemembered: o) not.
  					 [statCoalesces := statCoalesces + 1.
  					  here := self coalesce: here and: next.
  					  next := self objectAfter: here limit: endOfMemory.
  					  next = endOfMemory or: [self isMarked: next]] whileFalse].
  				 self setFree: here.
  				 firstFreeChunk = 0 ifTrue:
  					[firstFreeChunk := here].
  				 (self isLargeFreeObject: here)
  					ifTrue:
  						[lastLargeFree = 0
  							ifTrue: [sortedFreeChunks := here]
  							ifFalse:
  								[self setFree: here.
  								 self storePointer: self freeChunkNextAddressIndex ofFreeChunk: lastLargeFree withValue: here].
  						 lastLargeFree := here]
  					ifFalse:
  						[self freeSmallObject: here]]].
  	highestObjects last: lastHighest.
  	highestObjectsWraps ~= 0 ifTrue:
  		[highestObjects first: (lastHighest + self wordSize >= highestObjects limit
  								ifTrue: [highestObjects start]
  								ifFalse: [lastHighest + self wordSize])].
  	lastLargeFree ~= 0 ifTrue:
  		[self storePointer: self freeChunkNextAddressIndex ofFreeChunk: lastLargeFree withValue: 0].
  	totalFreeOldSpace := self reverseSmallListHeads.
  	totalFreeOldSpace := totalFreeOldSpace + (self rebuildFreeTreeFrom: sortedFreeChunks).
  	self checkFreeSpace.
  	self touch: highestObjectsWraps!

Item was changed:
  ----- Method: SpurMemoryManager>>sufficientSpaceAfterGC: (in category 'gc - scavenging') -----
  sufficientSpaceAfterGC: numBytes
  	"This is ObjectMemory's funky entry-point into its incremental GC,
  	 which is a stop-the-world a young generation reclaimer.  In Spur
  	 we run the scavenger.  Answer if space is not low."
  
  	self assert: numBytes = 0.
  	self scavengingGCTenuringIf: TenureByAge.
+ 	[totalFreeOldSpace < growHeadroom
+ 	 and: [(self growOldSpaceByAtLeast: 0) notNil]] whileTrue:
+ 		[totalFreeOldSpace >= growHeadroom ifTrue:
+ 			[^true]].
  	lowSpaceThreshold > totalFreeOldSpace ifTrue: "space is low"
  		[lowSpaceThreshold := 0. "avoid signalling low space twice"
  		 ^false].
  	^true!

Item was added:
+ ----- Method: SpurSegmentInfo>>segLimit (in category 'accessing') -----
+ segLimit
+ 	^segSize + segStart!

Item was changed:
  ----- Method: SpurSegmentManager>>addSegmentOfSize: (in category 'growing/shrinking memory') -----
  addSegmentOfSize: ammount
  	<returnTypeC: #'SpurSegmentInfo *'>
  	<inline: false>
  	| allocatedSize |
  	<var: #newSeg type: #'SpurSegmentInfo *'>
  	<var: #segAddress type: #'void *'>
  	(manager "sent to the manager so that the simulator can increase memory to simulate a new segment"
  			sqAllocateMemorySegmentOfSize: ammount
+ 			Above: (segments at: 0) segLimit asVoidPointer
- 			Above: ((segments at: 0) segStart + (segments at: 0) segSize) asVoidPointer
  			AllocatedSizeInto: (self cCode: [self addressOf: allocatedSize]
  									inSmalltalk: [[:sz| allocatedSize := sz]])) ifNotNil:
  		[:segAddress| | newSegIndex newSeg |
  		 newSegIndex := self insertSegmentFor: segAddress asUnsignedLong.
  		 newSeg := self addressOf: (segments at: newSegIndex).
  		 newSeg
  			segStart: segAddress;
  			segSize: allocatedSize.
  		 self bridgeFrom: (self addressOf: (segments at: newSegIndex - 1)) to: newSeg.
  		 self bridgeFrom: newSeg to: (newSegIndex = (numSegments - 1) ifFalse:
  										[self addressOf: (segments at: newSegIndex + 1)]).
  		 "and add the new free chunk to the free list; done here
  		  instead of in assimilateNewSegment: for the assert"
  		 manager addFreeChunkWithBytes: allocatedSize - manager bridgeSize at: newSeg segStart.
  		 self assert: (manager addressAfter: (manager objectStartingAt: newSeg segStart))
+ 					= (newSeg segLimit - manager bridgeSize).
- 					= (newSeg segStart + newSeg segSize - manager bridgeSize).
  		 ^newSeg].
  	^nil!

Item was changed:
  ----- Method: SpurSegmentManager>>allBridgesMarked (in category 'debug support') -----
  allBridgesMarked
  	0 to: numSegments - 1 do:
  		[:i| | bridgeObj |
+ 		 bridgeObj := (segments at: i) segLimit - manager baseHeaderSize.
- 		 bridgeObj := (segments at: i) segStart
- 					 + (segments at: i) segSize
- 					 - manager baseHeaderSize.
  		 self assert: (manager isSegmentBridge: bridgeObj).
  		 (manager isMarked: bridgeObj) ifFalse:
  			[^false]].
  	^true
  
  	"for debugging:"
  	"(0 to: numSegments - 1) select:
  		[:i| | bridgeObj |
  		 bridgeObj := (segments at: i) segStart
  					 + (segments at: i) segSize
  					 - manager baseHeaderSize.
  		 self assert: (manager isSegmentBridge: bridgeObj).
  		 manager isMarked: bridgeObj]"!

Item was changed:
  ----- Method: SpurSegmentManager>>bridgeFrom:to: (in category 'growing/shrinking memory') -----
  bridgeFrom: aSegment to: nextSegmentOrNil
  	"Create a bridge from aSegment to the next segment,
  	 or create a terminating bridge if there is no next segment."
  	<var: #aSegment type: #'SpurSegmentInfo *'>
  	<var: #nextSegmentOrNil type: #'SpurSegmentInfo *'>
  	| segEnd clifton bridgeSpan |
+ 	segEnd := aSegment segLimit.
- 	segEnd := aSegment segStart + aSegment segSize.
  	clifton := segEnd - manager bridgeSize. "clifton is where the Avon bridge begins..."
  	bridgeSpan := nextSegmentOrNil
  					ifNil: [manager bridgeSize]
  					ifNotNil: [nextSegmentOrNil segStart - segEnd + manager bridgeSize].
  	manager initSegmentBridgeWithBytes: bridgeSpan at: clifton.
  	"the revised bridge should get us to the new segment"
  	self assert: (nextSegmentOrNil isNil
  				 or: [(manager addressAfter: (manager objectStartingAt: clifton)) = nextSegmentOrNil segStart])
  !

Item was changed:
  ----- Method: SpurSegmentManager>>collapseSegmentsPostSwizzle (in category 'snapshot') -----
  collapseSegmentsPostSwizzle
  	"The image has been loaded, old segments reconstructed, and the heap
  	 swizzled into a single contiguous segment.  Collapse the segments into one."
  	<inline: false>
  	| bridge |
  	canSwizzle := false.
  	firstSegmentSize ifNil: "true when used by SpurBootstrap to transform an image"
  		[^self].
  
  	numSegments := 1.
  	(segments at: 0)
  		segStart: manager newSpaceLimit;
  		segSize: manager endOfMemory - manager newSpaceLimit.
  	"finally plant a bridge at the end of the coalesced segment and cut back the
  	 manager's notion of the end of memory to immediately before the bridge."
  	bridge := manager endOfMemory - manager bridgeSize.
+ 	self assert: bridge = ((segments at: 0) segLimit - manager bridgeSize).
- 	self assert: bridge = ((segments at: 0) segStart
- 						  + (segments at: 0) segSize
- 						  -  manager bridgeSize).
  	manager
  		initSegmentBridgeWithBytes: manager bridgeSize at: bridge;
  		setEndOfMemory: bridge!

Item was changed:
  ----- Method: SpurSegmentManager>>insertSegmentFor: (in category 'growing/shrinking memory') -----
  insertSegmentFor: segAddress
  	"Reserve a new segInfo for segAddress.  If segAddress
  	 is in the middle of the existing segments, shuffle them
  	 up to make room. Answer the new segment's index."
  	| segIndex lastSegIndex |
+ 	self assert: segAddress > (segments at: 0) segLimit.
- 	self assert: segAddress > ((segments at: 0) segStart + (segments at: 0) segSize).
  	numSegments = numSegInfos ifTrue:
  		[self allocateOrExtendSegmentInfos].
  	self assert: numSegments < numSegInfos.
  	segIndex := lastSegIndex := numSegments - 1.
  	numSegments := numSegments + 1.
+ 	[segAddress > (segments at: segIndex) segLimit ifTrue:
- 	[segAddress > ((segments at: segIndex) segStart
- 					+ (segments at: segIndex) segSize) ifTrue:
  		[segIndex := segIndex + 1.
  		 lastSegIndex to: segIndex by: -1 do:
  			[:idx| segments at: idx + 1 put: (segments at: idx)].
  		 ^segIndex].
  	 segIndex := segIndex - 1]
  		repeat!

Item was changed:
  ----- Method: SpurSegmentManager>>isInSegments: (in category 'testing') -----
  isInSegments: address
  	<var: #address type: #usqInt>
  	0 to: numSegments - 1 do:
  		[:i|
  		address < (segments at: i) segStart ifTrue:
  			[^false].
+ 		address < (segments at: i) segLimit ifTrue:
- 		address < ((segments at: i) segStart + (segments at: i) segSize) ifTrue:
  			[^true]].
  	^false!

Item was changed:
  ----- Method: SpurSegmentManager>>notePinned: (in category 'pinning') -----
  notePinned: objOop
  	"Let the segmentManager mark which segments contain pinned objects"
  	self assert: (manager isPinned: objOop).
+ 	(manager isSegmentBridge: objOop)
+ 		ifTrue:
+ 			[manager setIsMarkedOf: objOop to: true]
+ 		ifFalse:
+ 			[[(segments at: sweepIndex) segLimit < objOop] whileTrue:
+ 				[sweepIndex := sweepIndex + 1].
+ 			 (segments at: sweepIndex) containsPinned: true]!
- 	(manager isSegmentBridge: objOop) ifFalse:
- 		[[(segments at: sweepIndex) segStart + (segments at: sweepIndex) segSize < objOop] whileTrue:
- 			[sweepIndex := sweepIndex + 1].
- 		 (segments at: sweepIndex) containsPinned: true]!

Item was changed:
  ----- Method: SpurSegmentManager>>writeSegment:nextSegmentSize:toFile: (in category 'snapshot') -----
  writeSegment: aSpurSegmentInfo nextSegmentSize: nextSegSize toFile: aBinaryStream
  	<var: 'aSpurSegmentInfo' type: #'SpurSegmentInfo *'>
  	<var: 'aBinaryStream' type: #'FILE *'>
  	| bridge savedHeader nWritten |
  	<var: 'savedHeader' type: #usqLong>
+ 	bridge := aSpurSegmentInfo segLimit - manager baseHeaderSize.
- 	bridge := aSpurSegmentInfo segStart + aSpurSegmentInfo segSize - manager baseHeaderSize.
  	"last seg may be beyond endOfMemory/freeOldSpaceStart"
  	self assert: ((manager isValidSegmentBridge: bridge) or: [nextSegSize = 0]).
  	savedHeader := manager longLongAt: bridge.
  	manager longLongAt: bridge put: nextSegSize.
  	nWritten := self cCode:
  						[self
  							sq: aSpurSegmentInfo segStart
  							Image: 1
  							File: aSpurSegmentInfo segSize
  							Write: aBinaryStream]
  					inSmalltalk:
  						[aBinaryStream
  							next: aSpurSegmentInfo segSize / 4
  							putAll: manager memory
  							startingAt: aSpurSegmentInfo segStart / 4 + 1.
  						 aSpurSegmentInfo segSize].
  	manager longLongAt: bridge put: savedHeader.
  	^nWritten!

More information about the Vm-dev mailing list