[Vm-dev] VM Maker: VMMaker.oscog-tpr.1150.mcz

commits at source.squeak.org commits at source.squeak.org
Thu Apr 2 00:28:44 UTC 2015


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

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

Name: VMMaker.oscog-tpr.1150
Author: tpr
Time: 1 April 2015, 5:27:16.284 pm
UUID: af1f8f36-86cf-4fa7-9dad-1f92603c7891
Ancestors: VMMaker.oscog-eem.1149

Protect components of the ARM memory instructions from too-large values.
Improve the MoveRXwr/XwrRR code a tad.
Part of a low-level review of the instruction building code.

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

Item was changed:
  ----- Method: CogARMCompiler>>concretizeMoveRXwrR (in category 'generate machine code - concretize') -----
  concretizeMoveRXwrR
  	"Will get inlined into concretizeAt: switch."
  	"Write the word in R(src) into memory at address (base+4*index)"
  	<inline: true>
  	| index base src |
  	src := self concreteRegister: (operands at: 0).
  	index := self concreteRegister: (operands at: 1). "index is number of *words* = 4* bytes"
  	base := self concreteRegister: (operands at: 2).
  	"str		src, [base, +index, LSL #2]"
  	"cond 011 1100 0 base srcR 00010 00 0 inde"
+ 	self machineCodeAt: 0 put: (self memMxr: AL reg: src base: base p: 1 u: 1 b: 0 w: 0 l: 0 rmLsl2: index).
- 	self machineCodeAt: 0 put: (self str: src rn: base rm: (16r100 bitOr: index)).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeMoveXwrRR (in category 'generate machine code - concretize') -----
  concretizeMoveXwrRR
  	"Will get inlined into concretizeAt: switch."
  	
  	<inline: true>
  	| index base dest |
  	index := self concreteRegister: (operands at: 0).
  	base := self concreteRegister: (operands at: 1).
  	dest := self concreteRegister: (operands at: 2).
  	"LDR	dest, [base, +index, LSL #2]"
+ 	"cond 011 1100 1 base dest 00010 00 0 inde bulit by lowest level generator so we can do the lsl #2 on the index register"
+ 	self machineCodeAt: 0 put: (self memMxr: AL reg: dest base: base p: 1 u: 1 b: 0 w: 0 l: 1 rmLsl2: index).
- 	"cond 011 1100 1 base dest 00010 00 0 inde"
- 	self machineCodeAt: 0 put: (self ldr: dest rn: base rm: (16r100 bitOr: index)).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogARMCompiler>>is12BitValue:ifTrue:ifFalse: (in category 'testing') -----
  is12BitValue: constant ifTrue: trueAlternativeBlock	ifFalse: falseAlternativeBlock
+ 	"For LDR and STR, there is an instruction allowing for one instruction encoding if the offset is encodable in signed 12 bit form. pass the trueBlock the value and a 1-bit flag to tell it the sign.
+ 	The falseBlock can do whatever it needs to, typically building the constant as a full 32bit value and then ld/st with that as a register offset"
- 	"For LDR and STR, there is an instruction allowing for one instruction encoding if the offset is encodable in 12 bit."
  	constant abs <= 4095 "(2 raisedTo: 12)-1"
  		ifTrue: [
  			constant >= 0 
  				ifTrue: [trueAlternativeBlock value: 1 value: constant]
  				ifFalse: [trueAlternativeBlock value: 0 value: constant abs]]
  		ifFalse: falseAlternativeBlock!

Item was changed:
  ----- Method: CogARMCompiler>>ldrb:rn:plus:imm: (in category 'ARM convenience instructions') -----
  ldrb: destReg rn: baseReg plus: u imm: immediate12bitValue
+ "	LDRB destReg, [baseReg, 'u' immediate12bitValue] u=0 -> subtract imm; =1 -> add imm 
+ 	Note that this is a very low level interface that does not check the sign of the immediate, nor validity. See for example #concretizeMoveMbrR"
- "	LDRB destReg, [baseReg, 'u' immediate12bitValue] u=0 -> subtract imm; =1 -> add imm "
  	^self memMxr: AL reg: destReg  base: baseReg u: u b: 1 l: 1 imm: immediate12bitValue!

