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

commits at source.squeak.org commits at source.squeak.org
Sat Sep 14 18:39:57 UTC 2013


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

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

Name: VMMaker.oscog-eem.380
Author: eem
Time: 14 September 2013, 11:37:23.537 am
UUID: 88501329-fc68-48b0-aa14-c41c106b71bd
Ancestors: VMMaker.oscog-eem.379

Refactor
	(objectMemory isIntegerObject: oop) ifFalse:
		[oop := objectMemory remap: oop]
into
	(objectMemory shouldRemapOop: oop) ifFalse:
		[oop := objectMemory remapObj: oop]
which suits the scavenge also and avoids a lot of writes.

Move the remapping of the remap buffer and extra roots into
[New]ObjectMemory (called from mapPointersInObjectsFrom:to:).

Refactor mapInterpreterOops so it can be used in subclasses via
super (factor out remapCallbackState).

Interface the scavenger to coInterpreter.

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

Item was changed:
  ----- Method: CoInterpreter>>mapPrimTraceLog (in category 'debug support') -----
  mapPrimTraceLog
  	"The prim trace log is a circular buffer of selectors. If there is
  	 an entry at primTraceLogIndex - 1 \\ PrimTraceBufferSize it has entries.
  	 If there is something at primTraceLogIndex it has wrapped."
  	<inline: false>
  	| limit |
  	limit := self safe: primTraceLogIndex - 1 mod: PrimTraceLogSize.
  	(primTraceLog at: limit) = 0 ifTrue: [^nil].
  	(primTraceLog at: primTraceLogIndex) ~= 0 ifTrue:
  		[limit := PrimTraceLogSize - 1].
  	0 to: limit do:
  		[:i| | selector |
  		selector := primTraceLog at: i.
+ 		(objectMemory shouldRemapOop: selector) ifTrue:
+ 			[primTraceLog at: i put: (objectMemory remapObj: selector)]]!
- 		(objectMemory isIntegerObject: selector) ifFalse:
- 			[primTraceLog at: i put: (objectMemory remap: selector)]]!

Item was changed:
  ----- Method: CoInterpreter>>mapStackPages (in category 'object memory support') -----
  mapStackPages
  	<inline: false>
  	<var: #thePage type: #'StackPage *'>
  	<var: #theSP type: #'char *'>
  	<var: #theFP type: #'char *'>
  	<var: #frameRcvrOffset type: #'char *'>
  	<var: #callerFP type: #'char *'>
  	<var: #theIPPtr type: #'char *'>
  	"Need to write back the frame pointers unless all pages are free (as in snapshot)"
  	stackPage ~= 0 ifTrue:
  		[self externalWriteBackHeadFramePointers].
  	0 to: numStackPages - 1 do:
  		[:i| | thePage theSP theFP frameRcvrOffset callerFP theIPPtr theIP oop |
  		thePage := stackPages stackPageAt: i.
  		thePage isFree ifFalse:
  			[theSP := thePage headSP.
  			 theFP := thePage  headFP.
  			 "Skip the instruction pointer on top of stack of inactive pages."
  			 thePage = stackPage
  				ifTrue: [theIPPtr := ((self isMachineCodeFrame: theFP)
  									or: [(self iframeSavedIP: theFP) = 0])
  										ifTrue: [0]
  										ifFalse: [theFP + FoxIFSavedIP]]
  				ifFalse:
  					[theIPPtr := theSP.
  					 theSP := theSP + BytesPerWord].
  			[self assert: (thePage addressIsInPage: theFP).
  			 self assert: (thePage addressIsInPage: theSP).
  			 self assert: (theIPPtr = 0 or: [thePage addressIsInPage: theIPPtr]).
  			 frameRcvrOffset := self frameReceiverOffset: theFP.
  	 		  [theSP <= frameRcvrOffset] whileTrue:
  				[oop := stackPages longAt: theSP.
+ 				 (objectMemory shouldRemapOop: oop) ifTrue:
+ 					[stackPages longAt: theSP put: (objectMemory remapObj: oop)].
- 				 (objectMemory isIntegerObject: oop) ifFalse:
- 					[stackPages longAt: theSP put: (objectMemory remap: oop)].
  				 theSP := theSP + BytesPerWord].
+ 			 ((self frameHasContext: theFP)
+ 			  and: [objectMemory shouldRemapObj: (self frameContext: theFP)]) ifTrue:
- 			 (self frameHasContext: theFP) ifTrue:
  				[stackPages
  					longAt: theFP + FoxThisContext
+ 					put: (objectMemory remapObj: (self frameContext: theFP))].
- 					put: (objectMemory remap: (self frameContext: theFP))].
  			(self isMachineCodeFrame: theFP) ifFalse:
+ 				[(objectMemory shouldRemapObj: (self iframeMethod: theFP)) ifTrue:
+ 					[theIPPtr ~= 0 ifTrue:
+ 						[theIP := stackPages longAt: theIPPtr.
+ 						 theIP = cogit ceReturnToInterpreterPC
+ 							ifTrue:
+ 								[self assert: (self iframeSavedIP: theFP) > (self iframeMethod: theFP).
+ 								 theIPPtr := theFP + FoxIFSavedIP.
+ 								 theIP := stackPages longAt: theIPPtr]
+ 							ifFalse:
+ 								[self assert: theIP > (self iframeMethod: theFP)].
+ 						 theIP := theIP - (self iframeMethod: theFP)].
+ 					 stackPages
+ 						longAt: theFP + FoxMethod
+ 						put: (objectMemory remapObj: (self iframeMethod: theFP)).
+ 					 theIPPtr ~= 0 ifTrue:
+ 						[stackPages longAt: theIPPtr put: theIP + (self iframeMethod: theFP)]]].
- 				[theIPPtr ~= 0 ifTrue:
- 					[theIP := stackPages longAt: theIPPtr.
- 					 theIP = cogit ceReturnToInterpreterPC
- 						ifTrue:
- 							[self assert: (self iframeSavedIP: theFP) > (self iframeMethod: theFP).
- 							 theIPPtr := theFP + FoxIFSavedIP.
- 							 theIP := stackPages longAt: theIPPtr]
- 						ifFalse:
- 							[self assert: theIP > (self iframeMethod: theFP)].
- 					 theIP := theIP - (self iframeMethod: theFP)].
- 				 stackPages
- 					longAt: theFP + FoxMethod
- 					put: (objectMemory remap: (self iframeMethod: theFP)).
- 				 theIPPtr ~= 0 ifTrue:
- 					[stackPages longAt: theIPPtr put: theIP + (self iframeMethod: theFP)]].
  			 (callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
  				[theSP := (theIPPtr := theFP + FoxCallerSavedIP) + BytesPerWord.
  				 theFP := callerFP].
  			 theSP := theFP + FoxCallerSavedIP + BytesPerWord.
  			 [theSP <= thePage baseAddress] whileTrue:
  				[oop := stackPages longAt: theSP.
+ 				 (objectMemory shouldRemapOop: oop) ifTrue:
+ 					[stackPages longAt: theSP put: (objectMemory remapObj: oop)].
- 				 (objectMemory isIntegerObject: oop) ifFalse:
- 					[stackPages longAt: theSP put: (objectMemory remap: oop)].
  				 theSP := theSP + BytesPerWord]]]!

Item was changed:
  ----- Method: CoInterpreter>>mapTraceLog (in category 'debug support') -----
  mapTraceLog
  	"The trace log is a circular buffer of pairs of entries. If there is
  	 an entry at traceLogIndex - 3 \\ TraceBufferSize it has entries.
  	 If there is something at traceLogIndex it has wrapped."
  	<inline: false>
  	| limit |
  	limit := self safe: traceLogIndex - 3 mod: TraceBufferSize.
  	(traceLog at: limit) = 0 ifTrue: [^nil].
  	(traceLog at: traceLogIndex) ~= 0 ifTrue:
  		[limit := TraceBufferSize - 3].
  	0 to: limit by: 3 do:
  		[:i| | intOrClass selectorOrMethod |
  		intOrClass := traceLog at: i.
+ 		(objectMemory shouldRemapOop: intOrClass) ifTrue:
+ 			[traceLog at: i put: (objectMemory remapObj: intOrClass)].
- 		(objectMemory isIntegerObject: intOrClass) ifFalse:
- 			[traceLog at: i put: (objectMemory remap: intOrClass)].
  		selectorOrMethod := traceLog at: i + 1.
+ 		(objectMemory shouldRemapOop: selectorOrMethod) ifTrue:
+ 			[traceLog at: i + 1 put: (objectMemory remapObj: selectorOrMethod)]]!
- 		(objectMemory isIntegerObject: selectorOrMethod) ifFalse:
- 			[traceLog at: i + 1 put: (objectMemory remap: selectorOrMethod)]]!

