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

commits at source.squeak.org commits at source.squeak.org
Wed Apr 26 23:17:12 UTC 2017


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

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

Name: VMMaker.oscog-eem.2203
Author: eem
Time: 26 April 2017, 4:16:26.709864 pm
UUID: 12d4afae-8498-4e76-8efe-60eba6ef4db2
Ancestors: VMMaker.oscog-eem.2202

StackInterpreter: Slight refactor of primitiveClosureValue support routines to avoid accessing outerContext and method more than once.

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

Item was added:
+ ----- Method: CoInterpreter>>activateNewClosure:outer:method:numArgs:mayContextSwitch: (in category 'control primitives') -----
+ activateNewClosure: blockClosure outer: outerContext method: theMethod  numArgs: numArgs mayContextSwitch: mayContextSwitch
+ 	"Similar to activateNewMethod but for Closure and newMethod.
+ 	 Override to handle the various interpreter/machine code transitions
+ 	 and to create an appropriate frame layout."
+ 	| numCopied methodHeader inInterpreter closureIP switched |
+ 	<inline: true>
+ 	self assert: (objectMemory isContext: outerContext).
+ 	numCopied := self copiedValueCountOfClosure: blockClosure.
+ 	self assert: theMethod = (objectMemory fetchPointer: MethodIndex ofObject: outerContext).
+ 	self assert: (objectMemory isOopCompiledMethod: theMethod).
+ 	methodHeader := self rawHeaderOf: theMethod.
+ 	(self isCogMethodReference: methodHeader) ifTrue:
+ 		[^self executeCogBlock: (self cogMethodOf: theMethod)
+ 			closure: blockClosure
+ 			mayContextSwitch: mayContextSwitch].
+ 	"How do we know when to compile a block method?
+ 	 One simple criterion is to check if the block is running within its inner context,
+ 	 i.e. if the outerContext is married.
+ 	 Even simpler is to remember the previous block entered via the interpreter and
+ 	 compile if this is the same one.  But we can thrash trying to compile an uncoggable
+ 	 method unless we try and remember which ones can't be cogged.  So also record
+ 	 the last block method we failed to compile and avoid recompiling it."
+ 	(self methodWithHeaderShouldBeCogged: methodHeader)
+ 		ifTrue:
+ 			[(instructionPointer < objectMemory startOfMemory "If from machine code (via value primitive) attempt jitting"
+ 			  or: [theMethod = lastCoggableInterpretedBlockMethod]) "If from interpreter and repeat block, attempt jitting"
+ 				ifTrue:
+ 					[theMethod ~= lastUncoggableInterpretedBlockMethod ifTrue:
+ 						[cogit cog: theMethod selector: objectMemory nilObject.
+ 						 (self methodHasCogMethod: theMethod) ifTrue:
+ 							[^self executeCogBlock: (self cogMethodOf: theMethod)
+ 								closure: blockClosure
+ 								mayContextSwitch: mayContextSwitch].
+ 						 cogCompiledCodeCompactionCalledFor ifFalse:
+ 							[lastUncoggableInterpretedBlockMethod := theMethod]]]
+ 				ifFalse:
+ 					[lastCoggableInterpretedBlockMethod := theMethod]]
+ 		ifFalse:
+ 			[self maybeFlagMethodAsInterpreted: theMethod].
+ 
+ 	self assert: (self methodHasCogMethod: theMethod) not.
+ 	"Because this is an uncogged method we need to continue via the interpreter.
+ 	 We could have been reached either from the interpreter, in which case we
+ 	 should simply return, or from a machine code frame or from a compiled
+ 	 primitive.  In these latter two cases we must longjmp back to the interpreter.
+ 	 The instructionPointer tells us which path we took.
+ 	 If the sender was an interpreter frame but called through a (failing) primitive
+ 	 then make sure we restore the saved instruction pointer and avoid pushing
+ 	 ceReturnToInterpreterPC which is only valid between an interpreter caller
+ 	 frame and a machine code callee frame."
+ 	(inInterpreter := instructionPointer >= objectMemory startOfMemory) ifFalse:
+ 		[instructionPointer = cogit ceReturnToInterpreterPC ifTrue:
+ 			[instructionPointer := self iframeSavedIP: framePointer]].
+ 	self push: instructionPointer.
+ 	self push: framePointer.
+ 	framePointer := stackPointer.
+ 	self push: theMethod.
+ 	self push: objectMemory nilObject. "FxThisContext field"
+ 	self push: (self encodeFrameFieldHasContext: false isBlock: true numArgs: numArgs).
+ 	self push: 0. "FoxIFSavedIP"
+ 	"Because inst var access is not checked, we must follow the receiver in Spur to ensure it is valid."
+ 	self push: (objectMemory followField: ReceiverIndex ofObject: outerContext).
+ 
+ 	"Copy the copied values..."
+ 	0 to: numCopied - 1 do:
+ 		[:i|
+ 		self push: (objectMemory
+ 					fetchPointer: i + ClosureFirstCopiedValueIndex
+ 					ofObject: blockClosure)].
+ 
+ 	self assert: (self frameIsBlockActivation: framePointer).
+ 	self assert: (self frameHasContext: framePointer) not.
+ 
+ 	"The initial instructions in the block nil-out remaining temps."
+ 
+ 	"the instruction pointer is a pointer variable equal to 
+ 	method oop + ip + BaseHeaderSize 
+ 	-1 for 0-based addressing of fetchByte 
+ 	-1 because it gets incremented BEFORE fetching currentByte"
+ 	closureIP := self quickFetchInteger: ClosureStartPCIndex ofObject: blockClosure.
+ 	instructionPointer := theMethod + closureIP + objectMemory baseHeaderSize - 2.
+ 	self setMethod: theMethod methodHeader: methodHeader.
+ 
+ 	"Now check for stack overflow or an event (interrupt, must scavenge, etc)"
+ 	switched := false.
+ 	stackPointer < stackLimit ifTrue:
+ 		[switched := self handleStackOverflowOrEventAllowContextSwitch: mayContextSwitch].
+ 	self returnToExecutive: inInterpreter postContextSwitch: switched!

