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

commits at source.squeak.org commits at source.squeak.org
Wed Dec 31 22:24:56 UTC 2014


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

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

Name: VMMaker.oscog-eem.1004
Author: eem
Time: 31 December 2014, 2:21:00.125 pm
UUID: 132642b3-ab26-4957-82a4-8aa19b60f188
Ancestors: VMMaker.oscog-cb.1003

Revisit the bug fix for followed contexts during
scavenging in VMMaker.oscog-eem.913 of
24 October 2014.  Split isWidowedContext: into
a more careful version, isWidowedContextDuringGC:
for use only during scavenging.

Speed up non-local return processing by using the
fact that 98% of the time returns are within the
same page.  The search for the home context
following finding an unwind is unnecessary iff the
home is married and on the same page.

Refactor commonReturn to eiminate CoInterpreter's
version, moving the divergence into
maybeReturnToMachineCodeFrame.

Makew sure the search for the home through the
block's closure uses followField:ofObject:.

Fix a slip in genBinaryInlineComparison:opFalse:destReg:.

Nuke erroneous instance-side versions of
initializeFrameIndices (editing blunders).

Typos.

=============== Diff against VMMaker.oscog-cb.1003 ===============

Item was changed:
  ----- Method: CoInterpreter>>ceNonLocalReturn: (in category 'trampolines') -----
  ceNonLocalReturn: returnValue
  	<api>
  	| closure home unwindContextOrNilOrZero ourContext frameToReturnTo contextToReturnTo theFP callerFP newPage |
  	<var: #frameToReturnTo type: #'char *'>
  	<var: #theFP type: #'char *'>
  	<var: #callerFP type: #'char *'>
  	<var: #newPage type: #'StackPage *'>
  	<var: #thePage type: #'StackPage *'>
  
  	"self shortPrintFrameAndCallers: framePointer.
  	self printOop: returnValue.
  	self halt."
  
  	self assert: (self isMachineCodeFrame: framePointer).
  	self assert: (self frameIsBlockActivation: framePointer).
  
  	"Since this is a block activation the closure is on the stack above any args and the frame."
  	closure := self pushedReceiverOrClosureOfFrame: framePointer.
  
  	home := nil.
  	"Walk the closure's lexical chain to find the context or frame to return from (home)."
  	[closure ~= objectMemory nilObject] whileTrue:
+ 		[home := objectMemory followField: ClosureOuterContextIndex ofObject: closure.
+ 		 closure := objectMemory followField: ClosureIndex ofObject: home].
- 		[home := objectMemory fetchPointer: ClosureOuterContextIndex ofObject: closure.
- 		 closure := objectMemory fetchPointer: ClosureIndex ofObject: home].
  	"home is to be returned from provided there is no unwind-protect activation between
  	 this frame and home's sender.  Search for an unwind.  findUnwindThroughContext:
  	 will answer either the context for an unwind-protect activation or nilObj if the sender
  	 cannot be found or 0 if no unwind is found but the sender is.  We must update the
  	 current page's headFrame pointers to enable the search to identify widowed contexts
  	 correctly."
  	self externalWriteBackHeadFramePointers.
  	unwindContextOrNilOrZero := self findUnwindThroughContext: home.
  	unwindContextOrNilOrZero = objectMemory nilObject ifTrue:
  		["error: can't find home on chain; cannot return"
  		 ourContext := self ensureFrameIsMarried: framePointer SP: stackPointer.
  		 ^self externalCannotReturn: returnValue from: ourContext].
  	unwindContextOrNilOrZero ~= 0 ifTrue:
  		[^self externalAboutToReturn: returnValue through: unwindContextOrNilOrZero].
  
  	"Now we know home is on the sender chain.
  	 We could be returning to either a context or a frame.  Find out which."
  	contextToReturnTo := nil.
  	(self isMarriedOrWidowedContext: home)
  		ifTrue:
  			[self assert: (self checkIsStillMarriedContext: home currentFP: framePointer).
  			 theFP := self frameOfMarriedContext: home.
  			 (self isBaseFrame: theFP)
  				ifTrue:
  					[contextToReturnTo := self frameCallerContext: theFP]
  				ifFalse:
  					[frameToReturnTo := self frameCallerFP: theFP]]
  		ifFalse:
  			[contextToReturnTo := objectMemory fetchPointer: SenderIndex ofObject: home.
  			 ((objectMemory isContext: contextToReturnTo)
  			  and: [self isMarriedOrWidowedContext: contextToReturnTo]) ifTrue:
  				[self assert: (self checkIsStillMarriedContext: contextToReturnTo currentFP: framePointer).
  			 	 frameToReturnTo := self frameOfMarriedContext: contextToReturnTo.
  				 contextToReturnTo := nil]].
  
  	"If returning to a context we must make a frame for it unless it is dead."
  	contextToReturnTo ~= nil ifTrue:
  		[frameToReturnTo := self establishFrameForContextToReturnTo: contextToReturnTo.
  		 frameToReturnTo == 0 ifTrue:
  			["error: home's sender is dead; cannot return"
  			 ourContext := self ensureFrameIsMarried: framePointer SP: stackPointer.
  			 ^self externalCannotReturn: returnValue from: ourContext]].
  
  	"Now we have a frame to return to.  If it is on a different page we must
  	 free intervening pages and nil out intervening contexts.  We must free
  	 intervening stack pages because if we leave the pages to be divorced
  	 then their contexts will be divorced with intact senders and instruction
  	 pointers.  This code is similar to primitiveTerminateTo."
  	self assert: stackPages pageListIsWellFormed.
  	newPage := stackPages stackPageFor: frameToReturnTo.
  	newPage ~~ stackPage ifTrue:
  		[| currentCtx thePage nextCntx |
  		 currentCtx := self frameCallerContext: stackPage baseFP.
  		 self assert: (objectMemory isContext: currentCtx).
  		 stackPages freeStackPage: stackPage.
  		 [self assert: (objectMemory isContext: currentCtx).
  		  (self isMarriedOrWidowedContext: currentCtx)
  		   and: [(stackPages stackPageFor: (theFP := self frameOfMarriedContext: currentCtx)) = newPage]] whileFalse:
  			[(self isMarriedOrWidowedContext: currentCtx)
  				ifTrue:
  					[thePage := stackPages stackPageFor: theFP.
  					 currentCtx := self frameCallerContext: thePage baseFP.
  					 stackPages freeStackPage: thePage]
  				ifFalse:
  					[nextCntx := objectMemory fetchPointer: SenderIndex ofObject: currentCtx.
  					 self markContextAsDead: currentCtx.
  					 currentCtx := nextCntx]].
  		 self setStackPageAndLimit: newPage.
  		 stackPointer := stackPage headSP.
  		 framePointer := stackPage headFP].
  
  	"Two cases.  Returning to the top frame or an interior frame.  The
  	 top frame has its instruction pointer on top of stack.  An interior
  	 frame has its instruction pointer in the caller frame. We need to
  	 peel back any frames on the page until we get to the correct frame."
  	self flag: 'currently caller pushes result'. "(in machine code)"
  	framePointer = frameToReturnTo
  		ifTrue:
  			[instructionPointer := self popStack]
  		ifFalse:
  			[[callerFP := framePointer.
  			  framePointer := self frameCallerFP: framePointer.
  			  framePointer ~~ frameToReturnTo] whileTrue.
  			 instructionPointer := (self frameCallerSavedIP: callerFP) asUnsignedInteger.
  			 stackPointer := (self frameCallerSP: callerFP)].
  	^self return: returnValue toExecutive: false!

