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

commits at source.squeak.org commits at source.squeak.org
Wed Apr 22 01:54:23 UTC 2015


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

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

Name: VMMaker.oscog-eem.1234
Author: eem
Time: 21 April 2015, 6:52:37.482 pm
UUID: 012b3371-995e-451f-85ec-a5144379427d
Ancestors: VMMaker.oscog-tpr.1233

Cogit:
Allow ARM concretizeMoveCwR use pc-relative
addressing alongside PushCwR.  Fix the effects on
PIC parsing by introducing loadPICLiteralByteSize.

Correct slip in sub:rn:imm:ror:.
Fix sub:rn:imm:ror:.
Fix relocateMethodReferenceBeforeAddress:by:
for the 4 cases we have now.

Code compaction now works once again on ARM
but we generate more compact code and most
method/pic self-references are made with non-
relocateable pc-relative addressing.  Woot!

=============== Diff against VMMaker.oscog-tpr.1233 ===============

Item was changed:
  ----- Method: CogARMCompiler>>concretizeMoveCwR (in category 'generate machine code - concretize') -----
  concretizeMoveCwR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
+ 	^machineCodeSize := self loadCwInto: (self concreteRegister: (operands at: 1))!
- 	| constant destReg |
- 	constant := operands at: 0.
- 	destReg := self concreteRegister: (operands at: 1).
- 	^machineCodeSize :=self at: 0 moveCw: constant intoR: destReg!

Item was changed:
  ----- Method: CogARMCompiler>>concretizePushCw (in category 'generate machine code - concretize') -----
  concretizePushCw
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
+ 	| instrOffset |
+ 	instrOffset := self loadCwInto: ConcreteIPReg.
- 	| operand instrOffset distance |
- 	operand := operands at: 0.
- 	instrOffset := 0.
- 	"First try and encode as a pc-relative reference..."
- 	(cogit addressIsInCodeZone: operand) ifTrue:
- 		[distance := operand  - (address + 8).
- 		 self rotateable8bitImmediate: distance
- 		 	ifTrue: [ :rot :immediate |
- 		 		self machineCodeAt: 0 put: (self add: ConcreteIPReg rn: PC imm: immediate ror: rot).
- 		 		instrOffset := 4]
- 		 	ifFalse:
- 		 		[self rotateable8bitImmediate: distance negated
- 		 			ifTrue: [ :rot :immediate |
- 		 				self machineCodeAt: 0 put: (self sub: ConcreteIPReg rn: PC imm: immediate ror: rot).
- 		 				instrOffset := 4]
- 				ifFalse: [instrOffset := 0]]].
- 	"If this fails, use the conventional and painfully long 4 instruction sequence."
- 	instrOffset = 0 ifTrue:
- 		[instrOffset := self at: 0 moveCw: operand intoR: ConcreteIPReg].
  	self machineCodeAt: instrOffset put: (self pushR: ConcreteIPReg).
  	^machineCodeSize := instrOffset + 4!

Item was added:
+ ----- Method: CogARMCompiler>>instructionIsPush: (in category 'testing') -----
+ instructionIsPush: instr
+ 	"is this a push -str r??, [sp, #-4] -  instruction?"
+ 	^instr >> 28 < 16rF "test for allowed condcode - 0xF is extension"
+ 	  and: [(instr bitAnd: 16rFFF0FFF) = 16r52D0004]!

Item was added:
+ ----- Method: CogARMCompiler>>loadCwInto: (in category 'generate machine code - support') -----
+ loadCwInto: destReg
+ 	"Load the operand into the destination register, answering
+ 	 the size of the instructions generated to do so."
+ 	| operand distance |
+ 	operand := operands at: 0.
+ 	"First try and encode as a pc-relative reference..."
+ 	(cogit addressIsInCodeZone: operand) ifTrue:
+ 		[distance := operand  - (address + 8).
+ 		 self rotateable8bitImmediate: distance
+ 		 	ifTrue: [ :rot :immediate |
+ 		 		self machineCodeAt: 0 put: (self add: destReg rn: PC imm: immediate ror: rot).
+ 		 		^4]
+ 		 	ifFalse:
+ 		 		[self rotateable8bitImmediate: distance negated
+ 		 			ifTrue: [ :rot :immediate |
+ 		 				self machineCodeAt: 0 put: (self sub: destReg rn: PC imm: immediate ror: rot).
+ 		 				^4]
+ 					ifFalse: []]].
+ 	"If this fails, use the conventional and painfully long 4 instruction sequence."
+ 	^self at: 0 moveCw: operand intoR: destReg!

