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

commits at source.squeak.org commits at source.squeak.org
Fri Nov 1 00:42:32 UTC 2013


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

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

Name: VMMaker.oscog-eem.486
Author: eem
Time: 31 October 2013, 5:39:43.853 pm
UUID: 5f2d1eba-c707-41f7-8c97-f2b477779101
Ancestors: VMMaker.oscog-eem.485

The penny drops.  One cannot combine the unmarking sweep with
the weakling nilling sweep.  Doing so ends up removing live objects
if they are unmarked before the weakling referrer is reached.  So
add a weaklingStack obj stack to hold all reachable weaklings and
modify markAndTrace to push weaklings onto the weaklingStack.
Modify ephemeron processing to nil weaklings.
Add objStack:from:do: which allows incremental enumeration of an
objStack, even as it grows during enumeration.
Rename the big kahuna to fUOASACFS.

Refactor push:onObjStack: into noCheckPush:onObjStack: for the
ad-hoc testObjStackDo test.  Add emptyObjStack:.


Refactor flushMethodCache to flush the at cache instead of requiring
a separate send.  Add flushMethodCache to preGCAction: if using
the SpurMemMgrAPI.

Fix a slip in isValidObjStack:.

Eliminate some extraneous type declarations.

Hack the grow & shrink thresholds so the GC doesn't try to shrink
my test image.

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

Item was changed:
  ----- Method: CoInterpreter>>flushMethodCache (in category 'method lookup cache') -----
  flushMethodCache
  	"Flush the method cache. The method cache is flushed on every programming change and garbage collect."
  
+ 	super flushMethodCache.
- 	1 to: MethodCacheSize do: [ :i | methodCache at: i put: 0 ].
- 	lastMethodCacheProbeWrite := 0. "this for primitiveExternalMethod"
  	cogit unlinkAllSends!

Item was changed:
  ----- Method: NewObjectMemory>>eeAllocate:headerSize:h1:h2:h3: (in category 'allocation') -----
  eeAllocate: byteSize headerSize: hdrSize h1: baseHeader h2: classOop h3: extendedSize
  	"Allocate a new object of the given size and number of header words. (Note: byteSize already includes
  	 space for the base header word.) Initialize the header fields of the new object.
  	 Does *not* initialize the objects' fields. Will *not* cause a GC.  This version is for the execution engine's use only."
  
  	| newObj |
  	<inline: true>
  	<asmLabel: false>
- 	<var: #i type: #usqInt>
- 	<var: #end type: #usqInt>
  	newObj := self allocateInterpreterChunk: byteSize + (hdrSize - 1 * BytesPerWord).
  	newObj = 0 ifTrue: [^newObj].
  	hdrSize = 3 ifTrue:
  		[self longAt: newObj put: (extendedSize bitOr: HeaderTypeSizeAndClass).
  		 self longAt: newObj + BytesPerWord put: (classOop bitOr: HeaderTypeSizeAndClass).
  		 self longAt: newObj + (BytesPerWord*2) put: (baseHeader bitOr: HeaderTypeSizeAndClass).
  		 newObj := newObj + (BytesPerWord*2)].
  
  	 hdrSize = 2 ifTrue:
  		[self longAt: newObj put: (classOop bitOr: HeaderTypeClass).
  		 self longAt: newObj + BytesPerWord put: (baseHeader bitOr: HeaderTypeClass).
  		 newObj := newObj + BytesPerWord].
  
  	 hdrSize = 1 ifTrue:
  		[self longAt: newObj put: (baseHeader bitOr: HeaderTypeShort)].
  
  	DoExpensiveAssertionChecks ifTrue:
  		[self okayOop: newObj.
  		 self oopHasOkayClass: newObj.
  		 (self safeObjectAfter: newObj) = freeStart ifFalse:
  			[self error: 'allocate bug: did not set header of new oop correctly']].
  
  	^newObj!

Item was added:
+ ----- Method: Spur32BitMMLECoSimulator>>freeUnmarkedObjectsAndSortAndCoalesceFreeSpace (in category 'gc - global') -----
+ freeUnmarkedObjectsAndSortAndCoalesceFreeSpace
+ 	coInterpreter transcript nextPutAll: 'sweeping...'; flush.
+ 	^super freeUnmarkedObjectsAndSortAndCoalesceFreeSpace!

Item was removed:
- ----- Method: Spur32BitMMLECoSimulator>>freeUnmarkedObjectsNilUnmarkedWeaklingSlotsAndSortAndCoalesceFreeSpace (in category 'gc - global') -----
- freeUnmarkedObjectsNilUnmarkedWeaklingSlotsAndSortAndCoalesceFreeSpace
- 	coInterpreter transcript nextPutAll: 'sweeping...'; flush.
- 	^super freeUnmarkedObjectsNilUnmarkedWeaklingSlotsAndSortAndCoalesceFreeSpace!

Item was added:
+ ----- Method: Spur32BitMMLECoSimulator>>nilUnmarkedWeaklingSlots (in category 'gc - global') -----
+ nilUnmarkedWeaklingSlots
+ 	coInterpreter transcript nextPutAll: 'nilling...'; flush.
+ 	^super nilUnmarkedWeaklingSlots!

Item was added:
+ ----- Method: Spur32BitMMLESimulator>>freeUnmarkedObjectsAndSortAndCoalesceFreeSpace (in category 'gc - global') -----
+ freeUnmarkedObjectsAndSortAndCoalesceFreeSpace
+ 	coInterpreter transcript nextPutAll: 'sweeping...'; flush.
+ 	^super freeUnmarkedObjectsAndSortAndCoalesceFreeSpace!

Item was removed:
- ----- Method: Spur32BitMMLESimulator>>freeUnmarkedObjectsNilUnmarkedWeaklingSlotsAndSortAndCoalesceFreeSpace (in category 'gc - global') -----
- freeUnmarkedObjectsNilUnmarkedWeaklingSlotsAndSortAndCoalesceFreeSpace
- 	coInterpreter transcript nextPutAll: 'sweeping...'; flush.
- 	^super freeUnmarkedObjectsNilUnmarkedWeaklingSlotsAndSortAndCoalesceFreeSpace!