Item was removed:
- ----- Method: CoInterpreter>>commonReturn (in category 'return bytecodes') -----
- commonReturn
- 	"Do an ^-return (return form method), perhaps checking for unwinds if this is a block activation.
- 	 Note: Assumed to be inlined into the dispatch loop."
- 
- 	<sharedCodeNamed: 'commonReturn' inCase: #returnReceiver>
- 	| closure home unwindContextOrNilOrZero frameToReturnTo contextToReturnTo theFP callerFP newPage |
- 	<var: #frameToReturnTo type: #'char *'>
- 	<var: #theFP type: #'char *'>
- 	<var: #callerFP type: #'char *'>
- 	<var: #newPage type: #'StackPage *'>
- 	<var: #thePage type: #'StackPage *'>
- 
- 	"If this is a method simply return to the  sender/caller."
- 	(self frameIsBlockActivation: localFP) ifFalse:
- 		[^self commonCallerReturn].
- 
- 	"Since this is a block activation the closure is on the stack above any args and the frame."
- 	closure := self pushedReceiverOrClosureOfFrame: localFP.
- 
- 	home := nil.
- 	"Walk the closure's lexical chain to find the context or frame to return from (home)."
- 	[closure ~= objectMemory nilObject] whileTrue:
- 		[home := objectMemory fetchPointer: ClosureOuterContextIndex ofObject: closure.
- 		 closure := objectMemory fetchPointer: ClosureIndex ofObject: home].
- 	"home is to be returned from provided there is no unwind-protect activation between
- 	 this frame and home's sender.  Search for an unwind.  findUnwindThroughContext:
- 	 will answer either the context for an unwind-protect activation or nilObj if the sender
- 	 cannot be found or 0 if no unwind is found but the sender is.  We must update the
- 	 current page's headFrame pointers to enable the search to identify widowed contexts
- 	 correctly."
- 	self writeBackHeadFramePointers.
- 	unwindContextOrNilOrZero := self internalFindUnwindThroughContext: home.
- 	unwindContextOrNilOrZero = objectMemory nilObject ifTrue:
- 		["error: can't find home on chain; cannot return"
- 		 ^self internalCannotReturn: localReturnValue].
- 	unwindContextOrNilOrZero ~= 0 ifTrue:
- 		[^self internalAboutToReturn: localReturnValue through: unwindContextOrNilOrZero].
- 
- 	"Now we know home is on the sender chain.
- 	 We could be returning to either a context or a frame.  Find out which."
- 	contextToReturnTo := nil.
- 	(self isMarriedOrWidowedContext: home)
- 		ifTrue:
- 			[self assert: (self checkIsStillMarriedContext: home currentFP: localFP).
- 			 theFP := self frameOfMarriedContext: home.
- 			 (self isBaseFrame: theFP)
- 				ifTrue:
- 					[contextToReturnTo := self frameCallerContext: theFP]
- 				ifFalse:
- 					[frameToReturnTo := self frameCallerFP: theFP]]
- 		ifFalse:
- 			[contextToReturnTo := objectMemory fetchPointer: SenderIndex ofObject: home.
- 			 ((objectMemory isContext: contextToReturnTo)
- 			  and: [self isMarriedOrWidowedContext: contextToReturnTo]) ifTrue:
- 				[self assert: (self checkIsStillMarriedContext: contextToReturnTo currentFP: localFP).
- 			 	 frameToReturnTo := self frameOfMarriedContext: contextToReturnTo.
- 				 contextToReturnTo := nil]].
- 
- 	"If returning to a context we must make a frame for it unless it is dead."
- 	contextToReturnTo ~= nil ifTrue:
- 		[frameToReturnTo := self establishFrameForContextToReturnTo: contextToReturnTo.
- 		 frameToReturnTo == 0 ifTrue:
- 			["error: home's sender is dead; cannot return"
- 			 ^self internalCannotReturn: localReturnValue]].
- 
- 	"Now we have a frame to return to.  If it is on a different page we must free intervening pages and
- 	 nil out intervening contexts.  We must free intervening stack pages because if we leave the pages
- 	 to be divorced then their contexts will be divorced with intact senders and instruction pointers.  This
- 	 code is similar to primitiveTerminateTo.  We must move any frames on itervening pages above the
- 	 frame linked to because these may be in use, e.g. via co-routining (see baseFrameReturn)."
- 	self assert: stackPages pageListIsWellFormed.
- 	newPage := stackPages stackPageFor: frameToReturnTo.
- 	newPage ~~ stackPage ifTrue:
- 		[| currentCtx thePage nextCntx |
- 		 currentCtx := self frameCallerContext: stackPage baseFP.
- 		 self assert: (objectMemory isContext: currentCtx).
- 		 stackPages freeStackPage: stackPage.
- 		 [(self isMarriedOrWidowedContext: currentCtx)
- 		   and: [(stackPages stackPageFor: (theFP := self frameOfMarriedContext: currentCtx)) = newPage]] whileFalse:
- 			[(self isMarriedOrWidowedContext: currentCtx)
- 				ifTrue:
- 					[thePage := stackPages stackPageFor: theFP.
- 					 theFP ~= thePage headFP ifTrue:
- 						["Since we've just deallocated a page we know that newStackPage won't deallocate an existing one."
- 						 self moveFramesIn: thePage through: (self findFrameAbove: theFP inPage: thePage) toPage: self newStackPage].
- 					 currentCtx := self frameCallerContext: thePage baseFP.
- 					 stackPages freeStackPage: thePage]
- 				ifFalse:
- 					[nextCntx := objectMemory fetchPointer: SenderIndex ofObject: currentCtx.
- 					 self markContextAsDead: currentCtx.
- 					 currentCtx := nextCntx]].
- 		 self setStackPageAndLimit: newPage.
- 		 localSP := stackPage headSP.
- 		 localFP := stackPage headFP].
- 
- 	"Two cases.  Returning to the top frame on a new page or an interior frame on the current page.
- 	 The top frame has its instruction pointer on top of stack. An interior frame has its instruction pointer
- 	 in the caller frame. We need to peel back any frames on the page until we get to the correct frame."
- 
- 	localFP = frameToReturnTo
- 		ifTrue:
- 			[localIP := self pointerForOop: self internalStackTop]
- 		ifFalse:
- 			[[callerFP := localFP.
- 			  localFP := self frameCallerFP: localFP.
- 			  localFP ~~ frameToReturnTo] whileTrue.
- 			localIP := self frameCallerSavedIP: callerFP.
- 			localSP := (self frameCallerSP: callerFP) - objectMemory wordSize].
- 	localIP asUnsignedInteger < objectMemory startOfMemory ifTrue:
- 		[localIP asUnsignedInteger ~= cogit ceReturnToInterpreterPC ifTrue:
- 			["localIP in the cog method zone indicates a return to machine code."
- 			 ^self returnToMachineCodeFrame].
- 		 localIP := self pointerForOop: (self iframeSavedIP: localFP)].
- 	"pop the saved IP, push the return value and continue."
- 	self internalStackTopPut: localReturnValue.
- 	self setMethod: (self iframeMethod: localFP).
- 	^self fetchNextBytecode!

