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

commits at source.squeak.org commits at source.squeak.org
Fri Mar 21 05:16:03 UTC 2014


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

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

Name: VMMaker.oscog-eem.653
Author: eem
Time: 20 March 2014, 10:12:07.947 pm
UUID: 8ed77d78-2be2-4023-b767-7486dd43736f
Ancestors: VMMaker.oscog-eem.652

Fix store check call from machine code which in Spur was showing
that ClassReg (%ecx, a caller-saved reg) was not being saved when
calling ceStoreCheck:.  This /could/ be the cause of crashes in the
clang build (or at least one major cause).  It didn't show in the
classic VM because the store check is simpler.

Fix copyAndForward: to add tenured objects to weak and ephemeron
lists if required.  Because the weak and ephemeron lists are threaded
through forwarding corpses they can indeed refer to old objects,
adn just cuz a weak/ewphemeron object is tenured doesn't mean it
doesn't need to be scanned post-scavenge.

Relax the leak-check in Spur fullGC to allow invalid class indices at
any point except after fullGC, at which point the classTable should
have been purged.

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

Item was changed:
  CogClass subclass: #CogObjectRepresentation
+ 	instanceVariableNames: 'cogit methodZone objectMemory backEnd ceStoreCheckTrampoline'
- 	instanceVariableNames: 'cogit methodZone objectMemory ceStoreCheckTrampoline'
  	classVariableNames: ''
  	poolDictionaries: 'CogMethodConstants CogRTLOpcodes VMBasicConstants VMObjectIndices'
  	category: 'VMMaker-JIT'!
  
  !CogObjectRepresentation commentStamp: '<historical>' prior: 0!
  I am an abstract superclass for object representations whose job it is to generate abstract instructions for accessing objects.  It is hoped that this level of indirection between the Cogit code generator and object access makes it easier to adapt the code generator to different garbage collectors, object representations and languages.!

Item was added:
+ ----- Method: CogObjectRepresentation class>>forCogit:backEnd:methodZone: (in category 'instance creation') -----
+ forCogit: aCogit backEnd: backEnd methodZone: methodZone
+ 	^self new setCogit: aCogit backEnd: backEnd methodZone: methodZone!

Item was removed:
- ----- Method: CogObjectRepresentation class>>forCogit:methodZone: (in category 'instance creation') -----
- forCogit: aCogit methodZone: methodZone
- 	^self new setCogit: aCogit methodZone: methodZone!

Item was added:
+ ----- Method: CogObjectRepresentation class>>prepareToBeAddedToCodeGenerator: (in category 'translation') -----
+ prepareToBeAddedToCodeGenerator: aCCodeGenerator
+ 	aCCodeGenerator removeVariable: 'backEnd'!

Item was added:
+ ----- Method: CogObjectRepresentation>>setCogit:backEnd:methodZone: (in category 'initialization') -----
+ setCogit: aCogit backEnd: aBackEnd methodZone: aMethodZone
+ 	<doNotGenerate>
+ 	cogit := aCogit.
+ 	backEnd := backEnd.
+ 	methodZone := aMethodZone.
+ 	objectMemory := (aCogit coInterpreter isKindOf: StackInterpreter)
+ 						ifTrue: [aCogit coInterpreter objectMemory]
+ 						ifFalse: [aCogit coInterpreter]!

Item was removed:
- ----- Method: CogObjectRepresentation>>setCogit:methodZone: (in category 'initialization') -----
- setCogit: aCogit methodZone: aMethodZone
- 	<doNotGenerate>
- 	cogit := aCogit.
- 	methodZone := aMethodZone.
- 	objectMemory := (aCogit coInterpreter isKindOf: StackInterpreter)
- 						ifTrue: [aCogit coInterpreter objectMemory]
- 						ifFalse: [aCogit coInterpreter]!