Item was added:
+ ----- Method: Spur32BitMMLESimulator>>nilUnmarkedWeaklingSlots (in category 'gc - global') -----
+ nilUnmarkedWeaklingSlots
+ 	coInterpreter transcript nextPutAll: 'nilling...'; flush.
+ 	^super nilUnmarkedWeaklingSlots!

Item was added:
+ ----- Method: Spur32BitMMLESimulator>>testObjStackDo (in category 'ad-hoc tests') -----
+ testObjStackDo
+ 	| size them seqA seqB seqC rs |
+ 	self initializeWeaklingStack; emptyObjStack: weaklingStack.
+ 	self assert: (self topOfObjStack: weaklingStack) isNil.
+ 	self assert: (self capacityOfObjStack: weaklingStack) >= ObjStackLimit.
+ 	seqA := (1 to: ObjStackLimit * 5 // 2) collect: [:i| self integerObjectOf: i].
+ 	seqA do: [:it| self noCheckPush: it onObjStack: weaklingStack].
+ 	them := Set new.
+ 	size := self objStack: weaklingStack from: 0 do: [:it| them add: it].
+ 	self assert: size = seqA size.
+ 	self assert: (them asSortedCollection asArray = seqA).
+ 	self assert: (self isValidObjStack: weaklingStack).
+ 	seqB := (ObjStackLimit * 5 // 2 + 1 to: ObjStackLimit * 10 // 2) collect: [:i| self integerObjectOf: i].
+ 	self assert: seqA size = seqB size.
+ 	rs := seqB readStream.
+ 	them := Set new.
+ 	size := self objStack: weaklingStack from: 0 do:
+ 				[:it|
+ 				them add: it.
+ 				self noCheckPush: rs next onObjStack: weaklingStack].
+ 	self assert: size = seqA size.
+ 	self assert: rs atEnd.
+ 	self objStack: weaklingStack from: size do:
+ 		[:it| them add: it].
+ 	seqC := (seqA, seqB) sort.
+ 	self assert: them asSortedCollection asArray = seqC!

Item was added:
+ ----- Method: SpurGenerationScavengerSimulator>>scavenge: (in category 'scavenger') -----
+ scavenge: tenuringCriterion
+ 	coInterpreter transcript nextPutAll: 'scavenging...'; flush.
+ 	^super scavenge: tenuringCriterion!

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

Item was changed:
  ----- Method: SpurMemoryManager class>>initialize (in category 'class initialization') -----
  initialize
  	"SpurMemoryManager initialize"
  	BitsPerByte := 8.
  
  	"An obj stack is a stack of objects stored in a hidden root slot, such as
  	 the markStack or the ephemeronQueue.  It is a linked list of segments,
  	 with the hot end at the head of the list.  It is a word object.  The stack
  	 pointer is in ObjStackTopx and 0 means empty.  The list goes through
  	 ObjStackNextx. We don't want to shrink objStacks, since they're used
  	 in GC and its good to keep their memory around.  So unused pages
  	 created by popping emptying pages are kept on the ObjStackFreex list.
  	 ObjStackNextx must be the last field for swizzleObjStackAt:."
  	ObjStackPageSlots := 4092. "+ double header = 16k bytes per page in 32-bits"
  	ObjStackTopx := 0.
  	ObjStackMyx := 1.
  	ObjStackFreex := 2.
  	ObjStackNextx := 3.
  	ObjStackFixedSlots := 4.
  	ObjStackLimit := ObjStackPageSlots - ObjStackFixedSlots.
+ 	"There are currently three obj stacks, the mark stack, the weaklings and the ephemeron queue."
- 	"There are currently two obj stacks, the mark stack and the ephemeron queue."
  	MarkStackRootIndex := self basicNew classTableRootSlots.
+ 	WeaklingStackRootIndex := MarkStackRootIndex + 1.
+ 	EphemeronQueueRootIndex := MarkStackRootIndex + 2.
- 	EphemeronQueueRootIndex := MarkStackRootIndex + 1.
  
  	CheckObjectOverwrite := true.
  
  	"The remap buffer support is for compatibility; Spur doesn't GC during allocation.
  	 Eventually this should die."
  	RemapBufferSize := 25.
  
  	"Extra roots are for plugin support."
  	ExtraRootsSize := 2048 "max. # of external roots"!

Item was changed:
  ----- Method: SpurMemoryManager class>>initializeWithOptions: (in category 'class initialization') -----
  initializeWithOptions: optionsDictionary
  	"SpurMemoryManager initializeWithOptions: Dictionary new"
  
  	super initializeWithOptions: optionsDictionary.
+ 	self initialize.
  	self initBytesPerWord: (self == SpurMemoryManager
  								ifTrue: [optionsDictionary at: #BytesPerWord ifAbsent: [4]]
  								ifFalse: [self wordSize]).
  	BytesPerOop := optionsDictionary at: #BytesPerOop ifAbsent: [BytesPerWord].
  
  	self initializeObjectHeaderConstants. "Initializes BaseHeaderSize so do early"
  	self initializeSpurObjectRepresentationConstants.
  	self initializeSpecialObjectIndices.
  	self initializeCompactClassIndices.
  	self initializePrimitiveErrorCodes.
  
  	SpurGenerationScavenger initialize!

Item was added:
+ ----- Method: SpurMemoryManager>>emptyObjStack: (in category 'obj stacks') -----
+ emptyObjStack: objStack
+ 	"Remove all the entries on the stack.  Do so by setting Topx to 0
+ 	 on the first page, and adding all subsequent pages to the free list."
+ 	| nextPage nextNextPage |
+ 	self assert: (self isValidObjStack: objStack).
+ 	self storePointer: ObjStackTopx ofObject: objStack withValue: 0.
+ 	nextPage := self fetchPointer: ObjStackNextx ofObject: objStack.
+ 	[nextPage ~= 0] whileTrue:
+ 		[nextNextPage := self fetchPointer: ObjStackNextx ofObject: nextPage.
+ 		 self storePointer: ObjStackFreex
+ 			ofObjStack: nextPage
+ 			withValue: (self fetchPointer: ObjStackFreex ofObject: objStack).
+ 		 self storePointer: ObjStackNextx ofObjStack: nextPage withValue: 0.
+ 		 self storePointer: ObjStackFreex ofObjStack: objStack withValue: nextPage.
+ 		 nextPage := nextNextPage].
+ 	self storePointer: ObjStackNextx ofObjStack: objStack withValue: 0.
+ 	self assert: (self isValidObjStack: objStack)!

Item was added:
+ ----- Method: SpurMemoryManager>>freeUnmarkedObjectsAndSortAndCoalesceFreeSpace (in category 'gc - global') -----
+ freeUnmarkedObjectsAndSortAndCoalesceFreeSpace
+ 	"Sweep all of old space, freeing unmarked objects, coalescing free chunks, and sorting free space.
+ 
+ 	 Small free chunks are sorted in address order on each small list head.  Large free chunks
+ 	 are sorted on the sortedFreeChunks list.  Record as many of the highest objects as there
+ 	 is room for in highestObjects, a circular buffer, for the use of exactFitCompact.  Use
+ 	 unused eden space for highestObjects.  If highestObjects does not wrap, store 0
+ 	 at highestObjects last.  Record the lowest free object in firstFreeChunk.  Let the
+ 	 segmentManager mark which segments contain pinned objects via notePinned:."
+ 
+ 	| lastLargeFree lastHighest highestObjectsWraps sortedFreeChunks |
+ 	<var: #lastHighest type: #usqInt>
+ 	self checkFreeSpace.
+ 	scavenger forgetUnmarkedRememberedObjects.
+ 	segmentManager prepareForGlobalSweep."for notePinned:"
+ 	"for sorting free space throw away the list heads, rebuilding them for small free chunks below."
+ 	self resetFreeListHeads.
+ 	highestObjects initializeStart: freeStart limit: scavenger eden limit.
+ 	lastHighest := highestObjects last "a.k.a. freeStart - wordSize".
+ 	highestObjectsWraps := 0.
+ 	self assert: highestObjects limit - highestObjects start // self wordSize >= 1024.
+ 	firstFreeChunk := sortedFreeChunks := lastLargeFree := 0.
+ 	"Note that if we were truly striving for performance we could split the scan into
+ 	 two phases, one up to the first free object and one after, which would remove
+ 	 the need to test firstFreeChunk when filling highestObjects."
+ 	self allOldSpaceEntitiesForCoalescingDo:
+ 		[:o|
+ 		(self isMarked: o)
+ 			ifTrue: "forwarders should have been followed in markAndTrace:"
+ 				[self assert: (self isForwarded: o) not.
+ 				 self setIsMarkedOf: o to: false.
+ 				 (self isPinned: o) ifTrue:
+ 					[segmentManager notePinned: o].
+ 				 firstFreeChunk ~= 0 ifTrue:
+ 					[false "conceptually...: "
+ 						ifTrue: [highestObjects addLast: o]
+ 						ifFalse: "but we inline so we can use the local lastHighest"
+ 							[(lastHighest := lastHighest + self wordSize) >= highestObjects limit ifTrue:
+ 								[highestObjectsWraps := highestObjectsWraps + 1].
+ 							 self longAt: lastHighest put: o]]]
+ 			ifFalse: "unmarked; two cases, an unreachable object or a free chunk."
+ 				[| here next |
+ 				 self assert: (self isRemembered: o) not. "scavenger should have cleared this above"
+ 				 here := o.
+ 				 next := self objectAfter: here limit: endOfMemory.
+ 				 (self isMarked: next) ifFalse: "coalescing; rare case"
+ 					[self assert: (self isRemembered: o) not.
+ 					 [statCoalesces := statCoalesces + 1.
+ 					  here := self coalesce: here and: next.
+ 					  next := self objectAfter: here limit: endOfMemory.
+ 					  next = endOfMemory or: [self isMarked: next]] whileFalse].
+ 				 firstFreeChunk = 0 ifTrue:
+ 					[firstFreeChunk := here].
+ 				 (self isLargeFreeObject: here)
+ 					ifTrue:
+ 						[lastLargeFree = 0
+ 							ifTrue: [sortedFreeChunks := here]
+ 							ifFalse:
+ 								[self setFree: here.
+ 								 self storePointer: self freeChunkNextAddressIndex ofFreeChunk: lastLargeFree withValue: here].
+ 						 lastLargeFree := here]
+ 					ifFalse:
+ 						[self freeSmallObject: here]]].
+ 	highestObjects last: lastHighest.
+ 	highestObjectsWraps ~= 0 ifTrue:
+ 		[highestObjects first: (lastHighest + self wordSize >= highestObjects limit
+ 								ifTrue: [highestObjects start]
+ 								ifFalse: [lastHighest + self wordSize])].
+ 	lastLargeFree ~= 0 ifTrue:
+ 		[self storePointer: self freeChunkNextAddressIndex ofFreeChunk: lastLargeFree withValue: 0].
+ 	totalFreeOldSpace := self reverseSmallListHeads.
+ 	totalFreeOldSpace := totalFreeOldSpace + (self rebuildFreeTreeFrom: sortedFreeChunks).
+ 	self checkFreeSpace.
+ 	self touch: highestObjectsWraps!

Item was removed:
- ----- Method: SpurMemoryManager>>freeUnmarkedObjectsNilUnmarkedWeaklingSlotsAndSortAndCoalesceFreeSpace (in category 'gc - global') -----
- freeUnmarkedObjectsNilUnmarkedWeaklingSlotsAndSortAndCoalesceFreeSpace
- 	"Sweep all of old space, freeing unmarked objects, nilling the unmarked slots of weaklings,
- 	 coalescing free chunks, and sorting free space.
- 
- 	 Small free chunks are sorted in address order on each small list head.  Large free chunks
- 	 are sorted on the sortedFreeChunks list.  Record as many of the highest objects as there
- 	 is room for in highestObjects, a circular buffer, for the use of exactFitCompact.  Use
- 	 unused eden space for highestObjects.  If highestObjects does not wrap, store 0 at
- 	 highestObjects last.  Record the lowest free object in firstFreeChunk.  Let the
- 	 segmentManager mark which segments contain pinned objects via notePinned:."
- 
- 	| lastLargeFree lastHighest highestObjectsWraps sortedFreeChunks |
- 	<var: #lastHighest type: #usqInt>
- 	self checkFreeSpace.
- 	scavenger forgetUnmarkedRememberedObjects.
- 	segmentManager prepareForGlobalSweep."for notePinned:"
- 	"for sorting free space throw away the list heads, rebuilding them for small free chunks below."
- 	self resetFreeListHeads.
- 	highestObjects initializeStart: freeStart limit: scavenger eden limit.
- 	lastHighest := highestObjects last "a.k.a. freeStart - wordSize".
- 	highestObjectsWraps := 0.
- 	self assert: highestObjects limit - highestObjects start // self wordSize >= 1024.
- 	firstFreeChunk := sortedFreeChunks := lastLargeFree := 0.
- 	"Note that if we were truly striving for performance we could split the scan into
- 	 two phases, one up to the first free object and one after, which would remove
- 	 the need to test firstFreeChunk when filling highestObjects."
- 	self allOldSpaceEntitiesForCoalescingDo:
- 		[:o|
- 		(self isMarked: o)
- 			ifTrue: "forwarders should have been followed in markAndTrace:"
- 				[self assert: (self isForwarded: o) not.
- 				 self setIsMarkedOf: o to: false.
- 				 ((self isWeakNonImm: o)
- 				  and: [self nilUnmarkedWeaklingSlots: o]) ifTrue:
- 					[coInterpreter signalFinalization: o].
- 				 (self isPinned: o) ifTrue:
- 					[segmentManager notePinned: o].
- 				 firstFreeChunk ~= 0 ifTrue:
- 					[false "conceptually...: "
- 						ifTrue: [highestObjects addLast: o]
- 						ifFalse: "but we inline so we can use the local lastHighest"
- 							[(lastHighest := lastHighest + self wordSize) >= highestObjects limit ifTrue:
- 								[highestObjectsWraps := highestObjectsWraps + 1].
- 							 self longAt: lastHighest put: o]]]
- 			ifFalse: "unmarked; two cases, an unreachable object or a free chunk."
- 				[| here next |
- 				 self assert: (self isRemembered: o) not. "scavenger should have cleared this above"
- 				 here := o.
- 				 next := self objectAfter: here limit: endOfMemory.
- 				 (self isMarked: next) ifFalse: "coalescing; rare case"
- 					[self assert: (self isRemembered: o) not.
- 					 [statCoalesces := statCoalesces + 1.
- 					  here := self coalesce: here and: next.
- 					  next := self objectAfter: here limit: endOfMemory.
- 					  next = endOfMemory or: [self isMarked: next]] whileFalse].
- 				 firstFreeChunk = 0 ifTrue:
- 					[firstFreeChunk := here].
- 				 (self isLargeFreeObject: here)
- 					ifTrue:
- 						[lastLargeFree = 0
- 							ifTrue: [sortedFreeChunks := here]
- 							ifFalse:
- 								[self setFree: here.
- 								 self storePointer: self freeChunkNextAddressIndex ofFreeChunk: lastLargeFree withValue: here].
- 						 lastLargeFree := here]
- 					ifFalse:
- 						[self freeSmallObject: here]]].
- 	highestObjects last: lastHighest.
- 	highestObjectsWraps ~= 0 ifTrue:
- 		[highestObjects first: (lastHighest + self wordSize >= highestObjects limit
- 								ifTrue: [highestObjects start]
- 								ifFalse: [lastHighest + self wordSize])].
- 	lastLargeFree ~= 0 ifTrue:
- 		[self storePointer: self freeChunkNextAddressIndex ofFreeChunk: lastLargeFree withValue: 0].
- 	totalFreeOldSpace := self reverseSmallListHeads.
- 	totalFreeOldSpace := totalFreeOldSpace + (self rebuildFreeTreeFrom: sortedFreeChunks).
- 	self checkFreeSpace.
- 	self touch: highestObjectsWraps!

Item was changed:
  ----- Method: SpurMemoryManager>>globalGarbageCollect (in category 'gc - global') -----
  globalGarbageCollect
  	self runLeakCheckerForFullGC: true.
  	self markObjects.
+ 	self nilUnmarkedWeaklingSlots.
+ 	self freeUnmarkedObjectsAndSortAndCoalesceFreeSpace.
- 	self freeUnmarkedObjectsNilUnmarkedWeaklingSlotsAndSortAndCoalesceFreeSpace.
  	self bestFitCompact.
  	self eliminateAndFreeForwarders.
  	self runLeakCheckerForFullGC: true!

Item was changed:
  ----- Method: SpurMemoryManager>>initializeObjectMemory: (in category 'initialization') -----
  initializeObjectMemory: bytesToShift
  	"Initialize object memory variables at startup time. Assume endOfMemory is initially set (by the image-reading code) to the end of the last object in the image. Initialization redefines endOfMemory to be the end of the object allocation area based on the total available memory, but reserving some space for forwarding blocks."
  	"Assume: image reader initializes the following variables:
  		memory
  		memoryLimit
  		specialObjectsOop
  		lastHash
  	"
  	<inline: false>
  	| freeListObj |
  	"Catch mis-initializations leading to bad translations to C"
  	self assert: BaseHeaderSize = self baseHeaderSize.
  
  	segmentManager adjustSegmentSwizzlesBy: bytesToShift.
  	"image may be at a different address; adjust oops for new location"
  	self adjustAllOopsBy: bytesToShift.
  
  	segmentManager numSegments > 0 "false if Spur image bootstrap"
  		ifTrue: [specialObjectsOop := segmentManager swizzleObj: specialObjectsOop]
  		ifFalse: [self assert: bytesToShift = 0].
  
  	"heavily used special objects"
  	nilObj		:= self splObj: NilObject.
  	falseObj	:= self splObj: FalseObject.
  	trueObj		:= self splObj: TrueObject.
  
  	"In Cog we insist that nil, true & false are next to each other (Cogit generates tighter
  	 conditional branch code as a result).  In addition, Spur places the free lists and
  	 class table root page immediately following them."
  	self assert: nilObj = newSpaceLimit.
  	self assert: falseObj = (self objectAfter: nilObj).
  	self assert: trueObj = (self objectAfter: falseObj).
  	freeListObj := self objectAfter: trueObj.
  	self reInitializeClassTablePostLoad: (self objectAfter: freeListObj).
  	self initializeFreeSpacePostLoad: freeListObj.
  	markStack := self swizzleObjStackAt: MarkStackRootIndex.
+ 	weaklingStack := self swizzleObjStackAt: WeaklingStackRootIndex.
  	ephemeronQueue := self swizzleObjStackAt: EphemeronQueueRootIndex.
  
  	segmentManager collapseSegmentsPostSwizzle.
  
  	self initializeNewSpaceVariables.
  	self initializeOldSpaceFirstFree: freeOldSpaceStart. "initializes endOfMemory, freeStart"
  
  	"These defaults should depend on machine size; e.g. too small on a powerful laptop, too big on a Pi."
+ 	growHeadroom := 16*1024*1024.		"headroom when growing"
+ 	shrinkThreshold := 32*1024*1024.		"free space before shrinking"!
- 	growHeadroom := 8*1024*1024.		"headroom when growing"
- 	shrinkThreshold := 16*1024*1024.		"free space before shrinking"!

Item was added:
+ ----- Method: SpurMemoryManager>>initializeWeaklingStack (in category 'gc - global') -----
+ initializeWeaklingStack
+ 	self ensureRoomOnObjStackAt: WeaklingStackRootIndex!

Item was changed:
  ----- Method: SpurMemoryManager>>isValidObjStack: (in category 'obj stacks') -----
  isValidObjStack: objStack
  	"Answer if the obj stack at objStackRootIndex is valid."
  	((self addressCouldBeObj: objStack)
+ 	 and: [(self numSlotsOfAny: objStack) = ObjStackPageSlots]) ifFalse:
- 	 and: [(self numSlotsOf: objStack) = ObjStackPageSlots]) ifFalse:
  		[objStackInvalidBecause := 'first page not obj or wrong size'.
  		 ^false].
  	^self isValidObjStackPage: objStack
  		myIndex: (self fetchPointer: ObjStackMyx ofObject: objStack)
  		firstPage: true!

Item was changed:
  ----- Method: SpurMemoryManager>>markAccessibleObjects (in category 'gc - global') -----
  markAccessibleObjects
  	self assert: self validClassTableRootPages.
  	self assert: segmentManager allBridgesMarked.
  	marking := true.
  	self cCode: [] "for debugging markAndTrace: set (MarkStackRecord := OrderedCollection new)"
  		inSmalltalk: [MarkStackRecord ifNotNil: [MarkStackRecord resetTo: 1]].
  	self markAndTraceObjStack: self markStack andContents: false.
  	self assert: self validClassTableRootPages.
  	self markAndTraceObjStack: self ephemeronQueue andContents: true.
  	self assert: self validClassTableRootPages.
  	coInterpreter markAndTraceInterpreterOops: true.
  	self markAndTrace: self freeListsObj.
  	self markAndTrace: hiddenRootsObj.
  	self markAndTrace: self specialObjectsOop.
+ 	self markWeaklingsAndMarkAndFireEphemerons.
- 	self markAndFireEphemerons.
  	marking := false!

Item was removed:
- ----- Method: SpurMemoryManager>>markAndFireEphemerons (in category 'gc - global') -----
- markAndFireEphemerons
- 	"After the initial scan-mark is complete ephemerons can be processed."
- 	[coInterpreter markAndTraceUntracedReachableStackPages.
- 	 self noUnscannedEphemerons ifTrue:
- 		[^self].
- 	 self markInactiveEphemerons ifFalse:
- 		[self fireAllUnscannedEphemerons].
- 	 self markAllUnscannedEphemerons]
- 		repeat!

Item was changed:
  ----- Method: SpurMemoryManager>>markAndTrace: (in category 'gc - global') -----
  markAndTrace: objOop
  	"Mark the argument, and all objects reachable from it, and any remaining objects on the mark stack.
  	 Follow forwarding pointers in the scan."
  	| objToScan index field |
  	self assert: (self isNonImmediate: objOop).
  	"if markAndTrace: is to follow and eliminate forwarding pointers
  	 in its scan it cannot be handed an r-value which is forwarded."
  	self assert: (self isForwarded: objOop) not.
  	(self isMarked: objOop) ifTrue:
  		[^self].
  	"self setIsMarkedOf: objOop to: false" "for debugging"
  	self setIsMarkedOf: objOop to: true.
  
  	"Now scan the object, and any remaining objects on the mark stack."
  	objToScan := objOop.
  	"To avoid overflowing the mark stack when we encounter large objects, we
  	 push the obj, then its numStrongSlots, and then index the object from the stack."
  	[| numStrongSlots |
  	 ((self isImmediate: objToScan)
  	 or: [numStrongSlots := self numStrongSlotsOf: objToScan ephemeronInactiveIf: #inactiveOrFailedToDeferScan:.
  		 numStrongSlots > self traceImmediatelySlotLimit])
  		ifTrue: "scanning a large object. scan until hitting an unmarked object, then switch to it, if any."
  			[(self isImmediate: objToScan)
  				ifTrue:
  					[index := self integerValueOf: objToScan.
  					 objToScan := self topOfObjStack: markStack]
  				ifFalse:
  					[index := numStrongSlots].
  			 [index > 0] whileTrue:
  				[index := index - 1.
  				 field := self fetchPointer: index ofObject: objToScan.
  				 (self isOopForwarded: field) ifTrue:
  					[field := self followForwarded: field.
  					 self storePointerUnchecked: index ofObject: objToScan withValue: field].
  				 ((self isImmediate: field)
  				  or: [self isMarked: field]) ifFalse:
  					[self setIsMarkedOf: field to: true.
+ 					 (self isWeakNonImm: objToScan)
+ 						ifTrue: [self push: field onObjStack: weaklingStack]
+ 						ifFalse:
+ 							[(self topOfObjStack: markStack) ~= objToScan ifTrue: 
+ 								[self push: objToScan onObjStack: markStack].
+ 							 self push: (self integerObjectOf: index) onObjStack: markStack].
- 					 (self topOfObjStack: markStack) ~= objToScan ifTrue: 
- 						[self push: objToScan onObjStack: markStack].
- 					 self push: (self integerObjectOf: index) onObjStack: markStack.
  					 objToScan := field.
  					 index := -1]].
  			 index >= 0 ifTrue: "if loop terminated without finding an unmarked referent, switch to top of stack."
  				[objToScan := self popObjStack: markStack.
  				 objToScan = objOop ifTrue:
  					[objToScan := self popObjStack: markStack]]]
  		ifFalse: "scanning a small object. scan, marking, pushing unmarked referents, then switch to the top of the stack."
  			[index := numStrongSlots.
  			 [index > 0] whileTrue:
  				[index := index - 1.
  				 field := self fetchPointer: index ofObject: objToScan.
  				 (self isOopForwarded: field) ifTrue:
  					[field := self followForwarded: field.
  					 self storePointerUnchecked: index ofObject: objToScan withValue: field].
  				 ((self isImmediate: field)
  				  or: [self isMarked: field]) ifFalse:
  					[self setIsMarkedOf: field to: true.
+ 					 (self isWeakNonImm: field)
+ 						ifTrue: [self push: field onObjStack: weaklingStack]
+ 						ifFalse:
+ 							[self push: field onObjStack: markStack.
+ 							 numStrongSlots := self numStrongSlotsOf: field ephemeronInactiveIf: #inactiveOrFailedToDeferScan:.
+ 							 numStrongSlots > self traceImmediatelySlotLimit ifTrue:
+ 								[self push: (self integerObjectOf: numStrongSlots) onObjStack: markStack]]]].
- 					 self push: field onObjStack: markStack.
- 					 numStrongSlots := self numStrongSlotsOf: field ephemeronInactiveIf: #inactiveOrFailedToDeferScan:.
- 					 numStrongSlots > self traceImmediatelySlotLimit ifTrue:
- 						[self push: (self integerObjectOf: numStrongSlots) onObjStack: markStack]]].
  			 objToScan := self popObjStack: markStack].
  	 objToScan notNil] whileTrue!

