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

commits at source.squeak.org commits at source.squeak.org
Tue Nov 4 03:08:46 UTC 2014


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

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

Name: VMMaker.oscog-eem.921
Author: eem
Time: 3 November 2014, 7:06:08.512 pm
UUID: ab06d6ee-a8c8-47db-80cc-7530c9a4b945
Ancestors: VMMaker.oscog-eem.920

Spur: Fix possible forwarding of the receiver in implicit
receiver sends.

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

Item was added:
+ ----- Method: CoInterpreter>>internalFollowedReceiver (in category 'internal interpreter access') -----
+ internalFollowedReceiver
+ 	<inline: true>
+ 	| rcvr |
+ 	rcvr := stackPages longAt: localFP + FoxIFReceiver.
+ 	(objectMemory isOopForwarded: rcvr) ifTrue:
+ 		[rcvr := objectMemory followForwarded: rcvr.
+ 		 stackPages longAt: localFP + FoxIFReceiver put: rcvr].
+ 	^rcvr!

Item was added:
+ ----- Method: CogObjectRepresentationForSpur>>genEnsureObjInRegNotForwarded:scratchReg:updatingMw:r: (in category 'compile abstract instructions') -----
+ genEnsureObjInRegNotForwarded: reg scratchReg: scratch updatingMw: offset r: baseReg
+ 	"Make sure that the object in reg is not forwarded, and update the field reg[offset] is
+ 	 updated if the object in reg is forwarded.
+ 	 Use the fact that isForwardedObjectClassIndexPun is a power of two to save an instruction."
+ 	| loop imm ok |
+ 	<var: #ok type: #'AbstractInstruction *'>
+ 	<var: #imm type: #'AbstractInstruction *'>
+ 	<var: #loop type: #'AbstractInstruction *'>
+ 	self assert: reg ~= scratch.
+ 	loop := cogit Label.
+ 	cogit MoveR: reg R: scratch.
+ 	imm := self genJumpImmediateInScratchReg: scratch.
+ 	"notionally
+ 		self genGetClassIndexOfNonImm: reg into: scratch.
+ 		cogit CmpCq: objectMemory isForwardedObjectClassIndexPun R: TempReg.
+ 	 but the following is an instruction shorter:"
+ 	cogit MoveMw: 0 r: reg R: scratch.
+ 	cogit
+ 		AndCq: objectMemory classIndexMask - objectMemory isForwardedObjectClassIndexPun
+ 		R: scratch.
+ 	ok := cogit JumpNonZero:  0.
+ 	self genLoadSlot: 0 sourceReg: reg destReg: reg.
+ 	cogit MoveR: reg Mw: offset r: baseReg.
+ 	cogit Jump: loop.
+ 	ok jmpTarget: (imm jmpTarget: cogit Label).
+ 	^0!

Item was changed:
  ----- Method: Cogit>>generateNewspeakRuntime (in category 'initialization') -----
  generateNewspeakRuntime
  	<option: #NewspeakVM>
  	| jumpMiss jumpItsTheReceiverStupid retpcReg |
  	<var: #jumpMiss type: #'AbstractInstruction *'>
  	<var: #jumpItsTheReceiverStupid type: #'AbstractInstruction *'>
  	"Generate the non-send runtime support for Newspeak, explicit outer and implicit receiver.
  	 The dynamic frequency of explicit outer is so low we merely call an interpreter routine."
  	ceEnclosingObjectTrampoline := self genTrampolineFor: #ceEnclosingObjectAt:
  										called: 'ceEnclosingObjectTrampoline'
  										arg: SendNumArgsReg
  										result: ReceiverResultReg.
  	"Cached push implicit receiver implementation.  If objectRepresentation doesn't support
  	 pinning then caller looks like
  				mov selector, SendNumArgsReg
  				call ceImplicitReceiver
  				br continue
  		Lclass:	.word
  		Lmixin::	.word
  		continue:
  	 If objectRepresentation supports pinning then caller looks like
  				mov Lclass, Arg1Reg
  				mov selector, SendNumArgsReg
  				call ceImplicitReceiver
  	 and Lclass: .word; Lmixin: .word is somewhere on the heap.
  
  	 If class tag matches class of receiver then mixin contains either 0 or the implicit receiver.
  	 If 0, answer the actual receiver, otherwise the mixin.
  	 Generate the class fetch and cache probe inline for speed.
  	 Smashes Arg1Reg, RegClass and caller-saved regs."
  	opcodeIndex := 0.
  	self MoveMw: FoxMFReceiver r: FPReg R: ReceiverResultReg.
  	objectRepresentation
  		genGetInlineCacheClassTagFrom: ReceiverResultReg
  		into: ClassReg
  		forEntry: false.
  	objectRepresentation canPinObjects
  		ifTrue:
  			[self MoveMw: 0 r: Arg1Reg R: TempReg.
  			 self CmpR: ClassReg R: TempReg.
  			 jumpMiss := self JumpNonZero: 0.
  			 self MoveMw: BytesPerOop r: Arg1Reg R: TempReg.
  			 self CmpCq: 0 R: TempReg.
  			 jumpItsTheReceiverStupid := self JumpZero: 0.
  			 self MoveR: TempReg R: ReceiverResultReg.
  			 jumpItsTheReceiverStupid jmpTarget: (self RetN: 0).
  			 jumpMiss jmpTarget: self Label.
+ 			 objectRepresentation
+ 				genEnsureObjInRegNotForwarded: ReceiverResultReg
+ 				scratchReg: TempReg
+ 				updatingMw: FoxMFReceiver
+ 				r: FPReg.
  			 ceImplicitReceiverTrampoline := self
  												genTrampolineFor: #ceImplicitReceiverFor:receiver:cache:
  												called: 'ceImplicitReceiverTrampoline'
  												numArgs: 3
  												arg: SendNumArgsReg
  												arg: ReceiverResultReg
  												arg: Arg1Reg
  												arg: nil
  												saveRegs: false
  												pushLinkReg: true
  												resultReg: ReceiverResultReg
  												appendOpcodes: true]
  		ifFalse:
  			[backEnd hasLinkRegister
  				ifTrue: [retpcReg := LinkReg]
  				ifFalse: [self MoveMw: 0 r: SPReg R: (retpcReg := TempReg)].
  			 self MoveMw: 0 r: SPReg R: retpcReg.
  			 self MoveMw: backEnd jumpShortByteSize r: retpcReg R: Arg1Reg.
  			 self CmpR: ClassReg R: Arg1Reg.
  			 jumpMiss := self JumpNonZero: 0.
  			 self MoveMw: backEnd jumpShortByteSize + BytesPerOop r: retpcReg R: ClassReg.
  			 self CmpCq: 0 R: ClassReg.
  			 jumpItsTheReceiverStupid := self JumpZero: 0.
  			 self MoveR: ClassReg R: ReceiverResultReg.
  			 jumpItsTheReceiverStupid jmpTarget: (self RetN: 0).
  			 jumpMiss jmpTarget: self Label.
  			 ceImplicitReceiverTrampoline := self
  												genTrampolineFor: #ceImplicitReceiverFor:receiver:
  												called: 'ceImplicitReceiverTrampoline'
  												numArgs: 2
  												arg: SendNumArgsReg
  												arg: ReceiverResultReg
  												arg: nil
  												arg: nil
  												saveRegs: false
  												pushLinkReg: true
  												resultReg: ReceiverResultReg
  												appendOpcodes: true]!

