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

commits at source.squeak.org commits at source.squeak.org
Fri May 2 23:19:29 UTC 2014 

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

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

Name: VMMaker.oscog-eem.699
Author: eem
Time: 2 May 2014, 4:16:50.068 pm
UUID: d19fe4fd-f2b0-4779-9ed6-7b9ea20c5255
Ancestors: VMMaker.oscog-eem.698

VM:
Fix instantiation of large non-byet objects.  The old code
for sufficientSpaceToInstantiate:indexableSize: stupidly
subtracted BytesPerWord instead of ShiftForWord from
LongSizeNumBits in determining the max size (mea culpa).

Slang: fix indent of expressions in do whiles.

Spur:
Add more asserts to pigCompact to help debug the
edge case of compacting into the firstFreeChunk.

Make nextInSortedFreeListLink:given: available as a C func
for debugging.

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

Item was changed:
  ----- Method: CCodeGenerator>>generateDoWhileFalse:on:indent: (in category 'C translation') -----
  generateDoWhileFalse: msgNode on: aStream indent: level
  	"Generate do {stmtList} while(!!(cond))"
  
  	| testStmt receiverWithoutTest |
  	testStmt := msgNode receiver statements last.
  	receiverWithoutTest := TStmtListNode new setStatements: msgNode receiver statements allButLast.
  	aStream nextPutAll: 'do {'; cr.
  	receiverWithoutTest emitCCodeOn: aStream level: level + 1 generator: self.
  	aStream tab: level.
  	aStream nextPutAll: '} while(!!('.
+ 	testStmt emitCCodeAsExpressionOn: aStream level: level + 1 generator: self.
- 	testStmt emitCCodeAsExpressionOn: aStream level: 0 generator: self.
  	aStream nextPutAll: '))'!

Item was changed:
  ----- Method: CCodeGenerator>>generateDoWhileTrue:on:indent: (in category 'C translation') -----
  generateDoWhileTrue: msgNode on: aStream indent: level
  	"Generate do {stmtList} while(cond)"
  
  	| testStmt receiverWithoutTest |
  	testStmt := msgNode receiver statements last.
  	receiverWithoutTest := TStmtListNode new setStatements: msgNode receiver statements allButLast.
  	aStream nextPutAll: 'do {'; cr.
  	receiverWithoutTest emitCCodeOn: aStream level: level + 1 generator: self.
  	aStream tab: level.
  	aStream nextPutAll: '} while('.
+ 	testStmt emitCCodeAsExpressionOn: aStream level: level + 1 generator: self.
- 	testStmt emitCCodeAsExpressionOn: aStream level: 0 generator: self.
  	aStream nextPut: $)!

Item was changed:
  ----- Method: CCodeGenerator>>generateWhileForeverBreakIf:loop:on:indent: (in category 'C translation') -----
  generateWhileForeverBreakIf: breakBoolean loop: msgNode on: aStream indent: level
  	"Generate either of
  		while(1) {stmtListA; if(cond) break; stmtListB}
  		while(1) {stmtListA; if(!!(cond)) break; stmtListB}."
  
  	| testStmt receiverWithoutTest |
  	aStream peekLast ~~ Character tab ifTrue:
  		[aStream tab: level - 1].
  	aStream nextPutAll: 'while (1) {'; cr.
  	testStmt := msgNode receiver statements last.
  	receiverWithoutTest := TStmtListNode new setStatements: msgNode receiver statements allButLast.
  	receiverWithoutTest emitCCodeOn: aStream level: level + 1 generator: self.
  	aStream tab: level + 1; nextPutAll: 'if ('.
  	breakBoolean ifFalse: [aStream nextPut: $!!; nextPut: $(].
+ 	testStmt emitCCodeAsExpressionOn: aStream level: level + 1 generator: self.
- 	testStmt emitCCodeAsExpressionOn: aStream level: 0 generator: self.
  	breakBoolean ifFalse: [aStream nextPut: $)].
  	aStream nextPutAll: ') break;'; cr.
  	msgNode args first emitCCodeOn: aStream level: level + 1 generator: self.
  	aStream tab: level; nextPut: $}!