Item was removed:
- ----- Method: CoInterpreter>>initializeFrameIndices (in category 'as yet unclassified') -----
- initializeFrameIndices
- 	"Format of a stack frame.  Word-sized indices relative to the frame pointer.
- 	 Terminology
- 		Frames are either single (have no context) or married (have a context).
- 		Contexts are either single (exist on the heap), married (have a context) or widowed (had a frame that has exited).
- 	 Stacks grow down:
- 
- 			receiver for method activations/closure for block activations
- 			arg0
- 			...
- 			argN
- 			caller's saved ip/this stackPage (for a base frame)
- 	fp->	saved fp
- 			method
- 			context (initialized to nil)
- 			frame flags (interpreter only)
- 			saved method ip (initialized to 0; interpreter only)
- 			receiver
- 			first temp
- 			...
- 	sp->	Nth temp
- 
- 	In an interpreter frame
- 		frame flags holds
- 			the backward jump count (see ifBackwardsCheckForEvents)
- 			the number of arguments (since argument temporaries are above the frame)
- 			the flag for a block activation
- 			and the flag indicating if the context field is valid (whether the frame is married).
- 		saved method ip holds the saved method ip when the callee frame is a machine code frame.
- 		This is because the saved method ip is actually the ceReturnToInterpreterTrampoline address.
- 	In a machine code frame
- 		the flag indicating if the context is valid is the least significant bit of the method pointer
- 		the flag for a block activation is the next most significant bit of the method pointer
- 
- 	Interpreter frames are distinguished from method frames by the method field which will
- 	be a pointer into the heap for an interpreter frame and a pointer into the method zone for
- 	a machine code frame.
- 
- 	The first frame in a stack page is the baseFrame and is marked as such by a saved fp being its stackPage,
- 	in which case the first word on the stack is the caller context (possibly hybrid) beneath the base frame."
- 
- 	| fxCallerSavedIP fxSavedFP fxMethod fxIFrameFlags fxThisContext fxIFReceiver fxMFReceiver fxIFSavedIP |
- 	fxCallerSavedIP := 1.
- 	fxSavedFP := 0.
- 	fxMethod := -1.
- 	fxThisContext := -2.
- 	fxIFrameFlags := -3.	"Can find numArgs, needed for fast temp access. args are above fxCallerSavedIP.
- 							 Can find ``is block'' bit
- 							 Can find ``has context'' bit"
- 	fxIFSavedIP := -4.
- 	fxIFReceiver := -5.
- 	fxMFReceiver := -3.
- 
- 	"For debugging nil out values that differ in the StackInterpreter."
- 	FrameSlots := #undeclared.
- 	IFrameSlots := fxCallerSavedIP - fxIFReceiver + 1.
- 	MFrameSlots := fxCallerSavedIP - fxMFReceiver + 1.
- 
- 	FoxCallerSavedIP := fxCallerSavedIP * objectMemory wordSize.
- 	"In Cog a base frame's caller context is stored on the first word of the stack page."
- 	FoxCallerContext := #undeclared.
- 	FoxSavedFP := fxSavedFP * objectMemory wordSize.
- 	FoxMethod := fxMethod * objectMemory wordSize.
- 	FoxThisContext := fxThisContext * objectMemory wordSize.
- 	FoxFrameFlags := #undeclared.
- 	FoxIFrameFlags := fxIFrameFlags * objectMemory wordSize.
- 	FoxIFSavedIP := fxIFSavedIP * objectMemory wordSize.
- 	FoxReceiver := #undeclared.
- 	FoxIFReceiver := fxIFReceiver * objectMemory wordSize.
- 	FoxMFReceiver := fxMFReceiver * objectMemory wordSize.
- 
- 	"N.B.  There is room for one more flag given the current 8 byte alignment of methods (which
- 	 is at least needed to distinguish the checked and uncecked entry points by their alignment."
- 	MFMethodFlagHasContextFlag := 1.
- 	MFMethodFlagIsBlockFlag := 2.
- 	MFMethodFlagFrameIsMarkedFlag := 4. "for pathTo:using:followWeak:"
- 	MFMethodFlagsMask := MFMethodFlagHasContextFlag + MFMethodFlagIsBlockFlag + MFMethodFlagFrameIsMarkedFlag.
- 	MFMethodMask := (MFMethodFlagsMask + 1) negated!