Item was changed:
  ----- Method: CogObjectRepresentationForSpur>>genStoreCheckReceiverReg:valueReg:scratchReg: (in category 'compile abstract instructions') -----
  genStoreCheckReceiverReg: destReg valueReg: valueReg scratchReg: scratchReg
  	"Generate the code for a store check of valueReg into destReg."
  	| jmpImmediate jmpDestYoung jmpSourceOld jmpAlreadyRemembered mask rememberedBitByteOffset |
  	<var: #jmpImmediate type: #'AbstractInstruction *'>
  	<var: #jmpDestYoung type: #'AbstractInstruction *'>
  	<var: #jmpSourceOld type: #'AbstractInstruction *'>
  	<var: #jmpAlreadyRemembered type: #'AbstractInstruction *'>
  	"Is value stored an integer?  If so we're done"
  	cogit MoveR: valueReg R: scratchReg.
  	cogit AndCq: objectMemory tagMask R: scratchReg.
  	jmpImmediate := cogit JumpNonZero: 0.
  	"Get the old/new boundary in scratchReg"
  	cogit MoveCw: objectMemory storeCheckBoundary R: scratchReg.
  	"Is target young?  If so we're done"
  	cogit CmpR: scratchReg R: destReg. "N.B. FLAGS := destReg - scratchReg"
  	jmpDestYoung := cogit JumpBelow: 0.
  	"Is value stored old?  If so we're done."
  	cogit CmpR: scratchReg R: valueReg. "N.B. FLAGS := valueReg - scratchReg"
  	jmpSourceOld := cogit JumpAboveOrEqual: 0.
  	"value is young and target is old.
  	 Need to remember this only if the remembered bit is not already set.
  	 Test the remembered bit.  Only need to fetch the byte containing it,
  	 which reduces the size of the mask constant."
  	rememberedBitByteOffset := jmpSourceOld isBigEndian
  									ifTrue: [objectMemory baseHeaderSize - 1 - (objectMemory rememberedBitShift // 8)]
  									ifFalse:[objectMemory rememberedBitShift // 8].
  	mask := 1 << (objectMemory rememberedBitShift \\ 8).
  	"N.B. MoveMb:r:R: does not zero other bits"
  	cogit MoveMb: rememberedBitByteOffset r: destReg R: scratchReg.
  	cogit AndCq: mask R: scratchReg.
  	jmpAlreadyRemembered := cogit JumpNonZero: 0.
  	"Remembered bit is not set.  Call store check to insert dest into remembered table."
  	self assert: destReg == ReceiverResultReg.
+ 	cogit
+ 		CallRT: ceStoreCheckTrampoline
+ 		registersToBeSavedMask: ((cogit registerMaskFor: valueReg)
+ 										bitAnd: backEnd callerSavedRegisterMask).
- 	cogit CallRT: ceStoreCheckTrampoline.
  	jmpImmediate jmpTarget:
  	(jmpDestYoung jmpTarget:
  	(jmpSourceOld jmpTarget:
  	(jmpAlreadyRemembered jmpTarget:
  		cogit Label))).
  	^0!

Item was removed:
- ----- Method: CogObjectRepresentationForSpur>>getStoreCheckReceiverReg:valueReg:scratchReg: (in category 'compile abstract instructions') -----
- getStoreCheckReceiverReg: destReg valueReg: valueReg scratchReg: scratchReg
- 	"Generate the code for a store check of valueReg into destReg."
- 	| jmpImmediate jmpDestYoung jmpSourceOld jmpAlreadyRemembered mask rememberedBitByteOffset |
- 	<var: #jmpImmediate type: #'AbstractInstruction *'>
- 	<var: #jmpDestYoung type: #'AbstractInstruction *'>
- 	<var: #jmpSourceOld type: #'AbstractInstruction *'>
- 	<var: #jmpAlreadyRemembered type: #'AbstractInstruction *'>
- 	"Is value stored an integer?  If so we're done"
- 	cogit MoveR: valueReg R: scratchReg.
- 	cogit AndCq: objectMemory tagMask R: scratchReg.
- 	jmpImmediate := cogit JumpNonZero: 0.
- 	"Get the old/new boundary in scratchReg"
- 	cogit MoveCw: objectMemory storeCheckBoundary R: scratchReg.
- 	"Is target young?  If so we're done"
- 	cogit CmpR: scratchReg R: destReg. "N.B. FLAGS := destReg - scratchReg"
- 	jmpDestYoung := cogit JumpBelow: 0.
- 	"Is value stored old?  If so we're done."
- 	cogit CmpR: scratchReg R: valueReg. "N.B. FLAGS := valueReg - scratchReg"
- 	jmpSourceOld := cogit JumpAboveOrEqual: 0.
- 	"value is young and target is old.
- 	 Need to remember this only if the remembered bit is not already set.
- 	 Test the remembered bit.  Only need to fetch the byte containing it,
- 	 which reduces the size of the mask constant."
- 	rememberedBitByteOffset := jmpSourceOld isBigEndian
- 									ifTrue: [objectMemory baseHeaderSize - 1 - (objectMemory rememberedBitShift // 8)]
- 									ifFalse:[objectMemory rememberedBitShift // 8].
- 	mask := 1 << (objectMemory rememberedBitShift \\ 8).
- 	"N.B. MoveMb:r:R: does not zero other bits"
- 	cogit MoveMb: rememberedBitByteOffset r: destReg R: scratchReg.
- 	cogit AndCq: mask R: scratchReg.
- 	jmpAlreadyRemembered := cogit JumpNonZero: 0.
- 	"Remembered bit is not set.  Call store check to insert dest into remembered table."
- 	self assert: destReg == ReceiverResultReg.
- 	cogit CallRT: ceStoreCheckTrampoline.
- 	jmpImmediate jmpTarget:
- 	(jmpDestYoung jmpTarget:
- 	(jmpSourceOld jmpTarget:
- 	(jmpAlreadyRemembered jmpTarget:
- 		cogit Label))).
- 	^0!

Item was changed:
  ----- Method: CogObjectRepresentationForSqueakV3>>genStoreSourceReg:slotIndex:destReg:scratchReg: (in category 'compile abstract instructions') -----
  genStoreSourceReg: sourceReg slotIndex: index destReg: destReg scratchReg: scratchReg
  	| jmpImmediate jmpDestYoung jmpSourceOld jmpAlreadyRoot mask rootBitByteOffset |
  	<var: #jmpImmediate type: #'AbstractInstruction *'>
  	<var: #jmpDestYoung type: #'AbstractInstruction *'>
  	<var: #jmpSourceOld type: #'AbstractInstruction *'>
  	<var: #jmpAlreadyRoot type: #'AbstractInstruction *'>
  	"do the store"
  	cogit MoveR: sourceReg Mw: index * BytesPerWord + BaseHeaderSize r: destReg.
  	"now the check.  Is value stored an integer?  If so we're done"
  	cogit MoveR: sourceReg R: scratchReg.
  	cogit AndCq: 1 R: scratchReg.
  	jmpImmediate := cogit JumpNonZero: 0.
  	"Get the old/new boundary in scratchReg"
  	cogit MoveAw: objectMemory youngStartAddress R: scratchReg.
  	"Is target young?  If so we're done"
  	cogit CmpR: scratchReg R: destReg. "N.B. FLAGS := destReg - scratchReg"
  	jmpDestYoung := cogit JumpAboveOrEqual: 0.
  	"Is value stored old?  If so we're done."
  	cogit CmpR: scratchReg R: sourceReg. "N.B. FLAGS := sourceReg - scratchReg"
  	jmpSourceOld := cogit JumpBelow: 0.
  	"value is young and target is old.
  	 Need to make this a root if the root bit is not already set.
  	 Test the root bit.  Only need to fetch the byte containing it,
  	 which reduces the size of the mask constant."
  	rootBitByteOffset := jmpSourceOld isBigEndian
  							ifTrue: [BytesPerWord - RootBitDigitLength]
  							ifFalse:[RootBitDigitLength - 1].
  	mask := RootBitDigitLength > 1
  				ifTrue: [RootBit >> (RootBitDigitLength - 1 * 8)]
  				ifFalse: [RootBit].
  	"N.B. MoveMb:r:R: does not zero other bits"
  	cogit MoveMb: rootBitByteOffset r: destReg R: scratchReg.
  	cogit AndCq: mask R: scratchReg.
  	jmpAlreadyRoot := cogit JumpNonZero: 0.
  	"Root bit is not set.  Call store check to insert dest into root table."
  	self assert: destReg == ReceiverResultReg.
+ 	cogit
+ 		CallRT: ceStoreCheckTrampoline
+ 		registersToBeSavedMask: ((cogit registerMaskFor: sourceReg)
+ 										bitAnd: backEnd callerSavedRegisterMask).
- 	cogit CallRT: ceStoreCheckTrampoline.
  	jmpImmediate jmpTarget:
  	(jmpDestYoung jmpTarget:
  	(jmpSourceOld jmpTarget:
  	(jmpAlreadyRoot jmpTarget:
  		cogit Label))).
  	^0!

Item was changed:
  ----- Method: Cogit>>checkIfValidObjectRefAndTarget:pc:cogMethod: (in category 'garbage collection') -----
  checkIfValidObjectRefAndTarget: annotation pc: mcpc cogMethod: cogMethod
  	<var: #mcpc type: #'char *'>
  	| literal entryPoint |
  	annotation = IsObjectReference ifTrue:
  		[literal := backEnd literalBeforeFollowingAddress: mcpc asInteger.
  		 (self asserta: (objectRepresentation checkValidObjectReference: literal)) ifFalse:
  			[^1].
  		((objectRepresentation couldBeObject: literal)
  		 and: [objectMemory isReallyYoungObject: literal]) ifTrue:
  			[(self asserta: (self cCoerceSimple: cogMethod to: #'CogMethod *') cmRefersToYoung) ifFalse:
  				[^2]]].
  	(self isSendAnnotation: annotation) ifTrue:
  		[(self asserta: (self cCoerceSimple: cogMethod to: #'CogMethod *') cmType = CMMethod) ifFalse:
  			[^3].
  		 self offsetCacheTagAndCouldBeObjectAt: mcpc annotation: annotation into:
  			[:offset :cacheTag :tagCouldBeObject|
  			tagCouldBeObject
  				ifTrue:
  					[(objectRepresentation couldBeObject: cacheTag)
  						ifTrue:
  							[(self asserta: (objectRepresentation checkValidObjectReference: cacheTag)) ifFalse:
  								[^4]]
  						ifFalse:
  							[(self asserta: (objectRepresentation checkValidInlineCacheTag: cacheTag)) ifFalse:
  								[^5]].
  					((objectRepresentation couldBeObject: cacheTag)
+ 					 and: [objectMemory isReallyYoungObject: cacheTag]) ifTrue:
- 					 and: [coInterpreter isReallyYoungObject: cacheTag]) ifTrue:
  						[(self asserta: (self cCoerceSimple: cogMethod to: #'CogMethod *') cmRefersToYoung) ifFalse:
  							[^6]]]
  				ifFalse:
  					[(self asserta: (objectRepresentation checkValidInlineCacheTag: cacheTag)) ifFalse:
  						[^7]]].
  		entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
  		entryPoint > methodZoneBase ifTrue:
  			["It's a linked send; find which kind."
  			 self targetMethodAndSendTableFor: entryPoint annotation: annotation into:
  					[:targetMethod :sendTable|
  					 (self asserta: (targetMethod cmType = CMMethod
  								   or: [targetMethod cmType = CMClosedPIC
  								   or: [targetMethod cmType = CMOpenPIC]])) ifFalse:
  						[^8]]]].
  	^0 "keep scanning"!

Item was changed:
  ----- Method: Cogit>>freeUnmarkedMachineCode (in category 'jit - api') -----
  freeUnmarkedMachineCode
  	"Free machine-code methods whose compiled methods are unmarked
  	 and open PICs whose selectors are not marked."
  	<api>
  	<option: #SpurMemoryManager>
  	| cogMethod freedMethod |
  	<var: #cogMethod type: #'CogMethod *'>
  	freedMethod := false.
  	cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
  	[cogMethod < methodZone limitZony] whileTrue:
  		[(cogMethod cmType = CMMethod
  		  and: [(objectMemory isMarked: cogMethod methodObject) not]) ifTrue:
  			[freedMethod := true.
+ 			 methodZone freeMethod: cogMethod].
- 			 self freeMethod: cogMethod].
  		 (cogMethod cmType = CMOpenPIC
  		  and: [(objectMemory isImmediate: cogMethod selector) not
  		  and: [(objectMemory isMarked: cogMethod selector) not]]) ifTrue:
  			[freedMethod := true.
+ 			 methodZone freeMethod: cogMethod].
- 			 self freeMethod: cogMethod].
  		 cogMethod := methodZone methodAfter: cogMethod].
  	freedMethod ifTrue:
  		[self unlinkSendsToFree.
  		 methodZone pruneYoungReferrers.
  		 processor flushICacheFrom: codeBase to: methodZone limitZony asInteger]!

Item was changed:
  ----- Method: Cogit>>offsetCacheTagAndCouldBeObjectAt:annotation:into: (in category 'in-line cacheing') -----
  offsetCacheTagAndCouldBeObjectAt: mcpc annotation: annotation into: trinaryBlock
  	"Evaluate trinaryBlock with the entry, inline cache tag and whether the cache
  	 tag could be an object, for the send at mcpc with annotation annotation."
  	<inline: true>
  	| cacheTag entryPoint tagCouldBeObj |
  	cacheTag := backEnd inlineCacheTagAt: mcpc asInteger.
  	entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
  	"in-line cache tags are the selectors of sends if sends are unlinked,
+ 	 the selectors of super sends (entry offset = cmNoCheckEntryOffset),
+ 	 the selectors of open PIC sends (entry offset = cmEntryOffset, target is an Open PIC)
- 	 the selectors of super sends (entry offset = cmNoCheckEntryOffset)
  	 or in-line cache tags (classes, class indices, immediate bit patterns, etc).
  	 Note that selectors can be immediate so there is no guarantee that they
  	 are markable/remappable objects."
  	tagCouldBeObj := objectRepresentation inlineCacheTagsMayBeObjects
  						or: [entryPoint < methodZoneBase
+ 						or: [(entryPoint bitAnd: entryPointMask) = uncheckedEntryAlignment
+ 						or: [(entryPoint bitAnd: entryPointMask) = checkedEntryAlignment
+ 							and: [(self cCoerceSimple: entryPoint - cmEntryOffset to: #'CogMethod *') cmType = CMOpenPIC]]]].
- 						or: [(entryPoint bitAnd: entryPointMask) = cmNoCheckEntryOffset]].
  	trinaryBlock
  		value: entryPoint
  		value: cacheTag
  		value: tagCouldBeObj!

Item was changed:
  ----- Method: Cogit>>setInterpreter: (in category 'initialization') -----
  setInterpreter: aCoInterpreter
  	"Initialization of the code generator in the simulator.
  	 These objects already exist in the generated C VM
  	 or are used only in the simulation."
  	<doNotGenerate>
  	coInterpreter := aCoInterpreter.
  	objectMemory := aCoInterpreter objectMemory.
  	threadManager := aCoInterpreter threadManager. "N.B. may be nil"
  	methodZone := CogMethodZone new.
  	objectRepresentation := objectMemory objectRepresentationClass
+ 								forCogit: self
+ 								backEnd: backEnd
+ 								methodZone: methodZone.
- 								forCogit: self methodZone: methodZone.
  	methodZone setInterpreter: aCoInterpreter
  				objectRepresentation: objectRepresentation
  				cogit: self.
  	generatorTable := self class generatorTable.
  	primitiveGeneratorTable := self class primitiveTable.
  	processor := ProcessorClass new.
  	simulatedAddresses := Dictionary new.
  	simulatedTrampolines := Dictionary new.
  	simulatedVariableGetters := Dictionary new.
  	simulatedVariableSetters := Dictionary new.
  	traceStores := 0.
  	traceFlags := 8. "record prim trace on by default (see Cogit class>>decareCVarsIn:)"
  	debugPrimCallStackOffset := 0.
  	singleStep := printRegisters := printInstructions := clickConfirm := false.
  	breakBlock ifNil: [self breakPC: breakPC].
  	(backEnd := processor abstractInstructionCompilerClass new) cogit: self.
  	(methodLabel := processor abstractInstructionCompilerClass new) cogit: self.
  	sendTrampolines := CArrayAccessor on: (Array new: NumSendTrampolines).
  	superSendTrampolines := CArrayAccessor on: (Array new: NumSendTrampolines).
  	NewspeakVM ifTrue:
  		[dynamicSuperSendTrampolines := CArrayAccessor on: (Array new: NumSendTrampolines)].
  	"debug metadata"
  	objectReferencesInRuntime := CArrayAccessor on: (Array new: NumObjRefsInRuntime).
  	runtimeObjectRefIndex := 0.
  	"debug metadata"
  	trampolineAddresses := CArrayAccessor on: (Array new: NumTrampolines * 2).
  	trampolineTableIndex := 0.
  
  	compilationTrace ifNil: [compilationTrace := 0].
  	extA := extB := 0!

Item was changed:
  ----- Method: Spur32BitMMLECoSimulator>>runLeakCheckerForFullGC:excludeUnmarkedNewSpaceObjs:classIndicesShouldBeValid: (in category 'debug support') -----
  runLeakCheckerForFullGC: fullGCFlag excludeUnmarkedNewSpaceObjs: excludeUnmarkedNewSpaceObjs classIndicesShouldBeValid: classIndicesShouldBeValid
+ 	(coInterpreter displayView isNil
+ 	 and: [fullGCFlag
- 	(fullGCFlag
  			ifTrue: [self leakCheckFullGC]
+ 			ifFalse: [self leakCheckNewSpaceGC]]) ifTrue:
- 			ifFalse: [self leakCheckNewSpaceGC]) ifTrue:
  		[coInterpreter transcript nextPutAll: 'leak-checking...'; flush].
  	^super
  		runLeakCheckerForFullGC: fullGCFlag
  		excludeUnmarkedNewSpaceObjs: excludeUnmarkedNewSpaceObjs
  		classIndicesShouldBeValid: classIndicesShouldBeValid!

Item was changed:
  ----- Method: Spur32BitMMLESimulator>>runLeakCheckerForFullGC:excludeUnmarkedNewSpaceObjs:classIndicesShouldBeValid: (in category 'debug support') -----
  runLeakCheckerForFullGC: fullGCFlag excludeUnmarkedNewSpaceObjs: excludeUnmarkedNewSpaceObjs classIndicesShouldBeValid: classIndicesShouldBeValid
+ 	(coInterpreter displayView isNil
+ 	 and: [fullGCFlag
- 	(fullGCFlag
  			ifTrue: [self leakCheckFullGC]
+ 			ifFalse: [self leakCheckNewSpaceGC]]) ifTrue:
- 			ifFalse: [self leakCheckNewSpaceGC]) ifTrue:
  		[coInterpreter transcript nextPutAll: 'leak-checking...'; flush].
  	^super
  		runLeakCheckerForFullGC: fullGCFlag
  		excludeUnmarkedNewSpaceObjs: excludeUnmarkedNewSpaceObjs
  		classIndicesShouldBeValid: classIndicesShouldBeValid!

Item was changed:
  ----- Method: SpurGenerationScavenger>>copyAndForward: (in category 'scavenger') -----
  copyAndForward: survivor
  	"copyAndForward: survivor copies a survivor object either to
  	 futureSurvivorSpace or, if it is to be promoted, to oldSpace.
  	 It leaves a forwarding pointer behind.  If the object is weak
  	 then corpse is threaded onto the weakList for later treatment."
  	<inline: false>
  	| bytesInObj newLocation hash |
  	self assert: ((manager isInEden: survivor) "cog methods should be excluded."
  				or: [manager isInPastSpace: survivor]).
  	bytesInObj := manager bytesInObject: survivor.
  	"Must remember hash before copying because threading
  	 on to the weak & ephemeron lists smashes the hash field."
  	hash := manager rawHashBitsOf: survivor.
  	((self shouldBeTenured: survivor)
  	 or: [futureSurvivorStart + bytesInObj > futureSpace limit])
+ 		ifTrue: [newLocation := self copyToOldSpace: survivor]
+ 		ifFalse: [newLocation := self copyToFutureSpace: survivor bytes: bytesInObj].
- 		ifTrue:
- 			[newLocation := self copyToOldSpace: survivor.
- 			 manager forwardSurvivor: survivor to: newLocation]
- 		ifFalse:
- 			[newLocation := self copyToFutureSpace: survivor bytes: bytesInObj.
- 			 manager forwardSurvivor: survivor to: newLocation.
- 			 "if weak or ephemeron add to the relevant lists if newLocation is young.  If
- 			  old, newLocation will be remembered and dealt with in the rememberedSet."
- 			 (manager isWeakNonImm: newLocation) ifTrue:
- 				[self addToWeakList: survivor].
- 			 ((manager isEphemeron: newLocation)
- 			  and: [(self isScavengeSurvivor: (manager keyOfEphemeron: newLocation)) not]) ifTrue:
- 				[self addToEphemeronList: survivor]].
  	hash ~= 0 ifTrue:
  		[manager setHashBitsOf: newLocation to: hash].
+ 	manager forwardSurvivor: survivor to: newLocation.
+ 	"if weak or ephemeron add to the relevant list for subsequent scanning."
+ 	(manager isWeakNonImm: newLocation) ifTrue:
+ 		[self addToWeakList: survivor].
+ 	((manager isEphemeron: newLocation)
+ 	 and: [(self isScavengeSurvivor: (manager keyOfEphemeron: newLocation)) not]) ifTrue:
+ 		[self addToEphemeronList: survivor].
  	^newLocation!

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

Item was changed:
  ----- Method: SpurMemoryManager>>globalGarbageCollect (in category 'gc - global') -----
  globalGarbageCollect
+ 	self runLeakCheckerForFullGC: true
+ 		excludeUnmarkedNewSpaceObjs: false
+ 		classIndicesShouldBeValid: false.
- 	self runLeakCheckerForFullGC: true.
  	self assert: self validObjStacks.
  	self assert: (self isEmptyObjStack: markStack).
  	self assert: (self isEmptyObjStack: weaklingStack).
  
  	self markObjects.
  	self nilUnmarkedWeaklingSlots.
  	self freeUnmarkedObjectsAndSortAndCoalesceFreeSpace.
  
+ 	self runLeakCheckerForFullGC: true
+ 		excludeUnmarkedNewSpaceObjs: true
+ 		classIndicesShouldBeValid: false.
- 	self runLeakCheckerForFullGC: true excludeUnmarkedNewSpaceObjs: true classIndicesShouldBeValid: false.
  
  	self compact.
  	self eliminateAndFreeForwarders.
  
  	self assert: self validObjStacks.
  	self assert: (self isEmptyObjStack: markStack).
  	self assert: (self isEmptyObjStack: weaklingStack).
  	self assert: self allObjectsUnmarked.
+ 	self runLeakCheckerForFullGC: true
+ 		excludeUnmarkedNewSpaceObjs: false
+ 		classIndicesShouldBeValid: true!
- 	self runLeakCheckerForFullGC: true!



More information about the Vm-dev mailing list