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

commits at source.squeak.org commits at source.squeak.org
Sun Sep 22 16:15:52 UTC 2013 

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

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

Name: VMMaker.oscog-eem.402
Author: eem
Time: 22 September 2013, 9:12:45.57 am
UUID: 1609c567-42bc-4442-8d9e-ab5df5c7d4ca
Ancestors: VMMaker.oscog-eem.401

Implement low space handling and space queries to SpurMemMgr.
Maintain totalFreeOldSpace in a variable.

Rewrite primitiveIncrementalGC to interface to Spur.

Fix assert in iframeInstructionPointerForIndex:method:
BytesPerWord => BytesPerOop in initialPCForHeader:method:

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

Item was changed:
  ----- Method: Spur32BitMemoryManager>>allocateSlots:format:classIndex: (in category 'allocation') -----
  allocateSlots: numSlots format: formatField classIndex: classIndex
  	| numBytes newObj |
  	"Object headers are 8 bytes in length if the slot size fits in the num slots field (max implies overflow),
  	 16 bytes otherwise (slot size in preceeding word).
  	 Objects always have at least one slot, for the forwarding pointer,
  	 and are multiples of 8 bytes in length."
  	numSlots >= self numSlotsMask
  		ifTrue:
  			[newObj := freeStart + self baseHeaderSize.
  			 numBytes := self baseHeaderSize + self baseHeaderSize "double header"
  						+ (numSlots + (numSlots bitAnd: 1) * self bytesPerSlot)] "roundTo allocationUnit"
  		ifFalse:
  			[newObj := freeStart.
  			 numBytes := self baseHeaderSize "single header"
  						+ (numSlots <= 1
  							ifTrue: [self allocationUnit] "at least one slot for the forwarding pointer"
  							ifFalse: [numSlots + (numSlots bitAnd: 1) * self bytesPerSlot])]. "roundTo allocationUnit"
  	self assert: numBytes \\ self allocationUnit = 0.
  	freeStart + numBytes > scavengeThreshold ifTrue:
+ 		[needGCFlag ifFalse: [self scheduleScavenge].
+ 		 freeStart + numBytes > scavenger eden limit ifTrue:
+ 			[^self allocateSlotsInOldSpace: numSlots format: formatField classIndex: classIndex]].
- 		[freeStart + numBytes > scavenger eden limit ifTrue:
- 			[^self allocateSlotsInOldSpace: numSlots format: formatField classIndex: classIndex].
- 		 self scheduleScavenge].
  	numSlots >= self numSlotsMask
  		ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word"
  			[self flag: #endianness.
  			 self longAt: freeStart put: numSlots.
  			 self longAt: freeStart + 4 put: self numSlotsMask << self numSlotsHalfShift.
  			 self longLongAt: newObj put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex)]
  		ifFalse:
  			[self longLongAt: newObj put: (self headerForSlots: numSlots format: formatField classIndex: classIndex)].
  	self assert: numBytes \\ self allocationUnit = 0.
  	self assert: newObj \\ self allocationUnit = 0.
  	freeStart := freeStart + numBytes.
  	^newObj!

Item was changed:
  ----- Method: Spur64BitMemoryManager>>allocateSlots:format:classIndex: (in category 'allocation') -----
  allocateSlots: numSlots format: formatField classIndex: classIndex
  	| numBytes newObj |
  	"Object headers are 8 bytes in length if the slot size fits in the num slots field (max implies overflow),
  	 16 bytes otherwise (num slots in preceeding word).
  	 Objects always have at least one slot, for the forwarding pointer,
  	 and are multiples of 8 bytes in length."
  	numSlots >= self numSlotsMask
  		ifTrue:
  			[numSlots > 16rffffffff ifTrue:
  				[^nil].
  			 newObj := freeStart + self baseHeaderSize.
  			 numBytes := (self baseHeaderSize + self baseHeaderSize) "double header"
  						+ (numSlots * self bytesPerSlot)]
  		ifFalse:
  			[newObj := freeStart.
  			 numBytes := self baseHeaderSize "single header"
  						+ (numSlots < 1
  							ifTrue: [self allocationUnit] "at least one slot for the forwarding pointer"
  							ifFalse: [numSlots * self bytesPerSlot])].
  	
  	freeStart + numBytes > scavengeThreshold ifTrue:
