[Vm-dev] VM Maker: Cog-tpr.156.mcz

commits at source.squeak.org commits at source.squeak.org
Thu Jun 5 02:53:30 UTC 2014


tim Rowledge uploaded a new version of Cog to project VM Maker:
http://source.squeak.org/VMMaker/Cog-tpr.156.mcz

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

Name: Cog-tpr.156
Author: tpr
Time: 4 June 2014, 7:50:06.825 pm
UUID: 6f31ae79-5c54-4edc-97ae-29441a8d4508
Ancestors: Cog-eem.155

Add a bunch of lovverly coconuts, or more specifically some ARM convenience encoding methods.
Also add BIC (Bit clear) in order to support ANDing large values that happen to work ok inverted and BIC'd instead.
Also catch (with a vile hack) trampoline compiling issue when called from ceCheckForInterrupts.
Also platform factor some Cogit initialization.
Also, rabbits.

=============== Diff against Cog-eem.155 ===============

Item was removed:
- ----- Method: BochsIA32Alien class>>setStackAlignmentDelta: (in category 'accessing') -----
- setStackAlignmentDelta: 	stackAlignmentDelta
- 	self assert: stackAlignmentDelta isPowerOfTwo.
- 	PostBuildStackDelta :=  stackAlignmentDelta > 8
- 								ifTrue: [stackAlignmentDelta - 8]
- 								ifFalse: [0]!

Item was added:
+ ----- Method: BochsIA32Alien>>initializeStackFor: (in category 'processor setup') -----
+ initializeStackFor: aCogit
+ "Different cpus need different stack alignment etc, so handle the details here."
+ 	"This is for testing.  On many OS's the stack must remain aligned;
+ 	 e.g. IA32 using SSE requires 16 byte alignment."
+ 	| stackAlignment |
+ 	stackAlignment := 16.
+ 	aCogit setStackAlignment: stackAlignment expectedSPOffset: 0 expectedFPOffset: 8.
+ 	self assert: stackAlignment isPowerOfTwo.
+ 	PostBuildStackDelta :=  stackAlignment > 8
+ 								ifTrue: [stackAlignment - 8]
+ 								ifFalse: [0]!

Item was removed:
- ----- Method: GdbARMAlien class>>setStackAlignmentDelta: (in category 'accessing') -----
- setStackAlignmentDelta: 	stackAlignmentDelta
- 	"copy of BochsIA32Alien>>#setStackAlignmentDelta:, because I don't know yet what it's effect is."
- 	self assert: stackAlignmentDelta isPowerOfTwo.
- 	PostBuildStackDelta :=  stackAlignmentDelta > 8
- 								ifTrue: [stackAlignmentDelta - 8]
- 								ifFalse: [0]!

Item was changed:
+ ----- Method: GdbARMAlien>>fp (in category 'accessing') -----
- ----- Method: GdbARMAlien>>fp (in category 'accessing-abstract') -----
  fp
+ "fp is r11"
- 	"According to the use in SVr4"
  	^self r11!

Item was changed:
+ ----- Method: GdbARMAlien>>fp: (in category 'accessing') -----
+ fp: anUnsignedInteger
+ 
+ 	^self r11: anUnsignedInteger!
- ----- Method: GdbARMAlien>>fp: (in category 'accessing-abstract') -----
- fp: aNumber
- 	"According to SVr4, the frame pointer is stored in r11"
- 	^self r11: aNumber!

Item was changed:
  ----- Method: GdbARMAlien>>handleRetFailureAt:in: (in category 'error handling') -----
  handleRetFailureAt: pc "<Integer>" in: memoryArray "<Bitmap|ByteArray>"
  	"Convert an execution primitive failure for a ret into a ProcessorSimulationTrap signal."
  	self halt.
  	^(ProcessorSimulationTrap
  			pc: pc
  			nextpc: pc + 4
+ 			address: self lr " for popping off stack version of retiurn -> (memoryArray unsignedLongAt: self sp -3) "
- 			address: (memoryArray unsignedLongAt: self sp -3) 
  			type: #return
+ 			"don't quite know what to do with this yet ->accessor: #pc:")
- 			accessor: #pc:)
  		signal!