Item was removed:
- ----- Method: CoInterpreter>>activateNewClosureMethod:numArgs:mayContextSwitch: (in category 'control primitives') -----
- activateNewClosureMethod: blockClosure numArgs: numArgs mayContextSwitch: mayContextSwitch
- 	"Similar to activateNewMethod but for Closure and newMethod.
- 	 Override to handle the various interpreter/machine code transitions
- 	 and to create an appropriate frame layout."
- 	| numCopied outerContext theMethod methodHeader inInterpreter closureIP switched |
- 	<inline: true>
- 	outerContext := objectMemory fetchPointer: ClosureOuterContextIndex ofObject: blockClosure.
- 	self assert: (objectMemory isContext: outerContext).
- 	self assert: outerContext ~= blockClosure.
- 	numCopied := self copiedValueCountOfClosure: blockClosure.
- 	theMethod := objectMemory fetchPointer: MethodIndex ofObject: outerContext.
- 	self assert: (objectMemory isOopCompiledMethod: theMethod).
- 	methodHeader := self rawHeaderOf: theMethod.
- 	(self isCogMethodReference: methodHeader) ifTrue:
- 		[^self executeCogBlock: (self cogMethodOf: theMethod)
- 			closure: blockClosure
- 			mayContextSwitch: mayContextSwitch].
- 	"How do we know when to compile a block method?
- 	 One simple criterion is to check if the block is running within its inner context,
- 	 i.e. if the outerContext is married.
- 	 Even simpler is to remember the previous block entered via the interpreter and
- 	 compile if this is the same one.  But we can thrash trying to compile an uncoggable
- 	 method unless we try and remember which ones can't be cogged.  So also record
- 	 the last block method we failed to compile and avoid recompiling it."
- 	(self methodWithHeaderShouldBeCogged: methodHeader)
- 		ifTrue:
- 			[(instructionPointer < objectMemory startOfMemory "If from machine code (via value primitive) attempt jitting"
- 			  or: [theMethod = lastCoggableInterpretedBlockMethod]) "If from interpreter and repeat block, attempt jitting"
- 				ifTrue:
- 					[theMethod ~= lastUncoggableInterpretedBlockMethod ifTrue:
- 						[cogit cog: theMethod selector: objectMemory nilObject.
- 						 (self methodHasCogMethod: theMethod) ifTrue:
- 							[^self executeCogBlock: (self cogMethodOf: theMethod)
- 								closure: blockClosure
- 								mayContextSwitch: mayContextSwitch].
- 						 cogCompiledCodeCompactionCalledFor ifFalse:
- 							[lastUncoggableInterpretedBlockMethod := theMethod]]]
- 				ifFalse:
- 					[lastCoggableInterpretedBlockMethod := theMethod]]
- 		ifFalse:
- 			[self maybeFlagMethodAsInterpreted: theMethod].
- 
- 	self assert: (self methodHasCogMethod: theMethod) not.
- 	"Because this is an uncogged method we need to continue via the interpreter.
- 	 We could have been reached either from the interpreter, in which case we
- 	 should simply return, or from a machine code frame or from a compiled
- 	 primitive.  In these latter two cases we must longjmp back to the interpreter.
- 	 The instructionPointer tells us which path we took.
- 	 If the sender was an interpreter frame but called through a (failing) primitive
- 	 then make sure we restore the saved instruction pointer and avoid pushing
- 	 ceReturnToInterpreterPC which is only valid between an interpreter caller
- 	 frame and a machine code callee frame."
- 	(inInterpreter := instructionPointer >= objectMemory startOfMemory) ifFalse:
- 		[instructionPointer = cogit ceReturnToInterpreterPC ifTrue:
- 			[instructionPointer := self iframeSavedIP: framePointer]].
- 	self push: instructionPointer.
- 	self push: framePointer.
- 	framePointer := stackPointer.
- 	self push: theMethod.
- 	self push: objectMemory nilObject. "FxThisContext field"
- 	self push: (self encodeFrameFieldHasContext: false isBlock: true numArgs: numArgs).
- 	self push: 0. "FoxIFSavedIP"
- 	"Because inst var access is not checked, we must follow the receiver in Spur to ensure it is valid."
- 	self push: (objectMemory followField: ReceiverIndex ofObject: outerContext).
- 
- 	"Copy the copied values..."
- 	0 to: numCopied - 1 do:
- 		[:i|
- 		self push: (objectMemory
- 					fetchPointer: i + ClosureFirstCopiedValueIndex
- 					ofObject: blockClosure)].
- 
- 	self assert: (self frameIsBlockActivation: framePointer).
- 	self assert: (self frameHasContext: framePointer) not.
- 
- 	"The initial instructions in the block nil-out remaining temps."
- 
- 	"the instruction pointer is a pointer variable equal to 
- 	method oop + ip + BaseHeaderSize 
- 	-1 for 0-based addressing of fetchByte 
- 	-1 because it gets incremented BEFORE fetching currentByte"
- 	closureIP := self quickFetchInteger: ClosureStartPCIndex ofObject: blockClosure.
- 	instructionPointer := theMethod + closureIP + objectMemory baseHeaderSize - 2.
- 	self setMethod: theMethod methodHeader: methodHeader.
- 
- 	"Now check for stack overflow or an event (interrupt, must scavenge, etc)"
- 	switched := false.
- 	stackPointer < stackLimit ifTrue:
- 		[switched := self handleStackOverflowOrEventAllowContextSwitch: mayContextSwitch].
- 	self returnToExecutive: inInterpreter postContextSwitch: switched!