+ 		[needGCFlag ifFalse: [self scheduleScavenge].
+ 		 freeStart + numBytes > scavenger eden limit ifTrue:
+ 			[^self allocateSlotsInOldSpace: numSlots format: formatField classIndex: classIndex]].
- 		[freeStart + numBytes > scavenger eden limit ifTrue:
- 			[^self allocateSlotsInOldSpace: numSlots format: formatField classIndex: classIndex].
- 		 self scheduleScavenge].
  	numSlots >= self numSlotsMask
  		ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word"
  			[self flag: #endianness.
  			 self longAt: freeStart put: numSlots.
  			 self longAt: freeStart + 4 put: self numSlotsMask << self numSlotsHalfShift.
  			 self longLongAt: newObj put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex)]
  		ifFalse:
  			[self longLongAt: newObj put: (self headerForSlots: numSlots format: formatField classIndex: classIndex)].
  		freeStart := freeStart + numBytes.
  	^newObj!

Item was changed:
  CogClass subclass: #SpurMemoryManager
(excessive size, no diff calculated)

Item was changed:
  ----- Method: SpurMemoryManager>>allocateOldSpaceChunkOfBytes: (in category 'free space') -----
  allocateOldSpaceChunkOfBytes: chunkBytes
  	"Answer a chunk of oldSpace from the free lists, if available,
  	 otherwise answer nil.  N.B.  the chunk is simply a pointer, it has
  	 no valid header.  The caller *must* fill in the header correctly."
  	| index chunk nextIndex nodeBytes parent child smaller larger |
+ 	totalFreeOldSpace := totalFreeOldSpace - chunkBytes. "be optimistic (& don't wait for the write)"
  	index := chunkBytes / self allocationUnit.
  	(index < NumFreeLists and: [1 << index >= freeListsMask]) ifTrue:
  		[(chunk := freeLists at: index) ~= 0 ifTrue:
  			[self assert: chunk = (self startOfObject: chunk).
  			^self unlinkFreeChunk: chunk atIndex: index].
  		 "first search for free chunks of a multiple of chunkBytes in size"
  		 nextIndex := index.
  		 [1 << index >= freeListsMask
  		  and: [(nextIndex := nextIndex + index) < NumFreeLists]] whileTrue:
  			[((freeListsMask anyMask: 1 << index)
  			 and: [(chunk := freeLists at: index) ~= 0]) ifTrue:
  				[self assert: chunk = (self startOfObject: chunk).
  				 self unlinkFreeChunk: chunk atIndex: index.
  				 self assert: (self bytesInObject: chunk) = index * self allocationUnit.
  				 self freeChunkWithBytes: index * self allocationUnit - chunkBytes
  					at: (self startOfObject: chunk) + chunkBytes.
  				^chunk]].
  		 "now get desperate and use the first that'll fit"
  		 nextIndex := index.
  		 [1 << index >= freeListsMask
  		  and: [(nextIndex := nextIndex + 1) < NumFreeLists]] whileTrue:
  			[(freeListsMask anyMask: 1 << index) ifTrue:
  				[(chunk := freeLists at: index) ~= 0 ifTrue:
  					[self assert: chunk = (self startOfObject: chunk).
  					 self unlinkFreeChunk: chunk atIndex: index.
  					 self assert: (self bytesInObject: chunk) = index * self allocationUnit.
  					 self freeChunkWithBytes: index * self allocationUnit - chunkBytes
  						at: (self startOfObject: chunk) + chunkBytes.
  					^chunk].
  				 freeListsMask := freeListsMask - (1 << index)]]].
  
  	"Large chunk, or no space on small free lists.  Search the large chunk list.
  	 Large chunk list organized as a tree, each node of which is a list of chunks
  	 of the same size. Beneath the node are smaller and larger blocks."
  	parent := 0.
  	child := freeLists at: 0.
  	[child ~= 0] whileTrue:
  		[nodeBytes := self bytesInObject: child.
  		 parent := child.
  		 nodeBytes = chunkBytes
  			ifTrue: "size match; try to remove from list at node."
  				[chunk := self fetchPointer: self freeChunkNextIndex
  								ofFreeChunk: child.
  				 chunk ~= 0 ifTrue:
  					[self storePointer: self freeChunkNextIndex
  						ofFreeChunk: child
  						withValue: (self fetchPointer: self freeChunkNextIndex
  										ofFreeChunk: chunk).
  					 ^chunk].
  				 child := 0] "break out of loop to remove interior node"
  			ifFalse:"walk down the tree"
  				[child := self fetchPointer: (nodeBytes > chunkBytes
  												ifTrue: [self freeChunkSmallerIndex]
  												ifFalse: [self freeChunkLargerIndex])
  								ofFreeChunk: child]].
  	parent = 0 ifTrue:
+ 		[totalFreeOldSpace := totalFreeOldSpace + chunkBytes. "optimism was unfounded"
+ 		 self halt].
+ 
- 		[self halt].
  	"self printFreeChunk: parent"
  	self assert: (self bytesInObject: parent) = nodeBytes.
  	"attempt to remove from list"
  	chunk := self fetchPointer: self freeChunkNextIndex
  					ofFreeChunk: parent.
  	chunk ~= 0 ifTrue:
  		[self storePointer: self freeChunkNextIndex
  			ofFreeChunk: parent
  			withValue: (self fetchPointer: self freeChunkNextIndex
  							ofFreeChunk: chunk).
  		 chunkBytes ~= nodeBytes ifTrue:
  			[self freeChunkWithBytes: nodeBytes - chunkBytes
  					at: (self startOfObject: chunk) + chunkBytes].
  		 ^self startOfObject: chunk].
  	"no list; remove an interior node"
  	chunk := parent.
  	parent := self fetchPointer: self freeChunkParentIndex ofFreeChunk: chunk.
  	"no parent; stitch the subnodes back into the root"
  	parent = 0 ifTrue:
  		[smaller := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: chunk.
  		 larger := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: chunk.
  		 smaller = 0
  			ifTrue: [freeLists at: 0 put: larger]
  			ifFalse:
  				[freeLists at: 0 put: smaller.
  				 larger ~= 0 ifTrue:
  					[self addFreeSubTree: larger]].
  		"coInterpreter transcript ensureCr.
  		 coInterpreter print: 'new free tree root '.
  		 (freeLists at: 0) = 0 ifTrue: [coInterpreter print: '0'] ifFalse: [self printFreeChunk: (freeLists at: 0)].
  		 coInterpreter cr."
  		 chunkBytes ~= nodeBytes ifTrue:
  			[self freeChunkWithBytes: nodeBytes - chunkBytes
  					at: (self startOfObject: chunk) + chunkBytes].
  		 ^self startOfObject: chunk].
  	"remove node from tree; reorder tree simply.  two cases (which have mirrors, for four total):
  	 case 1. interior node has one child, P = parent, N = node, S = subtree (mirrored for large vs small)
  			___				  ___
  			| P |				  | P |
  		    _/_				_/_
  		    | N |		=>		| S |
  		 _/_
  		 | S |"
  	self halt.
  	"case 2: interior node has two children, , P = parent, N = node, L = smaller, left subtree, R = larger, right subtree.
  	 add the left subtree to the bottom left of the right subtree (mirrored for large vs small) 
  			___				  ___
  			| P |				  | P |
  		    _/_				_/_
  		    | N |		=>		| R |
  		 _/_  _\_		    _/_
  		 | L | | R |		    | L |"
  	self halt!