Item was changed:
  ----- Method: CoInterpreter>>mapVMRegisters (in category 'object memory support') -----
  mapVMRegisters
  	"Map the oops in the interpreter's vm ``registers'' to their new values 
  	 during garbage collection or a become: operation."
  	"Assume: All traced variables contain valid oops.
  	 N.B. Don't trace messageSelector and lkupClass; these are ephemeral, live
  	 only during message lookup and because createActualMessageTo will not
  	 cause a GC these cannot change during message lookup."
  	| mapInstructionPointer |
+ 	(objectMemory shouldRemapObj: method) ifTrue:
+ 		["i.e. interpreter instructionPointer in method as opposed to machine code?"
+ 		(mapInstructionPointer := instructionPointer > method) ifTrue:
+ 			[instructionPointer := instructionPointer - method]. "*rel to method"
+ 		method := objectMemory remapObj: method.
+ 		mapInstructionPointer ifTrue:
+ 			[instructionPointer := instructionPointer + method]]. "*rel to method"
+ 	(objectMemory shouldRemapOop: newMethod) ifFalse: "maybe oop due to object-as-method"
- 	"i.e. interpreter instructionPointer in method as opposed to machine code?"
- 	(mapInstructionPointer := instructionPointer > method) ifTrue:
- 		[instructionPointer := instructionPointer - method]. "*rel to method"
- 	method := objectMemory remap: method.
- 	mapInstructionPointer ifTrue:
- 		[instructionPointer := instructionPointer + method]. "*rel to method"
- 	(objectMemory isImmediate: newMethod) ifFalse:
  		[newMethod := objectMemory remap: newMethod]!

Item was changed:
  ----- Method: CoInterpreterMT>>mapInterpreterOops (in category 'object memory support') -----
  mapInterpreterOops
  	"Map all oops in the interpreter's state to their new values 
+ 	 during garbage collection or a become: operation."
- 	during garbage collection or a become: operation."
  	"Assume: All traced variables contain valid oops."
- 	| oop |
  	<var: #vmThread type: #'CogVMThread *'>
+ 	super mapInterpreterOops.
- 	objectMemory nilObject: (objectMemory remap: objectMemory nilObject).
- 	objectMemory falseObject: (objectMemory remap: objectMemory falseObject).
- 	objectMemory trueObject: (objectMemory remap: objectMemory trueObject).
- 	objectMemory specialObjectsOop: (objectMemory remap: objectMemory specialObjectsOop).
- 	self mapStackPages.
- 	self mapMachineCode.
- 	self mapTraceLogs.
- 	self mapVMRegisters.
- 	self mapProfileState.
- 	tempOop = 0 ifFalse: [tempOop := self remap: tempOop].
- 	1 to: objectMemory remapBufferCount do:
- 		[:i|
- 		oop := objectMemory remapBuffer at: i.
- 		(objectMemory isIntegerObject: oop) ifFalse:
- 			[objectMemory remapBuffer at: i put: (objectMemory remap: oop)]].
  