Item was added:
+ ----- Method: GdbARMAlien>>initializeStackFor: (in category 'processor setup') -----
+ initializeStackFor: aCogit
+ "Different cpus need different stack alignment etc, so handle the details here."
+ 	| stackAlignment |
+ 	stackAlignment := 8.
+ 	aCogit setStackAlignment: stackAlignment expectedSPOffset: 0 expectedFPOffset: 0.
+ 	self assert: stackAlignment isPowerOfTwo.
+ 	PostBuildStackDelta :=  stackAlignment > 8
+ 								ifTrue: [stackAlignment - 8]
+ 								ifFalse: [0]!

Item was added:
+ ----- Method: GdbARMAlien>>instructionIsLDR: (in category 'testing') -----
+ instructionIsLDR: instr
+ "is this a LDR instruction?"
+ 	| foo |
+ 	^instr >> 28 < 16rF "test for allowed condcode - 0xF is extension" 
+ 		and: [foo := (instr >> 20 bitAnd: 16rFF).
+ 			foo = 16r51 "ldr r1, [r2, #imm]"
+ 				or:[foo = 16r59 "ldr r1, [r2, #-imm]"
+ 				or:[foo = 16r79 "ldr r1, [r2, r3]"]]]!

Item was added:
+ ----- Method: GdbARMAlien>>instructionIsLDRSP: (in category 'testing') -----
+ instructionIsLDRSP: instr
+ "is this a LDR sp, [??] instruction? Special case to detect LDR sp, [] affecting stack pointer"
+ 	^(self instructionIsLDR: instr)  and:[(instr >>12 bitAnd: 16rF) = 13]!

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

Item was added:
+ ----- Method: GdbARMAlien>>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: GdbARMAlien>>instructionIsSTRSP: (in category 'testing') -----
+ instructionIsSTRSP: instr
+ "is this a STR sp, [??] instruction? Special case to detect STR sp, [] affecting stack pointer"
+ 	^(self instructionIsSTR: instr)  and:[(instr >>12 bitAnd: 16rF) = 13]!

Item was changed:
  ----- Method: GdbARMAlien>>integerRegisterState (in category 'accessing-abstract') -----
  integerRegisterState
  	^{	self r0. self r1. self r2. self r3. self r4. self r5. self r6. self r7. self r8. 
+ 		self r9. self r10. self fp. self r12. self sp. self lr. self pc}!
- 		self r9. self r10. self r11. self r12. self sp. self lr. self pc}!

Item was added:
+ ----- Method: GdbARMAlien>>popWordIn: (in category 'execution') -----
+ popWordIn: aMemory 
+ 	| sp word |
+ 	word := aMemory unsignedLongAt: (sp := self sp) + 1 bigEndian: false.
+ 	self sp: sp + 4.
+ 	^word!

Item was changed:
  ----- Method: GdbARMAlien>>printRegisterState:on: (in category 'printing') -----
  printRegisterState: registerStateVector on: aStream
  	self printFields: #(	r0 r1 r2 r3 cr
  						r4 r5 r6 r7 cr
+ 						r8 r9 r10 fp cr
- 						r8 r9 r10 r11 cr
  						r12 sp lr pc eflags cr)
  		inRegisterState: registerStateVector
  		on: aStream!

Item was changed:
  ----- Method: GdbARMAlien>>printRegisterStateExceptPC:on: (in category 'printing') -----
  printRegisterStateExceptPC: registerStateVector on: aStream
  	self printFields: #(	r0 r1 r2 r3 cr
  						r4 r5 r6 r7 cr
+ 						r8 r9 r10 fp cr
- 						r8 r9 r10 r11 cr
  						r12 sp lr eflags cr)
  		inRegisterState: registerStateVector
  		on: aStream!

Item was added:
+ ----- Method: GdbARMAlien>>register: (in category 'accessing') -----
+ register: int0to15
+ "return the value of register"
+ 	self assert:[int0to15 between: 0 and:15].
+ 	^self unsignedLongAt: 13 + (4 * int0to15)!

Item was changed:
  ----- Method: GdbARMAlien>>registerState (in category 'accessing-abstract') -----
  registerState
  	^{	self r0. self r1. self r2. self r3. self r4. self r5. self r6. self r7.
+ 		self r8. self r9. self r10. self fp. self r12. self sp. self lr. self pc. self eflags }!
- 		self r8. self r9. self r10. self r11. self r12. self sp. self lr. self pc. self eflags }!