Item was added:
+ ----- Method: CoInterpreter>>activateNewFullClosure:method:numArgs:mayContextSwitch: (in category 'control primitives') -----
+ activateNewFullClosure: blockClosure method: theMethod numArgs: numArgs mayContextSwitch: mayContextSwitch
+ 	"Similar to activateNewMethod but for Closure and newMethod."
+ 	| numCopied methodHeader numTemps inInterpreter switched |
+ 	<inline: true>
+ 	self assert: theMethod = (objectMemory fetchPointer: FullClosureCompiledBlockIndex ofObject: blockClosure).
+ 	methodHeader := self rawHeaderOf: theMethod.
+ 	(self isCogMethodReference: methodHeader) ifTrue:
+ 		[^self
+ 			executeFullCogBlock: (self cogMethodOf: theMethod)
+ 			closure: blockClosure
+ 			mayContextSwitch: mayContextSwitch].
+ 	numCopied := self copiedValueCountOfFullClosure: blockClosure.
+ 	"How do we know when to compile a block method?
+ 	 One simple criterion is to check if the block is running within its inner context,
+ 	 i.e. if the outerContext is married.
+ 	 Even simpler is to remember the previous block entered via the interpreter and
+ 	 compile if this is the same one.  But we can thrash trying to compile an uncoggable
+ 	 method unless we try and remember which ones can't be cogged.  So also record
+ 	 the last block method we failed to compile and avoid recompiling it."
+ 	(self methodWithHeaderShouldBeCogged: methodHeader)
+ 		ifTrue:
+ 			[(instructionPointer < objectMemory startOfMemory "If from machine code (via value primitive) attempt jitting"
+ 			  or: [theMethod = lastCoggableInterpretedBlockMethod]) "If from interpreter and repeat block, attempt jitting"
+ 				ifTrue:
+ 					[theMethod ~= lastUncoggableInterpretedBlockMethod ifTrue:
+ 						[cogit cogFullBlockMethod: theMethod numCopied: numCopied.
+ 						 (self methodHasCogMethod: theMethod) ifTrue:
+ 							[^self executeFullCogBlock: (self cogMethodOf: theMethod)
+ 								closure: blockClosure
+ 								mayContextSwitch: mayContextSwitch].
+ 						 cogCompiledCodeCompactionCalledFor ifFalse:
+ 							[lastUncoggableInterpretedBlockMethod := theMethod]]]
+ 				ifFalse:
+ 					[lastCoggableInterpretedBlockMethod := theMethod]]
+ 		ifFalse:
+ 			[self maybeFlagMethodAsInterpreted: theMethod].
+ 
+ 	self assert: (self methodHasCogMethod: theMethod) not.
+ 	"Because this is an uncogged method we need to continue via the interpreter.
+ 	 We could have been reached either from the interpreter, in which case we
+ 	 should simply return, or from a machine code frame or from a compiled
+ 	 primitive.  In these latter two cases we must longjmp back to the interpreter.
+ 	 The instructionPointer tells us which path we took.
+ 	 If the sender was an interpreter frame but called through a (failing) primitive
+ 	 then make sure we restore the saved instruction pointer and avoid pushing
+ 	 ceReturnToInterpreterPC which is only valid between an interpreter caller
+ 	 frame and a machine code callee frame."
+ 	(inInterpreter := instructionPointer >= objectMemory startOfMemory) ifFalse:
+ 		[instructionPointer = cogit ceReturnToInterpreterPC ifTrue:
+ 			[instructionPointer := self iframeSavedIP: framePointer]].
+ 
+ 	self push: instructionPointer.
+ 	self push: framePointer.
+ 	framePointer := stackPointer.
+ 	self push: theMethod.
+ 	self push: objectMemory nilObject. "FxThisContext field"
+ 	self push: (self encodeFrameFieldHasContext: false isBlock: true numArgs: numArgs).
+ 	self push: 0. "FoxIFSavedIP"
+ 	"Because inst var access is not checked, we must follow the receiver in Spur to ensure it is valid."
+ 	self push: (objectMemory followField: FullClosureReceiverIndex ofObject: blockClosure).
+ 
+ 	"Copy the copied values..."
+ 	0 to: numCopied - 1 do:
+ 		[:i|
+ 		self push: (objectMemory
+ 					fetchPointer: i + FullClosureFirstCopiedValueIndex
+ 					ofObject: blockClosure)].
+ 
+ 	self assert: (self frameIsBlockActivation: framePointer).
+ 	self assert: (self frameHasContext: framePointer) not.
+ 
+ 	methodHeader := objectMemory methodHeaderOf: theMethod.
+ 	numTemps := self temporaryCountOfMethodHeader: methodHeader.
+ 
+ 	numArgs + numCopied + 1 to: numTemps do: [ :i | self push: objectMemory nilObject].
+ 
+ 	instructionPointer := (self initialIPForHeader: methodHeader method: theMethod) - 1.
+ 	
+ 	self setMethod: theMethod.
+ 
+ 	"Now check for stack overflow or an event (interrupt, must scavenge, etc)"
+ 	switched := false.
+ 	stackPointer < stackLimit ifTrue:
+ 		[switched := self handleStackOverflowOrEventAllowContextSwitch: mayContextSwitch].
+ 	self returnToExecutive: inInterpreter postContextSwitch: switched!