Item was added:
+ ----- Method: CoInterpreter>>maybeReturnToMachineCodeFrame (in category 'return bytecodes') -----
+ maybeReturnToMachineCodeFrame
+ 	"If the frame we're returning to is a machine code one, then return to it.
+ 	 Otherwise, if it's an interpreter frame, load the saved ip."
+ 	<inline: true>
+ 	localIP asUnsignedInteger < objectMemory startOfMemory ifTrue:
+ 		[localIP asUnsignedInteger ~= cogit ceReturnToInterpreterPC ifTrue:
+ 			["localIP in the cog method zone indicates a return to machine code."
+ 			 ^self returnToMachineCodeFrame].
+ 		 localIP := self pointerForOop: (self iframeSavedIP: localFP)]!

Item was changed:
  ----- Method: CogObjectRepresentationFor32BitSpur>>genGetNumBytesOf:into: (in category 'compile abstract instructions') -----
  genGetNumBytesOf: srcReg into: destReg
  	"Get the size in byte-sized slots of the object in srcReg into destReg.
  	 srcReg may equal destReg.
  	 destReg <- numSlots << self shiftForWord - (fmt bitAnd: 3).
  	 Assumes the object in srcReg has a byte format, i.e. 16 to 23 or 24 to 31 "
  	<var: #jmp type: #'AbstractInstruction'>
  	| jmp |
  	self genGetRawSlotSizeOfNonImm: srcReg into: TempReg.
  	cogit CmpCq: objectMemory numSlotsMask R: TempReg.
  	jmp := cogit JumpLess: 0.
  	cogit MoveMw: objectMemory wordSize negated r: srcReg R: destReg.
  	jmp jmpTarget: (cogit LogicalShiftLeftCq: objectMemory shiftForWord R: destReg). 
+ 	"Now: destReg = numSlots << shiftForWord"
- 	"Now: TempReg = numSlots << shiftForWord"
  	cogit MoveMw: 0 r: srcReg R: TempReg.
  	cogit LogicalShiftRightCq: objectMemory formatShift R: TempReg.
  	cogit AndCq: objectMemory wordSize - 1 R: TempReg.
  	"Now: fmt bitAnd: 3 in TempReg"
  	cogit SubR: TempReg R: destReg.
  	^0!

Item was changed:
  ----- Method: StackInterpreter>>commonReturn (in category 'return bytecodes') -----
  commonReturn
+ 	"Do an ^-return (return from method), checking for unwinds if this is a block activation.
- 	"Do an ^-return (return form method), perhaps checking for unwinds if this is a block activation.
  	 Note: Assumed to be inlined into the dispatch loop."
  
  	<sharedCodeInCase: #returnReceiver>
  	| closure home unwindContextOrNilOrZero frameToReturnTo contextToReturnTo theFP callerFP newPage |
  	<var: #frameToReturnTo type: #'char *'>
  	<var: #theFP type: #'char *'>
  	<var: #callerFP type: #'char *'>
  	<var: #newPage type: #'StackPage *'>
  	<var: #thePage type: #'StackPage *'>
  
  	"If this is a method simply return to the  sender/caller."
  	(self frameIsBlockActivation: localFP) ifFalse:
  		[^self commonCallerReturn].
  
  	"Since this is a block activation the closure is on the stack above any args and the frame."
  	closure := self pushedReceiverOrClosureOfFrame: localFP.
  
  	home := nil.
  	"Walk the closure's lexical chain to find the context or frame to return from (home)."
  	[closure ~= objectMemory nilObject] whileTrue:
+ 		[home := objectMemory followField: ClosureOuterContextIndex ofObject: closure.
+ 		 closure := objectMemory followField: ClosureIndex ofObject: home].
- 		[home := objectMemory fetchPointer: ClosureOuterContextIndex ofObject: closure.
- 		 closure := objectMemory fetchPointer: ClosureIndex ofObject: home].
  	"home is to be returned from provided there is no unwind-protect activation between
  	 this frame and home's sender.  Search for an unwind.  findUnwindThroughContext:
  	 will answer either the context for an unwind-protect activation or nilObj if the sender
  	 cannot be found or 0 if no unwind is found but the sender is.  We must update the
  	 current page's headFrame pointers to enable the search to identify widowed contexts
  	 correctly."
  	self writeBackHeadFramePointers.