Item was changed:
  ----- Method: GdbARMAlien>>registerStateGetters (in category 'accessing-abstract') -----
  registerStateGetters
  	^#(	r0 r1 r2 r3 r4 r5 r6 r7
+ 		r8 r9 r10 fp r12 sp lr pc eflags )!
- 		r8 r9 r10 r11 r12 sp lr pc eflags )!

Item was changed:
  ----- Method: GdbARMAlien>>simulateCallOf:nextpc:memory: (in category 'execution simulation') -----
  simulateCallOf: address nextpc: nextpc memory: aMemory
  	"Simulate a frame-building call of address.  Build a frame since
  	a) this is used for calls into the run-time which are unlikely to be leaf-calls"
  	"This method builds a stack frame as expected by the simulator, not as defined by ARM aapcs-abi.
  	In ARM aapcs, every method can define for itself, wether it wants to push lr (nextpc), and wether it 
  	uses a frame pointer. The standard never mentions a fp. It merely defines r4-r11 to be callee-saved."
  
  	self assert: self sp \\ 8 = 0. "This check ensures, that we conform with ARM abi. Before doing anything to the stack, we ensure 2-word alignment."
  	self pushWord: nextpc in: aMemory.
+ 	self pushWord: self fp in: aMemory.
+ 	self fp: self sp.
- 	self pushWord: self r11 in: aMemory.
- 	self r11: self sp.
  	PostBuildStackDelta ~= 0 ifTrue:
  		[self sp: self sp - PostBuildStackDelta]. "In order to satisfy the CStackAlignment check by cogit, which is only valid on IA32 platforms."
  	self pc: address!

Item was changed:
  ----- Method: GdbARMAlien>>simulateLeafReturnIn: (in category 'execution simulation') -----
  simulateLeafReturnIn: aMemory
+ "simulate a leaf return; this may get a bit more complicated since we are trying to compensate for the IA32 automagically pushing the return address whereas the ARM doesn't."
+ self halt.
  	self pc: self lr!

Item was changed:
  ----- Method: GdbARMAlien>>simulateReturnIn: (in category 'execution simulation') -----
  simulateReturnIn: aMemory
+ "simulate a return; this may get a bit more complicated since we are trying to compensate for the IA32 automagically pushing the return address whereas the ARM doesn't."
+ self halt.
  	PostBuildStackDelta ~= 0 ifTrue:
  		[self sp: self sp + PostBuildStackDelta].
+ 	self fp: (self popWordIn: aMemory).
+ 	self lr: (self popWordIn: aMemory).
+ 	self pc: self lr!
- 	self r11: (self popWordIn: aMemory).
- 	self pc: (self popWordIn: aMemory)!

Item was changed:
  ----- Method: GdbARMAlien>>sp: (in category 'accessing') -----
  sp: anUnsignedInteger
+ Transcript nextPutAll: 'set SP to ', anUnsignedInteger hex; cr.
- 
  	^self unsignedLongAt: 65 put: anUnsignedInteger!

Item was added:
+ ----- Method: GdbARMAlien>>writePopPushDetailsIn:in:for: (in category 'execution simulation') -----
+ writePopPushDetailsIn:  memory in: transcript for: aCogit
+ "if the next instruction is a pop or push, or a ldr/str that touches the SP, write the details ontranscript"
+ 	| instr |
+ 
+ 	[ instr := memory unsignedLongAt: self pc + 1 bigEndian: false] on: Error do:[:ex| ^self].
+ 	(self instructionIsPop: instr) ifTrue:[transcript tab; nextPutAll: 'pop ', (memory unsignedLongAt: self sp + 1 bigEndian: false) hex , ' from ', (self sp hex); cr].
+ 	(self instructionIsPush: instr) ifTrue:[transcript tab; nextPutAll: 'push ', (self register: ((instr bitAnd: 16rF000) >>12)) hex , ' to ', (self sp -4) hex; cr].
+ 
+ 	(self instructionIsLDRSP: instr)  ifTrue:[| val|
+ 		val := self r10 > memory size
+ 			ifTrue:[aCogit simulatedVariableAt: self r10]
+ 			ifFalse:[memory unsignedLongAt: self r10 + 1 bigEndian: false].
+ 		transcript tab; nextPutAll: 'load SP', val hex , ' from ', (self r10) hex; cr].
+ 
+ 	(self instructionIsSTRSP: instr)  ifTrue:[transcript tab; nextPutAll: 'store SP', (self sp) hex , ' to ', (self r10) hex; cr].!

