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

commits at source.squeak.org commits at source.squeak.org
Sun May 10 16:10:01 UTC 2015


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

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

Name: VMMaker.oscog-eem.1296
Author: eem
Time: 10 May 2015, 9:07:52.076 am
UUID: 264a71ca-50a1-4e84-96f4-dcb1c571859b
Ancestors: VMMaker.oscog-eem.1295

Revert the commonSend path, keeping a distinct
commonSend: path, so that there is no duplication
of message lookup code in the non-Newspeak VMs.

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

Item was added:
+ ----- Method: CoInterpreter>>commonSend (in category 'send bytecodes') -----
+ commonSend
+ 	"Send a message, starting lookup with the receiver's class."
+ 	"Assume: messageSelector and argumentCount have been set, and that 
+ 	the receiver and arguments have been pushed onto the stack,"
+ 	"Note: This method is inlined into the interpreter dispatch loop."
+ 	<sharedCodeNamed: 'commonSend' inCase: #singleExtendedSendBytecode>
+ 	self sendBreakpoint: messageSelector receiver: (self internalStackValue: argumentCount).
+ 	cogit recordSendTrace ifTrue:
+ 		[self recordTrace: (objectMemory classForClassTag: lkupClassTag)
+ 			thing: messageSelector
+ 			source: TraceIsFromInterpreter.
+ 		cogit printOnTrace ifTrue:
+ 			[self printActivationNameForSelector: messageSelector
+ 				startClass: (objectMemory classForClassTag: lkupClassTag); cr]].
+ 	self internalFindNewMethod: LookupRuleOrdinary.
+ 	self internalExecuteNewMethod.
+ 	self fetchNextBytecode!

Item was changed:
  ----- Method: StackInterpreter>>bytecodePrimAt (in category 'common selector sends') -----
  bytecodePrimAt
  	"BytecodePrimAt will only succeed if the receiver is in the atCache.
  	 Otherwise it will fail so that the more general primitiveAt will put it in the
  	 cache after validating that message lookup results in a primitive response.
  	 Override to insert in the at: cache here.  This is necessary since once there
  	 is a compiled at: primitive method (which doesn't use the at: cache) the only
  	 way something can get installed in the atCache is here."
  	| index rcvr result atIx |
  	index := self internalStackTop.
  	rcvr := self internalStackValue: 1.
  	((objectMemory isNonImmediate: rcvr)
  	 and: [objectMemory isIntegerObject: index]) ifTrue:
  		[atIx := rcvr bitAnd: AtCacheMask.  "Index into atCache = 4N, for N = 0 ... 7"
  		(atCache at: atIx+AtCacheOop) ~= rcvr ifTrue:
  			[lkupClassTag := objectMemory fetchClassTagOfNonImm: rcvr.
  			 messageSelector := self specialSelector: 16.
  			 (self lookupInMethodCacheSel: messageSelector classTag: lkupClassTag) ifFalse:
  				[argumentCount := 1.
+ 				 ^self commonSend].
- 				 ^self commonSend: LookupRuleOrdinary].
  			 primitiveFunctionPointer == #primitiveAt
  				ifTrue: [self install: rcvr inAtCache: atCache at: atIx string: false]
  				ifFalse:
  					[primitiveFunctionPointer == #primitiveStringAt
  						ifTrue: [self install: rcvr inAtCache: atCache at: atIx string: true]
  						ifFalse:
  							[argumentCount := 1.
+ 							 ^self commonSend]]].
- 							 ^self commonSend: LookupRuleOrdinary]]].
  		 self successful ifTrue:
  			[result := self commonVariable: rcvr at: (objectMemory integerValueOf: index) cacheIndex: atIx].
  		 self successful ifTrue:
  			[self fetchNextBytecode.
  			 ^self internalPop: 2 thenPush: result].
  		 self initPrimCall].
  
  	messageSelector := self specialSelector: 16.
  	argumentCount := 1.
  	self normalSend!