+ 	self externalizeIPandSP.
+ 	unwindContextOrNilOrZero := self findUnwindThroughContext: home.
- 	unwindContextOrNilOrZero := self internalFindUnwindThroughContext: home.
  	unwindContextOrNilOrZero = objectMemory nilObject ifTrue:
  		["error: can't find home on chain; cannot return"
  		 ^self internalCannotReturn: localReturnValue].
  	unwindContextOrNilOrZero ~= 0 ifTrue:
  		[^self internalAboutToReturn: localReturnValue through: unwindContextOrNilOrZero].
  
  	"Now we know home is on the sender chain.
  	 We could be returning to either a context or a frame.  Find out which."
  	contextToReturnTo := nil.
  	(self isMarriedOrWidowedContext: home)
  		ifTrue:
  			[self assert: (self checkIsStillMarriedContext: home currentFP: localFP).
  			 theFP := self frameOfMarriedContext: home.
  			 (self isBaseFrame: theFP)
  				ifTrue:
  					[contextToReturnTo := self frameCallerContext: theFP]
  				ifFalse:
  					[frameToReturnTo := self frameCallerFP: theFP]]
  		ifFalse:
  			[contextToReturnTo := objectMemory fetchPointer: SenderIndex ofObject: home.
  			 ((objectMemory isContext: contextToReturnTo)
  			  and: [self isMarriedOrWidowedContext: contextToReturnTo]) ifTrue:
  				[self assert: (self checkIsStillMarriedContext: contextToReturnTo currentFP: localFP).
  			 	 frameToReturnTo := self frameOfMarriedContext: contextToReturnTo.
  				 contextToReturnTo := nil]].
  
  	"If returning to a context we must make a frame for it unless it is dead."
  	contextToReturnTo ~= nil ifTrue:
  		[frameToReturnTo := self establishFrameForContextToReturnTo: contextToReturnTo.
  		 frameToReturnTo == 0 ifTrue:
  			["error: home's sender is dead; cannot return"
  			 ^self internalCannotReturn: localReturnValue]].
  
  	"Now we have a frame to return to.  If it is on a different page we must free intervening pages and
  	 nil out intervening contexts.  We must free intervening stack pages because if we leave the pages
  	 to be divorced then their contexts will be divorced with intact senders and instruction pointers.  This
  	 code is similar to primitiveTerminateTo.  We must move any frames on itervening pages above the
  	 frame linked to because these may be in use, e.g. via co-routining (see baseFrameReturn)."
  	self assert: stackPages pageListIsWellFormed.
  	newPage := stackPages stackPageFor: frameToReturnTo.
  	newPage ~~ stackPage ifTrue:
  		[| currentCtx thePage nextCntx |
  		 currentCtx := self frameCallerContext: stackPage baseFP.
- 		 self assert: (objectMemory isContext: currentCtx).
  		 stackPages freeStackPage: stackPage.
  		 [self assert: (objectMemory isContext: currentCtx).
  		  (self isMarriedOrWidowedContext: currentCtx)
  		   and: [(stackPages stackPageFor: (theFP := self frameOfMarriedContext: currentCtx)) = newPage]] whileFalse:
  			[(self isMarriedOrWidowedContext: currentCtx)
  				ifTrue:
  					[thePage := stackPages stackPageFor: theFP.
  					 theFP ~= thePage headFP ifTrue:
  						["Since we've just deallocated a page we know that newStackPage won't deallocate an existing one."
  						 self moveFramesIn: thePage through: (self findFrameAbove: theFP inPage: thePage) toPage: self newStackPage].
  					 currentCtx := self frameCallerContext: thePage baseFP.
  					 stackPages freeStackPage: thePage]
  				ifFalse:
  					[nextCntx := objectMemory fetchPointer: SenderIndex ofObject: currentCtx.
  					 self markContextAsDead: currentCtx.
  					 currentCtx := nextCntx]].
  		 self setStackPageAndLimit: newPage.
  		 localSP := stackPage headSP.
  		 localFP := stackPage headFP].
  
  	"Two cases.  Returning to the top frame on a new page or an interior frame on the current page.
  	 The top frame has its instruction pointer on top of stack. An interior frame has its instruction pointer
  	 in the caller frame. We need to peel back any frames on the page until we get to the correct frame."
  
  	localFP = frameToReturnTo
  		ifTrue: "pop the saved IP, push the return value and continue."
  			[localIP := self pointerForOop: self internalStackTop]
  		ifFalse:
  			[[callerFP := localFP.
  			  localFP := self frameCallerFP: localFP.
  			  localFP ~~ frameToReturnTo] whileTrue.
  			localIP := self frameCallerSavedIP: callerFP.
  			localSP := (self frameCallerSP: callerFP) - objectMemory wordSize].
+ 	self maybeReturnToMachineCodeFrame.
  	self setMethod: (self frameMethod: localFP).
  	self fetchNextBytecode.
  	self internalStackTopPut: localReturnValue!

Item was changed:
  ----- Method: StackInterpreter>>findMethodWithPrimitive:FromContext:UpToContext: (in category 'handler search') -----
  findMethodWithPrimitive: primitive FromContext: senderContext UpToContext: homeContext
  	"See findUnwindThroughContext:.  Alas this is mutually recursive with
  	 findMethodWithPrimitive:FromFP:SP:ThroughContext: instead of iterative.
  	 We're doing the simplest thing that could possibly work.  Niceties can wait."
+ 	<inline: false>
  	| theContext theMethod |
  	self assert: (senderContext = objectMemory nilObject or: [objectMemory isContext: senderContext]).
  	self assert: (homeContext = objectMemory nilObject or: [objectMemory isContext: homeContext]).
  	theContext := senderContext.
  	[theContext = objectMemory nilObject ifTrue:
  		[^theContext].
  	 self isMarriedOrWidowedContext: theContext] whileFalse:
  		[theContext = homeContext ifTrue: [^0].
  		 (primitive = 0
  		  or: [(objectMemory fetchPointer: ClosureIndex ofObject: theContext) ~= objectMemory nilObject]) ifFalse:
  		 	[theMethod := objectMemory fetchPointer: MethodIndex ofObject: theContext.
  			 (self primitiveIndexOf: theMethod) = primitive ifTrue:
  				[^theContext]].
  		 theContext := objectMemory fetchPointer: SenderIndex ofObject: theContext].
  	(self isWidowedContext: theContext) ifTrue:
  		[^objectMemory nilObject].
  	^self
  		findMethodWithPrimitive: primitive
  		FromFP: (self frameOfMarriedContext: theContext)
  		UpToContext: homeContext!

Item was changed:
  ----- Method: StackInterpreter>>findMethodWithPrimitive:FromFP:UpToContext: (in category 'handler search') -----
  findMethodWithPrimitive: primitive FromFP: startFP UpToContext: homeContext
  	"See findUnwindThroughContext:.  Alas this is mutually recursive with
  	 findMethodWithPrimitive:FromContext:ThroughContext: instead of iterative.
  	 We're doing the simplest thing that could possibly work.  Niceties can wait."