- 	"Callback support - trace suspended callback list - will be made per-thread soon"
- 	1 to: jmpDepth do:
- 		[:i|
- 		oop := suspendedCallbacks at: i.
- 		(objectMemory isIntegerObject: oop) ifFalse:
- 			[suspendedCallbacks at: i put: (objectMemory remap: oop)].
- 		oop := suspendedMethods at: i.
- 		(objectMemory isIntegerObject: oop) ifFalse:
- 			[suspendedMethods at: i put: (objectMemory remap: oop)]].
- 
  	"Per-thread state; trace each thread's own newMethod and stack of awol processes."
  	1 to: cogThreadManager getNumThreads do:
  		[:i| | vmThread |
  		vmThread := cogThreadManager vmThreadAt: i.
+ 		vmThread state ifNotNil:
+ 			[(vmThread newMethodOrNull notNil
+ 			 and: [objectMemory shouldRemapOop: vmThread newMethodOrNull]) ifTrue:
+ 				[vmThread newMethodOrNull: (objectMemory remapObj: vmThread newMethodOrNull)].
- 		vmThread state notNil ifTrue:
- 			[vmThread newMethodOrNull notNil ifTrue:
- 				[vmThread newMethodOrNull: (objectMemory remap: vmThread newMethodOrNull)].
  			 0 to: vmThread awolProcIndex - 1 do:
  				[:j|
+ 				(objectMemory shouldRemapOop: (vmThread awolProcesses at: j)) ifTrue:
+ 					[vmThread awolProcesses at: j put: (objectMemory remap: (vmThread awolProcesses at: j))]]]]!
- 				vmThread awolProcesses at: j put: (objectMemory remap: (vmThread awolProcesses at: j))]]]
- !

Item was removed:
- ----- Method: CoInterpreterMT>>scavengeVMState (in category 'garbage collection') -----
- scavengeVMState
- 	"Scavenge all VM state.  We piggy-back off the ObjectMemory map
- 	 routines which are run after its maskAndTrace routines.  But here remap:
- 	 actually means scavenge."
- 	self shouldBeImplemented!

Item was added:
+ ----- Method: CogObjectRepresentationForSqueakV3>>remapObj: (in category 'garbage collection') -----
+ remapObj: oop
+ 	^objectMemory remap: oop!

Item was changed:
  ----- Method: Cogit>>mapObjectReferencesInGeneratedRuntime (in category 'garbage collection') -----
  mapObjectReferencesInGeneratedRuntime
  	"Update all references to objects in the generated runtime."
  	0 to: runtimeObjectRefIndex - 1 do:
  		[:i| | mcpc literal mappedLiteral |
  		 mcpc := objectReferencesInRuntime at: i.
  		 literal := backEnd literalBeforeFollowingAddress: mcpc asInteger.
+ 		 mappedLiteral := objectRepresentation remapObj: literal.
- 		 mappedLiteral := objectMemory remap: literal.
  		 mappedLiteral ~= literal ifTrue:
  			[backEnd storeLiteral: mappedLiteral beforeFollowingAddress: mcpc.
  			 codeModified := true]]!