Item was removed:
- ----- Method: CoInterpreter>>activateNewFullClosureMethod:numArgs:mayContextSwitch: (in category 'control primitives') -----
- activateNewFullClosureMethod: blockClosure numArgs: numArgs mayContextSwitch: mayContextSwitch
- 	"Similar to activateNewMethod but for Closure and newMethod."
- 	| numCopied theMethod methodHeader numTemps inInterpreter switched |
- 	<inline: true>
- 	numCopied := self copiedValueCountOfFullClosure: blockClosure.
- 	theMethod := objectMemory fetchPointer: FullClosureCompiledBlockIndex ofObject: blockClosure.
- 	self assert: (objectMemory isOopCompiledMethod: theMethod).
- 	methodHeader := self rawHeaderOf: theMethod.
- 	(self isCogMethodReference: methodHeader) ifTrue:
- 		[^self
- 			executeFullCogBlock: (self cogMethodOf: theMethod)
- 			closure: blockClosure
- 			mayContextSwitch: mayContextSwitch].
- 	"How do we know when to compile a block method?
- 	 One simple criterion is to check if the block is running within its inner context,
- 	 i.e. if the outerContext is married.
- 	 Even simpler is to remember the previous block entered via the interpreter and
- 	 compile if this is the same one.  But we can thrash trying to compile an uncoggable
- 	 method unless we try and remember which ones can't be cogged.  So also record
- 	 the last block method we failed to compile and avoid recompiling it."
- 	(self methodWithHeaderShouldBeCogged: methodHeader)
- 		ifTrue:
- 			[(instructionPointer < objectMemory startOfMemory "If from machine code (via value primitive) attempt jitting"
- 			  or: [theMethod = lastCoggableInterpretedBlockMethod]) "If from interpreter and repeat block, attempt jitting"
- 				ifTrue:
- 					[theMethod ~= lastUncoggableInterpretedBlockMethod ifTrue:
- 						[cogit cogFullBlockMethod: theMethod numCopied: numCopied.
- 						 (self methodHasCogMethod: theMethod) ifTrue:
- 							[^self executeFullCogBlock: (self cogMethodOf: theMethod)
- 								closure: blockClosure
- 								mayContextSwitch: mayContextSwitch].
- 						 cogCompiledCodeCompactionCalledFor ifFalse:
- 							[lastUncoggableInterpretedBlockMethod := theMethod]]]
- 				ifFalse:
- 					[lastCoggableInterpretedBlockMethod := theMethod]]
- 		ifFalse:
- 			[self maybeFlagMethodAsInterpreted: theMethod].
- 
- 	self assert: (self methodHasCogMethod: theMethod) not.
- 	"Because this is an uncogged method we need to continue via the interpreter.
- 	 We could have been reached either from the interpreter, in which case we
- 	 should simply return, or from a machine code frame or from a compiled
- 	 primitive.  In these latter two cases we must longjmp back to the interpreter.
- 	 The instructionPointer tells us which path we took.
- 	 If the sender was an interpreter frame but called through a (failing) primitive
- 	 then make sure we restore the saved instruction pointer and avoid pushing
- 	 ceReturnToInterpreterPC which is only valid between an interpreter caller
- 	 frame and a machine code callee frame."
- 	(inInterpreter := instructionPointer >= objectMemory startOfMemory) ifFalse:
- 		[instructionPointer = cogit ceReturnToInterpreterPC ifTrue:
- 			[instructionPointer := self iframeSavedIP: framePointer]].
- 
- 	self push: instructionPointer.
- 	self push: framePointer.
- 	framePointer := stackPointer.
- 	self push: theMethod.
- 	self push: objectMemory nilObject. "FxThisContext field"
- 	self push: (self encodeFrameFieldHasContext: false isBlock: true numArgs: numArgs).
- 	self push: 0. "FoxIFSavedIP"
- 	"Because inst var access is not checked, we must follow the receiver in Spur to ensure it is valid."
- 	self push: (objectMemory followField: FullClosureReceiverIndex ofObject: blockClosure).
- 
- 	"Copy the copied values..."
- 	0 to: numCopied - 1 do:
- 		[:i|
- 		self push: (objectMemory
- 					fetchPointer: i + FullClosureFirstCopiedValueIndex
- 					ofObject: blockClosure)].
- 
- 	self assert: (self frameIsBlockActivation: framePointer).
- 	self assert: (self frameHasContext: framePointer) not.
- 
- 	methodHeader := objectMemory methodHeaderOf: theMethod.
- 	numTemps := self temporaryCountOfMethodHeader: methodHeader.
- 
- 	numArgs + numCopied + 1 to: numTemps do: [ :i | self push: objectMemory nilObject].
- 
- 	instructionPointer := (self initialIPForHeader: methodHeader method: theMethod) - 1.
- 	
- 	self setMethod: theMethod.
- 
- 	"Now check for stack overflow or an event (interrupt, must scavenge, etc)"
- 	switched := false.
- 	stackPointer < stackLimit ifTrue:
- 		[switched := self handleStackOverflowOrEventAllowContextSwitch: mayContextSwitch].
- 	self returnToExecutive: inInterpreter postContextSwitch: switched!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveClosureValue (in category 'control primitives') -----
  primitiveClosureValue
  	| blockClosure numArgs closureMethod outerContext |
  	blockClosure := self stackValue: argumentCount.
  	numArgs := self argumentCountOfClosure: blockClosure.
  	argumentCount = numArgs ifFalse:
  		[^self primitiveFail].
  
  	"Somewhat paranoiac checks we need while debugging that we may be able to discard
  	 in a robust system."
  	outerContext := objectMemory fetchPointer: ClosureOuterContextIndex ofObject: blockClosure.
  	(objectMemory isContext: outerContext) ifFalse:
  		[^self primitiveFail].
  
  	closureMethod := objectMemory fetchPointer: MethodIndex ofObject: outerContext.
  	"Check if the closure's method is actually a CompiledMethod."
  	(objectMemory isOopCompiledMethod: closureMethod) ifFalse:
  		[^self primitiveFail].
  