+ 	<inline: true>
  	| theFP theFPAbove theSP theMethod senderContext |
  	<var: #startFP type: #'char *'>
  	<var: #theFP type: #'char *'>
  	<var: #theFPAbove type: #'char *'>
  	<var: #theSP type: #'char *'>
  	theFP := startFP.
  	theFPAbove := startFP.
  	[((self frameHasContext: theFP)
  	  and: [homeContext = (self frameContext: theFP)]) ifTrue:
  		[^0].
  	 (primitive = 0
  	  or: [self frameIsBlockActivation: theFP]) ifFalse:
  	 	[theMethod := self frameMethodObject: theFP.
  		 (self primitiveIndexOf: theMethod) = primitive ifTrue:
  			[theFP = theFPAbove
  						ifTrue: [theSP := self findSPOf: theFP on: (stackPages stackPageFor: theFP)]
  						ifFalse: [theSP := self frameCallerStackPointer: theFPAbove].
  			 ^self ensureFrameIsMarried: theFP SP: theSP]].
  	 theFPAbove := theFP.
  	 theFP := self frameCallerFP: theFP.
  	 theFP ~= 0] whileTrue.
  	senderContext := self frameCallerContext: theFPAbove.
  	(objectMemory isContext: senderContext) ifFalse:
  		[^objectMemory nilObject].
  	^self
  		findMethodWithPrimitive: primitive
  		FromContext: senderContext
  		UpToContext: homeContext!

Item was changed:
  ----- Method: StackInterpreter>>findUnwindThroughContext: (in category 'return bytecodes') -----
  findUnwindThroughContext: homeContext
  	"Search for either an unwind-protect (activation of method with primitive 198)
  	 or homeContext along the sender chain, which ever is found first.  Return values:
  		0			home context was found on sender chain with no intervening unwind-protects
  		nilObj		home context could not be found => cannotReturn
  		context		the context of an intervening unwind-protect implies home context was found"
+ 	| onSamePage ctxtOrNilOrZero theMethod |
+ 	"Almost always (98%) the home is on the same page."
+ 	onSamePage := (self isStillMarriedContext: homeContext)
+ 					and: [(stackPages pageIndexFor: framePointer) = (stackPages pageIndexFor: (self frameOfMarriedContext: homeContext))].
- 	| ctxtOrNilOrZero theMethod |
  	"Since nothing changes we don't need to internalize."
  	ctxtOrNilOrZero := self findMethodWithPrimitive: 198 FromFP: framePointer UpToContext: homeContext.
+ 	(onSamePage or: [ctxtOrNilOrZero = 0]) ifTrue:
- 	ctxtOrNilOrZero = 0 ifTrue:
  		[theMethod := objectMemory fetchPointer: MethodIndex ofObject: homeContext.
  		 (self primitiveIndexOf: theMethod) = 198 ifTrue:
  			[^homeContext].
  		 ^0].
+ 	"Found an unwind.  Can the home context be found also?"
  	ctxtOrNilOrZero = objectMemory nilObject ifFalse:
  		[(self findMethodWithPrimitive: 0 FromContext: ctxtOrNilOrZero UpToContext: homeContext)
  		  = objectMemory nilObject ifTrue:
  			[^objectMemory nilObject]].
  	^ctxtOrNilOrZero!

Item was removed:
- ----- Method: StackInterpreter>>initializeFrameIndices (in category 'as yet unclassified') -----
- initializeFrameIndices
- 	"Format of a stack frame.  Word-sized indices relative to the frame pointer.
- 	 Terminology
- 		Frames are either single (have no context) or married (have a context).
- 		Contexts are either single (exist on the heap), married (have a context) or widowed (had a frame that has exited).
- 	 Stacks grow down:
- 
- 			receiver for method activations/closure for block activations
- 			arg0
- 			...
- 			argN
- 			caller's method ip/base frame's sender context
- 	fp->	saved fp
- 			method
- 			frame flags
- 			context (uninitialized)
- 			receiver
- 			first temp
- 			...
- 	sp->	Nth temp
- 
- 	frame flags holds the number of arguments (since argument temporaries are above the frame)
- 	the flag for a block activation
- 	and the flag indicating if the context field is valid (whether the frame is married).
- 
- 	The first frame in a stack page is the baseFrame and is marked as such by a null saved fp,
- 	in which case the saved method ip is actually the context (possibly hybrid) beneath the base frame"
- 
- 	| fxCallerSavedIP fxSavedFP fxMethod fxFrameFlags fxThisContext fxReceiver |
- 	fxCallerSavedIP := 1.
- 	fxSavedFP := 0.
- 	fxMethod := -1.
- 	fxFrameFlags := -2.	"Can find numArgs, needed for fast temp access. args are above fxCallerSavedIP.
- 							 Can find ``is block'' bit
- 							 Can find ``has context'' bit"
- 	fxThisContext := -3.
- 	fxReceiver := -4.
- 
- 	FrameSlots := fxCallerSavedIP - fxReceiver + 1.
- 
- 	FoxCallerSavedIP := fxCallerSavedIP * objectMemory wordSize.
- 	"In base frames the caller saved ip field holds the caller context."
- 	FoxCallerContext := FoxCallerSavedIP.
- 	FoxSavedFP := fxSavedFP * objectMemory wordSize.
- 	FoxMethod := fxMethod * objectMemory wordSize.
- 	FoxFrameFlags := fxFrameFlags * objectMemory wordSize.
- 	FoxThisContext := fxThisContext * objectMemory wordSize.
- 	FoxReceiver := fxReceiver * objectMemory wordSize!

Item was removed:
- ----- Method: StackInterpreter>>internalFindUnwindThroughContext: (in category 'return bytecodes') -----
- internalFindUnwindThroughContext: homeContext
- 	"Search for either an unwind-protect (activation of method with primitive 198)
- 	 or homeContext along the sender chain, which ever is found first.  If homeContext
- 	 is not found answer nilObj, indicating cannotReturn:.  If homeContext is found
- 	 answer 0.  If homeContext is itself an unwind-protect answer the context, not 0."
- 	self externalizeIPandSP.
- 	^self findUnwindThroughContext: homeContext!

