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

commits at source.squeak.org commits at source.squeak.org
Thu Jul 17 00:18:30 UTC 2014


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

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

Name: VMMaker.oscog-eem.824
Author: eem
Time: 16 July 2014, 5:15:47.231 pm
UUID: 2f058f16-c0e9-4231-b14a-fe2dadb19735
Ancestors: VMMaker.oscog-eem.823

Mark the methods used by globalGarbageCollect as
inline: #never for profiling.

Fix some Slang conflicting return type translation complaints

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

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveFullGC (in category 'memory space primitives') -----
  primitiveFullGC
  	"Do a full garbage collection.  In SqueakV3ObjectMemory, answer the number
  	 of bytes available (including swap space if dynamic memory management is
  	 supported).  In Spur, answer the size of the largest free chunk."
  
  	objectMemory hasSpurMemoryManagerAPI ifTrue:
+ 		[self pop: 1 thenPushInteger: objectMemory fullGC.
+ 		 ^self].
- 		[^self pop: 1 thenPushInteger: objectMemory fullGC].
  	objectMemory fullGCLock > 0 ifTrue:
  		[^self primitiveFailFor: PrimErrInappropriate].
  	objectMemory incrementalGC.  "maximimize space for forwarding table"
  	objectMemory fullGC.
  	self pop: 1 thenPushInteger: (objectMemory bytesLeft: true)!

Item was changed:
  ----- Method: SpurMemoryManager>>compact (in category 'compaction') -----
  compact
  	"We'd like to use exact fit followed by best or first fit, but it doesn't work
  	 well enough in practice.  So use pig compact.  Fill large free objects starting
  	 from low memory with objects taken from the end of memory."
+ 	<inline: #never> "for profiling"
- 	<inline: false>
  	statCompactPassCount := statCompactPassCount + 1.
  	self assert: (firstFreeChunk = 0 or: [self isFreeObject: firstFreeChunk]).
  	1 to: 3 do:
  		[:i|
  		 self pigCompact.
  		 self eliminateAndFreeForwardersForPigCompact].
  	
  	"The free lists are zeroed in freeUnmarkedObjectsAndSortAndCoalesceFreeSpaceForPigCompact.
  	 They should still be zero here"
  	self assert: self freeListHeadsEmpty.
  	self rebuildFreeListsForPigCompact!

Item was changed:
  ----- Method: SpurMemoryManager>>freeUnmarkedObjectsAndSortAndCoalesceFreeSpaceForPigCompact (in category 'gc - global') -----
  freeUnmarkedObjectsAndSortAndCoalesceFreeSpaceForPigCompact
  	"Sweep all of old space, freeing unmarked objects, coalescing free chunks, and sorting free space.
  
  	 Doubly-link the free chunks in address order through the freeChunkNextIndex field 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.
  	 Record the lowest free object in firstFreeChunk and the highest in lastFreeChunk.
  
  	 Let the segmentManager mark which segments contain pinned objects via notePinned:."
  
  	| prevPrevFree prevFree |
+ 	<inline: #never> "for profiling"
- 	<inline: false>
  	self checkFreeSpace.
  	scavenger forgetUnmarkedRememberedObjects.
  	self doScavenge: MarkOnTenure.
  	segmentManager prepareForGlobalSweep."for notePinned:"
  	"throw away the list heads, including the tree."
  	self resetFreeListHeads.
  	firstFreeChunk := prevPrevFree := prevFree := 0.
  	self allOldSpaceEntitiesForCoalescingFrom: self firstObject do:
  		[:o|
  		 self assert: (firstFreeChunk = 0 or: [self isFreeObject: firstFreeChunk]).
  		 (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 isPinned: o) ifTrue:
  					[segmentManager notePinned: o]]
  			ifFalse: "unmarked; two cases, an unreachable object or a free chunk."
  				[| here |
  				 self assert: (self isRemembered: o) not. "scavenger should have cleared this above"
  				 here := self coallesceFreeChunk: o.
  				 self setObjectFree: here.
  				 self inSortedFreeListLink: prevFree to: here given: prevPrevFree.
  				 prevPrevFree := prevFree.
  				 prevFree := here]].
  	prevFree ~= firstFreeChunk ifTrue:
  		[self storePointer: self freeChunkNextIndex
  			ofFreeChunk: prevFree
  			withValue: prevPrevFree].
  	lastFreeChunk := prevFree.
  	self inSortedFreeListLink: lastFreeChunk to: 0 given: prevPrevFree.
  	self assert: self checkTraversableSortedFreeList!

