[Vm-dev] VM Maker: VMMaker.oscog-cb.1788.mcz

commits at source.squeak.org commits at source.squeak.org
Fri Apr 8 22:07:52 UTC 2016


ClementBera uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-cb.1788.mcz

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

Name: VMMaker.oscog-cb.1788
Author: cb
Time: 8 April 2016, 3:06:15.108621 pm
UUID: e171089f-d65b-4a37-bb49-6cf19cc8df7a
Ancestors: VMMaker.oscog-eem.1787

finished that constant generic methods I was willing to do for month.

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

Item was changed:
  ----- Method: CogSimStackEntry>>ensureSpilledAt:from: (in category 'compile abstract instructions') -----
  ensureSpilledAt: baseOffset from: baseRegister
  	| inst |
  	<var: #inst type: #'AbstractInstruction *'>
  	spilled ifTrue:
  		[type = SSSpill ifTrue:
  			[self assert: (offset = baseOffset and: [register = baseRegister]).
  			 ^self]].
  	self assert: type ~= SSSpill.
  	cogit traceSpill: self.
  	type = SSConstant
  		ifTrue:
+ 			[inst := cogit genPushConstant: constant]
- 			[inst := self genPushConstant: constant]
  		ifFalse:
  			[type = SSBaseOffset
  				ifTrue:
  					[cogit MoveMw: offset r: register R: TempReg.
  					 inst := cogit PushR: TempReg]
  				ifFalse:
  					[self assert: type = SSRegister.
  					 inst := cogit PushR: register].
  			 type := SSSpill.
  			 offset := baseOffset.
  			 register := baseRegister].
  	spilled := true.
  	annotateUse ifTrue:
  		[cogit annotateBytecode: inst.
  		 annotateUse := false]!

Item was removed:
- ----- Method: SimpleStackBasedCogit>>genAnnotatedSubCw:R: (in category 'constant support') -----
- genAnnotatedSubCw: constant R: reg
- 	"generates a SubCW instruction with an explicit annotation. This is called (as of today) only by the branch generation methods.
- 	The annotation needs to be there for some reasons unknown to me (removing the annotation crashes the must be boolean trampolines)"
- 	<inline: true>
- 	self flag: #TOCHECK. "We will check with eliot if this could be a SubCq, and if not, put the proper comment"
- 	self annotate: (self SubCw: constant R: TempReg) objRef: reg.
- 	!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genJumpIf:to: (in category 'bytecode generator support') -----
  genJumpIf: boolean to: targetBytecodePC
  	<inline: false>
  	"Cunning trick by LPD.  If true and false are contiguous subtract the smaller.
  	 Correct result is either 0 or the distance between them.  If result is not 0 or
  	 their distance send mustBeBoolean."
  	| ok |
  	<var: #ok type: #'AbstractInstruction *'>
  	extA := 0.
  	self assert: (objectMemory objectAfter: objectMemory falseObject) = objectMemory trueObject.
  	self PopR: TempReg.
+ 	self genSubConstant: boolean R: TempReg.
- 	self genAnnotatedSubCw: boolean R: TempReg.
  	self JumpZero: (self ensureFixupAt: targetBytecodePC - initialPC).
  	self CmpCq: (boolean == objectMemory falseObject
  					ifTrue: [objectMemory trueObject - objectMemory falseObject]
  					ifFalse: [objectMemory falseObject - objectMemory trueObject])
  		R: TempReg.
  	ok := self JumpZero: 0.
  	self CallRT: (boolean == objectMemory falseObject
  					ifTrue: [ceSendMustBeBooleanAddFalseTrampoline]
  					ifFalse: [ceSendMustBeBooleanAddTrueTrampoline]).
  	ok jmpTarget: (self annotateBytecode: self Label).
  	^0!

Item was added:
+ ----- Method: SimpleStackBasedCogit>>genSubConstant:R: (in category 'constant support') -----
+ genSubConstant: constant R: reg
+ 	"If the objectMemory allows it, generates a quick constant sub, else generates a word constant sub"
+ 	<inline: true>
+ 	^ (objectRepresentation shouldAnnotateObjectReference: constant)
+ 		ifTrue: [ self annotate: (self SubCw: constant R: TempReg) objRef: reg. ]
+ 		ifFalse: [ self SubCq: constant R: TempReg ]!