Item was added:
+ ----- Method: StackInterpreter>>isStillMarriedContextDuringGC: (in category 'frame access') -----
+ isStillMarriedContextDuringGC: aContext
+ 	"Answer if aContext is married or widowed and still married.
+ 	 If a context is widowed then turn it into a single dead context.
+ 	This version is for use during scavenging when stack references may be forwarded.
+ 	 Following what appear to be references to forwarded objects on the stack is dangerous;
+ 	 an instruction ponter may be correctly aligned and may point to bytes that just happen
+ 	 to look like a forwarder. So it is only safe to follow fields that we know are frameContext
+ 	 fields; hence the stack page is walked to check that aOnceMarriedContext is pointing to
+ 	 a live frame.  This only has to happen during scavenging because after a become: all
+ 	 frameContext fields have been followed and so there is no need to follow forwarders."
+ 	^(self isMarriedOrWidowedContext: aContext)
+ 	    and: [(self isWidowedContextDuringGC: aContext) not]!

Item was changed:
  ----- Method: StackInterpreter>>isWidowedContext: (in category 'frame access') -----
  isWidowedContext: aOnceMarriedContext
  	"See if the argument is married to a live frame or not.
+ 	 If it is not, turn it into a bereaved single context. This version is safe for use
+ 	 only when no frameContext fields may be forwarded (as maybe the case
+ 	 when scavenging).  Post become: all frameContext fields are followed, and
+ 	 hence nrmally no following of frameCOtext fields is necessary.  But during
+ 	 a scavenge one must use isWidowedContextDuringGC:."
+ 	| theFrame thePage shouldBeFrameCallerField |
+ 	<var: #theFrame type: #'char *'>
- 	 If it is not, turn it into a bereaved single context."
- 	| maybeFrame thePage shouldBeFrameCallerField maybeFrameCtxt |
- 	<var: #maybeFrame type: #'char *'>
  	<var: #thePage type: #'StackPage *'>
  	<var: #shouldBeFrameCallerField type: #'char *'>
  	self assert: ((objectMemory isContext: aOnceMarriedContext)
  				  and: [self isMarriedOrWidowedContext: aOnceMarriedContext]).
