[Vm-dev] VM Maker: Cog-eem.261.mcz

commits at source.squeak.org commits at source.squeak.org
Mon Apr 20 18:19:58 UTC 2015


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

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

Name: Cog-eem.261
Author: eem
Time: 20 April 2015, 11:19:46.178 am
UUID: 1ed67799-23e5-4d89-9ac5-95f1581db48e
Ancestors: Cog-eem.260

Fix location of BochsIA32Alien>>decorateDisassembly:for:.
Improve pc labelling in ARM code.

=============== Diff against Cog-eem.260 ===============

Item was added:
+ ----- Method: BochsIA32Alien>>decorateDisassembly:for: (in category 'disassembly') -----
+ decorateDisassembly: anInstructionString for: aSymbolManager "<Cogit>"
+ 	| string i1 i2 v |
+ 	string := anInstructionString.
+ 	(i1 := string indexOfSubCollection: '%ds:0x') > 0 ifTrue:
+ 		[i2 := i1 + 6.
+ 		 ['0123456789abcdef' includes: (string at: i2)] whileTrue: [i2 := i2 + 1].
+ 		 string := string
+ 					copyReplaceFrom: i1 + 4
+ 					to: i2 - 1
+ 					with: (aSymbolManager lookupCHexString: (string copyFrom: i1 + 4 to: i2 - 1))].
+ 	(i1 := string indexOfSubCollection: '%ss:0x') > 0 ifTrue:
+ 		[i2 := i1 + 6.
+ 		 ['0123456789abcdef' includes: (string at: i2)] whileTrue: [i2 := i2 + 1].
+ 		 ((string at: i2) = $(
+ 		 and: [(string at: i2 + 1) = $%]) ifTrue:
+ 			[v := Integer readFrom: (ReadStream on: string from: i1 + 6 to: i2 - 1) base: 16.
+ 			string := string
+ 						copyReplaceFrom: i1
+ 						to: i2 - 1
+ 						with: ((v bitAnd: (1 bitShift: 31) - 1) - (v bitAnd: (1 bitShift: 31))) printString]].
+ 	(i1 := string indexOfSubCollection: '$0x') > 0 ifTrue:
+ 		[i2 := i1 + 3.
+ 		 ['0123456789abcdef' includes: (string at: i2)] whileTrue: [i2 := i2 + 1].
+ 		 string := string
+ 					copyReplaceFrom: i1 + 1
+ 					to: i2 - 1
+ 					with: (aSymbolManager lookupCHexString: (string copyFrom: i1 + 1 to: i2 - 1))].
+ 	((i1 := string indexOf: $() > 1
+ 	 and: [(string at: i1 + 1) isDigit
+ 	 and: [i1 < (i2 := string indexOf: $))]]) ifTrue:
+ 		[string := string
+ 					copyReplaceFrom: i1 + 1
+ 					to: i2 - 1
+ 					with: (aSymbolManager lookupCHexString: (string copyFrom: i1 + 1 to: i2 - 1))].
+ 	^string!

Item was changed:
  ----- Method: CogProcessorAlien>>decorateDisassembly:for: (in category 'disassembly') -----
  decorateDisassembly: anInstructionString for: aSymbolManager "<Cogit>"
+ 	^self subclassResponsibility!
- 	| string i1 i2 v |
- 	string := anInstructionString.
- 	(i1 := string indexOfSubCollection: '%ds:0x') > 0 ifTrue:
- 		[i2 := i1 + 6.
- 		 ['0123456789abcdef' includes: (string at: i2)] whileTrue: [i2 := i2 + 1].
- 		 string := string
- 					copyReplaceFrom: i1 + 4
- 					to: i2 - 1
- 					with: (aSymbolManager lookupCHexString: (string copyFrom: i1 + 4 to: i2 - 1))].
- 	(i1 := string indexOfSubCollection: '%ss:0x') > 0 ifTrue:
- 		[i2 := i1 + 6.
- 		 ['0123456789abcdef' includes: (string at: i2)] whileTrue: [i2 := i2 + 1].
- 		 ((string at: i2) = $(
- 		 and: [(string at: i2 + 1) = $%]) ifTrue:
- 			[v := Integer readFrom: (ReadStream on: string from: i1 + 6 to: i2 - 1) base: 16.
- 			string := string
- 						copyReplaceFrom: i1
- 						to: i2 - 1
- 						with: ((v bitAnd: (1 bitShift: 31) - 1) - (v bitAnd: (1 bitShift: 31))) printString]].
- 	(i1 := string indexOfSubCollection: '$0x') > 0 ifTrue:
- 		[i2 := i1 + 3.
- 		 ['0123456789abcdef' includes: (string at: i2)] whileTrue: [i2 := i2 + 1].
- 		 string := string
- 					copyReplaceFrom: i1 + 1
- 					to: i2 - 1
- 					with: (aSymbolManager lookupCHexString: (string copyFrom: i1 + 1 to: i2 - 1))].
- 	((i1 := string indexOf: $() > 1
- 	 and: [(string at: i1 + 1) isDigit
- 	 and: [i1 < (i2 := string indexOf: $))]]) ifTrue:
- 		[string := string
- 					copyReplaceFrom: i1 + 1
- 					to: i2 - 1
- 					with: (aSymbolManager lookupCHexString: (string copyFrom: i1 + 1 to: i2 - 1))].
- 	^string!

Item was changed:
  ----- Method: GdbARMAlien>>decorateDisassembly:for:fromAddress: (in category 'disassembly') -----
  decorateDisassembly: anInstructionString for: aSymbolManager fromAddress: address
  "Decode what we can of the instruction and decorate it with useful stuff"
  	| word opcode rotate mode operand memory addressinatorBlock|
  	addressinatorBlock := [:value|
  		(aSymbolManager lookupAddress: value)
  		ifNotNil: [:string| ' = ', value hex, ' = ', string]
+ 		ifNil: ['']].
- 		ifNil: [' = ', value hex]].
  	
  	word := (memory:= aSymbolManager objectMemory) longAt: address.
  	(self instructionIsAnyB: word)
  		ifTrue:
  			[((self instructionIsB: word) or: [self instructionIsBL: word])
  				ifTrue:["We can extract the offset from a plain B/BL instruction"
  					operand := self extractOffsetFromBL: word..
  					 operand := operand + address + 8 bitAnd: aSymbolManager addressSpaceMask].
  			((self instructionIsBX: word) or: [self instructionIsBLX: word])
  				ifTrue:["We can extract the offset from a  BX/BLX instructions register"			
+ 					operand := (self perform: (self registerStateGetters at: (word bitAnd: 15) + 1))].
+ 			
+ 			(aSymbolManager lookupAddress: operand) ifNotNil:
+ 				[:name| ^anInstructionString, ' = ', operand hex, ' = ', name]]
- 					operand := (self perform: (self registerStateGetters at: (word bitAnd: 15) + 1))]]
  		ifFalse:
  			[(self instructionIsAnyLoadStore: word)
  				ifTrue: [|baseR|
  					"first see if this is a load via the varBase register - quick access globals. We'll trust
  					that nobody makes a nasty instruction that uses this reg in a mean way" 
  					(baseR := (word >> 16 bitAnd: 15)) = CogARMCompiler VarBaseReg
  						ifTrue:[ operand := aSymbolManager varBaseAddress + (word bitAnd: 1 << 12 - 1)]
  						ifFalse:[ operand := (self register: baseR) + (self extractOffsetFromLoadStore: word)].
  
  					"look for SP operations -pop/push"
  					 (self instructionIsPush: word) ifTrue: ["push - "
  						|srcR|
  						srcR := word >>12 bitAnd: 16rF.
  						^ (anInstructionString readStream upTo: $}), '}  (', (self register: srcR) hex, ') to ',  (self sp - 4) hex ].
  					(self instructionIsPop: word) ifTrue: ["pop - " 
  						^ (anInstructionString readStream upTo: $}), '}  (', (memory longAt: self sp) hex, ') ' , ' from ' , self sp hex ].
  
  					"look for a ld/st of the sp"
  					(self instructionIsLDRSP: word) ifTrue:[| val |
  						val := operand > memory memory size
  											ifTrue: [aSymbolManager simulatedVariableAt: operand ]
  											ifFalse: [memory longAt: operand].
  						^anInstructionString, '; Load SP (', (val ifNil:['unknown'] ifNotNil:[:v| v hex]) , ') from ', (addressinatorBlock value: operand)].
  					(self instructionIsSTRSP: word) ifTrue:[
  						^anInstructionString, '; Save SP (', self sp hex, ') to ',  (addressinatorBlock value: operand)].
  					]
  				ifFalse:
  					["check for SP changers not relating to read/writing data"
  					(self instructionIsAlignSP: word)
  						ifTrue: [^anInstructionString, ' ALIGN SP ' , self sp hex; cr].
  					(self instructionIsAddSP: word)
  						ifTrue:[^anInstructionString, ' ADD ', (word bitAnd: 16rFF) asString,' to SP = ' , self sp hex].				
  
  					"check for the end of a mov/orr/orr/orr set filling a reg with a const"
  					opcode := word >> 21 bitAnd: 16rF.
  					 opcode ~= CogARMCompiler orOpcode ifTrue:
  						[^anInstructionString].
  					 rotate := word >> 8 bitAnd: 16rF.
  					 mode := word >> 25 bitAnd: 7.
  					 "CogARMCompiler always uses a 0 rotate in the last operand of the final ORR when building long constants."
  					 (mode = 1 and: [rotate ~= 0]) ifTrue:
  						[^anInstructionString].
  					 operand := aSymbolManager backEnd literalBeforeFollowingAddress: address + 4]].
  	"is there an interesting address with this?"
+ 	^anInstructionString, (addressinatorBlock value: operand)!
- 	^anInstructionString", (addressinatorBlock value: operand) <-------------- NEEDS FIXING BETTERER"!



More information about the Vm-dev mailing list