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

commits at source.squeak.org commits at source.squeak.org
Mon Apr 27 12:30:20 UTC 2015


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

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

Name: VMMaker.oscog-cb.1262
Author: cb
Time: 27 April 2015, 2:28:22.575 pm
UUID: 9210cbaf-05f6-43e7-a3a6-57ab7cec7828
Ancestors: VMMaker.oscog-cb.1261

Removed 3 typos 'self self' instead of self.... Crashes at C code generation time...

=============== Diff against VMMaker.oscog-cb.1261 ===============

Item was changed:
  ----- Method: SistaStackToRegisterMappingCogit>>genExtJumpIfNotInstanceOfBehaviorsOrPopBytecode (in category 'bytecode generators') -----
  genExtJumpIfNotInstanceOfBehaviorsOrPopBytecode
  	"SistaV1: *	254		11111110	kkkkkkkk	jjjjjjjj		branch If Not Instance Of Behavior/Array Of Behavior kkkkkkkk (+ Extend A * 256, where Extend A >= 0) distance jjjjjjjj (+ Extend B * 256, where Extend B >= 0)"
  								
  	| reg literal distance targetFixUp |
  	
  	"We loose the information of in which register is stack top 
  	when jitting the branch target so we need to flush everything. 
  	We could use a fixed register here...."
+ 	reg := self allocateRegForStackEntryAt: 0.
- 	reg := self self allocateRegForStackEntryAt: 0.
  	self ssTop popToReg: reg.
  	self ssFlushTo: simStackPtr. "flushed but the value is still in reg"
  	
  	literal := self getLiteral: (extA * 256 + byte1).
  	extA := 0.
  	distance := extB * 256 + byte2.
  	extB := 0.
  	
  	targetFixUp := (self ensureFixupAt: bytecodePC + 3 + distance - initialPC) asUnsignedInteger.
  		
  	(objectMemory isArrayNonImm: literal)
  		ifTrue: [objectRepresentation branchIf: reg notInstanceOfBehaviors: literal target: targetFixUp]
  		ifFalse: [objectRepresentation branchIf: reg notInstanceOfBehavior: literal target: targetFixUp].
  						
  	self genPopStackBytecode.
  	
  	^0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genBinaryConstOpVarInlinePrimitive: (in category 'inline primitive generators') -----
  genBinaryConstOpVarInlinePrimitive: prim
  	"Const op var version of binary inline primitives."
  	"SistaV1: 248		11111000 	iiiiiiii		mjjjjjjj		Call Primitive #iiiiiiii + (jjjjjjj * 256) m=1 means inlined primitive, no hard return after execution.
  	 See EncoderForSistaV1's class comment and StackInterpreter>>#binaryInlinePrimitive:"
  	| ra val untaggedVal adjust |
+ 	ra := self allocateRegForStackEntryAt: 0.
- 	ra := self self allocateRegForStackEntryAt: 0.
  	self ssTop popToReg: ra.
  	self ssPop: 1.
  	val := self ssTop constant.
  	self ssPop: 1.
  	untaggedVal := val - objectMemory smallIntegerTag.
  	prim caseOf: {
  		"0 through 6, +, -, *, /, //, \\, quo:, SmallInteger op SmallInteger => SmallInteger, no overflow"
  		[0]	->	[self AddCq: untaggedVal R: ra].
  		[1]	->	[self MoveCq: val R: TempReg.
  				 self SubR: ra R: TempReg.
  				 objectRepresentation genAddSmallIntegerTagsTo: TempReg.
  				 self MoveR: TempReg R: ra].
  		[2]	->	[objectRepresentation genRemoveSmallIntegerTagsInScratchReg: ra.
  				 self MoveCq: (objectMemory integerValueOf: val) R: TempReg.
  				 self MulR: TempReg R: ra.
  				 objectRepresentation genAddSmallIntegerTagsTo: ra].
  
  		"2016 through 2019, bitAnd:, bitOr:, bitXor, bitShift:, SmallInteger op SmallInteger => SmallInteger, no overflow"
  
  		"2032	through 2037, >, <, >=, <=. =, ~=, SmallInteger op SmallInteger => Boolean (flags?? then in jump bytecodes if ssTop is a flags value, just generate the instruction!!!!)"
  		"CmpCqR is SubRCq so everything is reversed, but because no CmpRCq things are reversed again and we invert the sense of the jumps."
  		[32] -> [ self CmpCq: val R: ra.
  				self genBinaryInlineComparison: JumpLess opFalse: JumpGreaterOrEqual destReg: ra ].
  		[33] -> [ self CmpCq: val R: ra.
  				self genBinaryInlineComparison: JumpGreater opFalse: JumpLessOrEqual destReg: ra ].
  		[34] -> [ self CmpCq: val R: ra.
  				self genBinaryInlineComparison: JumpLessOrEqual opFalse: JumpGreater destReg: ra ].
  		[35] -> [ self CmpCq: val R: ra.
  				self genBinaryInlineComparison: JumpGreaterOrEqual opFalse: JumpLess destReg: ra ].
  		[36] -> [ self CmpCq: val R: ra.
  				self genBinaryInlineComparison: JumpZero opFalse: JumpNonZero destReg: ra ].
  		[37] -> [ self CmpCq: val R: ra.
  				self genBinaryInlineComparison: JumpNonZero opFalse: JumpZero destReg: ra ].
  
  		"2064	through 2068, Pointer Object>>at:, Byte Object>>at:, Short16 Word Object>>at: LongWord32 Object>>at: Quad64Word Object>>at:. obj op 0-rel SmallInteger => oop"
  		[64] ->	[objectRepresentation genConvertSmallIntegerToIntegerInReg: ra.
  				adjust := (objectMemory baseHeaderSize >> objectMemory shiftForWord) - 1. "shift by baseHeaderSize and then move from 1 relative to zero relative"
  				adjust ~= 0 ifTrue: [ self AddCq: adjust R: ra. ]. 
  				self genMoveConstant: val R: TempReg.
  				self MoveXwr: ra R: TempReg R: ra].
  		[65] ->	[objectRepresentation genConvertSmallIntegerToIntegerInReg: ra.
  				adjust := objectMemory baseHeaderSize - 1. "shift by baseHeaderSize and then move from 1 relative to zero relative"
  				self AddCq: adjust R: ra.
  				self genMoveConstant: val R: TempReg.
  				self MoveXbr: ra R: TempReg R: ra.
  				objectRepresentation genConvertIntegerToSmallIntegerInReg: ra]
  	}
  	otherwise: [^EncounteredUnknownBytecode].
  	self ssPushRegister: ra.
  	^0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genBinaryVarOpConstInlinePrimitive: (in category 'inline primitive generators') -----
  genBinaryVarOpConstInlinePrimitive: prim
  	"Var op const version of inline binary inline primitives."
  	"SistaV1: 248		11111000 	iiiiiiii		mjjjjjjj		Call Primitive #iiiiiiii + (jjjjjjj * 256) m=1 means inlined primitive, no hard return after execution.
  	 See EncoderForSistaV1's class comment and StackInterpreter>>#binaryInlinePrimitive:"
  	| rr val untaggedVal |
  	val := self ssTop constant.
  	self ssPop: 1.