+ 	self activateNewClosure: blockClosure outer: outerContext method: closureMethod numArgs: numArgs mayContextSwitch: true!
- 	self activateNewClosureMethod: blockClosure numArgs: numArgs mayContextSwitch: true!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveClosureValueNoContextSwitch (in category 'control primitives') -----
  primitiveClosureValueNoContextSwitch
  	"An exact clone of primitiveClosureValue except that this version will not
  	 check for interrupts on stack overflow.  It may invoke the garbage collector
  	 but will not switch processes.  See checkForInterruptsMayContextSwitch:"
  	<api>
  	| blockClosure numArgs closureMethod outerContext |
  	blockClosure := self stackValue: argumentCount.
  	numArgs := self argumentCountOfClosure: blockClosure.
  	argumentCount = numArgs ifFalse:
  		[^self primitiveFail].
  
  	"Somewhat paranoiac checks we need while debugging that we may be able to discard
  	 in a robust system."
  	outerContext := objectMemory fetchPointer: ClosureOuterContextIndex ofObject: blockClosure.
  	(objectMemory isContext: outerContext) ifFalse:
  		[^self primitiveFail].
  
  	closureMethod := objectMemory fetchPointer: MethodIndex ofObject: outerContext.
  	"Check if the closure's method is actually a CompiledMethod."
  	(objectMemory isOopCompiledMethod: closureMethod) ifFalse:
  		[^self primitiveFail].
  
