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

commits at source.squeak.org commits at source.squeak.org
Tue Nov 12 22:44:41 UTC 2013


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

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

Name: VMMaker.oscog-eem.508
Author: eem
Time: 12 November 2013, 2:39:57.354 pm
UUID: 55fa33b3-25f2-4d01-b2c2-02a5a5228bf7
Ancestors: VMMaker.oscog-eem.507

Add an assert to check that free chunk subdivision works correctly.

Fix the issue of integer variables assigned unsigned values but
compared against zero, but forcing these to be unsigned.  Affects
e.g. longPrintReferencesTo:.

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

Item was changed:
  ----- Method: Spur32BitMemoryManager>>allocateSlotsInOldSpace:bytes:format:classIndex: (in category 'allocation') -----
  allocateSlotsInOldSpace: numSlots bytes: totalBytes format: formatField classIndex: classIndex
  	"Answer the oop of a chunk of space in oldSpace with numSlots slots.  The header
  	 will have been filled-in but not the contents."
  	<inline: false>
  	| chunk |
  	chunk := self allocateOldSpaceChunkOfBytes: totalBytes.
  	self checkFreeSpace.
  	chunk ifNil:
  		[^nil].
  	numSlots >= self numSlotsMask ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word"
  		[self flag: #endianness.
  		 self longAt: chunk put: numSlots.
  		 self longAt: chunk + 4 put: self numSlotsMask << self numSlotsHalfShift.
  		 self longLongAt: chunk + self baseHeaderSize
  			put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex).
+ 		 self assert: (lastSubdividedFreeChunk = 0 or: [(self addressAfter: chunk + self baseHeaderSize) = lastSubdividedFreeChunk]).
  		 ^chunk + self baseHeaderSize].
  	self longLongAt: chunk put: (self headerForSlots: numSlots format: formatField classIndex: classIndex).
+ 	self assert: (lastSubdividedFreeChunk = 0 or: [(self addressAfter: chunk) = lastSubdividedFreeChunk]).
  	^chunk!

Item was changed:
  ----- Method: Spur64BitMemoryManager>>allocateSlotsInOldSpace:bytes:format:classIndex: (in category 'allocation') -----
  allocateSlotsInOldSpace: numSlots bytes: totalBytes format: formatField classIndex: classIndex
  	"Answer the oop of a chunk of space in oldSpace with numSlots slots.  The header
  	 will have been filled-in but not the contents."
  	<inline: false>
  	| chunk |
  	chunk := self allocateOldSpaceChunkOfBytes: totalBytes.
  	chunk ifNil:
  		[^nil].
  	numSlots >= self numSlotsMask ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word"
  		[self longAt: chunk
  			put: numSlots + (self numSlotsMask << self numSlotsFullShift).
  		 self longAt: chunk + self baseHeaderSize
  			put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex).
+ 		 self assert: (lastSubdividedFreeChunk = 0 or: [(self addressAfter: chunk + self baseHeaderSize) = lastSubdividedFreeChunk]).
  		 ^chunk + self baseHeaderSize].
  	self longAt: chunk
  		put: (self headerForSlots: numSlots format: formatField classIndex: classIndex).
+ 	self assert: (lastSubdividedFreeChunk = 0 or: [(self addressAfter: chunk) = lastSubdividedFreeChunk]).
  	^chunk!

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.  Break up a larger chunk if one of the
  	 exact size does not exist.  N.B.  the chunk is simply a pointer, it
  	 has no valid header.  The caller *must* fill in the header correctly."
  	| initialIndex chunk index nodeBytes parent child |
