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

commits at source.squeak.org commits at source.squeak.org
Sat Dec 7 22:40:11 UTC 2013


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

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

Name: VMMaker.oscog-eem.548
Author: eem
Time: 7 December 2013, 2:37:46.314 pm
UUID: eac3c43b-073b-4ad1-8520-3849a8d914da
Ancestors: VMMaker.oscog-eem.547

Spur:
Rename handleForwardedSendFaultForReceiver: to
handleForwardedSendFaultForReceiver:stackDelta: to skip the return
pc when handling send faults in machine-code sends.

Fix followForwardedObjectFields:toDepth: to follow only pointer
fields in compiled methods.

The system runs.  Am able to compare changes in Collections
package given all the Character method changes now Character is
immediate.

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

Item was changed:
  ----- Method: CoInterpreter>>ceDynamicSuperSend:to:numArgs: (in category 'trampolines') -----
  ceDynamicSuperSend: selector to: rcvr numArgs: numArgs
  	"Entry-point for an unlinked dynamic super send in a CogMethod.  Smalltalk stack looks like
  					receiver
  					args
  		head sp ->	sender return pc
  		
  	If an MNU then defer to handleMNUInMachineCodeTo:... which will dispatch the MNU and
  	may choose to allocate a closed PIC with a fast MNU dispatch for this send.  Otherwise
  	attempt to link the send site as efficiently as possible.  All link attempts may fail; e.g.
  	because we're out of code memory.
  
  	Continue execution via either executeMethod or interpretMethodFromMachineCode:
  	depending on whether the target method is cogged or not."
  	<api>
  	<option: #NewspeakVM>
  	| class classTag canLinkCacheTag errSelIdx cogMethod mClassMixin mixinApplication |
  	<inline: false>
  	<var: #cogMethod type: #'CogMethod *'>
  	<var: #newCogMethod type: #'CogMethod *'>
  	"self printExternalHeadFrame"
  	"self printStringOf: selector"
  	cogit assertCStackWellAligned.
  	self assert: (objectMemory addressCouldBeOop: rcvr).
  	self sendBreakpoint: selector receiver: rcvr.
  	mClassMixin := self mMethodClass.
  	mixinApplication := self 
  							findApplicationOfTargetMixin: mClassMixin
  							startingAtBehavior: (objectMemory fetchClassOf: rcvr).
  	self assert: (objectMemory lengthOf: mixinApplication) > (InstanceSpecificationIndex + 1).
  	classTag := self classTagForClass: (self superclassOf: mixinApplication).
  	class := objectMemory fetchClassOf: rcvr. "what about the read barrier??"
  	canLinkCacheTag := (objectMemory isYoungObject: class) not or: [cogit canLinkToYoungClasses].
  	argumentCount := numArgs.
  	(self lookupInMethodCacheSel: selector classTag: classTag)
  		ifTrue:"check for coggability because method is in the cache"
  			[self
  				ifAppropriateCompileToNativeCode: newMethod
  				selector: selector]
  		ifFalse:
  			[(objectMemory isOopForwarded: selector) ifTrue:
  				[^self
  					ceDynamicSuperSend: (self handleForwardedSelectorFaultFor: selector)
  					to: rcvr
  					numArgs: numArgs].
  			 (objectMemory isForwardedClassTag: classTag) ifTrue:
  				[^self
  					ceDynamicSuperSend: selector
+ 					to: (self handleForwardedSendFaultForReceiver: rcvr stackDelta: 1 "skip return pc")
- 					to: (self handleForwardedSendFaultForReceiver: rcvr)
  					numArgs: numArgs].
  			 messageSelector := selector.
  			 (errSelIdx := self lookupMethodNoMNUEtcInClass: (objectMemory classForClassTag: classTag)) ~= 0 ifTrue:
  				[self handleMNU: errSelIdx InMachineCodeTo: rcvr classForMessage: (objectMemory classForClassTag: classTag).
  				self assert: false "NOTREACHED"]].
  	"Method found and has a cog method.  Attempt to link to it."
  	(self maybeMethodHasCogMethod: newMethod) ifTrue:
  		[cogMethod := self cogMethodOf: newMethod.
  		 cogMethod selector = objectMemory nilObject
  			ifTrue: [cogit setSelectorOf: cogMethod to: selector]
  			ifFalse:
  				["Deal with anonymous accessors, e.g. in Newspeak.  The cogMethod may not have the correct
  				  selector.  If not, try and compile a new method with the correct selector."
  				 cogMethod selector ~= selector ifTrue:
  					[(cogit cog: newMethod selector: selector) ifNotNil:
  						[:newCogMethod| cogMethod := newCogMethod]]].
  		 (cogMethod selector = selector
  		 and: [canLinkCacheTag]) ifTrue:
  			[cogit
  				linkSendAt: (stackPages longAt: stackPointer)
  				in: (self mframeHomeMethod: framePointer)
  				to: cogMethod
  				offset: cogit dynSuperEntryOffset
  				receiver: rcvr].
  		 instructionPointer := self popStack.
  		 self executeNewMethod.
  		 self assert: false "NOTREACHED"].
  	instructionPointer := self popStack.
  	^self interpretMethodFromMachineCode
  	"NOTREACHED"!