Item was changed:
  ----- Method: ObjectMemory>>sufficientSpaceToInstantiate:indexableSize: (in category 'allocation') -----
  sufficientSpaceToInstantiate: classOop indexableSize: size 
  	"Return the number of bytes required to allocate an instance of the given class with the given number of indexable fields."
  	"Details: For speed, over-estimate space needed for fixed fields or literals; the low space threshold is a blurry line."
  	<var: #size type: #usqInt>
  	| format allocSize |
  	<inline: true>
  	(format := self instSpecOfClass: classOop) < self firstByteFormat
  		ifTrue:
  			["indexable fields are words or pointers"
  			size ~= 0 ifTrue:
  				["fail if attempting to call new: on non-indexable class"
  				 format < self arrayFormat ifTrue:
  					[^false].
  				 "fail if attempting to allocate over 2 Gb, since this overflows 32-bit arithmetic"
+ 				 size >> (LongSizeNumBits - ShiftForWord) > 0 ifTrue:
- 				 size >> (LongSizeNumBits - BytesPerWord) > 0 ifTrue:
  					[^false]].
  			allocSize := size * BytesPerWord]
  		ifFalse:
  			["indexable fields are bytes"
  			 "fail if attempting to allocate over 2 Gb, since this overflows 32-bit arithmetic"
  			 size >> LongSizeNumBits > 0 ifTrue:
  				[^false].
  			allocSize := size].
  	^self sufficientSpaceToAllocate: 2500 + allocSize!

Item was changed:
  ----- Method: SpurMemoryManager>>checkTraversableSortedFreeList (in category 'simulation only') -----
  checkTraversableSortedFreeList
  	| prevFree freeChunk next |
+ 	<api>
+ 	<inline: false>
  	prevFree := 0.
  	freeChunk := firstFreeChunk.
  	self allOldSpaceEntitiesDo:
  		[:o| | objOop |
  		(self isFreeObject: o) ifTrue:
  			[self assert: o = freeChunk.
  			 next := self nextInSortedFreeListLink: freeChunk given: prevFree.
  			 "coInterpreter transcript cr; print: freeChunk; tab; print: o; tab; print: prevFree; nextPutAll: '<->'; print: next; flush."
  			 objOop := freeChunk.
  			 [(objOop := self objectAfter: objOop) < next] whileTrue:
  				[self assert: (self isFreeObject: objOop) not].
  			 prevFree := freeChunk.
  			 freeChunk := next]].
  	self assert: prevFree = lastFreeChunk.
  	self assert: freeChunk = 0!

Item was changed:
  ----- Method: SpurMemoryManager>>moveARunOfObjectsStartingAt:upTo: (in category 'compaction') -----
  moveARunOfObjectsStartingAt: startAddress upTo: limit 
  	"Move the sequence of movable objects starting at startAddress.  Answer the start
  	 of the next sequence of movable objects after a possible run of unmovable objects,
  	 or the limit, if there are no more movable objects, or 0 if no more compaction can be
  	 done. Compaction is done when the search through the freeList has reached the
  	 address from which objects are being moved from.
  
  	 There are two broad cases to be dealt with here.  One is a run of smallish objects
  	 that can easily be moved into free chunks.  The other is a large object that is unlikely
  	 to fit in the typical free chunk. This second pig needs careful handling; it needs to be
  	 moved to the lowest place it will fit and not cause the scan to skip lots of smaller
  	 free chunks looking in vain for somewhere to put it."
  	| here hereObj hereObjHeader prevPrevFreeChunk prevFreeChunk thisFreeChunk maxFreeChunk |
  	here := startAddress.
  	hereObj := self objectStartingAt: startAddress.
  	hereObjHeader := self atLeastClassIndexHalfHeader: hereObj.
  	prevPrevFreeChunk := prevFreeChunk := 0.
  	thisFreeChunk := maxFreeChunk := firstFreeChunk.
  	[thisFreeChunk ~= 0] whileTrue:
  		[| freeBytes endOfFree nextFree destination there moved |
  
+ 		 "skip any initial immobile objects"
  		 [(self isMobileObjectHeader: hereObjHeader)] whileFalse:
  			[here := self addressAfter: hereObj.
  			 here >= limit ifTrue:
  				[^maxFreeChunk >= startAddress ifTrue: [0] ifFalse: [limit]].
  			 hereObj := self objectStartingAt: here.
+ 			 hereObjHeader := self atLeastClassIndexHalfHeader: hereObj].
- 			  hereObjHeader := self atLeastClassIndexHalfHeader: hereObj].
  