Item was changed:
  ----- Method: Cogit>>remapIfObjectRef:pc:hasYoung: (in category 'garbage collection') -----
  remapIfObjectRef: annotation pc: mcpc hasYoung: hasYoungPtr
  	<var: #mcpc type: #'char *'>
  	<var: #targetMethod type: #'CogMethod *'>
  	annotation = IsObjectReference ifTrue:
  		[| literal mappedLiteral |
  		 literal := backEnd literalBeforeFollowingAddress: mcpc asInteger.
  		 (objectRepresentation couldBeObject: literal) ifTrue:
+ 			[mappedLiteral := objectRepresentation remapObj: literal.
- 			[mappedLiteral := objectMemory remap: literal.
  			 literal ~= mappedLiteral ifTrue:
  				[backEnd storeLiteral: mappedLiteral beforeFollowingAddress: mcpc asInteger.
  				 codeModified := true].
  			 (hasYoungPtr ~= 0
  			  and: [objectMemory isYoung: mappedLiteral]) ifTrue:
  				[(self cCoerceSimple: hasYoungPtr to: #'sqInt *') at: 0 put: true]]].
  	(self isSendAnnotation: annotation) ifTrue:
  		[| cacheTag mappedCacheTag |
  		 cacheTag := backEnd inlineCacheTagAt: mcpc asInteger.
  		 (objectRepresentation couldBeObject: cacheTag) ifTrue:
+ 			[mappedCacheTag := objectRepresentation remapObj: cacheTag.
- 			[mappedCacheTag := objectMemory remap: cacheTag.
  			 cacheTag ~= mappedCacheTag ifTrue:
  				[backEnd rewriteInlineCacheTag: mappedCacheTag at: mcpc asInteger.
  				 codeModified := true].
  			 (hasYoungPtr ~= 0
  			  and: [objectMemory isYoung: mappedCacheTag]) ifTrue:
  				[(self cCoerceSimple: hasYoungPtr to: #'sqInt *') at: 0 put: true]].
  		 hasYoungPtr ~= 0 ifTrue:
  			[| entryPoint offset targetMethod |
  			 "Since the unlinking routines may rewrite the cacheTag to the send's selector, and
  			  since they don't have the cogMethod to hand and can't add it to youngReferrers,
  			  the method must remain in youngReferrers if the targetMethod's selector is young."
  			 entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
  			 entryPoint > methodZoneBase ifTrue: "It's a linked send."
  				[offset := (entryPoint bitAnd: entryPointMask) = checkedEntryAlignment
  							ifTrue: [cmEntryOffset]
  							ifFalse: [cmNoCheckEntryOffset].
  				targetMethod := self cCoerceSimple: entryPoint - offset to: #'CogMethod *'.
  				(objectMemory isYoung: targetMethod selector) ifTrue:
  					[(self cCoerceSimple: hasYoungPtr to: #'sqInt *') at: 0 put: true]]]].
  	^0 "keep scanning"!

Item was changed:
  ----- Method: Cogit>>remapNSIfObjectRef:pc:hasYoung: (in category 'garbage collection') -----
  remapNSIfObjectRef: annotation pc: mcpc hasYoung: hasYoungPtr
  	<option: #NewspeakVM>
  	<var: #mcpc type: #'char *'>
  	<var: #targetMethod type: #'CogMethod *'>
  	annotation = IsObjectReference ifTrue:
  		[| literal mappedLiteral |
  		 literal := backEnd literalBeforeFollowingAddress: mcpc asInteger.
  		 (objectRepresentation couldBeObject: literal) ifTrue:
+ 			[mappedLiteral := objectRepresentation remapObj: literal.
- 			[mappedLiteral := objectMemory remap: literal.
  			 literal ~= mappedLiteral ifTrue:
  				[backEnd storeLiteral: mappedLiteral beforeFollowingAddress: mcpc asInteger.
  				 codeModified := true].
  			 (hasYoungPtr ~= 0
  			  and: [objectMemory isYoung: mappedLiteral]) ifTrue:
  				[(self cCoerceSimple: hasYoungPtr to: #'sqInt *') at: 0 put: true]]].
  	(self isSendAnnotation: annotation) ifTrue:
  		[| cacheTag mappedCacheTag entryPoint |
  		 cacheTag := backEnd inlineCacheTagAt: mcpc asInteger.
  		 (objectRepresentation couldBeObject: cacheTag) ifTrue:
+ 			[mappedCacheTag := objectRepresentation remapObj: cacheTag.
- 			[mappedCacheTag := objectMemory remap: cacheTag.
  			 cacheTag ~= mappedCacheTag ifTrue:
  				[backEnd rewriteInlineCacheTag: mappedCacheTag at: mcpc asInteger.
  				 codeModified := true].
  			 (hasYoungPtr ~= 0
  			  and: [objectMemory isYoung: mappedCacheTag]) ifTrue:
  				[(self cCoerceSimple: hasYoungPtr to: #'sqInt *') at: 0 put: true]].
  		 entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
  		 entryPoint = ceImplicitReceiverTrampoline
  			ifTrue:
  				[| pc oop mappedOop |
  				 pc := mcpc asInteger + backEnd jumpShortByteSize.
  				 (oop := backEnd unalignedLongAt: pc) ~= 0 ifTrue:
+ 					[mappedOop := objectRepresentation remapOop: oop.
- 					[mappedOop := objectMemory remap: oop.
  					 mappedOop ~= oop ifTrue:
  						[backEnd unalignedLongAt: pc put: mappedOop].
  					 (hasYoungPtr ~= 0
  					  and: [objectMemory isYoung: mappedOop]) ifTrue:
  						[(self cCoerceSimple: hasYoungPtr to: #'sqInt *') at: 0 put: true].
  					 pc := mcpc asInteger + backEnd jumpShortByteSize + BytesPerOop.
  					 (oop := backEnd unalignedLongAt: pc) ~= 0 ifTrue:
+ 						[mappedOop := objectRepresentation remapOop: oop.
- 						[mappedOop := objectMemory remap: oop.
  						 mappedOop ~= oop ifTrue:
  							[backEnd unalignedLongAt: pc put: mappedOop].
  					 (hasYoungPtr ~= 0
  					  and: [objectMemory isYoung: mappedOop]) ifTrue:
  						[(self cCoerceSimple: hasYoungPtr to: #'sqInt *') at: 0 put: true]]]]
  			ifFalse:
  				[hasYoungPtr ~= 0 ifTrue:
  					[| offset targetMethod |
  					 "Since the unlinking routines may rewrite the cacheTag to the send's selector, and
  					  since they don't have the cogMethod to hand and can't add it to youngReferrers,
  					  the method must remain in youngReferrers if the targetMethod's selector is young."
  					 entryPoint > methodZoneBase ifTrue: "It's a linked send."
  						[offset := (entryPoint bitAnd: entryPointMask) = checkedEntryAlignment
  									ifTrue: [cmEntryOffset]
  									ifFalse: [cmNoCheckEntryOffset].
  						targetMethod := self cCoerceSimple: entryPoint - offset to: #'CogMethod *'.
  						(objectMemory isYoung: targetMethod selector) ifTrue:
  							[(self cCoerceSimple: hasYoungPtr to: #'sqInt *') at: 0 put: true]]]]].
  	^0 "keep scanning"!

Item was changed:
  ----- Method: Interpreter>>mapInterpreterOops (in category 'object memory support') -----
  mapInterpreterOops
  	"Map all oops in the interpreter's state to their new values 
  	during garbage collection or a become: operation."
  	"Assume: All traced variables contain valid oops."
  	| oop |
+ 	compilerInitialized ifFalse:
+ 		[stackPointer := stackPointer - activeContext. "*rel to active"
+ 		 activeContext := self remap: activeContext.
+ 		 stackPointer := stackPointer + activeContext. "*rel to active"
+ 		 theHomeContext := self remap: theHomeContext].
- 	nilObj := self remap: nilObj.
- 	falseObj := self remap: falseObj.
- 	trueObj := self remap: trueObj.
- 	specialObjectsOop := self remap: specialObjectsOop.
- 	compilerInitialized
- 		ifFalse: [stackPointer := stackPointer - activeContext. "*rel to active"
- 			activeContext := self remap: activeContext.
- 			stackPointer := stackPointer + activeContext. "*rel to active"
- 			theHomeContext := self remap: theHomeContext].
  	instructionPointer := instructionPointer - method. "*rel to method"
  	method := self remap: method.
  	instructionPointer := instructionPointer + method. "*rel to method"
  	receiver := self remap: receiver.
  	messageSelector := self remap: messageSelector.
  	newMethod := self remap: newMethod.
  	lkupClass := self remap: lkupClass.
  	receiverClass := self remap: receiverClass.
  	profileProcess := self remap: profileProcess.
  	profileMethod := self remap: profileMethod.
  	profileSemaphore := self remap: profileSemaphore.
- 	1 to: remapBufferCount do: [:i | 
- 			oop := remapBuffer at: i.
- 			(self isIntegerObject: oop)
- 				ifFalse: [remapBuffer at: i put: (self remap: oop)]].
  
  	"Callback support - trace suspended callback list"
  	1 to: jmpDepth do:[:i|
  		oop := suspendedCallbacks at: i.
  		(self isIntegerObject: oop) 
  			ifFalse:[suspendedCallbacks at: i put: (self remap: oop)].
  		oop := suspendedMethods at: i.
  		(self isIntegerObject: oop) 
  			ifFalse:[suspendedMethods at: i put: (self remap: oop)].
  	].
  !

Item was changed:
  ----- Method: NewObjectMemory>>mapPointersInObjectsFrom:to: (in category 'gc -- compaction') -----
  mapPointersInObjectsFrom: memStart to: memEnd
  	"Use the forwarding table to update the pointers of all non-free objects in the given range of memory.
  	 Also remap pointers in root objects which may contains pointers into the given memory range, and
  	 don't forget to flush the method cache based on the range."
  	<inline: false>
+ 	(self shouldRemapObj: nilObj) ifTrue:
+ 		[nilObj := self remapObj: nilObj].
+ 	(self shouldRemapObj: falseObj) ifTrue:
+ 		[falseObj := self remapObj: falseObj].
+ 	(self shouldRemapObj: trueObj) ifTrue:
+ 		[trueObj := self remapObj: trueObj].
+ 	(self shouldRemapObj: specialObjectsOop) ifTrue:
+ 		[specialObjectsOop := self remapObj: specialObjectsOop].
  	"update interpreter variables"
+ 	coInterpreter
+ 		mapInterpreterOops;
+ 		flushMethodCacheFrom: memStart to: memEnd.
+ 	self remapRemapBufferAndExtraRoots.
- 	coInterpreter mapInterpreterOops.
- 	1 to: extraRootCount do:
- 		[:i | | oop |
- 		oop := (extraRoots at: i) at: 0.
- 		((self isIntegerObject: oop) or: [self isFreeObject: oop]) ifFalse:
- 			[(extraRoots at: i) at: 0 put: (self remap: oop)]].
- 	coInterpreter flushMethodCacheFrom: memStart to: memEnd.
  	self updatePointersInRootObjectsFrom: memStart to: memEnd.
  	self updatePointersInRangeFrom: memStart to: memEnd!

Item was changed:
  ----- Method: NewspeakInterpreter>>mapInterpreterOops (in category 'object memory support') -----
  mapInterpreterOops
  	"Map all oops in the interpreter's state to their new values 
  	during garbage collection or a become: operation."
  	"Assume: All traced variables contain valid oops."
- 	| oop |
- 	nilObj := self remap: nilObj.
- 	falseObj := self remap: falseObj.
- 	trueObj := self remap: trueObj.
- 	specialObjectsOop := self remap: specialObjectsOop.
  	stackPointer := stackPointer - activeContext. "*rel to active"
  	activeContext := self remap: activeContext.
  	stackPointer := stackPointer + activeContext. "*rel to active"
  	theHomeContext := self remap: theHomeContext.
  	instructionPointer := instructionPointer - method. "*rel to method"
  	method := self remap: method.
  	instructionPointer := instructionPointer + method. "*rel to method"
  	receiver := self remap: receiver.
  	(self isIntegerObject: messageSelector) ifFalse:
  		[messageSelector := self remap: messageSelector].
  	(self isIntegerObject: newMethod) ifFalse:
  		[newMethod := self remap: newMethod].
  	lkupClass := self remap: lkupClass.
- 	1 to: remapBufferCount do: [:i | 
- 			oop := remapBuffer at: i.
- 			(self isIntegerObject: oop)
- 				ifFalse: [remapBuffer at: i put: (self remap: oop)]].
  	self mapTraceLogs!

Item was changed:
  ----- Method: ObjectMemory>>mapPointersInObjectsFrom:to: (in category 'gc -- compaction') -----
  mapPointersInObjectsFrom: memStart to: memEnd
+ 	"Use the forwarding table to update the pointers of all non-free objects in the given range of memory.
+ 	 Also remap pointers in root objects which may contains pointers into the given memory range, and
+ 	 don't forget to flush the method cache based on the range."
- 	"Use the forwarding table to update the pointers of all non-free objects in the given range of memory. Also remap pointers in root objects which may contains pointers into the given memory range, and don't forget to flush the method cache based on the range"
- 	| oop |
  	<inline: false>
+ 	(self shouldRemapObj: nilObj) ifTrue:
+ 		[nilObj := self remapObj: nilObj].
+ 	(self shouldRemapObj: falseObj) ifTrue:
+ 		[falseObj := self remapObj: falseObj].
+ 	(self shouldRemapObj: trueObj) ifTrue:
+ 		[trueObj := self remapObj: trueObj].
+ 	(self shouldRemapObj: specialObjectsOop) ifTrue:
+ 		[specialObjectsOop := self remapObj: specialObjectsOop].
  	"update interpreter variables"
+ 	self
+ 		mapInterpreterOops;
+ 		flushMethodCacheFrom: memStart to: memEnd.
+ 	self remapRemapBufferAndExtraRoots.
- 	self mapInterpreterOops.
- 	1 to: extraRootCount do:[:i |
- 		oop := (extraRoots at: i) at: 0.
- 		((self isIntegerObject: oop) or: [self isFreeObject: oop]) ifFalse:
- 			[(extraRoots at: i) at: 0 put: (self remap: oop)]].
- 	self flushMethodCacheFrom: memStart to: memEnd.
  	self updatePointersInRootObjectsFrom: memStart to: memEnd.
  	self updatePointersInRangeFrom: memStart to: memEnd.
  !

Item was added:
+ ----- Method: ObjectMemory>>remapObj: (in category 'gc -- compaction') -----
+ remapObj: obj
+ 	<api>
+ 	"Map the given oop to its new value during a compaction or become: operation."
+ 	<inline: false>
+ 	^self remappedObj: obj!

Item was added:
+ ----- Method: ObjectMemory>>remapRemapBufferAndExtraRoots (in category 'gc -- compaction') -----
+ remapRemapBufferAndExtraRoots
+ 	| oop |
+ 	1 to: remapBufferCount do:
+ 		[:i |
+ 		oop := remapBuffer at: i.
+ 		(self shouldRemapOop: oop) ifFalse:
+ 			[remapBuffer at: i put: (self remapObj: oop)]].
+ 	1 to: extraRootCount do:
+ 		[:i |
+ 		oop := (extraRoots at: i) at: 0.
+ 		((self isIntegerObject: oop) or: [self isFreeObject: oop]) ifFalse:
+ 			[(self shouldRemapObj: oop) ifTrue:
+ 				[(extraRoots at: i) at: 0 put: (self remapObj: oop)]]]!

Item was added:
+ ----- Method: ObjectMemory>>shouldRemapObj: (in category 'gc -- compaction') -----
+ shouldRemapObj: oop
+ 	<api>
+ 	"Answer if the oop should be remapped"
+ 	<inline: true>
+ 	^self isObjectForwarded: oop!

Item was added:
+ ----- Method: ObjectMemory>>shouldRemapOop: (in category 'gc -- compaction') -----
+ shouldRemapOop: oop
+ 	<api>
+ 	"Answer if the oop should be remapped"
+ 	<inline: true>
+ 	^(self isNonIntegerObject: oop)
+ 	  and: [self isObjectForwarded: oop]!

Item was added:
+ ----- Method: SpurGenerationScavenger>>coInterpreter: (in category 'accessing') -----
+ coInterpreter: aCoInterpreter
+ 	coInterpreter := aCoInterpreter!

Item was changed:
  ----- Method: SpurGenerationScavenger>>scavenge (in category 'scavenger') -----
  scavenge
  	"The main routine, scavenge, scavenges young objects reachable from the roots (the stack zone
  	 and the rememberedTable).  It first scavenges the new objects immediately reachable from the
  	 stack zone, then those directly from old ones (all in the remembered table).  Then it scavenges
  	 those that are transitively reachable.  If this results in a promotion, the promotee gets remembered,
  	 and it first scavenges objects adjacent to the promotee, then scavenges the ones reachable from
  	 the promoted.  This loop continues until no more reachable objects are left.  At that point,
  	 pastSurvivorSpace is exchanged with futureSurvivorSpace.
  
  	 Notice that each pointer in a live object is inspected once and only once.  The previousRememberedSetSize
  	 and previousFutureSurvivorSpaceSize variables ensure that no object is scanned twice, as well as
  	 detecting closure.  If this were not true, some pointers might get forwarded twice."
  
- 	coInterpreter scavengeVMState.
  	self scavengeLoop.
  	self exchange: pastSpace with: futureSpace.
  	self computeTenuringThreshold!

Item was changed:
  ----- Method: SpurGenerationScavenger>>scavengeLoop (in category 'scavenger') -----
  scavengeLoop
  	"This is the inner loop of the main routine, scavenge.  It first scavenges the new objects immediately
  	 reachable from old ones. Then it scavenges those that are transitively reachable.  If this results in a
  	 promotion, the promotee gets remembered, and it first scavenges objects adjacent to the promotee,
  	 then scavenges the ones reachable from the promoted.  This loop continues until no more reachable
  	 objects are left.  At that point, pastSurvivorSpace is exchanged with futureSurvivorSpace.
  
  	 Notice that each pointer in a live object is inspected once and only once.  The previousRememberedSetSize
  	 and previousFutureSurvivorSpaceLimit variables ensure that no object is scanned twice, as well as
  	 detecting closure.  If this were not true, some pointers might get forwarded twice."
  
+ 	| firstTime previousRememberedSetSize previousFutureSurvivorSpaceLimit |
+ 	self assert: futureSpace limit = futureSpace start. "future space should be empty at the start"
- 	| previousRememberedSetSize previousFutureSurvivorSpaceLimit |
  	previousRememberedSetSize := 0.
  	previousFutureSurvivorSpaceLimit := futureSpace limit.
- 	self assert: futureSpace limit = futureSpace start.
  	[self scavengeRememberedSetStartingAt: previousRememberedSetSize.
  	 previousFutureSurvivorSpaceLimit = futureSpace limit ifTrue:
  		[^self].
+ 
+ 	firstTime ifTrue:
+ 		[coInterpreter mapInterpreterOops.
+ 		 firstTime := false].
+ 
- 		
  	 previousRememberedSetSize := rememberedSetSize.
  	 self scavengeFutureSurvivorSpaceStartingAt: previousFutureSurvivorSpaceLimit.
  	 previousFutureSurvivorSpaceLimit = rememberedSetSize ifTrue:
  		[^self].
  
  	 previousFutureSurvivorSpaceLimit := futureSpace size] repeat!

Item was changed:
  ----- Method: SpurMemoryManager>>coInterpreter: (in category 'simulation') -----
  coInterpreter: aCoInterpreter
  	<doNotGenerate>
+ 	coInterpreter := aCoInterpreter.
+ 	scavenger coInterpreter: aCoInterpreter!
- 	coInterpreter := aCoInterpreter!

Item was added:
+ ----- Method: SpurMemoryManager>>remapObj: (in category 'generation scavenging') -----
+ remapObj: objOop
+ 	<inline: false>
+ 	^self followForwarded: objOop!

Item was changed:
+ ----- Method: SpurMemoryManager>>scheduleScavenge (in category 'generation scavenging') -----
- ----- Method: SpurMemoryManager>>scheduleScavenge (in category 'garbage collection') -----
  scheduleScavenge
  	needGCFlag := true.
  	coInterpreter forceInterruptCheck!

Item was added:
+ ----- Method: SpurMemoryManager>>shouldRemapObj: (in category 'generation scavenging') -----
+ shouldRemapObj: objOop
+ 	^self isForwarded: objOop!

Item was added:
+ ----- Method: SpurMemoryManager>>shouldRemapOop: (in category 'generation scavenging') -----
+ shouldRemapOop: oop
+ 	<api>
+ 	"Answer if the oop should be remapped"
+ 	<inline: true>
+ 	^(self isNonImmediate: oop)
+ 	   and: [self isForwarded: oop]!

Item was changed:
+ ----- Method: SpurMemoryManager>>sufficientSpaceAfterGC: (in category 'generation scavenging') -----
- ----- Method: SpurMemoryManager>>sufficientSpaceAfterGC: (in category 'garbage collection') -----
  sufficientSpaceAfterGC: numBytes
  	"This is ObjectMemoiry's funky entry-point into its incremental GC,
  	 which is a stop-the-world a young generation reclaimer.  In Spur
  	 we run the scavenger."
  	self assert: numBytes = 0.
  	scavenger scavenge!

Item was changed:
  ----- Method: StackInterpreter>>mapInterpreterOops (in category 'object memory support') -----
  mapInterpreterOops
  	"Map all oops in the interpreter's state to their new values 
+ 	 during garbage collection or a become: operation."
- 	during garbage collection or a become: operation."
  	"Assume: All traced variables contain valid oops."
- 	| oop |
- 	objectMemory nilObject: (objectMemory remap: objectMemory nilObject).
- 	objectMemory falseObject: (objectMemory remap: objectMemory falseObject).
- 	objectMemory trueObject: (objectMemory remap: objectMemory trueObject).
- 	objectMemory specialObjectsOop: (objectMemory remap: objectMemory specialObjectsOop).
  	self mapStackPages.
  	self mapMachineCode.
  	self mapTraceLogs.
  	self mapVMRegisters.
  	self mapProfileState.
+ 	self remapCallbackState.
+ 	tempOop = 0 ifFalse: [tempOop := objectMemory remap: tempOop]!
- 	tempOop = 0 ifFalse: [tempOop := objectMemory remap: tempOop].
- 	1 to: objectMemory remapBufferCount do: [:i | 
- 			oop := objectMemory remapBuffer at: i.
- 			(objectMemory isIntegerObject: oop)
- 				ifFalse: [objectMemory remapBuffer at: i put: (objectMemory remap: oop)]].
- 
- 	"Callback support - trace suspended callback list"
- 	1 to: jmpDepth do:[:i|
- 		oop := suspendedCallbacks at: i.
- 		(objectMemory isIntegerObject: oop) 
- 			ifFalse:[suspendedCallbacks at: i put: (objectMemory remap: oop)].
- 		oop := suspendedMethods at: i.
- 		(objectMemory isIntegerObject: oop) 
- 			ifFalse:[suspendedMethods at: i put: (objectMemory remap: oop)].
- 	].
- !

Item was changed:
  ----- Method: StackInterpreter>>mapProfileState (in category 'object memory support') -----
  mapProfileState
+ 	(objectMemory shouldRemapObj: profileProcess) ifTrue:
+ 		[profileProcess := objectMemory remapObj: profileProcess].
+ 	(objectMemory shouldRemapObj: profileMethod) ifTrue:
+ 		[profileMethod := objectMemory remapObj: profileProcess].
+ 	(objectMemory shouldRemapObj: profileSemaphore) ifTrue:
+ 		[profileSemaphore := objectMemory remapObj: profileSemaphore].
- 	profileProcess := objectMemory remap: profileProcess.
- 	profileMethod := objectMemory remap: profileMethod.
- 	profileSemaphore := objectMemory remap: profileSemaphore.
  	"The longRunningPrimitiveCheckMethod (LRPCM) is sampled in an interrupt.  Be very careful with it.
  	  If longRunningPrimitiveCheckSequenceNumber (LRPCSN) = statCheckForEvents then LRPCM has
  	  been recenty sampled and could be mapped or not, but it must be newMethod and we can simply
  	  copy newMethod.  If LRPCSN ~= statCheckForEvents then LRPCM must be some extant object and
  	  needs to be remapped."
  	self sqLowLevelMFence.
+ 	longRunningPrimitiveCheckMethod ifNotNil:
+ 		[longRunningPrimitiveCheckSequenceNumber = statCheckForEvents
+ 			ifTrue: [longRunningPrimitiveCheckMethod := newMethod]
+ 			ifFalse:
+ 				[(objectMemory shouldRemapObj: longRunningPrimitiveCheckMethod) ifTrue:
+ 					[longRunningPrimitiveCheckMethod := self remapObj: longRunningPrimitiveCheckMethod]].
- 	longRunningPrimitiveCheckMethod ~= nil ifTrue:
- 		[longRunningPrimitiveCheckMethod :=
- 			longRunningPrimitiveCheckSequenceNumber = statCheckForEvents
- 				ifTrue: [newMethod]
- 				ifFalse: [self remap: longRunningPrimitiveCheckMethod].
  		 self sqLowLevelMFence].
+ 	longRunningPrimitiveCheckSemaphore ifNotNil:
+ 		[(objectMemory shouldRemapObj: longRunningPrimitiveCheckSemaphore) ifTrue:
+ 			[longRunningPrimitiveCheckSemaphore := objectMemory remapObj: longRunningPrimitiveCheckSemaphore]]!
- 	longRunningPrimitiveCheckSemaphore ~= nil ifTrue:
- 		[longRunningPrimitiveCheckSemaphore := objectMemory remap: longRunningPrimitiveCheckSemaphore]!

Item was changed:
  ----- Method: StackInterpreter>>mapStackPages (in category 'object memory support') -----
  mapStackPages
  	<inline: false>
  	<var: #thePage type: #'StackPage *'>
  	<var: #theSP type: #'char *'>
  	<var: #theFP type: #'char *'>
  	<var: #callerFP type: #'char *'>
  	<var: #theIPPtr type: #'char *'>
  	"Need to write back the frame pointers unless all pages are free (as in snapshot)"
  	stackPage ~= 0 ifTrue:
  		[self externalWriteBackHeadFramePointers].
  	0 to: numStackPages - 1 do:
  		[:i| | thePage theSP theFP callerFP theIPPtr theIP oop |
  		thePage := stackPages stackPageAt: i.
  		thePage isFree ifFalse:
  			[theSP := thePage headSP.
  			 theFP := thePage  headFP.
  			 "Skip the instruction pointer on top of stack of inactive pages."
  			 thePage = stackPage
  				ifTrue: [theIPPtr := 0]
  				ifFalse:
  					[theIPPtr := theSP.
  					 theSP := theSP + BytesPerWord].
  			[self assert: (thePage addressIsInPage: theFP).
  			 self assert: (thePage addressIsInPage: theSP).
  			 self assert: (theIPPtr = 0 or: [thePage addressIsInPage: theIPPtr]).
  			 [theSP <= (theFP + FoxReceiver)] whileTrue:
  				[oop := stackPages longAt: theSP.
+ 				 (objectMemory shouldRemapOop: oop) ifTrue:
+ 					[stackPages longAt: theSP put: (objectMemory remapObj: oop)].
- 				 (objectMemory isIntegerObject: oop) ifFalse:
- 					[stackPages longAt: theSP put: (objectMemory remap: oop)].
  				 theSP := theSP + BytesPerWord].
+ 			 ((self frameHasContext: theFP)
+ 			  and: [objectMemory shouldRemapObj: (self frameContext: theFP)]) ifTrue:
- 			 (self frameHasContext: theFP) ifTrue:
  				[stackPages
  					longAt: theFP + FoxThisContext
+ 					put: (objectMemory remapObj: (self frameContext: theFP))].
+ 			 (objectMemory shouldRemapObj: (self frameMethod: theFP)) ifTrue:
+ 				[theIPPtr ~= 0 ifTrue:
+ 					[self assert: (stackPages longAt: theIPPtr) > (self frameMethod: theFP).
+ 					 theIP := (stackPages longAt: theIPPtr) - (self frameMethod: theFP)].
+ 				 stackPages
+ 					longAt: theFP + FoxMethod
+ 					put: (objectMemory remapObj: (self frameMethod: theFP)).
+ 				 theIPPtr ~= 0 ifTrue:
+ 					[stackPages longAt: theIPPtr put: theIP + (self frameMethod: theFP)]].
- 					put: (objectMemory remap: (self frameContext: theFP))].
- 			 theIPPtr ~= 0 ifTrue:
- 				[self assert: (stackPages longAt: theIPPtr) > (self frameMethod: theFP).
- 				 theIP := (stackPages longAt: theIPPtr) - (self frameMethod: theFP)].
- 			 stackPages
- 				longAt: theFP + FoxMethod
- 				put: (objectMemory remap: (self frameMethod: theFP)).
- 			 theIPPtr ~= 0 ifTrue:
- 				[stackPages longAt: theIPPtr put: theIP + (self frameMethod: theFP)].
  			 (callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
  				[theSP := (theIPPtr := theFP + FoxCallerSavedIP) + BytesPerWord.
  				 theFP := callerFP].
  			 theSP := theFP + FoxCallerContext. "a.k.a. FoxCallerSavedIP"
  			 [theSP <= thePage baseAddress] whileTrue:
  				[oop := stackPages longAt: theSP.
+ 				 (objectMemory shouldRemapOop: oop) ifTrue:
+ 					[stackPages longAt: theSP put: (objectMemory remapObj: oop)].
- 				 (objectMemory isIntegerObject: oop) ifFalse:
- 					[stackPages longAt: theSP put: (objectMemory remap: oop)].
  				 theSP := theSP + BytesPerWord]]]!

Item was changed:
  ----- Method: StackInterpreter>>mapVMRegisters (in category 'object memory support') -----
  mapVMRegisters
  	"Map the oops in the interpreter's vm ``registers'' to their new values 
  	during garbage collection or a become: operation."
  	"Assume: All traced variables contain valid oops.
  	 N.B. Don't trace messageSelector and lkupClass; these are ephemeral, live
  	 only during message lookup and because createActualMessageTo will not
  	 cause a GC these cannot change during message lookup."
+ 	(objectMemory shouldRemapObj: method) ifTrue:
+ 		[instructionPointer := instructionPointer - method. "*rel to method"
+ 		 method := objectMemory remapObj: method.
+ 		 instructionPointer := instructionPointer + method]. "*rel to method"
+ 	(objectMemory shouldRemapOop: newMethod) ifTrue: "maybe oop due to object-as-method"
+ 		[newMethod := objectMemory remapObj: newMethod]!
- 	instructionPointer := instructionPointer - method. "*rel to method"
- 	method := objectMemory remap: method.
- 	instructionPointer := instructionPointer + method. "*rel to method"
- 	(objectMemory isImmediate: newMethod) ifFalse:
- 		[newMethod := objectMemory remap: newMethod]!

Item was added:
+ ----- Method: StackInterpreter>>remapCallbackState (in category 'object memory support') -----
+ remapCallbackState
+ 	"Callback support - trace suspended callback list"
+ 	1 to: jmpDepth do:
+ 		[:i| | oop |
+ 		oop := suspendedCallbacks at: i.
+ 		(objectMemory shouldRemapOop: oop) ifTrue:
+ 			[suspendedCallbacks at: i put: (objectMemory remapObj: oop)].
+ 		oop := suspendedMethods at: i.
+ 		(objectMemory shouldRemapObj: oop) ifTrue:
+ 			[suspendedMethods at: i put: (objectMemory remapObj: oop)]]!

Item was removed:
- ----- Method: StackInterpreter>>scavengeVMState (in category 'garbage collection') -----
- scavengeVMState
- 	"Scavenge all VM state.  We piggy-back off the ObjectMemory map
- 	 routines which are run after its maskAndTrace routines.  But here remap:
- 	 actually means scavenge."
- 	| oop |
- 	self mapStackPages.
- 	self mapMachineCode.
- 	self mapTraceLogs.
- 	self mapVMRegisters.
- 	self mapProfileState.
- 	tempOop ~= 0 ifTrue:
- 		[tempOop := objectMemory remap: tempOop].
- 	1 to: objectMemory remapBufferCount do: [:i | 
- 		oop := objectMemory remapBuffer at: i.
- 		(objectMemory isIntegerObject: oop) ifFalse:
- 			[objectMemory remapBuffer at: i put: (objectMemory remap: oop)]].
- 
- 	"Callback support - trace suspended callback list"
- 	1 to: jmpDepth do:[:i|
- 		oop := suspendedCallbacks at: i.
- 		(objectMemory isIntegerObject: oop) ifFalse:
- 			[suspendedCallbacks at: i put: (objectMemory remap: oop)].
- 		oop := suspendedMethods at: i.
- 		(objectMemory isIntegerObject: oop) ifFalse:
- 			[suspendedMethods at: i put: (objectMemory remap: oop)]]!



More information about the Vm-dev mailing list