Item was added:
+ ----- Method: CogARMCompiler>>loadPICLiteralByteSize (in category 'accessing') -----
+ loadPICLiteralByteSize
+ 	"Answer the byte size of a MoveCwR opcode's corresponding machine code
+ 	 when the argument is a PIC.  This is for the self-reference at the end of a
+ 	 closed PIC.  On ARM this is a single instruction pc-relative register load."
+ 	^4!

Item was removed:
- ----- Method: CogARMCompiler>>movePCRelative:into: (in category 'generate machine code - support') -----
- movePCRelative: operand into: reg
- 	"Load a pc relative value into the register"
- 	| offset sign instr |
- 	offset := operand - (address + 8).
- 	sign := offset >= 0 ifTrue: [1] ifFalse: [0].
- 	instr := self ldr: reg rn: PC plus: sign imm: offset abs.
- 	self machineCodeAt: 0 put: instr.
- 	^4!

Item was changed:
  ----- Method: CogARMCompiler>>relocateMethodReferenceBeforeAddress:by: (in category 'inline cacheing') -----
  relocateMethodReferenceBeforeAddress: pc by: delta
  	"If possible we generate the method address using pc-relative addressing.
  	 If so we don't need to relocate it in code.  So check if pc-relative code was
+ 	 generated, and if not, adjust a long sequence.  There are two cases, a push
+ 	 or a register load.  If a push, then there is a register load, but in the instruction
+ 	 before."
+ 	| pcPreceedingLoad reference |
+ 	pcPreceedingLoad := (self instructionIsPush: (self instructionBeforeAddress: pc))
+ 							ifTrue: [pc - 4]
+ 							ifFalse: [pc].
+ 	"If the load is not done via pc-relative addressing we have to relocate."
+ 	(self isPCRelativeValueLoad: (self instructionBeforeAddress: pcPreceedingLoad)) ifFalse:
+ 		[reference := self extract32BitOperandFrom4InstructionsPreceeding: pcPreceedingLoad.
+ 		 reference := reference + delta.
+ 		 self insert32BitOperand: reference into4InstructionsPreceeding: pcPreceedingLoad]!
- 	 generated, and if not, adjust a long sequence."
- 	| location |
- 	(self isPCRelativeValueLoad: (self instructionBeforeAddress: pc - 4)) ifFalse:
- 		[location := self extract32BitOperandFrom4InstructionsPreceeding: pc - 4.
- 		 location := location + delta.
- 		 self insert32BitOperand: location into4InstructionsPreceeding: pc - 4]!

Item was changed:
  ----- Method: CogARMCompiler>>sub:rn:imm:ror: (in category 'ARM convenience instructions') -----
  sub: destReg rn: srcReg imm: immediate ror: rot
  "	Remember the ROR is doubled by the cpu so use 30>>1 etc
  	SUB destReg, srcReg, #immediate ROR rot"
  
+ 	^self type: 1 op: SubOpcode set: 0 rn: srcReg rd: destReg shifterOperand: ((rot>>1) <<8 bitOr: immediate)!
- 	^self type: 1 op: 2 set: 0 rn: srcReg rd: destReg shifterOperand: ((rot>>1) <<8 bitOr: immediate)!

Item was changed:
  ----- Method: CogAbstractInstruction>>isPCRelativeValueLoad: (in category 'testing') -----
  isPCRelativeValueLoad: instr
+ 	<var: 'instr' type: #'unsigned int'>
+ 	"add xx, pc, blah or sub xx, pc, blah"
+ 	^(instr >> 16) = 16rE28F or: [instr >> 16 = 16rE24F]!
- 	"add ip, pc, blah->  '16rE28FC000'
- 	 sub ip, pc, blah -> '16rE24FC000'"
- 	^(instr bitAnd: 16rFFFFF000) = 16rE28FC000
- 	  or: [(instr bitAnd: 16rFFFFF000) = 16rE24FC000]!

Item was added:
+ ----- Method: CogAbstractInstruction>>loadPICLiteralByteSize (in category 'accessing') -----
+ loadPICLiteralByteSize
+ 	"Answer the byte size of a MoveCwR opcode's corresponding machine code
+ 	 when the argument is a PIC.  This is for the self-reference at the end of a
+ 	 closed PIC."
+ 	self subclassResponsibility!