+ 		 "grab a free chunk, and the following one, because we want to overwrite this one."
+ 		 self assert: ((self isFreeObject: firstFreeChunk) and: [self isFreeObject: thisFreeChunk]).
  		 freeBytes		:= self bytesInObject: thisFreeChunk.
  		 nextFree		:= self nextInSortedFreeListLink: thisFreeChunk given: prevFreeChunk.
  		 destination	:= self startOfObject: thisFreeChunk.
  		 endOfFree		:= destination + freeBytes.
  		 moved			:= false.
  		 maxFreeChunk	:= maxFreeChunk max: nextFree.
+ 		 self assert: (nextFree = 0 or: [self isFreeObject: nextFree]).
  
  		"move as many objects as will fit in freeBytes..."
  		 [there := self addressAfter: hereObj.
  		  (self isMobileObjectHeader: hereObjHeader)
  		  and: [there - here < (freeBytes - self allocationUnit)
  			    or: [there - here = freeBytes]]] whileTrue:
  			[moved := true.
  			 self mem: destination cp: here y: there - here.
  			 self forward: hereObj to: destination + (hereObj - here).
  			 destination := destination + (there - here).
  			 freeBytes := freeBytes - (there - here).
  			 hereObj := self objectStartingAt: there.
  			 here := there.
  			 hereObjHeader := self atLeastClassIndexHalfHeader: hereObj].
  
  		 moved
+ 			ifTrue: "we did overwrite it; we need to repair the free list"
- 			ifTrue: "need to repair the free list"
  				[| nextNextFree |
+ 				 thisFreeChunk ~= firstFreeChunk ifTrue:
+ 					[self checkTraversableSortedFreeList].
  				 nextFree ~= 0 ifTrue:
+ 					[nextNextFree  := self nextInSortedFreeListLink: nextFree given: thisFreeChunk.
+ 					 self assert: (self isFreeObject: nextFree)].
- 					[nextNextFree  := self nextInSortedFreeListLink: nextFree given: thisFreeChunk].
  				 (destination > thisFreeChunk "if false couldn't move anything"
  				  and: [destination < endOfFree]) "if false, filled entire free chunk"
  					ifTrue:
  						[thisFreeChunk := self initFreeChunkWithBytes: endOfFree - destination at: destination.
  						 self inSortedFreeListLink: prevFreeChunk to: thisFreeChunk given: prevPrevFreeChunk.
  						 self inSortedFreeListLink: thisFreeChunk to: nextFree given: prevFreeChunk.
  						 nextFree ~= 0 ifTrue:
  							[self inSortedFreeListLink: nextFree to: nextNextFree given: thisFreeChunk].
  						 prevPrevFreeChunk := prevFreeChunk.
  						 prevFreeChunk := thisFreeChunk.
  						 thisFreeChunk := nextFree]
  					ifFalse:
  						[self inSortedFreeListLink: prevFreeChunk to: nextFree given: prevPrevFreeChunk.
  						 nextFree ~= 0 ifTrue:
+ 							[self inSortedFreeListLink: nextFree to: nextNextFree given: prevFreeChunk].
+ 						 thisFreeChunk := nextFree].
+ 				 self checkTraversableSortedFreeList]
- 							[self inSortedFreeListLink: nextFree to: nextNextFree given: prevFreeChunk.
- 						 thisFreeChunk := nextFree]].
- 				 "self checkTraversableSortedFreeList"]
  			ifFalse: "out of space (or immobile object); move on up the free list..."
  				[prevPrevFreeChunk := prevFreeChunk.
  				 prevFreeChunk := thisFreeChunk.
  				 thisFreeChunk := nextFree].
  
  		 (self isMobileObjectHeader: hereObjHeader) ifFalse:
  			[^maxFreeChunk >= startAddress ifTrue: [0] ifFalse: [there]].
  
  		 "Was the loop stopped by a pig? If so, try and find space for it"
  		 there - here >= (self averageObjectSizeInBytes * 8) ifTrue: "256b in 32 bit, 512b in 64 bit"
  			[| usedChunk |
  			 usedChunk := self tryToMovePig: hereObj at: here end: there.
  			"if it couldn't be moved we need to advance, so always
  			 set here to there whether the pig was moved or not."
  			 hereObj := self objectStartingAt: there.
  			 here := there.
  			 hereObjHeader := self atLeastClassIndexHalfHeader: hereObj.
  			 "In general it's a bad idea to reset the enumeration; it leads to N^2 behaviour
  			  when encountering pigs.  But if the move affected the enumeration this is
  			  simpler than resetting the list pointers."
  			 (usedChunk = prevPrevFreeChunk
  			  or: [usedChunk = prevFreeChunk
  			  or: [usedChunk = thisFreeChunk]]) ifTrue: "a bad idea; leads to N^2 behaviour when encountering pigs"
  				["reset the scan for free space back to the start of the list"
  				 prevPrevFreeChunk := prevFreeChunk := 0.
  				 thisFreeChunk := firstFreeChunk]].
  
  		((here > startAddress and: [there >= limit])
  		 or: [maxFreeChunk >= startAddress]) ifTrue:
  			[^maxFreeChunk >= startAddress ifTrue: [0] ifFalse: [there]]].!