Item was changed:
  ----- Method: StackInterpreter>>bytecodePrimAtPut (in category 'common selector sends') -----
  bytecodePrimAtPut
  	"BytecodePrimAtPut will only succeed if the receiver is in the atCache.
  	Otherwise it will fail so that the more general primitiveAtPut will put it in the
  	cache after validating that message lookup results in a primitive response.
  	 Override to insert in the atCache here.  This is necessary since once there
  	 is a compiled at:[put:] primitive method (which doesn't use the at: cache) the
  	 only way something can get installed in the atCache is here."
  	| index rcvr atIx value |
  	value := self internalStackTop.
  	index := self internalStackValue: 1.
  	rcvr := self internalStackValue: 2.
  	((objectMemory isNonImmediate: rcvr)
  	 and: [objectMemory isIntegerObject: index]) ifTrue:
  		[atIx := (rcvr bitAnd: AtCacheMask) + AtPutBase.  "Index into atPutCache"
  		 (atCache at: atIx+AtCacheOop) ~= rcvr ifTrue:
  			[lkupClassTag := objectMemory fetchClassTagOfNonImm: rcvr.
  			 messageSelector := self specialSelector: 17.
  			 (self lookupInMethodCacheSel: messageSelector classTag: lkupClassTag) ifFalse:
  				[argumentCount := 2.
+ 				 ^self commonSend].
- 				 ^self commonSend: LookupRuleOrdinary].
  			 primitiveFunctionPointer == #primitiveAtPut
  				ifTrue: [self install: rcvr inAtCache: atCache at: atIx string: false]
  				ifFalse:
  					[primitiveFunctionPointer == #primitiveStringAtPut
  						ifTrue: [self install: rcvr inAtCache: atCache at: atIx string: true]
  						ifFalse:
  							[argumentCount := 2.
+ 							 ^self commonSend]]].
- 							 ^self commonSend: LookupRuleOrdinary]]].
  		 self successful ifTrue:
  			[self commonVariable: rcvr at: (objectMemory integerValueOf: index) put: value cacheIndex: atIx].
  		 self successful ifTrue:
  			[self fetchNextBytecode.
  			 ^self internalPop: 3 thenPush: value].
  		 self initPrimCall].
  
  	messageSelector := self specialSelector: 17.
  	argumentCount := 2.
  	self normalSend!

Item was added:
+ ----- Method: StackInterpreter>>commonSend (in category 'send bytecodes') -----
+ commonSend
+ 	"Send a message, starting lookup with the receiver's class."
+ 	"Assume: messageSelector and argumentCount have been set, and that 
+ 	the receiver and arguments have been pushed onto the stack,"
+ 	"Note: This method is inlined into the interpreter dispatch loop."
+ 	<sharedCodeInCase: #singleExtendedSendBytecode>
+ 	self sendBreakpoint: messageSelector receiver: (self internalStackValue: argumentCount).
+ 	self printSends ifTrue:
+ 		[self printActivationNameForSelector: messageSelector startClass: (objectMemory classForClassTag: lkupClassTag); cr].
+ 	self internalFindNewMethod: LookupRuleOrdinary.
+ 	self internalExecuteNewMethod.
+ 	self fetchNextBytecode!

Item was changed:
  ----- Method: StackInterpreter>>directedSuperclassSend (in category 'send bytecodes') -----
  directedSuperclassSend
  	"Send a message to self, starting lookup with the superclass of the class on top of stack."
  	"Assume: messageSelector and argumentCount have been set, and that
  	 the receiver and arguments have been pushed onto the stack,"
  	"Note: This method is inlined into the interpreter dispatch loop."
  	<sharedCodeInCase: #extSendSuperBytecode>
  	<option: #SistaVM>
  	| class superclass |
  	class := self internalPopStack.
  	(objectMemory isForwarded: class) ifTrue:
  		[class := objectMemory followForwarded: class].
  	superclass := self superclassOf: class.
  	objectMemory ensureBehaviorHash: superclass.
  	lkupClassTag := objectMemory classTagForClass: superclass.
  	"To maintain the invariant that all receivers are unforwarded we need an explicit
  	 read barrier in the super send cases.  Even though we always follow receivers
  	 on become  e.g. super doSomethingWith: (self become: other) forwards the receiver
  	 self pushed on the stack."
  	self ensureReceiverUnforwarded.
  	self assert: lkupClassTag ~= objectMemory nilObject.
+ 	self commonSend!
- 	self commonSend: LookupRuleOrdinary!