+ 	theFrame := self frameOfMarriedContext: aOnceMarriedContext.
+ 	thePage := stackPages stackPageFor: theFrame.
- 	maybeFrame := self frameOfMarriedContext: aOnceMarriedContext.
- 	thePage := stackPages stackPageFor: maybeFrame.
  	((stackPages isFree: thePage)
+ 	 or: [theFrame < thePage headFP]) ifFalse:
- 	 or: [maybeFrame < thePage headFP]) ifFalse:
  		["The frame pointer is within the bounds of a live page.
  		   Now check if it matches a frame."
  		 shouldBeFrameCallerField := self withoutSmallIntegerTags:
  											(objectMemory
  												fetchPointer: InstructionPointerIndex
  												ofObject: aOnceMarriedContext).
+ 		 ((self frameCallerFP: theFrame) = shouldBeFrameCallerField
+ 		  and: [self frameHasContext: theFrame]) ifTrue:
+ 			[self deny: (((self isFrame: theFrame onPage: thePage))
+ 						and: [objectMemory isForwarded: (self frameContext: theFrame)]).
+ 			 (self frameContext: theFrame) = aOnceMarriedContext ifTrue: "It is still married!!"
- 		 ((self frameCallerFP: maybeFrame) = shouldBeFrameCallerField
- 		  and: [self frameHasContext: maybeFrame]) ifTrue:
- 			[maybeFrameCtxt := self frameContext: maybeFrame.
- 			 "On Spur we need to follow the context to check for a match, but since the VM is
- 			  only speculating about maybeFrame being a frame, and only speculating about
- 			  maybeContext being a context, we need to be sure before we can safely follow."
- 			 (objectMemory hasSpurMemoryManagerAPI
- 			  and: [(self isFrame: maybeFrame onPage: thePage)
- 			  and: [objectMemory isForwarded: maybeFrameCtxt]]) ifTrue:
- 				[maybeFrameCtxt := objectMemory followForwarded: maybeFrameCtxt.
- 				 self setFrameContext: maybeFrame to: maybeFrameCtxt].
- 			 maybeFrameCtxt = aOnceMarriedContext ifTrue: "It is still married!!"
  				[^false]]].
  	"It is out of range or doesn't match the frame's context.
  	 It is widowed. Time to wear black."
  	self markContextAsDead: aOnceMarriedContext.
  	^true!

Item was added:
+ ----- Method: StackInterpreter>>isWidowedContextDuringGC: (in category 'frame access') -----
+ isWidowedContextDuringGC: aOnceMarriedContext
+ 	"See if the argument is married to a live frame or not.  i.e. see if there is a matching
+ 	 frame whose frameContext field is aOnceMarriedContext, or a forwarder to it.
+ 	 If aOnceMarriedContext is not married to a live frame, turn it into a bereaved single context.
+ 	 This version is for use during scavenging when stack references may be forwarded.
+ 	 Following what appear to be references to forwarded objects on the stack is dangerous;
+ 	 an instruction ponter may be correctly aligned and may point to bytes that just happen
+ 	 to look like a forwarder. So it is only safe to follow fields that we know are frameContext
+ 	 fields; hence the stack page is walked to check that aOnceMarriedContext is pointing to
+ 	 a live frame.  This only has to happen during scavenging because after a become: all
+ 	 frameContext fields have been followed and so there is no need to follow forwarders."
+ 	| maybeFrame thePage shouldBeFrameCallerField maybeFrameCtxt |
+ 	<var: #maybeFrame type: #'char *'>
+ 	<var: #thePage type: #'StackPage *'>
+ 	<var: #shouldBeFrameCallerField type: #'char *'>
+ 	self assert: ((objectMemory isContext: aOnceMarriedContext)
+ 				  and: [self isMarriedOrWidowedContext: aOnceMarriedContext]).
+ 	maybeFrame := self frameOfMarriedContext: aOnceMarriedContext.
+ 	thePage := stackPages stackPageFor: maybeFrame.
+ 	((stackPages isFree: thePage)
+ 	 or: [maybeFrame < thePage headFP]) ifFalse:
+ 		["The frame pointer is within the bounds of a live page.
+ 		   Now check if it matches a frame."
+ 		 shouldBeFrameCallerField := self withoutSmallIntegerTags:
+ 											(objectMemory
+ 												fetchPointer: InstructionPointerIndex
+ 												ofObject: aOnceMarriedContext).
+ 		 ((self frameCallerFP: maybeFrame) = shouldBeFrameCallerField
+ 		  and: [self frameHasContext: maybeFrame]) ifTrue:
+ 			[maybeFrameCtxt := self frameContext: maybeFrame.
+ 			 "On Spur we need to follow the context to check for a match, but since the VM is
+ 			  only speculating about maybeFrame being a frame, and only speculating about
+ 			  maybeContext being a context, we need to be sure before we can safely follow."
+ 			 (objectMemory hasSpurMemoryManagerAPI
+ 			  and: [(self isFrame: maybeFrame onPage: thePage)
+ 			  and: [objectMemory isForwarded: maybeFrameCtxt]]) ifTrue:
+ 				[maybeFrameCtxt := objectMemory followForwarded: maybeFrameCtxt.
+ 				 self setFrameContext: maybeFrame to: maybeFrameCtxt].
+ 			 maybeFrameCtxt = aOnceMarriedContext ifTrue: "It is still married!!"
+ 				[^false]]].
+ 	"It is out of range or doesn't match the frame's context.
+ 	 It is widowed. Time to wear black."
+ 	self markContextAsDead: aOnceMarriedContext.
+ 	^true!

Item was added:
+ ----- Method: StackInterpreter>>maybeReturnToMachineCodeFrame (in category 'return bytecodes') -----
+ maybeReturnToMachineCodeFrame
+ 	"Hook for the CoInterpreter to return to machine-code or
+ 	 load the saved IP.  This is a nop in the StackInterpreter."!

Item was changed:
  ----- Method: StackInterpreter>>setTraceFlagOnContextsFramesPageIfNeeded: (in category 'object memory support') -----
  setTraceFlagOnContextsFramesPageIfNeeded: aContext
  	| thePage |
  	<inline: false>
  	<var: #thePage type: #'StackPage *'>
+ 	(self isStillMarriedContextDuringGC: aContext) ifTrue:
- 	(self isStillMarriedContext: aContext) ifTrue:
  		[thePage := stackPages stackPageFor: (self frameOfMarriedContext: aContext).
  		 self assert: (thePage trace between: StackPageUnreached and: StackPageTraced).
  		 thePage trace = StackPageUnreached ifTrue:
  			[thePage trace: StackPageReachedButUntraced]]!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genBinaryInlineComparison:opFalse:destReg: (in category 'inline primitive generators') -----
  genBinaryInlineComparison: opTrue opFalse: opFalse destReg: destReg
  	"Inlined comparison. opTrue = jump for true and opFalse = jump for false"
  	| nextPC branchDescriptor nExts |	
  	nextPC := bytecodePC + 3.
+ 	nExts := 0.	
  	[branchDescriptor := self generatorAt: (objectMemory fetchByte: nextPC ofObject: methodObj) + (byte0 bitAnd: 256).
+ 	 branchDescriptor isExtension] whileTrue:
+ 		[nExts := nExts + 1.
+ 	 	 nextPC := nextPC + branchDescriptor numBytes].
- 	 			nExts := 0.	
- 	branchDescriptor isExtension] whileTrue:
- 	[nExts := nExts + 1.
- 	 		nextPC := nextPC + branchDescriptor numBytes].
  	(branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse])
+ 		ifTrue: "This is the path where the inlined comparison is followed immediately by a branch"
+ 			[| targetBytecodePC postBranchPC |
+ 			targetBytecodePC := nextPC
+ 					+ branchDescriptor numBytes
+ 					+ (self spanFor: branchDescriptor at: nextPC exts: nExts in: methodObj).
+ 			postBranchPC := nextPC + branchDescriptor numBytes.
+ 			self ssPushConstant: objectMemory trueObject. "dummy object"
+ 			self gen: (branchDescriptor isBranchTrue ifTrue: [opTrue] ifFalse: [opFalse])
+ 				operand: (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger.
+ 			self Jump: (self ensureNonMergeFixupAt: postBranchPC - initialPC)]
+ 		ifFalse: "This is the path where the inlined comparison is *not* followed immediately by a branch"
+ 			[| condJump jump |
- 		ifTrue: [
- 		"This is the path where the inlined comparison is followed immediatly by a branch"
- 		| targetBytecodePC postBranchPC |
- 		targetBytecodePC := nextPC
- 				+ branchDescriptor numBytes
- 				+ (self spanFor: branchDescriptor at: nextPC exts: nExts in: methodObj).
- 		postBranchPC := nextPC + branchDescriptor numBytes.
- 		self ssPushConstant: objectMemory trueObject. "dummy object"
- 		self gen: (branchDescriptor isBranchTrue ifTrue: [opTrue] ifFalse: [opFalse])
- 			operand: (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger.
- 		self Jump: (self ensureNonMergeFixupAt: postBranchPC - initialPC).
- 		 ]
- 		ifFalse: [ 
- 		"This is the path where the inlined comparison is *not* followed immediatly by a branch"
- 			| condJump jump |
  			condJump := self gen: opTrue operand: 0.
  	 		self 
  				annotate: (self MoveCw: objectMemory falseObject R: destReg) 
  				objRef: objectMemory falseObject.
  	 		jump := self Jump: 0.
  			condJump jmpTarget: (self 
  				annotate: (self MoveCw: objectMemory trueObject R: destReg) 
  				objRef: objectMemory trueObject).
+ 			jump jmpTarget: self Label].
- 			jump jmpTarget: self Label ].
  	^ 0!



More information about the Vm-dev mailing list