Item was changed:
  ----- Method: SpurMemoryManager>>fullGC (in category 'gc - global') -----
  fullGC
  	"Perform a full lazy compacting GC.  Answer the size of the largest free chunk."
  	<returnTypeC: #usqLong>
+ 	<inline: #never> "for profiling"
- 	<inline: false>
  	needGCFlag := false.
  	gcStartUsecs := self ioUTCMicrosecondsNow.
  	statMarkCount := 0.
  	coInterpreter preGCAction: GCModeFull.
  	self globalGarbageCollect.
  	coInterpreter postGCAction: GCModeFull.
  	statFullGCs := statFullGCs + 1.
  	statGCEndUsecs := self ioUTCMicrosecondsNow.
  	statFullGCUsecs := statFullGCUsecs + (statGCEndUsecs - gcStartUsecs).
  	^(freeLists at: 0) ~= 0
  		ifTrue: [self bytesInObject: self findLargestFreeChunk]
  		ifFalse: [0]!

Item was changed:
  ----- Method: SpurMemoryManager>>globalGarbageCollect (in category 'gc - global') -----
  globalGarbageCollect
+ 	<inline: true> "inline into fullGC"
  	self cCode: [] inSmalltalk: [self halt: 'GC number ', statFullGCs printString].
  
  	self assert: self validObjStacks.
  	self assert: (self isEmptyObjStack: markStack).
  	self assert: (self isEmptyObjStack: weaklingStack).
  
  	self markObjects.
  	self expungeDuplicateAndUnmarkedClasses: true.
  	self nilUnmarkedWeaklingSlots.
  	self freeUnmarkedObjectsAndSortAndCoalesceFreeSpaceForPigCompact.
  
  	"Mid-way the leak check must be more lenient.  Unmarked classes will have been
  	 expunged from the table, but unmarked instances will not yet have been reclaimed."
  	self runLeakCheckerForFullGC: true
  		excludeUnmarkedNewSpaceObjs: true
  		classIndicesShouldBeValid: true.
  
  	self compact.
  	self setHeapSizeAtPreviousGC.
  
  	self assert: self validObjStacks.
  	self assert: (self isEmptyObjStack: markStack).
  	self assert: (self isEmptyObjStack: weaklingStack).
  	self assert: self allObjectsUnmarked.
  	self runLeakCheckerForFullGC: true!

Item was changed:
  ----- Method: SpurMemoryManager>>markObjects (in category 'gc - global') -----
  markObjects
+ 	<inline: #never> "for profiling"
- 	<inline: false>
  	"Mark all accessible objects."
  	"If the incremental collector is running mark bits may be set; stop it and clear them if necessary."
  	self cCode: '' inSmalltalk: [coInterpreter transcript nextPutAll: 'marking...'; flush].
  	self runLeakCheckerForFullGC: true.
  
  	self ensureAllMarkBitsAreZero.
  	self ensureAdequateClassTableBitmap.
  	self initializeUnscannedEphemerons.
  	self initializeMarkStack.
  	self initializeWeaklingStack.
  	self markAccessibleObjects!

Item was changed:
  ----- Method: SpurMemoryManager>>nilUnmarkedWeaklingSlots (in category 'weakness and ephemerality') -----
  nilUnmarkedWeaklingSlots
  	"Nil the unmarked slots in the weaklings on the
  	 weakling stack, finalizing those that lost references.
  	 Finally, empty the weaklingStack."
+ 	<inline: #never> "for profiling"
- 	<inline: false>
  	self cCode: '' inSmalltalk: [coInterpreter transcript nextPutAll: 'nilling...'; flush].
  	self assert: self allOldMarkedWeakObjectsOnWeaklingStack.
  	weaklingStack = nilObj ifTrue:
  		[^self].
  	self objStack: weaklingStack from: 0 do:
  		[:weakling| | anyUnmarked |
  		anyUnmarked := self nilUnmarkedWeaklingSlotsIn: weakling.
  		anyUnmarked ifTrue:
  			[coInterpreter signalFinalization: weakling]].
  	self emptyObjStack: weaklingStack!