+ 	self activateNewClosure: blockClosure outer: outerContext method: closureMethod numArgs: numArgs mayContextSwitch: false!
- 	self activateNewClosureMethod: blockClosure numArgs: numArgs mayContextSwitch: false!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveClosureValueWithArgs (in category 'control primitives') -----
  primitiveClosureValueWithArgs
  	| argumentArray arraySize blockClosure numArgs closureMethod index outerContext |
  	argumentArray := self stackTop.
  	(objectMemory isArray: argumentArray) ifFalse:
  		[^self primitiveFail].
  
  	"Check for enough space in thisContext to push all args"
  	arraySize := objectMemory numSlotsOf: argumentArray.
  	(self roomToPushNArgs: arraySize) ifFalse:
  		[^self primitiveFail].
  
  	blockClosure := self stackValue: argumentCount.
  	numArgs := self argumentCountOfClosure: blockClosure.
  	arraySize = numArgs ifFalse:
  		[^self primitiveFail].
  
  	"Somewhat paranoiac checks we need while debugging that we may be able to discard
  	 in a robust system."
  	outerContext := objectMemory fetchPointer: ClosureOuterContextIndex ofObject: blockClosure.
  	(objectMemory isContext: outerContext) ifFalse:
  		[^self primitiveFail].
  	closureMethod := objectMemory fetchPointer: MethodIndex ofObject: outerContext.
  	"Check if the closure's method is actually a CompiledMethod."
  	(objectMemory isOopCompiledMethod: closureMethod) ifFalse:
  		[^self primitiveFail].
  
  	self popStack.
  
  	"Copy the arguments to the stack, and activate"
  	index := 1.
  	[index <= numArgs] whileTrue:
  		[self push: (objectMemory fetchPointer: index - 1 ofObject: argumentArray).
  		index := index + 1].
  
+ 	self activateNewClosure: blockClosure outer: outerContext method: closureMethod numArgs: numArgs mayContextSwitch: true!
- 	self activateNewClosureMethod: blockClosure numArgs: numArgs mayContextSwitch: true!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveFullClosureValue (in category 'control primitives') -----
  primitiveFullClosureValue
  	<option: #SistaV1BytecodeSet>
  	| blockClosure numArgs closureMethod |
  	blockClosure := self stackValue: argumentCount.
  	numArgs := self argumentCountOfClosure: blockClosure.
  	argumentCount = numArgs ifFalse:
  		[^self primitiveFail].
  
  	closureMethod := objectMemory fetchPointer: FullClosureCompiledBlockIndex ofObject: blockClosure.
  	(objectMemory isOopCompiledMethod: closureMethod) ifFalse:
  		[^self primitiveFail].
  
+ 	self activateNewFullClosure: blockClosure method: closureMethod numArgs: numArgs mayContextSwitch: true!
- 	self activateNewFullClosureMethod: blockClosure numArgs: numArgs mayContextSwitch: true!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveFullClosureValueNoContextSwitch (in category 'control primitives') -----
  primitiveFullClosureValueNoContextSwitch
  	"An exact clone of primitiveFullClosureValue except that this version will not
  	 check for interrupts on stack overflow.  It may invoke the garbage collector
  	 but will not switch processes.  See checkForInterruptsMayContextSwitch:"
  	<api>
  	<option: #SistaV1BytecodeSet>
  	| blockClosure numArgs closureMethod |
  	blockClosure := self stackValue: argumentCount.
  	numArgs := self argumentCountOfClosure: blockClosure.
  	argumentCount = numArgs ifFalse:
  		[^self primitiveFail].
  
  	closureMethod := objectMemory fetchPointer: FullClosureCompiledBlockIndex ofObject: blockClosure.
  	(objectMemory isOopCompiledMethod: closureMethod) ifFalse:
  		[^self primitiveFail].
  
+ 	self activateNewFullClosure: blockClosure method: closureMethod numArgs: numArgs mayContextSwitch: false!
- 	self activateNewFullClosureMethod: blockClosure numArgs: numArgs mayContextSwitch: false!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveFullClosureValueWithArgs (in category 'control primitives') -----
  primitiveFullClosureValueWithArgs
  	<option: #SistaV1BytecodeSet>
  	| argumentArray arraySize blockClosure numArgs closureMethod index |
  	argumentArray := self stackTop.
  	(objectMemory isArray: argumentArray) ifFalse:
  		[^self primitiveFail].
  
  	"Check for enough space in thisContext to push all args"
  	arraySize := objectMemory numSlotsOf: argumentArray.
  	(self roomToPushNArgs: arraySize) ifFalse:
  		[^self primitiveFail].
  
  	blockClosure := self stackValue: argumentCount.
  	numArgs := self argumentCountOfClosure: blockClosure.
  	arraySize = numArgs ifFalse:
  		[^self primitiveFail].
  
- 
  	closureMethod := objectMemory fetchPointer: FullClosureCompiledBlockIndex ofObject: blockClosure.
  	(objectMemory isOopCompiledMethod: closureMethod) ifFalse:
  		[^self primitiveFail].
  
  	self popStack.
  
  	"Copy the arguments to the stack, and activate"
  	index := 1.
  	[index <= numArgs] whileTrue:
  		[self push: (objectMemory fetchPointer: index - 1 ofObject: argumentArray).
  		index := index + 1].
  