Item was changed:
  ----- Method: CoInterpreter>>ceSend:super:to:numArgs: (in category 'trampolines') -----
  ceSend: selector super: superNormalBar to: rcvr numArgs: numArgs
  	"Entry-point for an unlinked send in a CogMethod.  Smalltalk stack looks like
  					receiver
  					args
  		head sp ->	sender return pc
  		
  	If an MNU then defer to handleMNUInMachineCodeTo:... which will dispatch the MNU and
  	may choose to allocate a closed PIC with a fast MNU dispatch for this send.  Otherwise
  	attempt to link the send site as efficiently as possible.  All link attempts may fail; e.g.
  	because we're out of code memory.
  
  	Continue execution via either executeMethod or interpretMethodFromMachineCode:
  	depending on whether the target method is cogged or not."
  	<api>
  	| classTag canLinkCacheTag errSelIdx cogMethod |
  	<inline: false>
  	<var: #cogMethod type: #'CogMethod *'>
  	<var: #newCogMethod type: #'CogMethod *'>
  	"self printExternalHeadFrame"
  	"self printStringOf: selector"
  	cogit assertCStackWellAligned.
  	self assert: (objectMemory addressCouldBeOop: rcvr).
  	self sendBreakpoint: selector receiver: rcvr.
  	superNormalBar = 0
  		ifTrue: [classTag := objectMemory fetchClassTagOf: rcvr]
  		ifFalse: [classTag := objectMemory classTagForClass: (self superclassOf: (self methodClassOf: (self frameMethodObject: framePointer)))].
  	canLinkCacheTag := cogit canLinkToYoungClasses or: [(objectMemory isYoungObject: classTag) not].
  	argumentCount := numArgs.
  	(self lookupInMethodCacheSel: selector classTag: classTag)
  		ifTrue:"check for coggability because method is in the cache"
  			[self
  				ifAppropriateCompileToNativeCode: newMethod
  				selector: selector]
  		ifFalse:
  			[(objectMemory isOopForwarded: selector) ifTrue:
  				[^self
  					ceSend: (self handleForwardedSelectorFaultFor: selector)
  					super: superNormalBar
  					to: rcvr
  					numArgs: numArgs].
  			 (objectMemory isForwardedClassTag: classTag) ifTrue:
  				[self assert: superNormalBar = 0.
  				^self
  					ceSend: selector
  					super: superNormalBar
+ 					to: (self handleForwardedSendFaultForReceiver: rcvr stackDelta: 1 "skip return pc")
- 					to: (self handleForwardedSendFaultForReceiver: rcvr)
  					numArgs: numArgs].
  			 messageSelector := selector.
  			 (errSelIdx := self lookupMethodNoMNUEtcInClass: (objectMemory classForClassTag: classTag)) ~= 0 ifTrue:
  				[(canLinkCacheTag
  				  and: [errSelIdx = SelectorDoesNotUnderstand
  				  and: [(cogMethod := cogit cogMNUPICSelector: messageSelector
  											methodOperand: (self mnuMethodOrNilFor: rcvr)
  											numArgs: argumentCount) asUnsignedInteger
  						> cogit minCogMethodAddress]]) ifTrue:
  						[cogit
  							linkSendAt: (stackPages longAt: stackPointer)
  							in: (self mframeHomeMethod: framePointer)
  							to: cogMethod
  							offset: (superNormalBar = 0
  									ifTrue: [cogit entryOffset]
  									ifFalse: [cogit noCheckEntryOffset])
  							receiver: rcvr].
  				self handleMNU: errSelIdx
  					InMachineCodeTo: rcvr
  					classForMessage: (objectMemory classForClassTag: classTag).
  				self assert: false "NOTREACHED"]].
  	"Method found and has a cog method.  Attempt to link to it.  The receiver's class may be young.
  	 If the Cogit can't store young classes in inline caches we can link to an open PIC instead."
  	(self maybeMethodHasCogMethod: newMethod) ifTrue:
  		[cogMethod := self cogMethodOf: newMethod.
  		 cogMethod selector = objectMemory nilObject
  			ifTrue: [cogit setSelectorOf: cogMethod to: selector]
  			ifFalse:
  				["Deal with anonymous accessors, e.g. in Newspeak.  The cogMethod may not have the
  				  correct selector.  If not, try and compile a new method with the correct selector."
  				 cogMethod selector ~= selector ifTrue:
  					[(cogit cog: newMethod selector: selector) ifNotNil:
  						[:newCogMethod| cogMethod := newCogMethod]]].
  		 (cogMethod selector = selector
  		  and: [canLinkCacheTag])
  			ifTrue:
  				[cogit
  					linkSendAt: (stackPages longAt: stackPointer)
  					in: (self mframeHomeMethod: framePointer)
  					to: cogMethod
  					offset: (superNormalBar = 0
  								ifTrue: [cogit entryOffset]
  								ifFalse: [cogit noCheckEntryOffset])
  					receiver: rcvr]
  			ifFalse: "If patchToOpenPICFor:.. returns we're out of code memory"
  				[cogit
  					patchToOpenPICFor: selector
  					numArgs: numArgs
  					receiver: rcvr].
  		 instructionPointer := self popStack.
  		 self executeNewMethod.
  		 self assert: false "NOTREACHED"].
  	instructionPointer := self popStack.
  	^self interpretMethodFromMachineCode
  	"NOTREACHED"!