+ 	self assert: (lastSubdividedFreeChunk := 0) = 0.
  	"for debugging:" "totalFreeOldSpace := self totalFreeListBytes"
  	totalFreeOldSpace := totalFreeOldSpace - chunkBytes. "be optimistic (& don't wait for the write)"
  	initialIndex := chunkBytes / self allocationUnit.
  	(initialIndex < self numFreeLists and: [1 << initialIndex <= freeListsMask]) ifTrue:
  		[(freeListsMask anyMask: 1 << initialIndex) ifTrue:
  			[(chunk := freeLists at: initialIndex) ~= 0 ifTrue:
  				[self assert: chunk = (self startOfObject: chunk).
  				 self assert: (self isValidFreeObject: chunk).
  				^self unlinkFreeChunk: chunk atIndex: initialIndex].
  			 freeListsMask := freeListsMask - (1 << initialIndex)].
  		 "first search for free chunks of a multiple of chunkBytes in size"
  		 index := initialIndex.
  		 [(index := index + index) < self numFreeLists
  		  and: [1 << index <= freeListsMask]] whileTrue:
  			[(freeListsMask anyMask: 1 << index) ifTrue:
  				[(chunk := freeLists at: index) ~= 0 ifTrue:
  					[self assert: chunk = (self startOfObject: chunk).
  					 self assert: (self isValidFreeObject: 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)]].
  		 "now get desperate and use the first that'll fit.
  		  Note that because the minimum free size is 16 bytes (2 * allocationUnit), to
  		  leave room for the forwarding pointer/next free link, we can only break chunks
  		  that are at least 16 bytes larger, hence start at initialIndex + 2."
  		 index := initialIndex + 1.
  		 [(index := index + 1) < self numFreeLists
  		  and: [1 << index <= freeListsMask]] whileTrue:
  			[(freeListsMask anyMask: 1 << index) ifTrue:
  				[(chunk := freeLists at: index) ~= 0 ifTrue:
  					[self assert: chunk = (self startOfObject: chunk).
  					 self assert: (self isValidFreeObject: 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.
  	 When the search ends parent should hold the smallest chunk at least as
  	 large as chunkBytes, or 0 if none."
  	parent := 0.
  	child := freeLists at: 0.
  	[child ~= 0] whileTrue:
  		[| childBytes |
  		 self assert: (self isValidFreeObject: child).
  		 childBytes := self bytesInObject: child.
  		 childBytes = chunkBytes
  			ifTrue: "size match; try to remove from list at node."
  				[chunk := self fetchPointer: self freeChunkNextIndex
  								ofFreeChunk: child.
  				 chunk ~= 0 ifTrue:
  					[self assert: (self isValidFreeObject: chunk).
  					 self storePointer: self freeChunkNextIndex
  						ofFreeChunk: child
  						withValue: (self fetchPointer: self freeChunkNextIndex
  										ofFreeChunk: chunk).
  					 ^self startOfObject: chunk].
  				 child := 0] "break out of loop to remove interior node"
  			ifFalse:
  				["Note that because the minimum free size is 16 bytes (2 * allocationUnit), to
  				  leave room for the forwarding pointer/next free link, we can only break chunks
  				  that are at least 16 bytes larger, hence reject chunks < 2 * allocationUnit larger."
  				childBytes <= (chunkBytes + self allocationUnit)
  					ifTrue: "node too small; walk down the larger size of the tree"
  						[child := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: child]
  					ifFalse:
  						[parent := child. "parent will be smallest node >= chunkBytes + allocationUnit"
  						 nodeBytes := childBytes.
  						 child := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: child]]].
  	parent = 0 ifTrue:
  		[totalFreeOldSpace := totalFreeOldSpace + chunkBytes. "optimism was unfounded"
  		 ^nil].
  
  	"self printFreeChunk: parent"
  	self assert: (nodeBytes = chunkBytes or: [nodeBytes >= (chunkBytes + (2 * self allocationUnit))]).
  	self assert: (self bytesInObject: parent) = nodeBytes.
  
  	"attempt to remove from list"
  	chunk := self fetchPointer: self freeChunkNextIndex ofFreeChunk: parent.
  	chunk ~= 0 ifTrue:
  		[self assert: (chunkBytes = nodeBytes or: [chunkBytes + self allocationUnit < nodeBytes]).
  		 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 the interior node"
  	chunk := parent.
  	self unlinkSolitaryFreeTreeNode: chunk.
  
  	"if there's space left over, add the fragment back."
  	chunkBytes ~= nodeBytes ifTrue:
  		[self freeChunkWithBytes: nodeBytes - chunkBytes
  				at: (self startOfObject: chunk) + chunkBytes].
  	^self startOfObject: chunk!

Item was changed:
  ----- Method: SpurMemoryManager>>allocateOldSpaceChunkOfBytes:suchThat: (in category 'free space') -----
  allocateOldSpaceChunkOfBytes: chunkBytes suchThat: acceptanceBlock
  	"Answer a chunk of oldSpace from the free lists that satisfies acceptanceBlock,
  	 if available, otherwise answer nil.  Break up a larger chunk if one of the exact
  	 size cannot be found.  N.B.  the chunk is simply a pointer, it has no valid header.
  	 The caller *must* fill in the header correctly."
  	| initialIndex node next prev index child childBytes acceptedChunk acceptedNode |
  	<inline: true> "must inline for acceptanceBlock"
+ 	self assert: (lastSubdividedFreeChunk := 0) = 0.
  	"for debugging:" "totalFreeOldSpace := self totalFreeListBytes"
  	totalFreeOldSpace := totalFreeOldSpace - chunkBytes. "be optimistic (& don't wait for the write)"
  	initialIndex := chunkBytes / self allocationUnit.
  	(initialIndex < self numFreeLists and: [1 << initialIndex <= freeListsMask]) ifTrue:
  		[(freeListsMask anyMask: 1 << initialIndex) ifTrue:
  			[(node := freeLists at: initialIndex) = 0
  				ifTrue: [freeListsMask := freeListsMask - (1 << initialIndex)]
  				ifFalse:
  					[prev := 0.
  					 [node ~= 0] whileTrue:
  						[self assert: node = (self startOfObject: node).
  						 self assert: (self isValidFreeObject: node).
  						 next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node.
  						 (acceptanceBlock value: node) ifTrue:
  							[prev = 0
  								ifTrue: [freeLists at: initialIndex put: next]
  								ifFalse: [self storePointer: self freeChunkNextIndex ofFreeChunk: prev withValue: next].
  							 ^node].
  						 prev := node.
  						 node := next]]].
  		 "first search for free chunks of a multiple of chunkBytes in size"
  		 index := initialIndex.
  		 [(index := index + initialIndex) < self numFreeLists
  		  and: [1 << index <= freeListsMask]] whileTrue:
  			[(freeListsMask anyMask: 1 << index) ifTrue:
  				[(node := freeLists at: index) = 0
  					ifTrue: [freeListsMask := freeListsMask - (1 << index)]
  					ifFalse:
  						[prev := 0.
  						 [node ~= 0] whileTrue:
  							[self assert: node = (self startOfObject: node).
  							 self assert: (self isValidFreeObject: node).
  							 next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node.
  							 (acceptanceBlock value: node) ifTrue:
  								[prev = 0
  									ifTrue: [freeLists at: index put: next]
  									ifFalse: [self storePointer: self freeChunkNextIndex ofFreeChunk: prev withValue: next]. 
  								 self freeChunkWithBytes: index * self allocationUnit - chunkBytes
  									at: (self startOfObject: node) + chunkBytes.
  								 ^node].
  							 prev := node.
  							 node := next]]]].
  		 "now get desperate and use the first that'll fit.
  		  Note that because the minimum free size is 16 bytes (2 * allocationUnit), to
  		  leave room for the forwarding pointer/next free link, we can only break chunks
  		  that are at least 16 bytes larger, hence start at initialIndex + 2."
  		 index := initialIndex + 1.
  		 [(index := index + 1) < self numFreeLists
  		  and: [1 << index <= freeListsMask]] whileTrue:
  			[(freeListsMask anyMask: 1 << index) ifTrue:
  				[(node := freeLists at: index) = 0
  					ifTrue: [freeListsMask := freeListsMask - (1 << index)]
  					ifFalse:
  						[prev := 0.
  						 [node ~= 0] whileTrue:
  							[self assert: node = (self startOfObject: node).
  							 self assert: (self isValidFreeObject: node).
  							 next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node.
  							 (acceptanceBlock value: node) ifTrue:
  								[prev = 0
  									ifTrue: [freeLists at: index put: next]
  									ifFalse: [self storePointer: self freeChunkNextIndex ofFreeChunk: prev withValue: next]. 
  								 self freeChunkWithBytes: index * self allocationUnit - chunkBytes
  									at: (self startOfObject: node) + chunkBytes.
  								 ^node].
  							 prev := node.
  							 node := next]]]]].
  
  	"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.
  	 When the search ends parent should hold the smallest chunk at least as
  	 large as chunkBytes, or 0 if none.  acceptedChunk and acceptedNode save
  	 us from having to back-up when the acceptanceBlock filters-out all nodes
  	 of the right size, but there are nodes of the wrong size it does accept."
  	child := freeLists at: 0.
  	node := acceptedChunk := acceptedNode := 0.
  	[child ~= 0] whileTrue:
  		[self assert: (self isValidFreeObject: child).
  		 childBytes := self bytesInObject: child.
  		 childBytes = chunkBytes ifTrue: "size match; try to remove from list at node."
  			[node := child.
  			 [prev := node.
  			  node := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node.
  			  node ~= 0] whileTrue:
  				[(acceptanceBlock value: node) ifTrue:
  					[self assert: (self isValidFreeObject: node).
  					 self storePointer: self freeChunkNextIndex
  						ofFreeChunk: prev
  						withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: node).
  					 ^self startOfObject: node]].
  			 (acceptanceBlock value: child) ifTrue:
  				[next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: child.
  				 next = 0
  					ifTrue: "no list; remove the interior node"
  						[self unlinkSolitaryFreeTreeNode: child]
  					ifFalse: "list; replace node with it"
  						[self inFreeTreeReplace: child with: next].
  				 ^self startOfObject: child]].
  		 child ~= 0 ifTrue:
  			["Note that because the minimum free size is 16 bytes (2 * allocationUnit), to
  			  leave room for the forwarding pointer/next free link, we can only break chunks
  			  that are at least 16 bytes larger, hence reject chunks < 2 * allocationUnit larger."
  			childBytes <= (chunkBytes + self allocationUnit)
  				ifTrue: "node too small; walk down the larger size of the tree"
  					[child := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: child]
  				ifFalse:
  					[self flag: 'we can do better here; preferentially choosing the lowest node. That would be a form of best-fit since we are trying to compact down'.
  					 acceptedNode = 0 ifTrue:
  						[acceptedChunk := child.
  						 "first search the list."
  						 [acceptedChunk := self fetchPointer: self freeChunkNextIndex
  													ofFreeChunk: acceptedChunk.
  						  (acceptedChunk ~= 0 and: [acceptanceBlock value: acceptedChunk]) ifTrue:
  							[acceptedNode := child].
  						  acceptedChunk ~= 0 and: [acceptedNode = 0]] whileTrue.
  						 "nothing on the list; will the node do?  This prefers
  						  acceptable nodes higher up the tree over acceptable
  						  list elements further down, but we haven't got all day..."
  						 (acceptedNode = 0
  						  and: [acceptanceBlock value: child]) ifTrue:
  							[acceptedNode := child]].
  					 child := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: child]]].
  
  	acceptedNode ~= 0 ifTrue:
  		[acceptedChunk ~= 0 ifTrue:
  			[self assert: (self bytesInObject: acceptedChunk) >= (chunkBytes + self allocationUnit).
  			 [next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: acceptedNode.
  			  next ~= acceptedChunk] whileTrue:
  				[acceptedNode := next].
  			 self storePointer: self freeChunkNextIndex
  				ofFreeChunk: acceptedNode
  				withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: acceptedChunk).
  			self freeChunkWithBytes: (self bytesInObject: acceptedChunk) - chunkBytes
  					at: (self startOfObject: acceptedChunk) + chunkBytes.
  			^self startOfObject: acceptedChunk].
  		next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: acceptedNode.
  		next = 0
  			ifTrue: "no list; remove the interior node"
  				[self unlinkSolitaryFreeTreeNode: acceptedNode]
  			ifFalse: "list; replace node with it"
  				[self inFreeTreeReplace: acceptedNode with: next].
  		 self assert: (self bytesInObject: acceptedNode) >= (chunkBytes + self allocationUnit).
  		 self freeChunkWithBytes: (self bytesInObject: acceptedNode) - chunkBytes
  				at: (self startOfObject: acceptedNode) + chunkBytes.
  		^self startOfObject: acceptedNode].
  
  	totalFreeOldSpace := totalFreeOldSpace + chunkBytes. "optimism was unfounded"
  	^nil!

Item was changed:
  ----- Method: SpurMemoryManager>>firstFitCompact (in category 'compaction') -----
  firstFitCompact
  	"Compact all of memory above firstFreeChunk using first-fit, assuming free
  	 space is sorted and that as many of the the highest objects as will fit are
  	 recorded in highestObjects.  Don't move pinned objects.
  	 Note that we don't actually move; we merely copy and forward.  Eliminating
  	 forwarders will be done in a final pass."
  
  	<inline: false>
  	| first nhits nmisses |
  	self checkFreeSpace.
  	totalFreeOldSpace = 0 ifTrue: [^self].
  	highestObjects isEmpty ifTrue:
  		[^self].
  	nhits := nmisses  := 0.
  	[statCompactPassCount := statCompactPassCount + 1.
  	 highestObjects reverseDo:
  		[:o| | b |
  		 o <= firstFreeChunk ifTrue:
  			[coInterpreter print: 'firstFitCompact fits: '; printNum: nhits; print: ' misfits: '; printNum: nmisses; cr.
  			 ^self].
  		 ((self isForwarded: o) or: [self isPinned: o]) ifFalse:
  			[b := self bytesInObject: o.
  			 (self allocateOldSpaceChunkOfBytes: b suchThat: [:f| f < o])
  				ifNil:
  					[nmisses := nmisses + 1]
  				ifNotNil:
  					[:f|
  					 nhits := nhits + 1.
+ 					 self copyAndForward: o withBytes: b toFreeChunk: f.
+ 					 self assert: (lastSubdividedFreeChunk = 0
+ 								  or: [(self addressAfter: (self objectStartingAt: f)) = lastSubdividedFreeChunk])]]].
- 					 self copyAndForward: o withBytes: b toFreeChunk: f]]].
  	 self checkFreeSpace.
  	 first := self longAt: highestObjects first.
  	 self assert: first > firstFreeChunk.
  	 self findFirstFreeChunkPostCompactionPass.
  	 self fillHighestObjectsWithMovableObjectsFrom: firstFreeChunk upTo: first.
  	 highestObjects usedSize > 0] whileTrue.
  
  	coInterpreter print: 'firstFitCompact fits: '; printNum: nhits; print: ' misfits: '; printNum: nmisses; cr!

Item was changed:
  ----- Method: SpurMemoryManager>>freeChunkWithBytes:at: (in category 'free space') -----
  freeChunkWithBytes: bytes at: address
  	<inline: false>
  	| freeChunk |
+ 	self assert: (lastSubdividedFreeChunk := address) ~= 0.
  	freeChunk := self initFreeChunkWithBytes: bytes at: address.
  	self addToFreeList: freeChunk bytes: bytes.
+ 	self assert: freeChunk = (self objectStartingAt: address).
  	^freeChunk!

Item was added:
+ ----- Method: TAssignmentNode>>variableNameOrNil (in category 'accessing') -----
+ variableNameOrNil
+ 	^variable variableNameOrNil!

Item was changed:
  ----- Method: TMethod>>inferTypesForImplicitlyTypedVariablesIn: (in category 'type inference') -----
  inferTypesForImplicitlyTypedVariablesIn: aCodeGen
  	parseTree nodesDo:
+ 		[:node| | type var m |
+ 		"If there is something of the form i >= 0, then i should be signed, not unsigned."
+ 		(node isSend
+ 		 and: [(locals includes: (var := node receiver variableNameOrNil))
+ 		 and: [(#(<= < >= >) includes: node selector)
+ 		 and: [node args first isConstant
+ 		 and: [node args first value = 0
+ 		 and: [(type := self typeFor: var in: aCodeGen) notNil
+ 		 and: [type first == $u]]]]]]) ifTrue:
+ 			[declarations at: var put: (declarations at: var) allButFirst].
+ 		"if an assignment of a known send, set the variable's type to the return type of the send."
- 		[:node| | var m |
  		(node isAssignment
  		 and: [(locals includes: (var := node variable name))
  		 and: [(declarations includesKey: var) not
  		 and: [node expression isSend
  		 and: [(m := aCodeGen methodNamed: node expression selector) notNil]]]]) ifTrue:
  			[(#(sqInt void nil) includes: m returnType) ifFalse:
  				["the $: is to map things like unsigned field : 3 to usqInt"
  				 declarations
  					at: var
  					put: ((m returnType includes: $:) ifTrue: [#usqInt] ifFalse: [m returnType]), ' ', var]]]!

Item was added:
+ ----- Method: TParseNode>>variableNameOrNil (in category 'accessing') -----
+ variableNameOrNil
+ 	"Overridden in TAssignmentNode & TVariableNode to answer their variable name."
+ 	^nil!

Item was added:
+ ----- Method: TVariableNode>>variableNameOrNil (in category 'accessing') -----
+ variableNameOrNil
+ 	^name!



More information about the Vm-dev mailing list