Item was added:
+ ----- Method: SpurMemoryManager>>bytesInFreeTree: (in category 'free space') -----
+ bytesInFreeTree: freeNode
+ 	| freeBytes bytesInObject next |
+ 	freeNode = 0 ifTrue: [^0].
+ 	freeBytes := 0.
+ 	bytesInObject := self bytesInObject: freeNode.
+ 	self assert: bytesInObject / self allocationUnit >= NumFreeLists.
+ 	next := freeNode.
+ 	[next ~= 0] whileTrue:
+ 		[freeBytes := freeBytes + bytesInObject.
+ 		 self assert: bytesInObject = (self bytesInObject: next).
+ 		 next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: next].
+ 	^freeBytes
+ 	+ (self bytesInFreeTree: (self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: next))
+ 	+ (self bytesInFreeTree: (self fetchPointer: self freeChunkLargerIndex ofFreeChunk: next))!

Item was added:
+ ----- Method: SpurMemoryManager>>bytesLeft: (in category 'free space') -----
+ bytesLeft: includeSwapSpace
+ 	"Answer the amount of available free space. If includeSwapSpace is true, include
+ 	 possibly available swap space. If includeSwapSpace is false, include possibly available
+ 	 physical memory. For a report on the largest free block currently availabe within
+ 	 Squeak memory but not counting extra memory use #primBytesLeft."
+ 	^totalFreeOldSpace
+ 	+ (scavenger eden limit - freeStart)
+ 	+ (scavenger pastSpace limit - pastSpaceStart)
+ 	+ (scavenger futureSpace limit - scavenger futureSpace limit)!

Item was added:
+ ----- Method: SpurMemoryManager>>classMutex (in category 'plugin support') -----
+ classMutex
+ 	^self splObj: ClassMutex!

Item was added:
+ ----- Method: SpurMemoryManager>>classSemaphore (in category 'plugin support') -----
+ classSemaphore
+ 	^self splObj: ClassSemaphore!

Item was changed:
  ----- Method: SpurMemoryManager>>freeObject: (in category 'free space') -----
  freeObject: objOop
+ 	| bytes |
+ 	bytes := self bytesInObject: objOop.
+ 	totalFreeOldSpace := totalFreeOldSpace + bytes.
+ 	^self freeChunkWithBytes: bytes at: (self startOfObject: objOop)!
- 	^self freeChunkWithBytes: (self bytesInObject: objOop) at: (self startOfObject: objOop)!

Item was changed:
  ----- Method: SpurMemoryManager>>freeSize (in category 'free space') -----
  freeSize
+ 	^totalFreeOldSpace!
- 	self flag: #temporary.
- 	^0!

Item was changed:
  ----- Method: SpurMemoryManager>>initialize (in category 'initialization') -----
  initialize
  	"We can put all initializatins that set something to 0 or to false here.
  	 In C all global variables are initialized to 0, and 0 is false."
  	freeLists := CArrayAccessor on: (Array new: NumFreeLists withAll: 0).
  	remapBuffer := Array new: RemapBufferSize.
  	remapBufferCount := 0.
+ 	freeListsMask := totalFreeOldSpace := lowSpaceThreshold := 0.
- 	freeListsMask := 0.
  	checkForLeaks := 0.
  	needGCFlag := signalLowSpace := scavengeInProgress := false.
  	becomeEffectsFlags := 0.
  	statScavenges := statIncrGCs := statFullGCs := 0.
  	statScavengeGCUsecs := statIncrGCUsecs := statFullGCUsecs := 0.
  	statSGCDeltaUsecs := statIGCDeltaUsecs := statFGCDeltaUsecs := 0.
  
  	"We can also initialize here anything that is only for simulation."
  	heapMap := self wordSize = 4 ifTrue: [CogCheck32BitHeapMap new]!