Item was changed:
  ----- Method: SistaStackToRegisterMappingCogit>>genCounterTripOnlyJumpIf:to: (in category 'bytecode generator support') -----
  genCounterTripOnlyJumpIf: boolean to: targetBytecodePC 
  	"Specific version if the branch is only reached while falling through if the counter trips after an inlined #== branch. We do not regenerate the counter logic in this case to avoid 24 bytes instructions."
  	
  	<var: #ok type: #'AbstractInstruction *'>
  	<var: #mustBeBooleanTrampoline type: #'AbstractInstruction *'>
  
  	| ok mustBeBooleanTrampoline |
  
  	extA := 0.
  
  	self ssFlushTo: simStackPtr - 1.
  	
  	self ssTop popToReg: TempReg.
  	
  	self ssPop: 1.
  
  	counterIndex := counterIndex + 1. "counters are increased / decreased in the inlined branch"
  
  	"We need SendNumArgsReg because of the mustBeBooleanTrampoline"
  	self ssAllocateRequiredReg: SendNumArgsReg.
  	self MoveCq: 1 R: SendNumArgsReg.
  	
  	"The first time this is reached, it calls necessarily the counter trip for the trampoline because SendNumArgsReg is non zero"
  	mustBeBooleanTrampoline := self CallRT: (boolean == objectMemory falseObject
  						ifTrue: [ceSendMustBeBooleanAddFalseTrampoline]
  						ifFalse: [ceSendMustBeBooleanAddTrueTrampoline]).
  
  	self annotateBytecode: self Label.
  
  	"Cunning trick by LPD.  If true and false are contiguous subtract the smaller.
  	 Correct result is either 0 or the distance between them.  If result is not 0 or
  	 their distance send mustBeBoolean."
  	self assert: (objectMemory objectAfter: objectMemory falseObject) = objectMemory trueObject.
+ 	self genSubConstant: boolean R: TempReg.
- 	self genAnnotatedSubCw: boolean R: TempReg.
  	self JumpZero: (self ensureFixupAt: targetBytecodePC - initialPC).
  
  	self CmpCq: (boolean == objectMemory falseObject
  					ifTrue: [objectMemory trueObject - objectMemory falseObject]
  					ifFalse: [objectMemory falseObject - objectMemory trueObject])
  		R: TempReg.
  		
  	ok := self JumpZero: 0.
  	self MoveCq: 0 R: SendNumArgsReg. "if counterReg is 0 this is a mustBeBoolean, not a counter trip."		
  
  	self Jump: mustBeBooleanTrampoline.
  	
  	ok jmpTarget: self Label.
  	^0!