+ 	rr := self allocateRegForStackEntryAt: 0.
- 	rr := self self allocateRegForStackEntryAt: 0.
  	self ssTop popToReg: rr.
  	self ssPop: 1.
  	untaggedVal := val - objectMemory smallIntegerTag.
  	prim caseOf: {
  		"0 through 6, +, -, *, /, //, \\, quo:, SmallInteger op SmallInteger => SmallInteger, no overflow"
  		[0]	->	[self AddCq: untaggedVal R: rr].
  		[1]	->	[self SubCq: untaggedVal R: rr ].
  		[2]	->	[self flag: 'could use MulCq:R'.
  				 objectRepresentation genShiftAwaySmallIntegerTagsInScratchReg: rr.
  				 self MoveCq: (objectMemory integerValueOf: val) R: TempReg.
  				 self MulR: TempReg R: rr.
  				 objectRepresentation genAddSmallIntegerTagsTo: rr].
  
  		"2016 through 2019, bitAnd:, bitOr:, bitXor, bitShift:, SmallInteger op SmallInteger => SmallInteger, no overflow"
  
  		"2032	through 2037, >, <, >=, <=. =, ~=, SmallInteger op SmallInteger => Boolean (flags?? then in jump bytecodes if ssTop is a flags value, just generate the instruction!!!!)"
  		"CmpCqR is SubRCq so everything is reversed."
  		[32] -> [ self CmpCq: val R: rr.
  				self genBinaryInlineComparison: JumpGreater opFalse: JumpLessOrEqual destReg: rr ].
  		[33] -> [ self CmpCq: val R: rr.
  				self genBinaryInlineComparison: JumpLess opFalse: JumpGreaterOrEqual destReg: rr ].
  		[34] -> [ self CmpCq: val R: rr.
  				self genBinaryInlineComparison: JumpGreaterOrEqual opFalse: JumpLess destReg: rr ].
  		[35] -> [ self CmpCq: val R: rr.
  				self genBinaryInlineComparison: JumpLessOrEqual opFalse: JumpGreater destReg: rr ].
  		[36] -> [ self CmpCq: val R: rr.
  				self genBinaryInlineComparison: JumpZero opFalse: JumpNonZero destReg: rr ].
  		[37] -> [ self CmpCq: val R: rr.
  				self genBinaryInlineComparison: JumpNonZero opFalse: JumpZero destReg: rr ].
  
  		"2064	through 2068, Pointer Object>>at:, Byte Object>>at:, Short16 Word Object>>at: LongWord32 Object>>at: Quad64Word Object>>at:. obj op 0-rel SmallInteger => oop"
  		[64] ->	[objectRepresentation genLoadSlot: (objectMemory integerValueOf: val) - 1 sourceReg: rr destReg: rr].
  		[65] ->	[self MoveCq: (objectMemory integerValueOf: val) + objectMemory baseHeaderSize - 1 R: TempReg.
  				self MoveXbr: TempReg R: rr R: rr.
  				objectRepresentation genConvertIntegerToSmallIntegerInReg: rr]
  
  	}
  	otherwise: [^EncounteredUnknownBytecode].
  	self ssPushRegister: rr.
  	^0!



More information about the Vm-dev mailing list