Item was changed:
  ----- Method: GdbARMAlienTests>>integerRegisterGetters (in category 'accessing') -----
  integerRegisterGetters
+ 	^#(r0 r1 r2 r3 r4 r5 r6 r7 r8 r9 r10 fp r12 lr sp pc)!
- 	^#(r0 r1 r2 r3 r4 r5 r6 r7 r8 r9 r10 r11 r12 lr sp pc)!

Item was changed:
  ----- Method: GdbARMAlienTests>>integerRegisterSetters (in category 'accessing') -----
  integerRegisterSetters
+ 	^#(r0: r1: r2: r3: r4: r5: r6: r7: r8: r9: r10: fp: r12: lr: sp: pc:)!
- 	^#(r0: r1: r2: r3: r4: r5: r6: r7: r8: r9: r10: r11: r12: lr: sp: pc:)!

Item was changed:
  ----- Method: GdbARMAlienTests>>testReturnTrap (in category 'tests') -----
  testReturnTrap
+ 	"return above-range with a bad address"
- 	"return above-range."
  	
  	"self new testReturnTrap"
+ 	| memory badAddress|
+ 	badAddress := 16r1E000000. 
- 	| memory |
  	memory := self memory.
  	self processor reset.
  
- 	"assemble a nasty number in r10"
- 	memory unsignedLongAt: 5 put: (CogARMCompiler new mov: 10 imm: 16r1E ror: 8)  bigEndian: false. 
- 	memory unsignedLongAt: 9 put: (CogARMCompiler new orr: 10 imm: 0 ror: 0) bigEndian: false.
- 	memory unsignedLongAt: 13 put: (CogARMCompiler new orr: 10 imm: 0 ror: 0) bigEndian: false. 
- 	memory unsignedLongAt: 17 put: (CogARMCompiler new orr: 10 imm: 1 ror: 0) bigEndian: false. 
- 	"push this on the stack"
- 	memory unsignedLongAt: 21 put: (CogARMCompiler new pushR: 10) bigEndian: false.
  	"pop the stack into pc to emulate a return via stack as generated in  various trampoline code"	
+ 	memory unsignedLongAt: 1 put: (CogARMCompiler new mov: 15 rn: 14) bigEndian: false.
- 	memory unsignedLongAt: 25 put: (CogARMCompiler new popR: 15) bigEndian: false.
  
  	
  	"processor disassembleFrom: 0 to: 60 in: memory on: Transcript cr"
  	self processor
+ 			pc: 0;
- 			pc: 4;
  			sp: (memory size - 4); "Room for return address"