Item was changed:
  ----- Method: StackInterpreter>>commonSendAbsentImplicit (in category 'send bytecodes') -----
  commonSendAbsentImplicit
  	"Send a message to the implicit receiver for that message."
  	"Assume: messageSelector and argumentCount have been set, and that 
  	the arguments but not the receiver have been pushed onto the stack,"
  	"Note: This method is inlined into the interpreter dispatch loop."
  	"160-175	1010 i i i i		Send To Absent Implicit Receiver Literal Selector #iiii With 0 Arguments"
  	"240		11110000	i i i i i j j j	Send To Absent Implicit Receiver Literal Selector #iiiii (+ Extend A * 32) with jjj (+ Extend B * 8) Arguments"
  	<sharedCodeInCase: #extSendAbsentImplicitBytecode>
+ 	| followedReceiver implicitReceiver |
+ 	followedReceiver := self internalFollowedReceiver.
- 	| implicitReceiver |
  	implicitReceiver := self
+ 							implicitReceiverFor: followedReceiver
- 							implicitReceiverFor: self receiver
  							mixin: (self methodClassOf: method)
  							implementing: messageSelector.
  	self shuffleArgumentsAndStoreAbsentReceiver: implicitReceiver.
  	lkupClassTag := objectMemory fetchClassTagOf: implicitReceiver.
  	self assert: lkupClassTag ~= objectMemory nilObject.
  	self commonSend!

Item was added:
+ ----- Method: StackInterpreter>>internalFollowedReceiver (in category 'internal interpreter access') -----
+ internalFollowedReceiver
+ 	<inline: true>
+ 	| rcvr |
+ 	rcvr := stackPages longAt: localFP + FoxReceiver.
+ 	(objectMemory isOopForwarded: rcvr) ifTrue:
+ 		[rcvr := objectMemory followForwarded: rcvr.
+ 		 stackPages longAt: localFP + FoxReceiver put: rcvr].
+ 	^rcvr!

Item was changed:
  ----- Method: StackInterpreter>>pushImplicitReceiverBytecode (in category 'stack bytecodes') -----
  pushImplicitReceiverBytecode
  	"This bytecode is used to implement outer sends in NS2/NS3. The
  	 bytecode takes as an argument the literal offset of a selector. It
  	 effectively finds the nearest lexically-enclosing implementation of
  	 that selector by searching up the static chain of the receiver,
  	 starting at the current method."
+ 	| selector followedReceiver |
- 	| selector |
  	selector := self literal: self fetchByte.
  	self fetchNextBytecode.
+ 	followedReceiver := self internalFollowedReceiver.
  	self internalPush: (self
+ 						implicitReceiverFor: followedReceiver
- 						implicitReceiverFor: self receiver
  						mixin: (self methodClassOf: method)
  						implementing: selector)!



More information about the Vm-dev mailing list