Item was changed:
  ----- Method: StackInterpreterPrimitives>>primitiveContextAt (in category 'indexing primitives') -----
  primitiveContextAt
  	"Special version of primitiveAt for accessing contexts.
  	 Written to be varargs for use from mirror primitives."
  	| index value aContext spouseFP hdr fmt totalLength fixedFields stSize |
  	<inline: false>
  	<var: #spouseFP type: #'char *'>
  	index := self stackTop.
  	(objectMemory isIntegerObject: index) ifFalse:
  		[^self primitiveFailFor: PrimErrBadArgument].
  	index := objectMemory integerValueOf: index.
  	aContext := self stackValue: 1.
  	"Duplicating much of stObject:at:put: here allows stObject:at:put: to omit tests for contexts."
  	hdr := objectMemory baseHeader: aContext.
  	(objectMemory isContextHeader: hdr) ifFalse: "might be an instance of a subclass"
  		[value := self stObject: aContext at: index.
+ 		 self successful ifTrue:
+ 			[self pop: argumentCount + 1 thenPush: value].
+ 		 ^self].
- 		 ^self successful ifTrue:
- 			[self pop: argumentCount + 1 thenPush: value]].
  	self externalWriteBackHeadFramePointers.
  	(self isStillMarriedContext: aContext) ifFalse:
  		[fmt := objectMemory formatOfHeader: hdr.
  		 totalLength := objectMemory lengthOf: aContext baseHeader: hdr format: fmt.
  		 fixedFields := objectMemory fixedFieldsOf: aContext format: fmt length: totalLength.
  		 stSize := self fetchStackPointerOf: aContext.
  		 (index between: 1 and: stSize) ifFalse:
  			[^self primitiveFailFor: PrimErrBadIndex].			
  		value := self subscript: aContext with: (index + fixedFields) format: fmt.
+ 		self pop: argumentCount + 1 thenPush: value.
+ 		^self].
- 		^self pop: argumentCount + 1 thenPush: value].
  	spouseFP := self frameOfMarriedContext: aContext.
  	(index between: 1 and: (self stackPointerIndexForFrame: spouseFP)) ifFalse:
  		[^self primitiveFailFor: PrimErrBadIndex].
  	value := self temporary: index - 1 in: spouseFP.
  	self pop: argumentCount + 1 thenPush: value!

Item was changed:
  ----- Method: StackInterpreterPrimitives>>primitiveContextAtPut (in category 'indexing primitives') -----
  primitiveContextAtPut
  	"Special version of primitiveAtPut for accessing contexts.
  	 Written to be varargs for use from mirror primitives."
  	| index value aContext spouseFP hdr fmt totalLength fixedFields stSize |
  	<inline: false>
  	<var: #spouseFP type: #'char *'>
  	value := self stackTop.
  	index := self stackValue: 1.
  	aContext := self stackValue: 2.
  	(objectMemory isIntegerObject: index) ifFalse:
  		[^self primitiveFailFor: PrimErrBadArgument].
  	"Duplicating much of stObject:at:put: here allows stObject:at:put: to omit tests for contexts."
  	hdr := objectMemory baseHeader: aContext.
  	index := objectMemory integerValueOf: index.
  	(objectMemory isContextHeader: hdr) ifFalse: "might be an instance of a subclass"
  		[self stObject: aContext at: index put: value.
+ 		 self successful ifTrue:
+ 			[self pop: argumentCount + 1 thenPush: value].
+ 		 ^self].
- 		 ^self successful ifTrue:
- 			[self pop: argumentCount + 1 thenPush: value]].
  	self externalWriteBackHeadFramePointers.
  	(self isStillMarriedContext: aContext) ifFalse:
  		[fmt := objectMemory formatOfHeader: hdr.
  		 totalLength := objectMemory lengthOf: aContext baseHeader: hdr format: fmt.
  		 fixedFields := objectMemory fixedFieldsOf: aContext format: fmt length: totalLength.
  		 stSize := self fetchStackPointerOf: aContext.
  		 (index between: 1 and: stSize) ifFalse:
  			[^self primitiveFailFor: PrimErrBadIndex].			
  		self subscript: aContext with: (index + fixedFields) storing: value format: fmt.
+ 		self pop: argumentCount + 1 thenPush: value.
+ 		^self].
- 		^self pop: argumentCount + 1 thenPush: value].
  	spouseFP := self frameOfMarriedContext: aContext.
  	(index between: 1 and: (self stackPointerIndexForFrame: spouseFP)) ifFalse:
  		[^self primitiveFailFor: PrimErrBadIndex].
  	self temporary: index - 1 in: spouseFP put: value.
  	self pop: argumentCount + 1 thenPush: value!



More information about the Vm-dev mailing list