+ 			lr: badAddress;
  			singleStepIn: memory readExecuteOnlyBelow: memory size /2 .
  			"We have to step several times, because the first step only changes the pc, but does not fetch anything from the address it points to."
  	self should: [self processor singleStepIn: memory readExecuteOnlyBelow: memory size /2.
  				self processor singleStepIn: memory readExecuteOnlyBelow: memory size /2.
  				self processor singleStepIn: memory readExecuteOnlyBelow: memory size /2.
  				self processor singleStepIn: memory readExecuteOnlyBelow: memory size /2.
  				self processor singleStepIn: memory readExecuteOnlyBelow: memory size /2.
  				self processor singleStepIn: memory readExecuteOnlyBelow: memory size /2.
  				self processor singleStepIn: memory readExecuteOnlyBelow: memory size /2]
  		raise: ProcessorSimulationTrap
  		withExceptionDo:
  			[:pst|
+ 			self assert: self processor pc = 0.
+ 			self assert: pst pc = 0.
+ 			self assert: pst nextpc = 4.
+ 			self assert: pst address = badAddress.
- 			self assert: self processor pc = 16r18.
- 			self assert: pst pc = 16r18.
- 			self assert: pst nextpc = 16r1C.
- 			self assert: pst address = 16r1E000000.
  			self assert: pst type = #return].!

Item was removed:
- ----- Method: GdbARMAlienTests>>testReturnTrap2 (in category 'tests') -----
- testReturnTrap2
- 	"return above-range."
- 	
- 	"self new testReturnTrap2"
- 	| memory |
- 	memory := self memory.
- 	self processor reset.
- 
- 	"assemble a nasty number in r10"
- 	memory unsignedLongAt: 5 put: (CogARMCompiler new mov: 10 imm: 16r1E ror: 8)  bigEndian: false. 
- 	memory unsignedLongAt: 9 put: (CogARMCompiler new orr: 10 imm: 0 ror: 0) bigEndian: false.
- 	memory unsignedLongAt: 13 put: (CogARMCompiler new orr: 10 imm: 0 ror: 0) bigEndian: false. 
- 	memory unsignedLongAt: 17 put: (CogARMCompiler new orr: 10 imm: 0 ror: 0) bigEndian: false. 
- 	"push this on the stack"
- 	memory unsignedLongAt: 21 put: (CogARMCompiler new pushR: 10) bigEndian: false.
- 	"pop the stack into pc to emulate a return via stack as generated in  various trampoline code"	
- 	memory unsignedLongAt: 25 put: (CogARMCompiler new popR: 15) bigEndian: false.
- 
- 	
- 	"processor disassembleFrom: 0 to: 60 in: memory on: Transcript cr"
- 	self processor
- 			pc: 4;
- 			sp: (memory size - 4); "Room for return address"
- 			singleStepIn: memory readExecuteOnlyBelow: memory size /2 .
- 			"We have to step several times, because the first step only changes the pc, but does not fetch anything from the address it points to."
- 	self should: [self processor runInMemory: memory readExecuteOnlyBelow: memory size /2.]
- 		raise: ProcessorSimulationTrap
- 		withExceptionDo:
- 			[:pst|
- 			self assert: self processor pc = 16r18.
- 			self assert: pst pc = 16r18.
- 			self assert: pst nextpc = 16r1C.
- 			self assert: pst address = 16r1E000000.
- 			self assert: pst type = #return].!

Item was changed:
  ----- Method: GdbARMAlienTests>>testReturnTrapWithThumbBug (in category 'tests') -----
  testReturnTrapWithThumbBug
  	"return above-range with a bad address that ends in 1 - which triggers an ARM sim bug"
  	
  	"self new testReturnTrapWithThumbBug"
+ 	| memory badAddress|
+ 	badAddress := 16r1E000001. "this will try to set thumb mode"
- 	| memory |
  	memory := self memory.
  	self processor reset.
  
  	"pop the stack into pc to emulate a return via stack as generated in  various trampoline code"	
  	memory unsignedLongAt: 1 put: (CogARMCompiler new mov: 15 rn: 14) bigEndian: false.
  
  	
  	"processor disassembleFrom: 0 to: 60 in: memory on: Transcript cr"
  	self processor
  			pc: 0;
  			sp: (memory size - 4); "Room for return address"
+ 			lr: badAddress;
- 			pushWord:16r1E000001 in: memory;
  			singleStepIn: memory readExecuteOnlyBelow: memory size /2 .
  			"We have to step several times, because the first step only changes the pc, but does not fetch anything from the address it points to."
  	self should: [self processor singleStepIn: memory readExecuteOnlyBelow: memory size /2.
  				self processor singleStepIn: memory readExecuteOnlyBelow: memory size /2.
  				self processor singleStepIn: memory readExecuteOnlyBelow: memory size /2.
  				self processor singleStepIn: memory readExecuteOnlyBelow: memory size /2.
  				self processor singleStepIn: memory readExecuteOnlyBelow: memory size /2.
  				self processor singleStepIn: memory readExecuteOnlyBelow: memory size /2.
  				self processor singleStepIn: memory readExecuteOnlyBelow: memory size /2]
  		raise: ProcessorSimulationTrap
  		withExceptionDo:
  			[:pst|
+ 			self assert: self processor pc = 0.
+ 			self assert: pst pc = 0.
+ 			self assert: pst nextpc = 4.
+ 			self assert: pst address = badAddress.
- 			self assert: self processor pc = 16r18.
- 			self assert: pst pc = 16r18.
- 			self assert: pst nextpc = 16r1C.
- 			self assert: pst address = 16r1E000000.
  			self assert: pst type = #return].!



More information about the Vm-dev mailing list