Item was changed:
  ----- Method: SistaStackToRegisterMappingCogit>>genJumpIf:to: (in category 'bytecode generator support') -----
  genJumpIf: boolean to: targetBytecodePC
  	"The heart of performance counting in Sista.  Conditional branches are 6 times less
  	 frequent than sends and can provide basic block frequencies (send counters can't).
  	 Each conditional has a 32-bit counter split into an upper 16 bits counting executions
  	 and a lower half counting untaken executions of the branch.  Executing the branch
  	 decrements the upper half, tripping if the count goes negative.  Not taking the branch
  	 decrements the lower half.  N.B. We *do not* eliminate dead branches (true ifTrue:/true ifFalse:)
  	 so that scanning for send and branch data is simplified and that branch data is correct."
  	<inline: false>
  	| ok counterAddress countTripped retry nextPC nextDescriptor |
  	<var: #ok type: #'AbstractInstruction *'>
  	<var: #retry type: #'AbstractInstruction *'>
  	<var: #countTripped type: #'AbstractInstruction *'>
  	<var: #nextDescriptor type: #'AbstractInstruction *'>
  
  	(coInterpreter isOptimizedMethod: methodObj) ifTrue: [ ^ super genJumpIf: boolean to: targetBytecodePC ].
  	
  	branchReachedOnlyForCounterTrip ifTrue: 
  		[ branchReachedOnlyForCounterTrip := false.
  		^ self genCounterTripOnlyJumpIf: boolean to: targetBytecodePC ].
  	
  	boolean == objectMemory falseObject ifTrue:
  		[ "detection of and: / or:"
  		nextPC := bytecodePC + (self generatorAt: byte0) numBytes.
  		nextDescriptor := self generatorAt: (objectMemory fetchByte: nextPC ofObject: methodObj) + bytecodeSetOffset.
  		nextDescriptor generator ==  #genPushConstantTrueBytecode ifTrue: [ ^ super genJumpIf: boolean to: targetBytecodePC ].
  		nextDescriptor := self generatorAt: (objectMemory fetchByte: targetBytecodePC ofObject: methodObj) + bytecodeSetOffset.
  		nextDescriptor generator ==  #genPushConstantFalseBytecode ifTrue: [ ^ super genJumpIf: boolean to: targetBytecodePC ].  ].
  
  	extA := 0.
  
  	self ssFlushTo: simStackPtr - 1.
  	self ssTop popToReg: TempReg.
  	self ssPop: 1.
  
  	"We need SendNumArgsReg because of the mustBeBooleanTrampoline"
  	self ssAllocateRequiredReg: SendNumArgsReg.
  
  	retry := self Label.
  	self 
  		genExecutionCountLogicInto: [ :cAddress :countTripBranch | 
  			counterAddress := cAddress. 
  			countTripped := countTripBranch ] 
  		counterReg: SendNumArgsReg.
  	counterIndex := counterIndex + 1.
  
  	"Cunning trick by LPD.  If true and false are contiguous subtract the smaller.
  	 Correct result is either 0 or the distance between them.  If result is not 0 or
  	 their distance send mustBeBoolean."
  	self assert: (objectMemory objectAfter: objectMemory falseObject) = objectMemory trueObject.
+ 	self genSubConstant: boolean R: TempReg.
- 	self genAnnotatedSubCw: boolean R: TempReg.
  	self JumpZero: (self ensureFixupAt: targetBytecodePC - initialPC).
  
  	self genFallsThroughCountLogicCounterReg: SendNumArgsReg counterAddress: counterAddress.
  
  	self CmpCq: (boolean == objectMemory falseObject
  					ifTrue: [objectMemory trueObject - objectMemory falseObject]
  					ifFalse: [objectMemory falseObject - objectMemory trueObject])
  		R: TempReg.
  	ok := self JumpZero: 0.
  	self MoveCq: 0 R: SendNumArgsReg. "if counterReg is 0 this is a mustBeBoolean, not a counter trip."
  	
  	countTripped jmpTarget:
  		(self CallRT: (boolean == objectMemory falseObject
  						ifTrue: [ceSendMustBeBooleanAddFalseTrampoline]
  						ifFalse: [ceSendMustBeBooleanAddTrueTrampoline])).
  						
  	"If we're in an image which hasn't got the Sista code loaded then the ceCounterTripped:
  	 trampoline will return directly to machine code, returning the boolean.  So the code should
  	 jump back to the retry point. The trampoline makes sure that TempReg has been reloaded."
  	self annotateBytecode: self Label.
  
  	self Jump: retry.
  	
  	ok jmpTarget: self Label.
  	^0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genJumpIf:to: (in category 'bytecode generator support') -----
  genJumpIf: boolean to: targetBytecodePC
  	<inline: false>
  	| desc fixup ok |
  	<var: #desc type: #'CogSimStackEntry *'>
  	<var: #fixup type: #'BytecodeFixup *'>
  	<var: #ok type: #'AbstractInstruction *'>
  	self ssFlushTo: simStackPtr - 1.
  	desc := self ssTop.
  	self ssPop: 1.
  	(desc type == SSConstant
  	 and: [desc constant = objectMemory trueObject or: [desc constant = objectMemory falseObject]]) ifTrue:
  		["Must arrange there's a fixup at the target whether it is jumped to or
  		  not so that the simStackPtr can be kept correct."
  		 fixup := self ensureFixupAt: targetBytecodePC - initialPC.
  		 "Must enter any annotatedConstants into the map"
  		 desc annotateUse ifTrue:
  			[self annotateBytecode: (self prevInstIsPCAnnotated
  											ifTrue: [self Nop]
  											ifFalse: [self Label])].
  		 "Must annotate the bytecode for correct pc mapping."
  		 self annotateBytecode: (desc constant = boolean
  									ifTrue: [self Jump: fixup]
  									ifFalse: [self prevInstIsPCAnnotated
  												ifTrue: [self Nop]
  												ifFalse: [self Label]]).
  		 ^0].
  	desc popToReg: TempReg.
  	"Cunning trick by LPD.  If true and false are contiguous subtract the smaller.
  	 Correct result is either 0 or the distance between them.  If result is not 0 or
  	 their distance send mustBeBoolean."
  	self assert: (objectMemory objectAfter: objectMemory falseObject) = objectMemory trueObject.
+ 	self genSubConstant: boolean R: TempReg.
- 	self genAnnotatedSubCw: boolean R: TempReg.
  	self JumpZero: (self ensureFixupAt: targetBytecodePC - initialPC).
  	
  	self extASpecifiesNoMustBeBoolean ifTrue: 
  		[ extA := 0. 
  		self annotateBytecode: self lastOpcode.
  		^ 0].
  	extA := 0.
  	
  .	self CmpCq: (boolean == objectMemory falseObject
  					ifTrue: [objectMemory trueObject - objectMemory falseObject]
  					ifFalse: [objectMemory falseObject - objectMemory trueObject])
  		R: TempReg.
  	ok := self JumpZero: 0.
  	self CallRT: (boolean == objectMemory falseObject
  					ifTrue: [ceSendMustBeBooleanAddFalseTrampoline]
  					ifFalse: [ceSendMustBeBooleanAddTrueTrampoline]).
  	ok jmpTarget: (self annotateBytecode: self Label).
  	^0!



More information about the Vm-dev mailing list