Item was changed:
  ----- Method: CoInterpreter>>ceSendFromInLineCacheMiss: (in category 'trampolines') -----
  ceSendFromInLineCacheMiss: cogMethodOrPIC
  	"Send from an Open PIC when the first-level method lookup probe has failed,
  	 or to continue when PIC creation has failed (e.g. because we're out of code space),
  	 or when a send has failed due to a forwarded receiver."
  	<api>
  	<var: #cogMethodOrPIC type: #'CogMethod *'>
  	| numArgs rcvr classTag errSelIdx |
  	"self printFrame: stackPage headFP WithSP: stackPage headSP"
  	"self printStringOf: selector"
  	numArgs := cogMethodOrPIC cmNumArgs.
  	rcvr := self stackValue: numArgs + 1. "skip return pc"
  	self assert: (objectMemory addressCouldBeOop: rcvr).
  	classTag := objectMemory fetchClassTagOf: rcvr.
  	argumentCount := numArgs.
  	(self lookupInMethodCacheSel: cogMethodOrPIC selector classTag: classTag)
  		ifTrue:"check for coggability because method is in the cache"
  			[self
  				ifAppropriateCompileToNativeCode: newMethod
  				selector: cogMethodOrPIC selector]
  		ifFalse:
  			[(objectMemory isOopForwarded: cogMethodOrPIC selector) ifTrue:
  				[self handleForwardedSelectorFaultFor: cogMethodOrPIC selector.
  				 ^self ceSendFromInLineCacheMiss: cogMethodOrPIC].
  			 (objectMemory isForwardedClassTag: classTag) ifTrue:
+ 				[self handleForwardedSendFaultForReceiver: rcvr stackDelta: 1 "skip return pc".
- 				[self handleForwardedSendFaultForReceiver: rcvr.
  				 ^self ceSendFromInLineCacheMiss: cogMethodOrPIC].
  			 messageSelector := cogMethodOrPIC selector.
  			 (errSelIdx := self lookupMethodNoMNUEtcInClass: (objectMemory classForClassTag: classTag)) ~= 0 ifTrue:
  				[self handleMNU: errSelIdx InMachineCodeTo: rcvr classForMessage: (objectMemory classForClassTag: classTag).
  				"NOTREACHED"
  				self assert: false]].
  	instructionPointer := self popStack.
  	(self maybeMethodHasCogMethod: newMethod) ifTrue:
  		[self executeNewMethod.
  		 self assert: false
  		 "NOTREACHED"].
  	^self interpretMethodFromMachineCode
  	"NOTREACHED"!

Item was removed:
- ----- Method: CoInterpreter>>handleForwardedSendFaultForReceiver: (in category 'message sending') -----
- handleForwardedSendFaultForReceiver: forwardedReceiver
- 	"Handle a send fault that may be due to a send to a forwarded object.
- 	 Unforward the receiver on the stack and answer it."
- 	<option: #SpurObjectMemory>
- 	| rcvr |
- 	<inline: false>
- 	"should *not* be a super send, so the receiver should be forwarded."
- 	self assert: (objectMemory isOopForwarded: forwardedReceiver).
- 
- 	self assert: (self stackValue: argumentCount) = forwardedReceiver.
- 	rcvr := objectMemory followForwarded: forwardedReceiver.
- 	self stackValue: argumentCount put: rcvr.
- 	self followForwardedFrameContents: framePointer
- 		stackPointer: stackPointer + (argumentCount + 1 * BytesPerWord). "don't repeat effort"
- 	(objectMemory isPointers: (self frameReceiver: framePointer)) ifTrue:
- 		[objectMemory
- 			followForwardedObjectFields: (self frameReceiver: framePointer)
- 			toDepth: 0].
- 	self followForwardedFieldsInCurrentMethod.
- 	^rcvr!

Item was added:
+ ----- Method: CoInterpreter>>handleForwardedSendFaultForReceiver:stackDelta: (in category 'message sending') -----
+ handleForwardedSendFaultForReceiver: forwardedReceiver stackDelta: stackDelta
+ 	"Handle a send fault that may be due to a send to a forwarded object.
+ 	 Unforward the receiver on the stack and answer it."
+ 	<option: #SpurObjectMemory>
+ 	| rcvrStackIndex rcvr |
+ 	<inline: false>
+ 	"should *not* be a super send, so the receiver should be forwarded."
+ 	self assert: (objectMemory isOopForwarded: forwardedReceiver).
+ 	rcvrStackIndex := argumentCount + stackDelta.
+ 	self assert: (self stackValue: rcvrStackIndex) = forwardedReceiver.
+ 	rcvr := objectMemory followForwarded: forwardedReceiver.
+ 	self stackValue: rcvrStackIndex put: rcvr.
+ 	self followForwardedFrameContents: framePointer
+ 		stackPointer: stackPointer + (rcvrStackIndex + 1 * BytesPerWord). "don't repeat effort"
+ 	(objectMemory isPointers: (self frameReceiver: framePointer)) ifTrue:
+ 		[objectMemory
+ 			followForwardedObjectFields: (self frameReceiver: framePointer)
+ 			toDepth: 0].
+ 	self followForwardedFieldsInCurrentMethod.
+ 	^rcvr!

Item was changed:
  ----- Method: SpurMemoryManager>>followForwardedObjectFields:toDepth: (in category 'forwarding') -----
  followForwardedObjectFields: objOop toDepth: depth
  	"follow pointers in the object to depth.
  	 How to avoid cyclic structures?? A temproary mark bit?"
  	| oop |
  	self assert: ((self isPointers: objOop) or: [self isOopCompiledMethod: objOop]).
+ 	0 to: (self numPointerSlotsOf: objOop) - 1 do:
- 	0 to: (self numSlotsOf: objOop) - 1 do:
  		[:i|
  		oop := self fetchPointer: i ofObject: objOop.
  		((self isNonImmediate: oop)
  		 and: [self isForwarded: oop]) ifTrue:
  			[oop := self followForwarded: oop.
  			self storePointer: i ofObject: objOop withValue: oop].
  		depth > 0 ifTrue:
  			[self followForwardedObjectFields: objOop toDepth: depth - 1]]!



More information about the Vm-dev mailing list