+ 	self activateNewFullClosure: blockClosure method: closureMethod numArgs: numArgs mayContextSwitch: true!
- 	self activateNewFullClosureMethod: blockClosure numArgs: numArgs mayContextSwitch: true!

Item was added:
+ ----- Method: StackInterpreter>>activateNewClosure:outer:method:numArgs:mayContextSwitch: (in category 'control primitives') -----
+ activateNewClosure: blockClosure outer: outerContext method: theMethod  numArgs: numArgs mayContextSwitch: mayContextSwitch
+ 	"Similar to activateNewMethod but for Closure and newMethod."
+ 	| numCopied closureIP |
+ 	<inline: true>
+ 	self assert: (objectMemory isContext: outerContext).
+ 	numCopied := self copiedValueCountOfClosure: blockClosure.
+ 	self assert: theMethod = (objectMemory fetchPointer: MethodIndex ofObject: outerContext).
+ 	self assert: (objectMemory isOopCompiledMethod: theMethod).
+ 
+ 	self push: instructionPointer.
+ 	self push: framePointer.
+ 	framePointer := stackPointer.
+ 	self push: theMethod.
+ 	self push: (self encodeFrameFieldHasContext: false isBlock: true numArgs: numArgs).
+ 	self push: objectMemory nilObject. "FxThisContext field"
+ 	"Because inst var access is not checked, we must follow the receiver in Spur to ensure it is valid."
+ 	self push: (objectMemory followField: ReceiverIndex ofObject: outerContext).
+ 
+ 	"Copy the copied values..."
+ 	0 to: numCopied - 1 do:
+ 		[:i|
+ 		self push: (objectMemory
+ 					fetchPointer: i + ClosureFirstCopiedValueIndex
+ 					ofObject: blockClosure)].
+ 
+ 	self assert: (self frameIsBlockActivation: framePointer).
+ 	self assert: (self frameHasContext: framePointer) not.
+ 
+ 	"The initial instructions in the block nil-out remaining temps."
+ 
+ 	"the instruction pointer is a pointer variable equal to 
+ 	method oop + ip + BaseHeaderSize 
+ 	-1 for 0-based addressing of fetchByte 
+ 	-1 because it gets incremented BEFORE fetching currentByte"
+ 	closureIP := self quickFetchInteger: ClosureStartPCIndex ofObject: blockClosure.
+ 	instructionPointer := theMethod + closureIP + objectMemory baseHeaderSize - 2.
+ 	self setMethod: theMethod.
+ 
+ 	"Now check for stack overflow or an event (interrupt, must scavenge, etc)"
+ 	stackPointer < stackLimit ifTrue:
+ 		[self handleStackOverflowOrEventAllowContextSwitch: mayContextSwitch]!

Item was removed:
- ----- Method: StackInterpreter>>activateNewClosureMethod:numArgs:mayContextSwitch: (in category 'control primitives') -----
- activateNewClosureMethod: blockClosure numArgs: numArgs mayContextSwitch: mayContextSwitch
- 	"Similar to activateNewMethod but for Closure and newMethod."
- 	| numCopied outerContext theMethod closureIP |
- 	<inline: true>
- 	outerContext := objectMemory fetchPointer: ClosureOuterContextIndex ofObject: blockClosure.
- 	self assert: (objectMemory isContext: outerContext).
- 	numCopied := self copiedValueCountOfClosure: blockClosure.
- 
- 	theMethod := objectMemory fetchPointer: MethodIndex ofObject: outerContext.
- 	self assert: (objectMemory isOopCompiledMethod: theMethod).
- 	self push: instructionPointer.
- 	self push: framePointer.
- 	framePointer := stackPointer.
- 	self push: theMethod.
- 	self push: (self encodeFrameFieldHasContext: false isBlock: true numArgs: numArgs).
- 	self push: objectMemory nilObject. "FxThisContext field"
- 	"Because inst var access is not checked, we must follow the receiver in Spur to ensure it is valid."
- 	self push: (objectMemory followField: ReceiverIndex ofObject: outerContext).
- 
- 	"Copy the copied values..."
- 	0 to: numCopied - 1 do:
- 		[:i|
- 		self push: (objectMemory
- 					fetchPointer: i + ClosureFirstCopiedValueIndex
- 					ofObject: blockClosure)].
- 
- 	self assert: (self frameIsBlockActivation: framePointer).
- 	self assert: (self frameHasContext: framePointer) not.
- 
- 	"The initial instructions in the block nil-out remaining temps."
- 
- 	"the instruction pointer is a pointer variable equal to 
- 	method oop + ip + BaseHeaderSize 
- 	-1 for 0-based addressing of fetchByte 
- 	-1 because it gets incremented BEFORE fetching currentByte"
- 	closureIP := self quickFetchInteger: ClosureStartPCIndex ofObject: blockClosure.
- 	instructionPointer := theMethod + closureIP + objectMemory baseHeaderSize - 2.
- 	self setMethod: theMethod.
- 
- 	"Now check for stack overflow or an event (interrupt, must scavenge, etc)"
- 	stackPointer < stackLimit ifTrue:
- 		[self handleStackOverflowOrEventAllowContextSwitch: mayContextSwitch]!