Item was added:
+ ----- Method: CogIA32Compiler>>loadPICLiteralByteSize (in category 'accessing') -----
+ loadPICLiteralByteSize
+ 	"Answer the byte size of a MoveCwR opcode's corresponding machine code
+ 	 when the argument is a PIC.  This is for the self-reference at the end of a
+ 	 closed PIC."
+ 	<inline: true>
+ 	^self loadLiteralByteSize!

Item was changed:
  ----- Method: Cogit>>addressIsInCodeZone: (in category 'testing') -----
  addressIsInCodeZone: address
  	"N.B. We /don't/ write this as address between: codeBase and: methodZone limitZony in case we're
  	 testing an address in a method whose code has yet to be allocated and is hence >= methodZone limitZony"
  	^address asUnsignedInteger >= codeBase
+ 	  and: [address < (methodZone youngReferrers ifNil: [0])]!
- 	  and: [address < methodZone youngReferrers]!

Item was changed:
  ----- Method: Cogit>>compileClosedPICPrototype (in category 'in-line cacheing') -----
  compileClosedPICPrototype
  	"Compile the abstract instructions for a full closed PIC used to initialize closedPICSize.
  	 The loads into SendNumArgsReg are those for optional method objects which may be
  	 used in MNU cases."
  	| numArgs jumpNext |
  	<var: #jumpNext type: #'AbstractInstruction *'>
  	numArgs := 0.
  	self compilePICAbort: numArgs.
  	jumpNext := self compileCPICEntry.
  	self MoveCw: 16r5EAF00D R: SendNumArgsReg.
  	self JumpLong: methodZoneBase + 16rCA5E10.
  	jumpNext jmpTarget: (endCPICCase0 := self Label).
  	1 to: numPICCases - 1 do:
  		[:h|
  		self CmpCw: 16rBABE1F15+h R: TempReg.
  		self MoveCw: 16rBADA550 + h R: SendNumArgsReg.
  		self JumpLongZero: 16rCA5E10 + (h * 16).
  		h = 1 ifTrue:
  			[endCPICCase1 := self Label]].
+ 	self MoveCw: methodZoneBase R: ClassReg.
- 	self MoveCw: 16rAB5CE55 R: ClassReg.
  	self JumpLong: (self cPICMissTrampolineFor: numArgs).
  	^0!

Item was changed:
  ----- Method: Cogit>>relocateCallsInClosedPIC: (in category 'compaction') -----
  relocateCallsInClosedPIC: cPIC
  	<var: #cPIC type: #'CogMethod *'>
  	| delta pc entryPoint targetMethod |
  	<var: #targetMethod type: #'CogMethod *'>
  	delta := cPIC objectHeader.
  	self assert: (backEnd callTargetFromReturnAddress: cPIC asInteger + missOffset)
  					= (self picAbortTrampolineFor: cPIC cmNumArgs).
  	backEnd relocateCallBeforeReturnPC: cPIC asInteger + missOffset by: delta negated.
  
  	pc := cPIC asInteger + firstCPICCaseOffset.
  	1 to: cPIC cPICNumCases do:
  		[:i|
  		entryPoint := backEnd jumpLongTargetBeforeFollowingAddress: pc.
  		"Find target from jump.  Ignore jumps to the interpret and MNU calls within this PIC"
  		(entryPoint < cPIC asInteger
  		 or: [entryPoint > (cPIC asInteger + cPIC blockSize)]) ifTrue:
  			[targetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
  			 self assert: targetMethod cmType = CMMethod.
  			 backEnd
  				relocateJumpLongBeforeFollowingAddress: pc
  				by: (delta - targetMethod objectHeader) negated].
  		pc := pc + cPICCaseSize].
  	self assert: cPIC cPICNumCases > 0.
  	pc := pc - cPICCaseSize.
  	"Finally relocate the load of the PIC and the jump to the overflow routine ceCPICMiss:receiver:"
+ 	backEnd relocateMethodReferenceBeforeAddress: pc + backEnd loadPICLiteralByteSize by: delta.
- 	backEnd relocateMethodReferenceBeforeAddress: pc + backEnd loadLiteralByteSize by: delta.
  	backEnd relocateJumpLongBeforeFollowingAddress: pc + cPICEndSize by: delta negated!



More information about the Vm-dev mailing list