Item was added:
+ ----- Method: SpurMemoryManager>>markAndTraceWeaklingsFrom: (in category 'weakness and ephemerality') -----
+ markAndTraceWeaklingsFrom: startIndex
+ 	"Mark weaklings on the weaklingStack, ignoring startIndex
+ 	 number of elements on the bottom of the stack.  Answer
+ 	 the size of the stack *before* the enumeration began."
+ 	^self objStack: weaklingStack from: startIndex do:
+ 		[:weakling|
+ 		 0 to: (self numStrongSlotsOf: weakling ephemeronInactiveIf: nil) - 1 do:
+ 			[:field|
+ 			((self isImmediate: field) or: [self isMarked: field]) ifFalse:
+ 				[self markAndTrace: field]]]!

Item was changed:
  ----- Method: SpurMemoryManager>>markObjects (in category 'gc - global') -----
  markObjects
  	"Mark all accessible objects."
  	"If the incremental collector is running mark bits may be set; stop it and clear them if necessary."
  	self ensureAllMarkBitsAreZero.
  	self initializeUnscannedEphemerons.
  	self initializeMarkStack.
+ 	self initializeWeaklingStack.
  	self markAccessibleObjects!

Item was added:
+ ----- Method: SpurMemoryManager>>markWeaklingsAndMarkAndFireEphemerons (in category 'gc - global') -----
+ markWeaklingsAndMarkAndFireEphemerons
+ 	"After the initial scan-mark is complete ephemerons can be processed.
+ 	 Weaklings have accumulated on the weaklingStack, but more may be
+ 	 uncovered during ephemeron processing.  So trace the strong slots
+ 	 of the weaklings, and as ephemerons are processed ensure any newly
+ 	 reached weaklings are also traced."
+ 	| numTracedWeaklings |
+ 	numTracedWeaklings := 0.
+ 	[coInterpreter markAndTraceUntracedReachableStackPages.
+ 	 numTracedWeaklings := self markAndTraceWeaklingsFrom: numTracedWeaklings.
+ 	 self noUnscannedEphemerons ifTrue:
+ 		[^self].
+ 	 self markInactiveEphemerons ifFalse:
+ 		[self fireAllUnscannedEphemerons].
+ 	 self markAllUnscannedEphemerons]
+ 		repeat!