Item was added:
+ ----- Method: StackInterpreter>>activateNewFullClosure:method:numArgs:mayContextSwitch: (in category 'control primitives') -----
+ activateNewFullClosure: blockClosure method: theMethod numArgs: numArgs mayContextSwitch: mayContextSwitch
+ 	"Similar to activateNewMethod but for Closure and newMethod."
+ 	| numCopied methodHeader numTemps |
+ 	<inline: true>
+ 	self assert: theMethod = (objectMemory fetchPointer: FullClosureCompiledBlockIndex ofObject: blockClosure).
+ 	numCopied := self copiedValueCountOfFullClosure: blockClosure.
+ 	self push: instructionPointer.
+ 	self push: framePointer.
+ 	framePointer := stackPointer.
+ 	self push: theMethod.
+ 	self push: (self encodeFrameFieldHasContext: false isBlock: true numArgs: numArgs).
+ 	self push: objectMemory nilObject. "FxThisContext field"
+ 	"Because inst var access is not checked, we must follow the receiver in Spur to ensure it is valid."
+ 	self push: (objectMemory followField: FullClosureReceiverIndex ofObject: blockClosure).
+ 
+ 	"Copy the copied values..."
+ 	0 to: numCopied - 1 do:
+ 		[:i|
+ 		self push: (objectMemory
+ 					fetchPointer: i + FullClosureFirstCopiedValueIndex
+ 					ofObject: blockClosure)].
+ 
+ 	self assert: (self frameIsBlockActivation: framePointer).
+ 	self assert: (self frameHasContext: framePointer) not.
+ 
+ 	methodHeader := objectMemory methodHeaderOf: theMethod.
+ 	numTemps := self temporaryCountOfMethodHeader: methodHeader.
+ 
+ 	numArgs + numCopied + 1 to: numTemps do: [ :i | self push: objectMemory nilObject].
+ 
+ 	instructionPointer := (self initialIPForHeader: methodHeader method: theMethod) - 1.
+ 	
+ 	self setMethod: theMethod.
+ 
+ 	"Now check for stack overflow or an event (interrupt, must scavenge, etc)"
+ 	stackPointer < stackLimit ifTrue:
+ 		[self handleStackOverflowOrEventAllowContextSwitch: mayContextSwitch]!

Item was removed:
- ----- Method: StackInterpreter>>activateNewFullClosureMethod:numArgs:mayContextSwitch: (in category 'control primitives') -----
- activateNewFullClosureMethod: blockClosure numArgs: numArgs mayContextSwitch: mayContextSwitch
- 	"Similar to activateNewMethod but for Closure and newMethod."
- 	| numCopied theMethod methodHeader numTemps |
- 	<inline: true>
- 	numCopied := self copiedValueCountOfFullClosure: blockClosure.
- 	theMethod := objectMemory fetchPointer: FullClosureCompiledBlockIndex ofObject: blockClosure.
- 	self assert: (objectMemory isOopCompiledMethod: theMethod).
- 	self push: instructionPointer.
- 	self push: framePointer.
- 	framePointer := stackPointer.
- 	self push: theMethod.
- 	self push: (self encodeFrameFieldHasContext: false isBlock: true numArgs: numArgs).
- 	self push: objectMemory nilObject. "FxThisContext field"
- 	"Because inst var access is not checked, we must follow the receiver in Spur to ensure it is valid."
- 	self push: (objectMemory followField: FullClosureReceiverIndex ofObject: blockClosure).
- 
- 	"Copy the copied values..."
- 	0 to: numCopied - 1 do:
- 		[:i|
- 		self push: (objectMemory
- 					fetchPointer: i + FullClosureFirstCopiedValueIndex
- 					ofObject: blockClosure)].
- 
- 	self assert: (self frameIsBlockActivation: framePointer).
- 	self assert: (self frameHasContext: framePointer) not.
- 
- 	methodHeader := objectMemory methodHeaderOf: theMethod.
- 	numTemps := self temporaryCountOfMethodHeader: methodHeader.
- 
- 	numArgs + numCopied + 1 to: numTemps do: [ :i | self push: objectMemory nilObject].
- 
- 	instructionPointer := (self initialIPForHeader: methodHeader method: theMethod) - 1.
- 	
- 	self setMethod: theMethod.
- 
- 	"Now check for stack overflow or an event (interrupt, must scavenge, etc)"
- 	stackPointer < stackLimit ifTrue:
- 		[self handleStackOverflowOrEventAllowContextSwitch: mayContextSwitch]!



More information about the Vm-dev mailing list