Item was changed:
  ----- Method: SpurMemoryManager>>nextInSortedFreeListLink:given: (in category 'compaction') -----
  nextInSortedFreeListLink: freeChunk given: prevFree
  	 "Answer the next free free chunk using the xor trick to use only one field, see e.g.
  		The Art of Computer Programming, Vol 1, D.E. Knuth, 3rd Ed, Sec 2.2.4 `Circular Lists', exercise. 18
  		http://en.wikipedia.org/wiki/XOR_linked_list."
+ 	<api>
  	^(self fetchPointer: self freeChunkNextIndex ofFreeChunk: freeChunk) bitXor: prevFree!

Item was changed:
  ----- Method: SpurMemoryManager>>tryToMovePig:at:end: (in category 'compaction') -----
  tryToMovePig: pigObj at: pigStart end: pigEnd
  	"Try to move a pig (a largish object) to a free chunk in low memory.
  	 Answer the freeChunk that was used to house the moved pig, or
  	 0 if no free chunk could be found."
  	| freeChunk prevFree prevPrevFree pigBytes nextNext |
  	prevPrevFree := prevFree := 0.
  	freeChunk := firstFreeChunk.
  	pigBytes := pigEnd - pigStart.
  	[freeChunk ~= 0 and: [freeChunk < pigObj]] whileTrue:
  		[| next dest chunkBytes newChunk |
  		 next			:= self nextInSortedFreeListLink: freeChunk given: prevFree.
  		 dest			:= self startOfObject: freeChunk.
  		 chunkBytes	:= (self addressAfter: freeChunk) - dest.
  		 (chunkBytes = pigBytes
  		  or: [chunkBytes - self allocationUnit > pigBytes]) ifTrue:
  			[self mem: dest cp: pigStart y: pigBytes.
  			 self forward: pigObj to: dest + (pigObj - pigStart).
  			 next ~= 0 ifTrue:
  				[nextNext  := self nextInSortedFreeListLink: next given: freeChunk].
  			 "now either shorten the chunk, or remove it, adjusting the links to keep the list sorted."
  			 pigBytes < chunkBytes "if false, filled entire free chunk"
  				ifTrue:
  					[newChunk := self initFreeChunkWithBytes: chunkBytes - pigBytes at: dest + pigBytes.
  					 self inSortedFreeListLink: prevFree to: newChunk given: prevPrevFree.
  					 self inSortedFreeListLink: newChunk to: next given: prevFree.
  					 next ~= 0 ifTrue:
  						[self inSortedFreeListLink: next to: nextNext given: newChunk]]
  				ifFalse:
  					[self inSortedFreeListLink: prevFree to: next given: prevPrevFree.
  					 next ~= 0 ifTrue:
  						[self inSortedFreeListLink: next to: nextNext given: prevFree]].
+ 			 self checkTraversableSortedFreeList.
- 			 "self checkTraversableSortedFreeList."
  			 ^freeChunk].
  		 prevPrevFree := prevFree.
  		 prevFree := freeChunk.
  		 freeChunk := next].
  	^0!

More information about the Vm-dev mailing list