Item was changed:
  ----- Method: SpurMemoryManager>>initializeOldSpaceFirstFree: (in category 'free space') -----
  initializeOldSpaceFirstFree: startOfFreeOldSpace
  	<var: 'startOfFreeOldSpace' type: #usqLong>
  	| freeOldStart freeChunk |
  	<var: 'freeOldStart' type: #usqLong>
  	freeOldStart := startOfFreeOldSpace.
  	[endOfMemory - freeOldStart >= (2 raisedTo: 32)] whileTrue:
  		[freeChunk := self freeChunkWithBytes: (2 raisedTo: 32) at: freeOldStart.
  		freeOldStart := freeOldStart + (2 raisedTo: 32).
  		self assert: freeOldStart = (self addressAfter: freeChunk)].
  	freeOldStart < endOfMemory ifTrue:
  		[freeChunk := self freeChunkWithBytes: endOfMemory - freeOldStart at: freeOldStart.
  		 self assert: (self addressAfter: freeChunk) = endOfMemory].
+ 	freeOldSpaceStart := endOfMemory.
+ 	self assert: totalFreeOldSpace = self totalFreeListBytes!
- 	freeOldSpaceStart := endOfMemory!

Item was added:
+ ----- Method: SpurMemoryManager>>lowSpaceThreshold: (in category 'free space') -----
+ lowSpaceThreshold: threshold
+ 	lowSpaceThreshold := threshold.
+ 	totalFreeOldSpace < threshold ifTrue:
+ 		[self growOldSpaceByAtLeast: threshold - totalFreeOldSpace].
+ 	self assert: totalFreeOldSpace >= lowSpaceThreshold!

Item was added:
+ ----- Method: SpurMemoryManager>>scavengingGC (in category 'generation scavenging') -----
+ scavengingGC
+ 	"Run the scavenger."
+ 
+ 	self assert: remapBufferCount = 0.
+ 	self assert: self totalFreeListBytes = totalFreeOldSpace.
+ 	"coInterpreter printCallStackFP: coInterpreter framePointer"
+ 
+ 	self runLeakCheckerForFullGC: false.
+ 	coInterpreter preGCAction: GCModeIncr.
+ 	needGCFlag := false.
+ 
+ 	gcStartUsecs := coInterpreter ioUTCMicrosecondsNow.
+ 
+ 	scavengeInProgress := true.
+ 	pastSpaceStart := scavenger scavenge.
+ 	self assert: (self
+ 					oop: pastSpaceStart
+ 					isGreaterThanOrEqualTo: scavenger pastSpace start
+ 					andLessThanOrEqualTo: scavenger pastSpace limit).
+ 	freeStart := scavenger eden start.
+ 	self initSpaceForAllocationCheck: scavenger eden.
+ 	scavengeInProgress := false.
+ 
+ 	statScavenges := statScavenges + 1.
+ 	statGCEndUsecs := coInterpreter ioUTCMicrosecondsNow.
+ 	statSGCDeltaUsecs := statGCEndUsecs - gcStartUsecs.
+ 	statScavengeGCUsecs := statScavengeGCUsecs + statSGCDeltaUsecs.
+ 
+ 	coInterpreter postGCAction.
+ 	self runLeakCheckerForFullGC: false.
+ 
+ 	self assert: self totalFreeListBytes = totalFreeOldSpace!