Item was changed:
  ----- Method: StackInterpreter>>extSendBytecode (in category 'send bytecodes') -----
  extSendBytecode
  	"238		11101110	i i i i i j j j	Send Literal Selector #iiiii (+ Extend A * 32) with jjj (+ Extend B * 8) Arguments"
  	| byte rcvr |
  	byte := self fetchByte.
  	messageSelector := self literal: (byte >> 3) + (extA << 5).
  	extA := 0.
  	argumentCount := (byte bitAnd: 7) + (extB << 3).
  	extB := 0.
  	rcvr := self internalStackValue: argumentCount.
  	lkupClassTag := objectMemory fetchClassTagOf: rcvr.
  	self assert: (objectMemory classForClassTag: lkupClassTag) ~= objectMemory nilObject.
+ 	self commonSend!
- 	self commonSend: LookupRuleOrdinary!

Item was changed:
  ----- Method: StackInterpreter>>normalSend (in category 'send bytecodes') -----
  normalSend
  	"Send a message, starting lookup with the receiver's class."
  	"Assume: messageSelector and argumentCount have been set, and that 
  	the receiver and arguments have been pushed onto the stack,"
  	"Note: This method is inlined into the interpreter dispatch loop."
  	<sharedCodeInCase: #singleExtendedSendBytecode>
  	| rcvr |
  	rcvr := self internalStackValue: argumentCount.
  	lkupClassTag := objectMemory fetchClassTagOf: rcvr.
  	self assert: lkupClassTag ~= objectMemory nilObject.
+ 	self commonSend!
- 	self commonSend: LookupRuleOrdinary!

Item was changed:
  ----- Method: StackInterpreter>>sendLiteralSelector0ArgsBytecode (in category 'send bytecodes') -----
  sendLiteralSelector0ArgsBytecode
  	"Can use any of the first 16 literals for the selector."
  	| rcvr |
  	messageSelector := self literal: (currentBytecode bitAnd: 16rF).
  	argumentCount := 0.
  	rcvr := self internalStackValue: 0.
  	lkupClassTag := objectMemory fetchClassTagOf: rcvr.
  	self assert: lkupClassTag ~= objectMemory nilObject.
+ 	self commonSend!
- 	self commonSend: LookupRuleOrdinary!

Item was changed:
  ----- Method: StackInterpreter>>sendLiteralSelector1ArgBytecode (in category 'send bytecodes') -----
  sendLiteralSelector1ArgBytecode
  	"Can use any of the first 16 literals for the selector."
  	| rcvr |
  	messageSelector := self literal: (currentBytecode bitAnd: 16rF).
  	argumentCount := 1.
  	rcvr := self internalStackValue: 1.
  	lkupClassTag := objectMemory fetchClassTagOf: rcvr.
  	self assert: lkupClassTag ~= objectMemory nilObject.
+ 	self commonSend!
- 	self commonSend: LookupRuleOrdinary!

Item was changed:
  ----- Method: StackInterpreter>>sendLiteralSelector2ArgsBytecode (in category 'send bytecodes') -----
  sendLiteralSelector2ArgsBytecode
  	"Can use any of the first 16 literals for the selector."
  	| rcvr |
  	messageSelector := self literal: (currentBytecode bitAnd: 16rF).
  	argumentCount := 2.
  	rcvr := self internalStackValue: 2.
  	lkupClassTag := objectMemory fetchClassTagOf: rcvr.
  	self assert: lkupClassTag ~= objectMemory nilObject.
+ 	self commonSend!
- 	self commonSend: LookupRuleOrdinary!

Item was changed:
  ----- Method: StackInterpreter>>superclassSend (in category 'send bytecodes') -----
  superclassSend
  	"Send a message to self, starting lookup with the superclass of the class
  	 containing the currently executing method."
  	"Assume: messageSelector and argumentCount have been set, and that
  	 the receiver and arguments have been pushed onto the stack,"
  	"Note: This method is inlined into the interpreter dispatch loop."
  	<sharedCodeInCase: #singleExtendedSuperBytecode>
  	| superclass |
  	superclass := self superclassOf: (self methodClassOf: method).
  	objectMemory ensureBehaviorHash: superclass.
  	lkupClassTag := objectMemory classTagForClass: superclass.
  	"To maintain the invariant that all receivers are unforwarded we need an explicit
  	 read barrier in the super send cases.  Even though we always follow receivers
  	 on become  e.g. super doSomethingWith: (self become: other) forwards the receiver
  	 self pushed on the stack."
  	self ensureReceiverUnforwarded.
  	self assert: lkupClassTag ~= objectMemory nilObject.
+ 	self commonSend!
- 	self commonSend: LookupRuleOrdinary!



More information about the Vm-dev mailing list