Item was added:
+ ----- 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."
+ 	self objStack: weaklingStack from: 0 do:
+ 		[:weakling|
+ 		(self nilUnmarkedWeaklingSlots: weakling) ifTrue:
+ 			[coInterpreter signalFinalization: weakling]].
+ 	self emptyObjStack: weaklingStack!

Item was added:
+ ----- Method: SpurMemoryManager>>nilUnmarkedWeaklingSlotsIn: (in category 'weakness and ephemerality') -----
+ nilUnmarkedWeaklingSlotsIn: aWeakling
+ 	"Nil the unmarked slots in aWeakling and
+ 	 answer if any unmarked slots were found."
+ 	| anyUnmarked |
+ 	anyUnmarked := false.
+ 	(self numStrongSlotsOf: aWeakling ephemeronInactiveIf: nil) to: (self numSlotsOf: aWeakling) - 1 do:
+ 		[:i| | oop |
+ 		oop := self fetchPointer: i ofObject: aWeakling.
+ 		((self isImmediate: oop) or: [self isMarked: oop]) ifFalse:
+ 			[self storePointerUnchecked: i ofObject: aWeakling withValue: nilObj.
+ 			 anyUnmarked := true]].
+ 	^anyUnmarked!

Item was added:
+ ----- Method: SpurMemoryManager>>noCheckPush:onObjStack: (in category 'obj stacks') -----
+ noCheckPush: objOop onObjStack: objStack
+ 	"Push an element on an objStack.  Split from push:onObjStack: for testing."
+ 	| topx |
+ 	self assert: (self isValidObjStack: objStack).
+ 	self cCode: [] "for debugging markAndTrace: set (MarkStackRecord := OrderedCollection new)"
+ 		inSmalltalk:
+ 			[objStack = markStack ifTrue:
+ 				[MarkStackRecord ifNotNil: [MarkStackRecord addLast: {#push. objOop}]]].
+ 	topx := self fetchPointer: ObjStackTopx ofObject: objStack.
+ 	topx >= ObjStackLimit
+ 		ifTrue:
+ 			[self noCheckPush: objOop
+ 				onObjStack: (self ensureRoomOnObjStackAt: (self fetchPointer: ObjStackMyx ofObject: objStack))]
+ 		ifFalse:
+ 			[self storePointer: ObjStackFixedSlots + topx ofObjStack: objStack withValue: objOop.
+ 			 self storePointer: ObjStackTopx ofObjStack: objStack withValue: topx + 1].
+ 	^objOop!

Item was added:
+ ----- Method: SpurMemoryManager>>objStack:from:do: (in category 'obj stacks') -----
+ objStack: objStack from: start do: aBlock
+ 	"Evaluate aBlock with all elements from start (0-relative) in objStack.
+ 	 Answer the size of the stack *before* the enumeration commences.
+ 	 This evaluates in top-of-stack-to-bottom order.  N.B. this is also stable
+ 	 if aBlock causes new elements to be added to the objStack, but
+ 	 unstable if aBlock causes elements to be removed."
+ 	| size objStackPage numToEnumerate |
+ 	size := self fetchPointer: ObjStackTopx ofObject: objStack.
+ 	objStackPage := self fetchPointer: ObjStackNextx ofObject: objStack.
+ 	[objStackPage ~= 0] whileTrue:
+ 		[size := size + ObjStackLimit.
+ 		 self assert: (self fetchPointer: ObjStackTopx ofObject: objStackPage) = ObjStackLimit.
+ 		 objStackPage := self fetchPointer: ObjStackNextx ofObject: objStackPage].
+ 	numToEnumerate := size - start.
+ 	objStackPage := objStack.
+ 	[numToEnumerate > 0] whileTrue:
+ 		[| numOnThisPage numToEnumerateOnThisPage topIndex |
+ 		 numOnThisPage := self fetchPointer: ObjStackTopx ofObject: objStackPage.
+ 		 numToEnumerateOnThisPage := numToEnumerate min: numOnThisPage.
+ 		 topIndex := numOnThisPage + ObjStackFixedSlots - 1.
+ 		 topIndex
+ 			to: topIndex - numToEnumerateOnThisPage + 1
+ 			by: -1
+ 			do:	[:i| aBlock value: (self fetchPointer: i ofObject: objStackPage)].
+ 		 numToEnumerate := numToEnumerate - numToEnumerateOnThisPage.
+ 		 objStackPage := self fetchPointer: ObjStackNextx ofObject: objStackPage].
+ 	^size!

Item was changed:
  ----- Method: SpurMemoryManager>>popObjStack: (in category 'obj stacks') -----
  popObjStack: objStack
  	| topx top nextPage myx |
  	self assert: (self isValidObjStack: objStack).
  	topx := self fetchPointer: ObjStackTopx ofObject: objStack.
  	topx = 0 ifTrue:
  		[self assert: (self fetchPointer: ObjStackNextx ofObject: objStack) = 0.
  		 self cCode: [] "for debugging markAndTrace: set (MarkStackRecord := OrderedCollection new)"
  			inSmalltalk:
  				[MarkStackRecord ifNotNil:
  					[MarkStackRecord addLast: {#EMPTY. nil}]].
  		^nil].
  	topx := topx - 1.
  	top := self fetchPointer: topx + ObjStackFixedSlots ofObject: objStack.
  	self cCode: [] "for debugging markAndTrace: set (MarkStackRecord := OrderedCollection new)"
  		inSmalltalk:
  			[MarkStackRecord ifNotNil:
  				[(MarkStackRecord last first = #push and: [MarkStackRecord last last = top])
  					ifTrue: [MarkStackRecord removeLast]
  					ifFalse: [MarkStackRecord addLast: {#pop. top}]]].
  	self storePointer: ObjStackTopx ofObject: objStack withValue: topx.
  	(topx = 0
  	 and: [(nextPage := self fetchPointer: ObjStackNextx ofObject: objStack) ~= 0]) ifTrue:
  		[self storePointer: ObjStackFreex ofObjStack: nextPage withValue: objStack.
  		 self storePointer: ObjStackNextx ofObjStack: objStack withValue: 0.
+ 		 myx := self fetchPointer: ObjStackMyx ofObject: objStack.
+ 		 self updateRootOfObjStack: myx with: nextPage].
- 		myx := self fetchPointer: ObjStackMyx ofObject: objStack.
- 		self updateRootOfObjStack: myx with: nextPage].
  	^top!

Item was changed:
  ----- Method: SpurMemoryManager>>push:onObjStack: (in category 'obj stacks') -----
  push: objOop onObjStack: objStack
- 	| topx |
  	self assert: (self addressCouldBeOop: objOop).
+ 	(self isImmediate: objOop)
- 	self assert: (self isValidObjStack: objStack).
- 	(self isImmediate: objOop) ifTrue:
- 		[self assert: objStack = markStack.
- 		 self assert: (self addressCouldBeObj: (self topOfObjStack:
- 						(0 = (self fetchPointer: ObjStackTopx ofObject: objStack)
- 							ifTrue: [self fetchPointer: ObjStackNextx ofObject: objStack]
- 							ifFalse: [objStack])))].
- 	self cCode: [] "for debugging markAndTrace: set (MarkStackRecord := OrderedCollection new)"
- 		inSmalltalk: [MarkStackRecord ifNotNil: [MarkStackRecord addLast: {#push. objOop}]].
- 	topx := self fetchPointer: ObjStackTopx ofObject: objStack.
- 	topx >= ObjStackLimit
  		ifTrue:
+ 			[self assert: objStack = markStack.
+ 			 self assert: (self addressCouldBeObj: (self topOfObjStack:
+ 							(0 = (self fetchPointer: ObjStackTopx ofObject: objStack)
+ 								ifTrue: [self fetchPointer: ObjStackNextx ofObject: objStack]
+ 								ifFalse: [objStack])))]
+ 		ifFalse: "There should be no weaklings on the mark stack."
+ 			[self assert: (objStack = markStack and: [self isWeakNonImm: objOop]) not.
+ 			"There should only be weaklings on the weaklingStack"
+ 			 self assert: (objStack ~= weaklingStack or: [self isWeakNonImm: objOop])].
+ 	^self noCheckPush: objOop onObjStack: objStack!
- 			[self push: objOop
- 				onObjStack: (self ensureRoomOnObjStackAt: (self fetchPointer: ObjStackMyx ofObject: objStack))]
- 		ifFalse:
- 			[self storePointer: ObjStackFixedSlots + topx ofObjStack: objStack withValue: objOop.
- 			 self storePointer: ObjStackTopx ofObjStack: objStack withValue: topx + 1].
- 	^objOop!

Item was changed:
  ----- Method: SpurMemoryManager>>updateRootOfObjStack:with: (in category 'obj stacks') -----
  updateRootOfObjStack: objStackRootIndex with: newRootPage
  	self storePointer: objStackRootIndex
  		ofObject: hiddenRootsObj
  		withValue: newRootPage.
  	objStackRootIndex caseOf: {
  		[MarkStackRootIndex]			->	[markStack := newRootPage].
+ 		[WeaklingStackRootIndex]		->	[weaklingStack := newRootPage].
  		[EphemeronQueueRootIndex]	->	[ephemeronQueue := newRootPage] }.
  	self assert: (self isValidObjStack: newRootPage).
  	^newRootPage!

Item was changed:
  ----- Method: StackInterpreter>>flushMethodCache (in category 'method lookup cache') -----
  flushMethodCache
  	"Flush the method cache. The method cache is flushed on every programming change and garbage collect."
  
  	1 to: MethodCacheSize do: [ :i | methodCache at: i put: 0 ].
+ 	lastMethodCacheProbeWrite := 0. "this for primitiveExternalMethod"
+ 	self flushAtCache.!
- 	lastMethodCacheProbeWrite := 0 "this for primitiveExternalMethod"!

Item was changed:
  ----- Method: StackInterpreter>>preGCAction: (in category 'object memory support') -----
  preGCAction: gcModeArg
  	<asmLabel: false>
  	"Need to write back the frame pointers unless all pages are free (as in snapshot)"
  	stackPage ~= 0 ifTrue:
+ 		[self externalWriteBackHeadFramePointers].
+ 	(gcModeArg = GCModeFull
+ 	 and: [objectMemory hasSpurMemoryManagerAPI]) ifTrue:
+ 		[self flushMethodCache]!
- 		[self externalWriteBackHeadFramePointers]!

Item was changed:
  ----- Method: StackInterpreterSimulator>>initialize (in category 'initialization') -----
  initialize
  	"Initialize the StackInterpreterSimulator when running the interpreter
  	 inside Smalltalk. The primary responsibility of this method is to allocate
  	 Smalltalk Arrays for variables that will be declared as statically-allocated
  	 global arrays in the translated code."
  
  	objectMemory ifNil:
  		[objectMemory := self class objectMemoryClass simulatorClass new].
  	objectMemory coInterpreter: self.
  
  	"Note: we must initialize ConstMinusOne differently for simulation,
  		due to the fact that the simulator works only with +ve 32-bit values"
  	ConstMinusOne := objectMemory integerObjectOf: -1.
  
  	methodCache := Array new: MethodCacheSize.
  	atCache := Array new: AtCacheTotalSize.
  	self flushMethodCache.
- 	self flushAtCache.
  	gcSemaphoreIndex := 0.
  	externalSemaphoreSignalRequests := externalSemaphoreSignalResponses := #().
  	externalPrimitiveTable := CArrayAccessor on: (Array new: MaxExternalPrimitiveTableSize).
  	externalPrimitiveTableFirstFreeIndex := 0.
  	primitiveTable := self class primitiveTable copy.
  	pluginList := {'' -> self }.
  	mappedPluginEntries := #().
  	desiredNumStackPages := desiredEdenBytes := 0.
  	"This is initialized on loading the image, but convenient for testing stack page values..."
  	numStackPages := self defaultNumStackPages. 
  	startMicroseconds := Time totalSeconds * 1000000.
  
  	"initialize InterpreterSimulator variables used for debugging"
  	byteCount := 0.
  	sendCount := 0.
  	quitBlock := [^ self].
  	traceOn := true.
  	printSends := printReturns := printFrameAtEachStep := printBytecodeAtEachStep := false.
  	myBitBlt := BitBltSimulator new setInterpreter: self.
  	transcript := Transcript.
  	displayForm := 'Display has not yet been installed' asDisplayText form.
  	suppressHeartbeatFlag := false.
  	extSemTabSize := 256.
  	disableBooleanCheat := false!



More information about the Vm-dev mailing list