Item was changed:
  ----- Method: CogARMCompiler>>memMxr:reg:base:p:u:b:w:l:rm: (in category 'encoding') -----
  memMxr: cond reg: destReg base: baseReg p: postpreoffset u: updown b: byteword w: weirdstuff l: loadstore rm: offsetReg 
  	"build an ARM [base +/- offsetReg] memory instruction
  	p -> pre-index (1) or post-index (0) the offset. Combines with W to do some odd things.
  	u -> up (1) or down (0) ie + or - for the offset
  	b -> byte(1) or word (0)
  	w -> write-back (1) if pre-indexing. 
  	l -> load (1) or store (0)"
+ 	^ (cond bitAnd: 16rF)  << 28
- 	^ cond << 28
  		bitOr: (3 << 25
+ 		bitOr: ((postpreoffset  bitAnd: 1) << 24
+ 		bitOr: ((updown bitAnd: 1) << 23
+ 		bitOr: ((byteword bitAnd: 1) << 22
+ 		bitOr: ((weirdstuff bitAnd: 1) << 21
+ 		bitOr: ((loadstore bitAnd: 1) << 20
+ 		bitOr: ((baseReg bitAnd: 16rF) << 16
+ 		bitOr: ((destReg bitAnd: 16rF) << 12 
+ 		bitOr: (offsetReg bitAnd: 16rF)))))))))!
- 		bitOr: (postpreoffset << 24
- 		bitOr: (updown << 23
- 		bitOr: (byteword << 22
- 		bitOr: (weirdstuff << 21
- 		bitOr: (loadstore << 20
- 		bitOr: (baseReg << 16
- 		bitOr: (destReg << 12 bitOr: offsetReg))))))))!

Item was added:
+ ----- Method: CogARMCompiler>>memMxr:reg:base:p:u:b:w:l:rmLsl2: (in category 'encoding') -----
+ memMxr: cond reg: destReg base: baseReg p: postpreoffset u: updown b: byteword w: weirdstuff l: loadstore rmLsl2: offsetReg 
+ 	"build an ARM [base +/- offsetReg lsl #2] memory instruction - see also #memMxr:reg:base:p:u:b:w:l:rm: and keep them correlated properly
+ 	p -> pre-index (1) or post-index (0) the offset. Combines with W to do some odd things.
+ 	u -> up (1) or down (0) ie + or - for the offset
+ 	b -> byte(1) or word (0)
+ 	w -> write-back (1) if pre-indexing. 
+ 	l -> load (1) or store (0)"
+ 	^ (cond bitAnd: 16rF)  << 28
+ 		bitOr: (3 << 25
+ 		bitOr: ((postpreoffset  bitAnd: 1) << 24
+ 		bitOr: ((updown bitAnd: 1) << 23
+ 		bitOr: ((byteword bitAnd: 1) << 22
+ 		bitOr: ((weirdstuff bitAnd: 1) << 21
+ 		bitOr: ((loadstore bitAnd: 1) << 20
+ 		bitOr: ((baseReg bitAnd: 16rF) << 16
+ 		bitOr: ((destReg bitAnd: 16rF) << 12
+ 		bitOr: (16r100
+ 		bitOr: (offsetReg bitAnd: 16rF))))))))))!

Item was changed:
  ----- Method: CogARMCompiler>>memMxr:reg:base:u:b:l:imm: (in category 'encoding') -----
  memMxr: cond reg: destReg  base: baseReg u: updown b: byteword l: loadstore imm: immediate12bitValue
+ "This is the lowest level build of an ARM [base +/- immediate 12bit offset] memory instruction
- "build an ARM [base +/- immediate 12bit offset] memory instruction
  u -> up (1) or down (0) ie + or - for the offset
  b -> byte(1) or word (0)
  l -> load (1) or store (0)"
  
+ 	^ (cond bitAnd: 16rF) << 28
- 	^ cond << 28
  		bitOr: (5<<24
+ 		bitOr: ((updown bitAnd: 1) << 23
+ 		bitOr:((byteword bitAnd: 1) <<22
+ 		bitOr:((loadstore bitAnd: 1) <<20
+ 		bitOr:((baseReg bitAnd: 16rF) <<16
+ 		bitOr:((destReg bitAnd: 16rF) <<12
+ 		bitOr: (immediate12bitValue bitAnd: 16rFFF)))))))!
- 		bitOr: (updown << 23
- 		bitOr:(byteword<<22
- 		bitOr:(loadstore<<20
- 		bitOr:(baseReg<<16
- 		bitOr:(destReg<<12
- 		bitOr: immediate12bitValue))))))!



More information about the Vm-dev mailing list