Item was changed:
  ----- Method: SpurMemoryManager>>sufficientSpaceAfterGC: (in category 'generation 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."
- 	 we run the scavenger."
- 	self assert: numBytes = 0.
- 	self assert: remapBufferCount = 0.
- 	"coInterpreter printCallStackFP: coInterpreter framePointer"
  
+ 	self assert: numBytes = 0.
+ 	self scavengingGC.
+ 	lowSpaceThreshold > totalFreeOldSpace ifTrue: "space is low"
+ 		[lowSpaceThreshold := 0. "avoid signalling low space twice"
+ 		 ^false].
- 	self runLeakCheckerForFullGC: false.
- 	coInterpreter preGCAction: GCModeIncr.
- 	needGCFlag := false.
- 
- 	gcStartUsecs := coInterpreter ioUTCMicrosecondsNow.
- 
- 	scavengeInProgress := true.
- 	pastSpaceStart := scavenger scavenge.
- 	self assert: (self
- 					oop: pastSpaceStart
- 					isGreaterThanOrEqualTo: scavenger pastSpace start
- 					andLessThanOrEqualTo: scavenger pastSpace limit).
- 	freeStart := scavenger eden start.
- 	self initSpaceForAllocationCheck: scavenger eden.
- 	scavengeInProgress := false.
- 
- 	statScavenges := statScavenges + 1.
- 	statGCEndUsecs := coInterpreter ioUTCMicrosecondsNow.
- 	statSGCDeltaUsecs := statGCEndUsecs - gcStartUsecs.
- 	statScavengeGCUsecs := statScavengeGCUsecs + statSGCDeltaUsecs.
- 
- 	coInterpreter postGCAction.
- 	self runLeakCheckerForFullGC: false.
- 
  	^true!

Item was added:
+ ----- Method: SpurMemoryManager>>totalFreeListBytes (in category 'free space') -----
+ totalFreeListBytes
+ 	| freeBytes bytesInObject obj |
+ 	freeBytes := 0.
+ 	1 to: NumFreeLists - 1 do:
+ 		[:i| 
+ 		bytesInObject := i * self allocationUnit.
+ 		obj := freeLists at: i.
+ 		[obj ~= 0] whileTrue:
+ 			[freeBytes := freeBytes + bytesInObject.
+ 			 self assert: bytesInObject = (self bytesInObject: obj).
+ 			 obj := self fetchPointer: self freeChunkNextIndex ofFreeChunk: obj]].
+ 	^freeBytes + (self bytesInFreeTree: (freeLists at: 0))!

Item was changed:
  ----- Method: StackInterpreter>>iframeInstructionPointerForIndex:method: (in category 'frame access') -----
  iframeInstructionPointerForIndex: ip method: aMethod
  	"Answer the instruction pointer for use in an interpreter frame (a pointer to a bytecode)."
+ 	self assert: (ip between: (((LiteralStart + (self literalCountOf: aMethod)) * BytesPerOop)) + 1
- 	self assert: (ip between: (objectMemory lastPointerOf: aMethod) - 1
  					and: (objectMemory lengthOf: aMethod)).
  	^aMethod + ip + objectMemory baseHeaderSize - 2!

Item was changed:
  ----- Method: StackInterpreter>>initialPCForHeader:method: (in category 'compiled methods') -----
  initialPCForHeader: methodHeader method: theMethod
  	<api>
+ 	^theMethod
+ 	+ ((LiteralStart + (self literalCountOfHeader: methodHeader)) * BytesPerOop)
+ 	+ objectMemory baseHeaderSize!
- 	^theMethod + ((LiteralStart + (self literalCountOfHeader: methodHeader)) * BytesPerWord) + BaseHeaderSize!

Item was changed:
  ----- Method: StackInterpreterPrimitives>>primitiveIncrementalGC (in category 'memory space primitives') -----
  primitiveIncrementalGC
  	"Do a quick, incremental garbage collection and return the number of bytes immediately available.
  	 (Note: more space may be made available by doing a full garbage collection."
  
  	self externalWriteBackHeadFramePointers.
+ 	objectMemory hasSpurMemoryManagerAPI
+ 		ifTrue: [objectMemory scavengingGC]
+ 		ifFalse: [objectMemory incrementalGC].
- 	objectMemory incrementalGC.
  	self pop: 1 thenPushInteger: (objectMemory bytesLeft: false)!

Item was changed:
  ----- Method: StackInterpreterSimulator>>primitiveIdentityHash (in category 'debugging traps') -----
  primitiveIdentityHash
+ 	"| oop |
- 	| oop |
  	oop := self stackTop.
  	((objectMemory isBytes: oop)
  	and: [(objectMemory lengthOf: oop) = 'smallSelect' size
  	and: [(self stringOf: oop) = 'smallSelect']]) ifTrue:
+ 		[self halt]."
- 		[self halt].
  	^super primitiveIdentityHash!

More information about the Vm-dev mailing list