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

commits at source.squeak.org commits at source.squeak.org
Mon May 5 00:48:19 UTC 2014


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

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

Name: VMMaker.oscog-eem.704
Author: eem
Time: 4 May 2014, 5:45:34.57 pm
UUID: 5a1a2624-b349-4d95-aeb3-097087219b4e
Ancestors: VMMaker.oscog-eem.703

Slang: fix return types of float accessors (void).

Spur: cast args to mem:cp:y: in compaction to aovid warning.

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

Item was changed:
  ----- Method: CCodeGenerator>>computeKernelReturnTypes (in category 'public') -----
  computeKernelReturnTypes
  	^Dictionary newFromPairs:
  		#(oopAt: #sqInt oopAt:put: #sqInt
  			oopAtPointer: #sqInt oopAtPointer:put: #sqInt
  		 byteAt: #sqInt byteAt:put: #sqInt
  			byteAtPointer: #sqInt byteAtPointer:put: #sqInt
  		 shortAt: #sqInt shortAt:put: #sqInt
  			shortAtPointer: #sqInt shortAtPointer:put: #sqInt
  		 intAt: #sqInt intAt:put: #sqInt
  			intAtPointer: #sqInt intAtPointer:put: #sqInt
  		 longAt: #sqInt longAt:put: #sqInt
  			longAtPointer: #sqInt longAtPointer:put: #sqInt
  				long32At: #sqInt long32At:put: #sqInt
  
  		 longLongAt: #sqLong longLongAt:put: #sqLong
  			longLongAtPointer: #sqLong longLongAtPointer:put: #sqLong
  				long64At: #sqLong long64At:put: #sqLong
  		
+ 		 fetchFloatAt:into: #void storeFloatAt:from: #void
+ 			fetchFloatAtPointer:into: #void storeFloatAtPointer:from: #void
+ 		 fetchSingleFloatAt:into: #void storeSingleFloatAt:from: #void
+ 			fetchSingleFloatAtPointer:into: #void storeSingleFloatAtPointer:from: #void
- 		 fetchFloatAt:into: #float storeFloatAt:from: #float
- 			fetchFloatAtPointer:into: #float storeFloatAtPointer:from: #float
- 		 fetchSingleFloatAt:into: #float storeSingleFloatAt:from: #float
- 			fetchSingleFloatAtPointer:into: #float storeSingleFloatAtPointer:from: #float
  
  		 pointerForOop: #'char *' oopForPointer: #sqInt)!

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."
  	<var: #startAddress type: #usqInt>
  	<var: #limit type: #usqInt>
  	<inline: false>
  	| here hereObj hereObjHeader prevPrevFreeChunk prevFreeChunk thisFreeChunk maxFreeChunk |
  	<var: #here type: #usqInt>
  	<var: #there type: #usqInt>
  	<var: #nextFree type: #usqInt>
  	<var: #endOfFree type: #usqInt>
  	<var: #destination type: #usqInt>
  	<var: #maxFreeChunk type: #usqInt>
  	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].
  
  		 "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.
  		  "N.B. *must* add allocationUnit, not subtract, to avoid unsigned arithmetic issues when freeBytes = 0"
  		  (self isMobileObjectHeader: hereObjHeader)
  		  and: [freeBytes > (there - here + self allocationUnit)
  			    or: [freeBytes = (there - here)]]] whileTrue:
  			[moved := true.
+ 			 self mem: destination asVoidPointer cp: here asVoidPointer y: there - here.
- 			 self mem: destination cp: here y: there - here.
  			 self forwardUnchecked: 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"
  				[| nextNextFree |
  				 nextFree ~= 0 ifTrue:
  					[nextNextFree  := self nextInSortedFreeListLink: nextFree given: thisFreeChunk.
  					 self assert: (self isFreeObject: nextFree)].
  				 (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]]
  			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:
  				["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]]].
  	^here!

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.
  		 "N.B. *must* add allocationUnit, not subtract, to avoid unsigned arithmetic issues when chunkBytes = 0"
  		 (chunkBytes = pigBytes
  		  or: [chunkBytes > (pigBytes + self allocationUnit)]) ifTrue:
+ 			[self mem: dest asVoidPointer cp: pigStart asVoidPointer y: pigBytes.
- 			[self mem: dest cp: pigStart y: pigBytes.
  			 self forwardUnchecked: 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".
  			 ^freeChunk].
  		 prevPrevFree := prevFree.
  		 prevFree := freeChunk.
  		 freeChunk := next].
  	^0!



More information about the Vm-dev mailing list