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

commits at source.squeak.org commits at source.squeak.org
Fri Dec 25 19:37:53 UTC 2015


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

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

Name: VMMaker.oscog-eem.1612
Author: eem
Time: 25 December 2015, 7:36:01.334 pm
UUID: be393e64-c959-4132-b754-cd2bda5bcf0d
Ancestors: VMMaker.oscog-eem.1611

Complete the "abstract registers simply name concrete registers" coup.  Eliminate all uses of concreteRegister: concreteDPFPRegister: abstractRegisterForConcreteRegister:.

Make the abstract instruction tests initializeAbstractRegisters before running (CogRTLOpcodes still needs to be initialized separately).

Slang: fix default in shouldIncludeMethodForSelector:.  Missing options need to default to false.

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

Item was changed:
  ----- Method: AbstractInstructionTests>>runAddCwR: (in category 'running') -----
  runAddCwR: assertPrintBar
  	"self defaultTester runAddCwR: false"
  	self concreteCompilerClass dataRegistersWithAccessorsDo:
  		[:reg :rgetter :rsetter|
  		self pairs: (-2 to: 2)  do:
  			[:a :b| | inst len bogus memory |
  			inst := self gen: AddCwR operand: a operand: reg.
  			len := inst concretizeAt: 0.
  			memory := self memoryAsBytes: inst machineCode.
  			self processor
  				reset;
  				perform: rsetter with: (self processor convertIntegerToInternal: b).
  			[[processor pc < len] whileTrue:
  				[self processor singleStepIn: memory]]
  				on: Error
  				do: [:ex| ].
  			"self processor printRegistersOn: Transcript.
  			 Transcript show: (self processor disassembleInstructionAt: 0 In: memory); cr"
  			assertPrintBar
  				ifTrue: [self assert: processor pc = inst machineCodeSize.
  						self assertCheckLongArithOpCodeSize: inst machineCodeSize]
  				ifFalse: [bogus := processor pc ~= inst machineCodeSize].
  			self concreteCompilerClass dataRegistersWithAccessorsDo:
  				[:ireg :getter :setter| | expected |
+ 				(self concreteCompilerClass isRISCTempRegister: ireg) ifFalse:
- 				(self concreteCompilerClass isConcreteRISCTempRegister: ireg) ifFalse:
  					[expected := getter == rgetter ifTrue: [b + a] ifFalse: [0].
  					assertPrintBar
  						ifTrue: [self assert: (self processor convertInternalToInteger: (self processor perform: getter)) equals: expected]
  						ifFalse:
  							[(self processor convertInternalToInteger: (self processor perform: getter)) ~= expected ifTrue:
  								[bogus := true]]].
  					assertPrintBar ifFalse:
  						[Transcript
  							nextPutAll: rgetter; nextPut: $(; print: b; nextPutAll: ') + '; print: a; nextPutAll: ' = ';
  							print: (self processor convertInternalToInteger: (self processor perform: rgetter)); cr; flush.
  						 bogus ifTrue:
  							[self processor printRegistersOn: Transcript.
  							 Transcript show: (self processor disassembleInstructionAt: 0 In: memory); cr]]]]]!

Item was changed:
  ----- Method: AbstractInstructionTests>>runSubCwR: (in category 'running') -----
  runSubCwR: assertPrintBar
  	"self defaultTester runSubCwR: false"
  	self concreteCompilerClass dataRegistersWithAccessorsDo:
  		[:reg :rgetter :rsetter|
  		self pairs: (-2 to: 2)  do:
  			[:a :b| | inst len bogus memory |
  			inst := self gen: SubCwR operand: a operand: reg.
  			len := inst concretizeAt: 0.
  			memory := self memoryAsBytes: inst machineCode.
  			self processor
  				reset;
  				perform: rsetter with: (self processor convertIntegerToInternal: b).
  			[[processor pc < len] whileTrue:
  				[self processor singleStepIn: memory]]
  				on: Error
  				do: [:ex| ].
  			"self processor printRegistersOn: Transcript.
  			 Transcript show: (self processor disassembleInstructionAt: 0 In: memory); cr"
  			assertPrintBar
  				ifTrue: [self assert: processor pc = inst machineCodeSize.
  						self assertCheckLongArithOpCodeSize: inst machineCodeSize]
  				ifFalse: [bogus := processor pc ~= inst machineCodeSize].
  			self concreteCompilerClass dataRegistersWithAccessorsDo:
  				[:ireg :getter :setter| | expected |
+ 				(self concreteCompilerClass isRISCTempRegister: ireg) ifFalse:
- 				(self concreteCompilerClass isConcreteRISCTempRegister: ireg) ifFalse:
  					[expected := getter == rgetter ifTrue: [b - a] ifFalse: [0].
  					assertPrintBar
  						ifTrue: [self assert: (self processor convertInternalToInteger: (self processor perform: getter)) equals: expected]
  						ifFalse:
  							[(self processor convertInternalToInteger: (self processor perform: getter)) ~= expected ifTrue:
  								[bogus := true]]].
  					assertPrintBar ifFalse:
  						[Transcript
  							nextPutAll: rgetter; nextPut: $(; print: b; nextPutAll: ') - '; print: a; nextPutAll: ' = ';
  							print: (self processor convertInternalToInteger: (self processor perform: rgetter)); cr; flush.
  						 bogus ifTrue:
  							[self processor printRegistersOn: Transcript.
  							 Transcript show: (self processor disassembleInstructionAt: 0 In: memory); cr]]]]]!

Item was added:
+ ----- Method: AbstractInstructionTests>>setUp (in category 'running') -----
+ setUp
+ 	self concreteCompilerClass initializeAbstractRegisters!

Item was removed:
- ----- Method: CogARMCompiler class>>isConcreteRISCTempRegister: (in category 'testing') -----
- isConcreteRISCTempRegister: concreteRegister
- 	"For tests to filter-out bogus values left in the ConcreteRISCTempRegister, if any."
- 	^concreteRegister = ConcreteIPReg!

Item was added:
+ ----- Method: CogARMCompiler class>>isRISCTempRegister: (in category 'testing') -----
+ isRISCTempRegister: reg
+ 	"For tests to filter-out bogus values left in the RISCTempRegister, if any."
+ 	^reg = ConcreteIPReg!

Item was changed:
  ----- Method: CogARMCompiler>>cResultRegister (in category 'abi') -----
  cResultRegister
+ 	"Answer the register through which C funcitons return integral results."
+ 	<inline: true>
- 	"Answer the abstract register for the C result register.
- 	 Only partially implemented.  Works on x86 since TempReg = EAX = C result reg."
  	^R0!

Item was changed:
  ----- Method: CogARMCompiler>>callerSavedRegisterMask (in category 'accessing') -----
  callerSavedRegisterMask
  	"According to IHI0042E ARM Architecture Procedure Calling Standard, in section 5.1.1:
  		A subroutine must preserve the contents of the registers r4-r8, r10, r11 and SP (and r9 in PCS variants that designate r9 as v6).
  	 SP = r13, so the callee-saved regs are r4-r8 & r10-r12.
  	 The caller-saved registers are those that are not callee-saved and not reserved for hardware/abi uses,
  	 i..e r0-r3, r9 & r12.  We can't name all the C argument registers.  So..."
  	^cogit
+ 		registerMaskFor: 0
+ 		"and: 1"
+ 		"and: 2"
+ 		"and: 3"
+ 		"and: 9"
+ 		and: 12!
- 		registerMaskFor: (self abstractRegisterForConcreteRegister: 0)
- 		"and: (self abstractRegisterForConcreteRegister: 1)"
- 		"and: (self abstractRegisterForConcreteRegister: 2)"
- 		"and: (self abstractRegisterForConcreteRegister: 3)"
- 		"and: (self abstractRegisterForConcreteRegister: 9)"
- 		and: (self abstractRegisterForConcreteRegister: 12)!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeAddRdRd (in category 'generate machine code - concretize') -----
  concretizeAddRdRd
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	"Add FP regRHS to FP regLHS and stick result in FP regLHS"
  	| regLHS regRHS |
+ 	regRHS := operands at: 0.
+ 	regLHS := operands at: 1.
- 	regRHS := self concreteDPFPRegister: (operands at: 0).
- 	regLHS := self concreteDPFPRegister: (operands at: 1).
  	machineCode at: 0 put:(self faddd: regLHS with: regRHS).
  	^machineCodeSize := 4
  	!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeAndCqRR (in category 'generate machine code - concretize') -----
  concretizeAndCqRR
  	"Will get inlined into concretizeAt: switch."
  	"AND is very important since it's used to mask all sorts of flags in the jit. We take special care to try to find compact ways to make the masks"
  	<inline: true>
  	| val srcReg dstReg |
  	val := operands at: 0.
+ 	srcReg := operands at: 1.
+ 	dstReg := operands at: 2.
- 	srcReg := self concreteRegister: (operands at: 1).
- 	dstReg := self concreteRegister: (operands at: 2).
  	self rotateable8bitBitwiseImmediate: val
  		ifTrue:
  			[:rot :immediate :invert|
  			self machineCodeAt: 0 put: (invert
  											ifTrue: [self bics: dstReg rn: srcReg imm: immediate ror: rot]
  											ifFalse: [self ands: dstReg rn: srcReg imm: immediate ror: rot]).
  			^machineCodeSize := 4]
  		ifFalse: "let's try to see if the constant can be made from a simple shift of 0xFFFFFFFF"
  			[| hb |
  			hb := (operands at: 0) highBit.
  			1 << hb = (val +1)
  				ifTrue: "MVN temp reg, 0, making 0xffffffff"
  					[self machineCodeAt: 0 put:(self mvn: ConcreteIPReg imm: 0 ror: 0).
  					"Then AND reg, temp reg, lsr #(32-hb)"
  					 self machineCodeAt: 4 put: (self dataOpType: AndOpcode rd: dstReg rn: srcReg rm: ConcreteIPReg lsr: 32 - hb).
  					^machineCodeSize := 8]
  				ifFalse:
  					[^self concretizeDataOperationCwR: AndOpcode]].
  	^0 "to keep Slang happy"!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeArithmeticShiftRightCqR (in category 'generate machine code - concretize') -----
  concretizeArithmeticShiftRightCqR
  	"Will get inlined into concretizeAt: switch."
  	"this is an unfortunate waste of an instruction in most cases since the shift can usually be done in a subsequent arithmetic instruction. 
  	Handle for now with a MOVS reg, reg, ASR #distance"
  	<inline: true>
  	| distance reg |
  	distance := (operands at: 0) min: 31.
+ 	reg := operands at: 1.
- 	reg := self concreteRegister: (operands at: 1).
  	"cond 000 1101 0 0000 dest dist -100 srcR"
  	self machineCodeAt: 0 put: (self type: 0 op: MoveOpcode set: 1 rn: 0 rd: reg 
  									shifterOperand: (distance << 7 bitOr: (64 "flag for arithmetic" bitOr: reg))).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeArithmeticShiftRightRR (in category 'generate machine code - concretize') -----
  concretizeArithmeticShiftRightRR
  	"Will get inlined into concretizeAt: switch."
  	"this is an unfortunate waste of an instruction in most cases since the shift can usually be done in a subsequent arithmetic instruction. 
  	Handle for now with a MOVS reg, reg, ASR distReg"
  	<inline: true>
  	| destReg distReg |
+ 	distReg := operands at: 0.
+ 	destReg := operands at: 1.
- 	distReg := self concreteRegister: (operands at: 0).
- 	destReg := self concreteRegister: (operands at: 1).
  	"cond 000 1101 0 0000 destR distR 0101 srcR"
  	self machineCodeAt: 0 put: (self type: 0 op: MoveOpcode set: 1 rn: 0 rd: destReg 
  									shifterOperand: (distReg << 8 bitOr: (80 bitOr: destReg))).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeCMPSMULL (in category 'generate machine code - concretize') -----
  concretizeCMPSMULL
  	"Generate a CMP a, b, ASR #31 instruction, specifically for comparing the resutls of SMULLs in genMulR:R:"
  	| hiReg loReg |
+ 	hiReg := operands at: 0.
+ 	loReg := operands at: 1.
- 	hiReg := self concreteRegister: (operands at: 0).
- 	loReg := self concreteRegister: (operands at: 1).
  	self machineCodeAt: 0
  		put: (self type: 0 op: CmpOpcode set: 1 rn: hiReg rd: 0)
  			+ (31<<7) "the shift amount"
  			+ (2<<5) "the shift type - ASR"
  			+ loReg.
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeCmpRdRd (in category 'generate machine code - concretize') -----
  concretizeCmpRdRd
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	"Compare FP regB with FP regA and leave the FP status reg ready to be transferred back to ARM with next instruction"
  	| regB regA |
+ 	regA := operands at:0.
+ 	regB := operands at: 1.
- 	regA := self concreteDPFPRegister: (operands at:0).
- 	regB := self concreteDPFPRegister: (operands at: 1).
  	machineCode at: 0 put:(self fcmpFrom: regB to: regA).
  	^machineCodeSize := 4
  		
  !

Item was changed:
  ----- Method: CogARMCompiler>>concretizeConvertRRd (in category 'generate machine code - concretize') -----
  concretizeConvertRRd
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| srcReg destReg |
+ 	srcReg := operands at:0.
+ 	destReg := operands at: 1.
- 	srcReg := self concreteRegister: (operands at:0).
- 	destReg := self concreteDPFPRegister: (operands at: 1).
  	machineCode at: 0 put:(self fmsrFrom: srcReg to: 9).
  	machineCode at: 1 put: (self fsitodFrom: 9 to: destReg). "probably not quite right"
  	^machineCodeSize := 8
  		
  !

Item was changed:
  ----- Method: CogARMCompiler>>concretizeDataOperationCqR: (in category 'generate machine code - concretize') -----
  concretizeDataOperationCqR: armOpcode
  	"Will get inlined into concretizeAt: switch."
  	"4 == Add, 2 == Sub, Xor == 1, And == 0, Or == 12, Bic == 14"
  	<inline: true>
  	|val rd rn |
  	val := operands at: 0.
+ 	rn := operands at: 1.
- 	rn := self concreteRegister: (operands at: 1).
  	rd := opcode = CmpOpcode ifTrue: [0] ifFalse:[rn]. "Extra note - if ever a version of this code wants to NOT set the Set flag - Cmp must always have it set or it will pretend to be a SMALALBT and Very Bad Things might happen"
  
  	self  rotateable8bitImmediate: val 
  		ifTrue: [:rot :immediate |
  			self machineCodeAt: 0 put: (self type: 1 op: armOpcode set: 1 rn: rn rd: rd shifterOperand: ((rot>>1)"in this usage we have to halve the rot value" << 8 bitOr: immediate)).
  			^machineCodeSize := 4]
  		ifFalse: ["let's try to see if the constant can be made from a simple shift of 0xFFFFFFFF"
  				val > 0 ifTrue: [
  					|hb |
  					hb := val highBit.
  					1 << hb = (val +1)
  						ifTrue: [ "MVN temp,  #0, making 0xffffffff"
  							self machineCodeAt: 0 put:(self mvn: ConcreteIPReg imm: 0 ror: 0).
  							"Then armOpcode reg, temp reg, lsr #(32-hb)"
  							 self machineCodeAt: 4 put:(self dataOpType: armOpcode rd: rd  rn: rn rm: ConcreteIPReg lsr: (32-hb)).
  							^machineCodeSize :=8]].
  					^self concretizeDataOperationCwR: armOpcode].
  	^0 "to keep Slang happy"
  	!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeDataOperationCwR: (in category 'generate machine code - concretize') -----
  concretizeDataOperationCwR: armOpcode
  	"Will get inlined into concretizeAt: switch."
  	"Load the word into the RISCTempReg, then cmp R, RISCTempReg"
  	<inline: true>
  	| constant rn rd instrOffset|
  	constant := operands at: 0.
+ 	rn := operands at: 1.
- 	rn := (self concreteRegister: (operands at: 1)).
  	rd := armOpcode = CmpOpcode ifTrue: [0] ifFalse:[rn].
  	instrOffset := self moveCw: constant intoR: ConcreteIPReg.
  	self machineCodeAt: instrOffset 
  		put: (self type: 0 op: armOpcode set: 1 rn: rn rd: rd shifterOperand: ConcreteIPReg).
  	^machineCodeSize := instrOffset + 4!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeDataOperationRR: (in category 'generate machine code - concretize') -----
  concretizeDataOperationRR: armOpcode
  	"Will get inlined into concretizeAt: switch."
  	"Load the word into the RISCTempReg, then op R, RISCTempReg"
  	<inline: true>
  	| rn rd srcReg |
+ 	srcReg := operands at: 0.
+ 	rn := operands at: 1.
- 	srcReg := self concreteRegister: (operands at: 0).
- 	rn := (self concreteRegister: (operands at: 1)).
  	rd := armOpcode = CmpOpcode ifTrue: [0] ifFalse: [rn].
  	self machineCodeAt: 0 
  		put: (self type: 0 op: armOpcode set: 1 rn: rn rd: rd shifterOperand: srcReg).
  	^machineCodeSize := 4.!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeDivRdRd (in category 'generate machine code - concretize') -----
  concretizeDivRdRd
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	"FP divide regLHS by regRHS and stick result in regLHS"
  	| regLHS regRHS |
+ 	regRHS := operands at: 0.
+ 	regLHS := operands at: 1.
- 	regRHS := self concreteDPFPRegister: (operands at: 0).
- 	regLHS := self concreteDPFPRegister: (operands at: 1).
  	machineCode at: 0 put:(self fdivd: regLHS by: regRHS).
  	^machineCodeSize := 4
  	!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeInvertibleDataOperationCqR: (in category 'generate machine code - concretize') -----
  concretizeInvertibleDataOperationCqR: armOpcode
  	"Will get inlined into concretizeAt: switch."
  	"Xor == 1, And == 0, Or == 12, Bic == 14"
  	<inline: true>
  	| val rn |
  	val := operands at: 0.
+ 	rn := operands at: 1.
- 	rn := self concreteRegister: (operands at: 1).
  	self deny: opcode = CmpOpcode.
  
  	self rotateable8bitBitwiseImmediate: val 
  		ifTrue:
  			[:rot :immediate : invert|
  			self machineCodeAt: 0
  				put: (self
  						type: 1
  						op: (invert ifTrue: [self inverseOpcodeFor: armOpcode] ifFalse: [armOpcode])
  						set: 1
  						rn: rn
  						rd: rn
  						shifterOperand: (rot >> 1"in this usage we have to halve the rot value" << 8 bitOr: immediate)).
  			^machineCodeSize := 4]
  		ifFalse: "let's try to see if the constant can be made from a simple shift of 0xFFFFFFFF"
  			[val > 0 ifTrue:
  				[| hb |
  				hb := val highBit.
  				1 << hb = (val +1) ifTrue: "MVN temp,  #0, making 0xffffffff"
  					[self machineCodeAt: 0 put: (self mvn: ConcreteIPReg imm: 0 ror: 0).
  					 "Then armOpcode reg, temp reg, lsr #(32-hb)"
  					 self machineCodeAt: 4 put: (self dataOpType: armOpcode rd: rn  rn: rn rm: ConcreteIPReg lsr: 32 - hb).
  					^machineCodeSize := 8]].
  			 ^self concretizeDataOperationCqR: armOpcode].
  	^0 "to keep Slang happy"!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeJumpR (in category 'generate machine code - concretize') -----
  concretizeJumpR
  	"Will get inlined into concretizeAt: switch."
  	"Sizing/generating jumps.
  		Jump targets can be to absolute addresses or other abstract instructions.
  		Generating initial trampolines instructions may have no maxSize and be to absolute addresses.
  		Otherwise instructions must have a machineCodeSize which must be kept to."
  	<inline: true>
  	| reg |
+ 	reg := operands at: 0.
- 	reg := self concreteRegister: (operands at: 0).
  	"bx reg"
  	self machineCodeAt: 0 put: (self bx: reg).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeLoadEffectiveAddressMwrR (in category 'generate machine code - concretize') -----
  concretizeLoadEffectiveAddressMwrR
  	"Will get inlined into concretizeAt: switch."
  	"destReg = srcReg (which contains an address) + offset"
  	<inline: true>
  	| srcReg offset destReg instrOffset |
  	offset := operands at: 0.
+ 	srcReg := operands at: 1.
+ 	destReg := operands at: 2.
- 	srcReg := self concreteRegister: (operands at: 1).
- 	destReg := self concreteRegister: (operands at: 2).
  	self rotateable8bitImmediate: offset
  		ifTrue:
  			[ :rot :immediate | 
  			self machineCodeAt: 0 
  				"add destReg, srcReg, #immediate ROR rot"
  				put: (self add: destReg rn: srcReg imm: immediate ror: rot<<1).
  			machineCodeSize := 4]
  		ifFalse:
  			[instrOffset := self moveCw: offset intoR: ConcreteIPReg.
  			"add destReg, srcReg, ConcreteIPReg"
  			self machineCodeAt: 16 put: (self add: destReg rn: srcReg rm: ConcreteIPReg).
  			machineCodeSize := instrOffset + 4].
  	^machineCodeSize "to keep Slang happy"!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeLogicalShiftLeftCqR (in category 'generate machine code - concretize') -----
  concretizeLogicalShiftLeftCqR
  	"Will get inlined into concretizeAt: switch."
  	"this is an unfortunate waste of an instruction in most cases since the shift can usually be done in a subsequent arithmetic instruction. 
  	Handle for now with a MOVS reg, reg, LSL #distance"
  	<inline: true>
  	| distance reg |
  	distance := (operands at: 0) min: 31.
+ 	reg := operands at: 1.
- 	reg := self concreteRegister: (operands at: 1).
  	"cond 000 1101 0 0000 dest dista 000 srcR"
  	self machineCodeAt: 0 put: (self type: 0 op: MoveOpcode set: 1 rn: 0 rd: reg shifterOperand: (distance << 7 bitOr: reg)).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeLogicalShiftLeftRR (in category 'generate machine code - concretize') -----
  concretizeLogicalShiftLeftRR
  	"Will get inlined into concretizeAt: switch."
  	"this is an unfortunate waste of an instruction in most cases since the shift can usually be done in a subsequent arithmetic instruction. 
  	Handle for now with a MOVS reg, reg, LSL distReg" 
  	<inline: true>
  	| destReg distReg |
+ 	distReg := operands at: 0.
+ 	destReg := operands at: 1.
- 	distReg := self concreteRegister: (operands at: 0).
- 	destReg := self concreteRegister: (operands at: 1).
  	"cond 000 1101 0 0000 dest dist 0001 srcR"
  	self machineCodeAt: 0 put: (self type: 0 op: MoveOpcode set: 1 rn: 0 rd: destReg 
  									shifterOperand: (distReg << 8 bitOr: (16 bitOr: destReg))).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeLogicalShiftRightCqR (in category 'generate machine code - concretize') -----
  concretizeLogicalShiftRightCqR
  	"Will get inlined into concretizeAt: switch."
  	"this is an unfortunate waste of an instruction in most cases since the shift can usually be done in a subsequent arithmetic instruction. 
  	Handle for now with a MOVS reg, reg, LSR #distance"
  	<inline: true>
  	| distance reg |
  	distance := (operands at: 0) min: 31.
+ 	reg := operands at: 1.
- 	reg := self concreteRegister: (operands at: 1).
  	"cond 000 1101 0 0000 dest dist -010 srcR"
  	self machineCodeAt: 0 put: (self type: 0 op: MoveOpcode set: 1 rn: 0 rd: reg 
  									shifterOperand: (distance << 7 bitOr: (32 bitOr: reg))).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeLogicalShiftRightRR (in category 'generate machine code - concretize') -----
  concretizeLogicalShiftRightRR
  	"Will get inlined into concretizeAt: switch."
  	"this is an unfortunate waste of an instruction in most cases since the shift can usually be done in a subsequent arithmetic instruction. 
  	Handle for now with a MOVS reg, reg, LSR distReg"
  	<inline: true>
  	| destReg distReg |
+ 	distReg := operands at: 0.
+ 	destReg := operands at: 1.
- 	distReg := self concreteRegister: (operands at: 0).
- 	destReg := self concreteRegister: (operands at: 1).
  	"cond 000 1101 0 0000 dest dist 0011 srcR"
  	self machineCodeAt: 0 put: (self type: 0 op: MoveOpcode set: 1 rn: 0 rd: destReg 
  									shifterOperand: (distReg << 8 bitOr: (48 bitOr: destReg))).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeMSR (in category 'generate machine code - concretize') -----
  concretizeMSR
  	"Generate an MSR CPSR_f, #flags instruction.
  Note that we only have business with the NZCV flags so we use
  N -> 8
  Z -> 4
  C -> 2
  V -> 1.
  You don't want to mess with this too much."
  	|  flags |
+ 	flags := operands at: 0.
- 	flags := self concreteRegister: (operands at: 0).
  	self machineCodeAt: 0 put: (self msr: flags).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeMoveAbR (in category 'generate machine code - concretize') -----
  concretizeMoveAbR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| srcAddr destReg instrOffset|
  	srcAddr := operands at: 0.
+ 	destReg := operands at: 1.
- 	destReg := self concreteRegister: (operands at: 1).
  	(self isAddressRelativeToVarBase: srcAddr) ifTrue:
  		[self machineCodeAt: 0 put: (self ldrb: destReg rn: ConcreteVarBaseReg plus: 1 imm: srcAddr - cogit varBaseAddress).
  		 ^machineCodeSize := 4].
  	"load the address into ConcreteIPReg"
  	instrOffset := self moveCw: srcAddr intoR: ConcreteIPReg.
  	"We *could* overwrite the last instruction above with a LDR a, b, last-byte-of-srcAddr BUT that would break if we change to loading literals instead of forming long constants"
  	self machineCodeAt: instrOffset put: (self ldrb: destReg rn: ConcreteIPReg plus: 1 imm: 0).
  	^machineCodeSize := instrOffset + 4!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeMoveAwR (in category 'generate machine code - concretize') -----
  concretizeMoveAwR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| srcAddr destReg instrOffset|
  	srcAddr := operands at: 0.
+ 	destReg := operands at: 1.
- 	destReg := self concreteRegister: (operands at: 1).
  	(self isAddressRelativeToVarBase: srcAddr) ifTrue:
  		[self machineCodeAt: 0 put: (self ldr: destReg rn: ConcreteVarBaseReg plusImm: srcAddr - cogit varBaseAddress).
  		 ^machineCodeSize := 4].
  	"load the address into ConcreteIPReg"
  	instrOffset := self moveCw: srcAddr intoR: ConcreteIPReg.
  	"We *could* overwrite the last instruction above with a LDR a, b, last-byte-of-srcAddr BUT that would break if we change to loading literals instead of forming long constants"
  	self machineCodeAt: instrOffset put: (self ldr: destReg rn: ConcreteIPReg plusImm: 0).
  	^machineCodeSize := instrOffset + 4!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeMoveCqR (in category 'generate machine code - concretize') -----
  concretizeMoveCqR
  	"Will get inlined into concretizeAt: switch."
  	"If the quick constant is in fact a shiftable 8bit, generate the apropriate MOV, otherwise do what is necessary for a whole word."
  	<var: #word type: #sqInt>
  	<inline: true>
  	|word reg|
  	word := operands at: 0.
+ 	reg := operands at: 1.
- 	reg := self concreteRegister: (operands at: 1).
  	self 
  		rotateable8bitImmediate: word 
  		ifTrue: [:rot :immediate |
  			self machineCodeAt: 0 put: (self mov: reg imm: immediate ror: rot).
  			^machineCodeSize := 4]
  		ifFalse: [|invVal|
  			word <0
  				ifTrue:[invVal := -1 - word]
  				ifFalse:[invVal := word bitInvert32].
  			self rotateable8bitImmediate: invVal
  				ifTrue: [ :rot :immediate |
  					self machineCodeAt: 0 put: (self mvn: reg imm: immediate ror: rot).
  					^machineCodeSize := 4]
  				ifFalse: [^self concretizeMoveCwR]].
  	^0 "to keep Slang happy"!

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

Item was changed:
  ----- Method: CogARMCompiler>>concretizeMoveM16rR (in category 'generate machine code - concretize') -----
  concretizeMoveM16rR
  	"Will get inlined into concretizeAt: switch."
  	"ldrh destReg, [srcReg, #immediate],
  	or 
  	move offset to ConcreteIPReg
  	ldrh destReg, [srcReg, ConcreteIPReg]"
  	<var: #offset type: #sqInt>
  	<inline: true>
  	| srcReg offset destReg instrOffset|
  	offset := operands at: 0.
+ 	srcReg := operands at: 1.
+ 	destReg := operands at: 2.
- 	srcReg := self concreteRegister: (operands at: 1).
- 	destReg := self concreteRegister: (operands at: 2).
  	self is8BitValue: offset
  		ifTrue:
  			[ :u :immediate | 
  			self machineCodeAt: 0 "ldrh destReg, [srcReg, #immediate]"
  				put: (self ldrh: destReg rn: srcReg plus: u imm: immediate).
  			^machineCodeSize := 4]
  		ifFalse:
  			[instrOffset := self moveCw: offset intoR: ConcreteIPReg.
  			"ldrh destReg, [srcReg, ConcreteIPReg]"
  			self machineCodeAt: instrOffset put: (self ldrh: destReg rn: srcReg rm: ConcreteIPReg).
  			^machineCodeSize := instrOffset + 4 ].
  	^0 "to keep Slang happy"!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeMoveM64rRd (in category 'generate machine code - concretize') -----
  concretizeMoveM64rRd
  	"Will get inlined into concretizeAt: switch."	
  	<inline: true>
  	"Load a float from srcReg+offset into FP destReg"
  	| srcReg offset destReg u|
  	offset := operands at: 0.
  	u := offset >0 ifTrue:[1] ifFalse:[0].
+ 	srcReg := operands at: 1.
+ 	destReg := operands at: 2.
- 	srcReg := self concreteRegister: (operands at: 1).
- 	destReg := self concreteDPFPRegister: (operands at: 2).
  	machineCode at: 0 put: (self fldd: destReg rn: srcReg plus: u imm: offset>>2).
  	^machineCodeSize := 4
  !

Item was changed:
  ----- Method: CogARMCompiler>>concretizeMoveMbrR (in category 'generate machine code - concretize') -----
  concretizeMoveMbrR
  	"Will get inlined into concretizeAt: switch."
  	"ldrb destReg, [srcReg, #immediate] or ldrb destReg, [srcReg, ConcreteIPReg]"
  	<var: #offset type: #sqInt>
  	<inline: true>
  	| srcReg offset destReg instrOffset|
  	offset := operands at: 0.
+ 	srcReg := operands at: 1.
+ 	destReg := operands at: 2.
- 	srcReg := self concreteRegister: (operands at: 1).
- 	destReg := self concreteRegister: (operands at: 2).
  	self is12BitValue: offset
  		ifTrue:
  			[ :u :immediate | 
  			self machineCodeAt: 0 "ldrb destReg, [srcReg, #immediate]"
  				put: (self ldrb: destReg rn: srcReg plus: u imm: immediate).
  			^machineCodeSize := 4]
  		ifFalse:
  			[(self isAddressRelativeToVarBase: offset)
  				ifTrue:
  					[self machineCodeAt: 0 put: (self adds: ConcreteIPReg rn: ConcreteVarBaseReg imm: offset - cogit varBaseAddress ror: 0).
  					 instrOffset := 4]
  				ifFalse:
  					[instrOffset := self moveCw: offset intoR: ConcreteIPReg].
  			 "ldrb destReg, [srcReg, ConcreteIPReg]"
  			 self machineCodeAt: instrOffset put: (self ldrb: destReg rn: srcReg rm: ConcreteIPReg).
  			 ^machineCodeSize := instrOffset + 4].
  	^0 "to keep Slang happy"!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeMoveMwrR (in category 'generate machine code - concretize') -----
  concretizeMoveMwrR
  	"Will get inlined into concretizeAt: switch."
  	<var: #offset type: #sqInt>
  	<inline: true>
  	| srcReg offset destReg instrOffset|
  	offset := operands at: 0.
+ 	srcReg := operands at: 1.
+ 	destReg := operands at: 2.
- 	srcReg := self concreteRegister: (operands at: 1).
- 	destReg := self concreteRegister: (operands at: 2).
  	self is12BitValue: offset
  		ifTrue:
  			[ :u :immediate | 
  			self machineCodeAt: 0 "ldr destReg, [srcReg, #immediate]"
  				put: (self ldr: destReg rn: srcReg plus: u imm: immediate).
  			^machineCodeSize := 4]
  		ifFalse:
  			[instrOffset := self moveCw: offset intoR: ConcreteIPReg.
  			"ldr destReg, [srcReg, ConcreteIPReg]"
  			self machineCodeAt: instrOffset put: (self ldr: destReg rn: srcReg rm: ConcreteIPReg).
  			^machineCodeSize := instrOffset + 4].
  	^0 "to keep Slang happy"!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeMoveRAb (in category 'generate machine code - concretize') -----
  concretizeMoveRAb
  	"Will get inlined into concretizeAt: switch."
  	"LEA ConcreteIPReg
  	strb srcReg, [ConcreteIPReg]"
  	<inline: true>
  	| srcReg destAddr instrOffset|
+ 	srcReg := operands at: 0.
- 	srcReg := self concreteRegister: (operands at: 0).
  	destAddr := operands at: 1.
  	(self isAddressRelativeToVarBase: destAddr) ifTrue:
  		[self machineCodeAt: 0 put: (self strb: srcReg rn: ConcreteVarBaseReg plus: 1 imm: destAddr - cogit varBaseAddress).
  		 ^machineCodeSize := 4].
  	"load the address into ConcreteIPReg"
  	instrOffset := self moveCw: destAddr intoR: ConcreteIPReg.
  	"We *could* overwrite the last instruction above with a LDR a, b, last-byte-of-srcAddr BUT that would break if we change to loading literals instead of forming long constants"
  	self machineCodeAt: instrOffset put: (self strb: srcReg rn: ConcreteIPReg plus: 1 imm: 0).
  	^machineCodeSize := instrOffset + 4!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeMoveRAw (in category 'generate machine code - concretize') -----
  concretizeMoveRAw
  	"Will get inlined into concretizeAt: switch."
  	"LEA ConcreteIPReg
  	str srcReg, [ConcreteIPReg]"
  	<inline: true>
  	| srcReg destAddr instrOffset|
+ 	srcReg := operands at: 0.
- 	srcReg := self concreteRegister: (operands at: 0).
  	destAddr := operands at: 1.
  	(self isAddressRelativeToVarBase: destAddr) ifTrue:
  		[self machineCodeAt: 0 put: (self str: srcReg rn: ConcreteVarBaseReg plusImm: destAddr - cogit varBaseAddress).
  		 ^machineCodeSize := 4].
  	"load the address into ConcreteIPReg"
  	instrOffset := self moveCw: destAddr intoR: ConcreteIPReg.
  	"We *could* overwrite the last instruction above with a LDR a, b, last-byte-of-srcAddr BUT that would break if we change to loading literals instead of forming long constants"
  	self machineCodeAt: instrOffset put: (self str: srcReg rn: ConcreteIPReg plusImm: 0).
  	^machineCodeSize := instrOffset + 4!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeMoveRMbr (in category 'generate machine code - concretize') -----
  concretizeMoveRMbr
  	"Will get inlined into concretizeAt: switch."
  	<var: #offset type: #sqInt>
  	<inline: true>
  	| srcReg offset baseReg instrOffset|
+ 	srcReg := operands at: 0.
- 	srcReg := self concreteRegister: (operands at: 0).
  	offset := operands at: 1.
+ 	baseReg := operands at: 2.
- 	baseReg := self concreteRegister: (operands at: 2).
  	self is12BitValue: offset
  		ifTrue:
  			[ :u :immediate | 
  			self machineCodeAt: 0 "strb 	srcReg, [baseReg, #immediate]"
  				put: (self strb: srcReg rn: baseReg plus: u imm: immediate).
  			^machineCodeSize := 4]
  		ifFalse:
  			[(self isAddressRelativeToVarBase: offset)
  				ifTrue:
  					[self machineCodeAt: 0 put: (self adds: ConcreteIPReg rn: ConcreteVarBaseReg imm: offset - cogit varBaseAddress ror: 0).
  					 instrOffset := 4]
  				ifFalse:
  					[instrOffset := self moveCw: offset intoR: ConcreteIPReg].
  			"strb 	srcReg, [baseReg, ConcreteIPReg]"
  			self machineCodeAt: instrOffset put: (self strb: srcReg rn: baseReg rm: ConcreteIPReg).
  			^machineCodeSize := instrOffset + 4 ].
  	^0 "to keep Slang happy"!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeMoveRMwr (in category 'generate machine code - concretize') -----
  concretizeMoveRMwr
  	"Will get inlined into concretizeAt: switch."
  	<var: #offset type: #sqInt>
  	<inline: true>
  	| srcReg offset baseReg instrOffset|
+ 	srcReg := operands at: 0.
- 	srcReg := self concreteRegister: (operands at: 0).
  	offset := operands at: 1.
+ 	baseReg := operands at: 2.
- 	baseReg := self concreteRegister: (operands at: 2).
  	self is12BitValue: offset
  		ifTrue:
  			[ :u :immediate | 
  			self machineCodeAt: 0  "str 	srcReg, [baseReg, #immediate]"
  				put: (self str: srcReg rn: baseReg plus: u imm: immediate).
  			^machineCodeSize := 4]
  		ifFalse:
  			[instrOffset := self moveCw: offset intoR: ConcreteIPReg.
  			"str srcReg, [baseReg, ConcreteIPReg]"
  			self machineCodeAt: instrOffset put: (self str: srcReg rn: baseReg rm: ConcreteIPReg).
  			^machineCodeSize := instrOffset + 4].
  	^0 "to keep Slang happy"!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeMoveRR (in category 'generate machine code - concretize') -----
  concretizeMoveRR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| srcReg destReg |
+ 	srcReg := operands at: 0.
+ 	destReg := operands at: 1.
- 	srcReg := self concreteRegister: (operands at: 0).
- 	destReg := self concreteRegister: (operands at: 1).
  	"cond 000 1101 0 0000 dest 0000 0000 srcR"
  	self machineCodeAt: 0 put: (self mov: destReg rn: srcReg).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeMoveRXbrR (in category 'generate machine code - concretize') -----
  concretizeMoveRXbrR
  	"Will get inlined into concretizeAt: switch."
  	"Write the word in R(src) into memory at address (base+1*index)"
  	<inline: true>
  	| index base src |
+ 	src := operands at: 0.
+ 	index := operands at: 1.
+ 	base := operands at: 2.
- 	src := self concreteRegister: (operands at: 0).
- 	index := self concreteRegister: (operands at: 1).
- 	base := self concreteRegister: (operands at: 2).
  	"str	b	src, [base, +index, LSL #0]"
  	"cond 011 1100 0 base srcR 00000 00 0 index"
  	self machineCodeAt: 0 put: (self strb: src rn: base rm: index).
  	^machineCodeSize := 4!

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 := operands at: 0.
+ 	index := operands at: 1. "index is number of *words* = 4* bytes"
+ 	base := operands at: 2.
- 	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).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeMoveRdM64r (in category 'generate machine code - concretize') -----
  concretizeMoveRdM64r
  	"Will get inlined into concretizeAt: switch."	
  	<inline: true>
  	"Store FP fpReg to dstReg+offset"
  	| dstReg offset fpReg u|
  	offset := operands at: 1.
  	u := offset >0 ifTrue:[1] ifFalse:[0].
+ 	dstReg := operands at: 2.
+ 	fpReg := operands at: 0.
- 	dstReg := self concreteRegister: (operands at: 2).
- 	fpReg := self concreteDPFPRegister: (operands at: 0).
  	machineCode at: 0 put: (self fstd: fpReg rn: dstReg plus: u imm: offset>>2).
  	^machineCodeSize := 4
  !

Item was changed:
  ----- Method: CogARMCompiler>>concretizeMoveXbrRR (in category 'generate machine code - concretize') -----
  concretizeMoveXbrRR
  	"Will get inlined into concretizeAt: switch."
  	
  	<inline: true>
  	| index base dest |
+ 	index := operands at: 0. "index is number of *bytes*"
+ 	base := operands at: 1.
+ 	dest := operands at: 2.
- 	index := self concreteRegister: (operands at: 0). "index is number of *bytes*"
- 	base := self concreteRegister: (operands at: 1).
- 	dest := self concreteRegister: (operands at: 2).
  	"LDRB	dest, [base, +index, LSL #0]"
  	"cond 011 1100 1 base dest 00000 00 0 inde"
  	self machineCodeAt: 0 put: (self ldrb: dest rn: base rm: 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 := operands at: 0.
+ 	base := operands at: 1.
+ 	dest := operands at: 2.
- 	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).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeMulRdRd (in category 'generate machine code - concretize') -----
  concretizeMulRdRd
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	"FP multiply regLHS by regRHS and stick result in regLHS"
  	| regLHS regRHS |
+ 	regRHS := operands at: 0.
+ 	regLHS := operands at: 1.
- 	regRHS := self concreteDPFPRegister: (operands at: 0).
- 	regLHS := self concreteDPFPRegister: (operands at: 1).
  	machineCode at: 0 put:(self fmuld: regLHS with: regRHS).
  	^machineCodeSize := 4
  	!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeNegateR (in category 'generate machine code - concretize') -----
  concretizeNegateR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| reg |
+ 	reg := operands at: 0.
- 	reg := self concreteRegister: (operands at: 0).
  	"RSB destReg, srcReg, #0"
  	self machineCodeAt: 0 put: (self type: 1 op: RsbOpcode set: 0 rn: reg rd: reg).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeNegateableDataOperationCqR: (in category 'generate machine code - concretize') -----
  concretizeNegateableDataOperationCqR: armOpcode
  	"Will get inlined into concretizeAt: switch."
  	"4 == Add, 2 == Sub, 10 = Cmp"
  	<inline: true>
  	| val rd rn |
  	val := operands at: 0.
+ 	rn := operands at: 1.
- 	rn := self concreteRegister: (operands at: 1).
  	"Extra note - if ever a version of this code wants to NOT set the Set flag
  	 - Cmp must always have it set or it will pretend to be a SMALALBT and Very Bad Things might happen."
  	rd := opcode = CmpOpcode ifTrue: [0] ifFalse: [rn].
  
  	self rotateable8bitSignedImmediate: val 
  		ifTrue:
  			[:rot :immediate : negate|
  			self machineCodeAt: 0
  				put: (self
  						type: 1
  						op: (negate ifTrue: [self inverseOpcodeFor: armOpcode] ifFalse: [armOpcode])
  						set: 1
  						rn: rn
  						rd: rd
  						shifterOperand: (rot >> 1"in this usage we have to halve the rot value" << 8 bitOr: immediate)).
  			^machineCodeSize := 4]
  		ifFalse: "let's try to see if the constant can be made from a simple shift of 0xFFFFFFFF"
  			[val > 0 ifTrue:
  				[| hb |
  				hb := val highBit.
  				1 << hb = (val +1) ifTrue: "MVN temp,  #0, making 0xffffffff"
  					[self machineCodeAt: 0 put:(self mvn: ConcreteIPReg imm: 0 ror: 0).
  					 "Then armOpcode reg, temp reg, lsr #(32-hb)"
  					 self machineCodeAt: 4 put:(self dataOpType: armOpcode rd: rd  rn: rn rm: ConcreteIPReg lsr: 32 - hb).
  					^machineCodeSize := 8]].
  			 ^self concretizeDataOperationCwR: armOpcode].
  	^0 "to keep Slang happy"!

Item was changed:
  ----- Method: CogARMCompiler>>concretizePopR (in category 'generate machine code - concretize') -----
  concretizePopR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| destReg |
+ 	destReg := operands at: 0.
- 	destReg := self concreteRegister: (operands at: 0).
  	"LDR destReg, [SP], #4"
  	self machineCodeAt: 0 put: (self popR: destReg).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogARMCompiler>>concretizePushR (in category 'generate machine code - concretize') -----
  concretizePushR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| srcReg |
+ 	srcReg := operands at: 0.
- 	srcReg := self concreteRegister: (operands at: 0).
  	"cond | 010 | 1001 | 0 | -Rn- | -Rd- | 0000 0000 0100" "STR srcReg, [sp, #-4]"
  	self machineCodeAt: 0 put: (self pushR: srcReg).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeSMULL (in category 'generate machine code - concretize') -----
  concretizeSMULL
  	| srcA srcB hiResultReg loResultReg |
  	"Generate an SMULL loResultReg, hiResultReg, srcA, srcB instruction"
+ 	srcA := operands at: 0.
- 	srcA := self concreteRegister: (operands at: 0).
  	"NOTE: srcB contains the other mutiplicand at this point. It is OK to use it as the destination for the low part of the result and in fact this saves us moving it later"
+ 	loResultReg := srcB := operands at: 1.
+ 	hiResultReg := RISCTempReg.
- 	loResultReg := srcB := self concreteRegister: (operands at: 1).
- 	hiResultReg := self concreteRegister: RISCTempReg.
  	self machineCodeAt: 0
  		put: (self type: 0 op: 6 set: 0 rn: hiResultReg rd: loResultReg)
  			+ (srcA << 8)
  			+ (9 << 4)
  			+ srcB.
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeSqrtRd (in category 'generate machine code - concretize') -----
  concretizeSqrtRd
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	"Square root of FP regLHS into regLHS"
  	| regLHS  |
+ 	regLHS := operands at: 1.
- 	regLHS := self concreteDPFPRegister: (operands at: 1).
  	machineCode at: 0 put:(self fsqrtd: regLHS).
  	^machineCodeSize := 4
  	!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeSubCqR (in category 'generate machine code - concretize') -----
  concretizeSubCqR
  	"Will get inlined into concretizeAt: switch."
  	"Try whether the quick constant is a small negative number. If it is, optimize."
  	<var: #word type: #sqInt>
  	<inline: true>
  	| word |
  	word := operands at: 0.
  	self rotateable8bitImmediate: word
  		ifTrue: [ :rot :immediate | | reg |
+ 			reg := operands at: 1.
- 			reg := self concreteRegister: (operands at: 1).
  			self machineCodeAt: 0 put: (self subs: reg rn: reg imm: immediate ror: rot).
  			^machineCodeSize := 4]
  		ifFalse: [
  			"before building a full load of a big constant, see if we can do an add of the constant negated"
  			self rotateable8bitImmediate: word negated
  				ifTrue: [ :rot :immediate | | reg |
+ 					reg := operands at: 1.
- 					reg := self concreteRegister: (operands at: 1).
  					self machineCodeAt: 0 put: (self adds: reg rn: reg imm: immediate ror: rot).
  					^machineCodeSize := 4]
  				ifFalse: [^self concretizeDataOperationCwR: SubOpcode]].
  	^0 "to keep Slang happy"!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeSubRdRd (in category 'generate machine code - concretize') -----
  concretizeSubRdRd
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| regLHS regRHS |
  	"Subtract FP regRHS from FP regLHS and leave the result in FP regLHS"
+ 	regRHS := operands at: 0.
+ 	regLHS := operands at: 1.
- 	regRHS := self concreteDPFPRegister: (operands at: 0).
- 	regLHS := self concreteDPFPRegister: (operands at: 1).
  	machineCode at: 0 put:(self fsubd: regLHS with: regRHS).
  	^machineCodeSize := 4
  	!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeTstCqR (in category 'generate machine code - concretize') -----
  concretizeTstCqR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	self rotateable8bitImmediate: (operands at: 0)
  		ifTrue: [ :rot :immediate | | reg |
+ 			reg := operands at: 1.
- 			reg := self concreteRegister: (operands at: 1).
  			self machineCodeAt: 0 put: (self tst: reg rn: reg imm: immediate ror: rot).
  			^machineCodeSize := 4]
  		ifFalse: [^self concretizeDataOperationCwR: TstOpcode].
  	^0 "to keep Slang happy"!

Item was changed:
  ----- Method: CogARMCompiler>>genDivR:R:Quo:Rem: (in category 'abstract instructions') -----
  genDivR: abstractRegDivisor R: abstractRegDividend Quo: abstractRegQuotient Rem: abstractRegRemainder
  "Currently no instruction level support for divide on ARM. See also #canDivQuoRem"
  	| rDividend rDivisor rQuotient rRemainder divRemFunctionAddr |
  	<var: #divRemFunctionAddr type: #usqInt>
  	self assert: abstractRegDividend ~= abstractRegDivisor.
  	self assert: abstractRegQuotient ~= abstractRegRemainder.
+ 	rDividend := abstractRegDividend.
+ 	rDivisor := abstractRegDivisor.
- 	rDividend := self concreteRegister: abstractRegDividend.
- 	rDivisor := self concreteRegister: abstractRegDivisor.
  	rDividend = CArg0Reg ifFalse:[
  		"we need to move the value in rDividend to CArg0Reg. Best to double check if rDivisor is already using it first"
  		rDivisor = CArg0Reg ifTrue:[ "oh dear; we also need to move rDivisor's value out of the way first.. I'll move it to CArg1Reg and if some nitwit has managed to put rDividend there they deserve the crash"
  			rDividend = CArg1Reg ifTrue:[self error: 'register choices in genDivR:R:Quo:Rem: made life impossible'].
  			cogit MoveR: rDivisor R: CArg1Reg.
  			"and update rDivisor or we get buggerd by the next clause"
  			rDivisor := CArg1Reg].
  		cogit MoveR: rDividend R: CArg0Reg.
  	].
  	rDivisor = CArg1Reg ifFalse:[
  		cogit MoveR: rDivisor R: CArg1Reg].
  	divRemFunctionAddr := self aeabiDivModFunctionAddr.
  	cogit backEnd saveAndRestoreLinkRegAround:
  		[cogit CallFullRT: (self cCode: [divRemFunctionAddr asUnsignedInteger]
  					   inSmalltalk: [cogit simulatedTrampolineFor: divRemFunctionAddr])].
  	"Now we need to move the r0/1 results back to rQuotient & rRemainder"
+ 	rQuotient := abstractRegQuotient.
+ 	rRemainder := abstractRegRemainder.
- 	rQuotient := self concreteRegister: abstractRegQuotient.
- 	rRemainder := self concreteRegister: abstractRegRemainder.
  	rQuotient = CArg0Reg ifFalse:["oh good grief, not again"
  		cogit MoveR: CArg0Reg R: rQuotient.
  		rQuotient = CArg1Reg ifTrue:[self error: 'register choices in genDivR:R:Quo:Rem: made life impossible'] ].
  	rRemainder = CArg1Reg  ifFalse:[
  		cogit MoveR: CArg1Reg R: rRemainder].
  	
  				
  !

Item was removed:
- ----- Method: CogAbstractInstruction class>>isConcreteRISCTempRegister: (in category 'testing') -----
- isConcreteRISCTempRegister: concreteRegister
- 	"For tests to filter-out bogus values left in the ConcreteRISCTempRegister, if any."
- 	^self subclassResponsibility!

Item was added:
+ ----- Method: CogAbstractInstruction class>>isRISCTempRegister: (in category 'testing') -----
+ isRISCTempRegister: reg
+ 	"For tests to filter-out bogus values left in the RISCTempRegister, if any."
+ 	^self subclassResponsibility!

Item was removed:
- ----- Method: CogAbstractInstruction>>abstractRegisterForConcreteRegister: (in category 'private') -----
- abstractRegisterForConcreteRegister: reg
- 	<inline: true>
- 	self cCode: [] inSmalltalk: [self assert: reg isInteger].
- 	^reg!

Item was changed:
  ----- Method: CogAbstractInstruction>>cResultRegister (in category 'accessing') -----
  cResultRegister
+ 	"Answer the register through which C funcitons return integral results."
+ 	<inline: true>
- 	"Answer the abstract register for the C result register.
- 	 Only partially implemented (there is as yet no CResultReg abstract reg).
- 	 Works on x86 since TempReg = EAX = C result reg."
  	self subclassResponsibility!

Item was removed:
- ----- Method: CogAbstractInstruction>>concreteDPFPRegister: (in category 'encoding') -----
- concreteDPFPRegister: reg
- 	<inline: true>
- 	self cCode: [] inSmalltalk: [self assert: reg isInteger].
- 	^reg!

Item was removed:
- ----- Method: CogAbstractInstruction>>concreteRegister: (in category 'private') -----
- concreteRegister: reg
- 	<inline: true>
- 	self cCode: [] inSmalltalk: [self assert: reg isInteger].
- 	^reg!

Item was changed:
  CogAbstractInstruction subclass: #CogIA32Compiler
  	instanceVariableNames: ''
+ 	classVariableNames: 'CDQ CMPXCHGAwR CMPXCHGMwrR CPUID EAX EBP EBX ECX EDI EDX ESI ESP IDIVR IMULRR LFENCE LOCK MFENCE ModReg ModRegInd ModRegIndDisp32 ModRegIndSIB ModRegRegDisp32 ModRegRegDisp8 SFENCE SIB1 SIB2 SIB4 SIB8 XCHGAwR XCHGMwrR XCHGRR XMM0L XMM1L XMM2L XMM3L XMM4L XMM5L XMM6L XMM7L'
- 	classVariableNames: 'CDQ CMPXCHGAwR CMPXCHGMwrR CPUID EAX EBP EBX ECX EDI EDX ESI ESP IDIVR IMULRR LFENCE LOCK MFENCE ModReg ModRegInd ModRegIndDisp32 ModRegIndSIB ModRegRegDisp32 ModRegRegDisp8 SFENCE SIB1 SIB2 SIB4 SIB8 XCHGAwR XCHGMwrR XCHGRR XMM0H XMM0L XMM1H XMM1L XMM2H XMM2L XMM3H XMM3L XMM4H XMM4L XMM5H XMM5L XMM6H XMM6L XMM7H XMM7L'
  	poolDictionaries: ''
  	category: 'VMMaker-JIT'!
  
  !CogIA32Compiler commentStamp: 'eem 9/14/2015 17:13' prior: 0!
  I generate IA32 (x86) instructions from CogAbstractInstructions.  For reference see
  1. IA-32 Intel® Architecture Software Developer's Manual Volume 2A: Instruction Set Reference, A-M
  2. IA-32 Intel® Architecture Software Developer's Manual Volume 2A: Instruction Set Reference, N-Z
  	http://www.intel.com/products/processor/manuals/
  (® is supposed to be the Unicode "registered  sign".
  
  This class does not take any special action to flush the instruction cache on instruction-modification, trusting that Intel and AMD processors correctly invalidate the instruction cache via snooping.  According to the manuals, this will work on systems where code and data have the same virtual address.  The CogICacheFlushingIA32Compiler subclass exists to use the CPUID instruction to serialize instruction-modification for systems with code and data at different virtual addresses.!

Item was changed:
  ----- Method: CogIA32Compiler class>>initialize (in category 'class initialization') -----
  initialize
  	"Initialize various IA32/x86 instruction-related constants.
  	 [1] IA-32 Intel® Architecture Software Developer's Manual Volume 2A: Instruction Set Reference, A-M"
  
  	"CogIA32Compiler initialize"
  
  	self ~~ CogIA32Compiler ifTrue: [^self].
  
  	"N.B. EAX ECX and EDX are caller-save (scratch) registers.
  		EBX ESI and EDI are callee-save; see concreteRegisterFor:"
  	EAX := 0.
  	ECX := 1.  "Were they completely mad or simply sadistic?"
  	EDX := 2.
  	EBX := 3.
  	ESP := 4.
  	EBP := 5.
  	ESI := 6.
  	EDI := 7.
  
  	XMM0L := 0.
+ 	XMM1L := 1.
+ 	XMM2L := 2.
+ 	XMM3L := 3.
+ 	XMM4L := 4.
+ 	XMM5L := 5.
+ 	XMM6L := 6.
+ 	XMM7L := 7.
- 	XMM1L := 2.
- 	XMM2L := 4.
- 	XMM3L := 6.
- 	XMM4L := 8.
- 	XMM5L := 10.
- 	XMM6L := 12.
- 	XMM7L := 14.
  
- 	XMM0H := 1.
- 	XMM1H := 3.
- 	XMM2H := 5.
- 	XMM3H := 7.
- 	XMM4H := 9.
- 	XMM5H := 11.
- 	XMM6H := 13.
- 	XMM7H := 15.
- 
  	"Mod R/M Mod fields.  See [1] Sec 2.4, 2.5 & 2.6 & Table 2-2"
  	ModRegInd := 0.
  		ModRegIndSIB := 4.
  		ModRegIndDisp32 := 5.
  	ModRegRegDisp8 := 1.
  	ModRegRegDisp32 := 2.
  	ModReg := 3.
  
  	"SIB Scaled Index modes.  See [1] Sec 2.4, 2.5 & 2.6 & Table 2-3"
  	SIB1 := 0.
  	SIB2 := 1.
  	SIB4 := 2.
  	SIB8 := 3.
  
  	"Specific instructions"
  	self
  		initializeSpecificOpcodes: #(CDQ IDIVR IMULRR CPUID LFENCE MFENCE SFENCE LOCK CMPXCHGAwR CMPXCHGMwrR XCHGAwR XCHGMwrR XCHGRR)
  		in: thisContext method!

Item was removed:
- ----- Method: CogIA32Compiler class>>isConcreteRISCTempRegister: (in category 'testing') -----
- isConcreteRISCTempRegister: concreteRegister
- 	"For tests to filter-out bogus values left in the ConcreteRISCTempRegister, if any."
- 	^false!

Item was added:
+ ----- Method: CogIA32Compiler class>>isRISCTempRegister: (in category 'testing') -----
+ isRISCTempRegister: reg
+ 	"For tests to filter-out bogus values left in the RISCTempRegister, if any."
+ 	^false!

Item was changed:
  ----- Method: CogIA32Compiler>>cResultRegister (in category 'accessing') -----
  cResultRegister
+ 	"Answer the register through which C funcitons return integral results."
+ 	<inline: true>
+ 	^EAX!
- 	"Answer the abstract register for the C result register.
- 	 Only partially implemented.  Works on x86 since TempReg = EAX = C result reg."
- 	^self abstractRegisterForConcreteRegister: EAX!

Item was changed:
  ----- Method: CogIA32Compiler>>callerSavedRegisterMask (in category 'accessing') -----
  callerSavedRegisterMask
+ 	^cogit registerMaskFor: EAX and: ECX and: EDX!
- 	^cogit
- 		registerMaskFor: (self abstractRegisterForConcreteRegister: EAX)
- 		and: (self abstractRegisterForConcreteRegister: ECX)
- 		and: (self abstractRegisterForConcreteRegister: EDX)!

Item was changed:
  ----- Method: CogIA32Compiler>>computeMaximumSize (in category 'generate machine code') -----
  computeMaximumSize
  	"Compute the maximum size for each opcode.  This allows jump offsets to
  	 be determined, provided that all backward branches are long branches."
  	"N.B.  The ^N forms are to get around the bytecode compiler's long branch
  	 limits which are exceeded when each case jumps around the otherwise."
  	opcode caseOf: {
  		"Noops & Pseudo Ops"
  		[Label]					-> [^0].
  		[AlignmentNops]		-> [^(operands at: 0) - 1].
  		[Fill32]					-> [^4].
  		[Nop]					-> [^1].
  		"Specific Control/Data Movement"
  		[CDQ]					-> [^1].
  		[IDIVR]					-> [^2].
  		[IMULRR]				-> [^3].
  		[CPUID]					-> [^2].
  		[CMPXCHGAwR]			-> [^7].
+ 		[CMPXCHGMwrR]		-> [^(operands at: 1) = ESP
- 		[CMPXCHGMwrR]		-> [^(self concreteRegister: (operands at: 1)) = ESP
  										ifTrue: [(self isQuick: (operands at: 0)) ifTrue: [5] ifFalse: [8]]
  										ifFalse: [(self isQuick: (operands at: 0)) ifTrue: [4] ifFalse: [7]]].
  		[LFENCE]				-> [^3].
  		[MFENCE]				-> [^3].
  		[SFENCE]				-> [^3].
  		[LOCK]					-> [^1].
  		[XCHGAwR]				-> [^6].
+ 		[XCHGMwrR]			-> [^(operands at: 1) = ESP
- 		[XCHGMwrR]			-> [^(self concreteRegister: (operands at: 1)) = ESP
  										ifTrue: [(self isQuick: (operands at: 0)) ifTrue: [4] ifFalse: [7]]
  										ifFalse: [(self isQuick: (operands at: 0)) ifTrue: [3] ifFalse: [6]]].
+ 		[XCHGRR]				-> [^((operands at: 0) = EAX
+ 									   or: [(operands at: 1) = EAX])
- 		[XCHGRR]				-> [^((self concreteRegister: (operands at: 0)) = EAX
- 									   or: [(self concreteRegister: (operands at: 1)) = EAX])
  										ifTrue: [1]
  										ifFalse: [2]].
  		"Control"
  		[CallFull]					-> [^5].
  		[Call]						-> [^5].
  		[JumpR]						-> [^2].
  		[JumpFull]					-> [self resolveJumpTarget. ^5].
  		[JumpLong]					-> [self resolveJumpTarget. ^5].
  		[Jump]						-> [self resolveJumpTarget. ^5].
  		[JumpZero]					-> [self resolveJumpTarget. ^6].
  		[JumpNonZero]				-> [self resolveJumpTarget. ^6].
  		[JumpNegative]				-> [self resolveJumpTarget. ^6].
  		[JumpNonNegative]			-> [self resolveJumpTarget. ^6].
  		[JumpOverflow]				-> [self resolveJumpTarget. ^6].
  		[JumpNoOverflow]			-> [self resolveJumpTarget. ^6].
  		[JumpCarry]				-> [self resolveJumpTarget. ^6].
  		[JumpNoCarry]				-> [self resolveJumpTarget. ^6].
  		[JumpLess]					-> [self resolveJumpTarget. ^6].
  		[JumpGreaterOrEqual]		-> [self resolveJumpTarget. ^6].
  		[JumpGreater]				-> [self resolveJumpTarget. ^6].
  		[JumpLessOrEqual]			-> [self resolveJumpTarget. ^6].
  		[JumpBelow]				-> [self resolveJumpTarget. ^6].
  		[JumpAboveOrEqual]		-> [self resolveJumpTarget. ^6].
  		[JumpAbove]				-> [self resolveJumpTarget. ^6].
  		[JumpBelowOrEqual]		-> [self resolveJumpTarget. ^6].
  		[JumpLongZero]			-> [self resolveJumpTarget. ^6].
  		[JumpLongNonZero]		-> [self resolveJumpTarget. ^6].
  		[JumpFPEqual]				-> [self resolveJumpTarget. ^6].
  		[JumpFPNotEqual]			-> [self resolveJumpTarget. ^6].
  		[JumpFPLess]				-> [self resolveJumpTarget. ^6].
  		[JumpFPGreaterOrEqual]	-> [self resolveJumpTarget. ^6].
  		[JumpFPGreater]			-> [self resolveJumpTarget. ^6].
  		[JumpFPLessOrEqual]		-> [self resolveJumpTarget. ^6].
  		[JumpFPOrdered]			-> [self resolveJumpTarget. ^6].
  		[JumpFPUnordered]			-> [self resolveJumpTarget. ^6].
  		[RetN]						-> [^(operands at: 0) = 0 ifTrue: [1] ifFalse: [3]].
  		[Stop]						-> [^1].
  
  		"Arithmetic"
  		[AddCqR]		-> [^(self isQuick: (operands at: 0))
  											ifTrue: [3]
+ 											ifFalse: [(operands at: 1) = EAX
- 											ifFalse: [(self concreteRegister: (operands at: 1)) = EAX
  														ifTrue: [5]
  														ifFalse: [6]]].
  		[AndCqR]		-> [^(self isQuick: (operands at: 0))
  											ifTrue: [3]
+ 											ifFalse: [(operands at: 1) = EAX
- 											ifFalse: [(self concreteRegister: (operands at: 1)) = EAX
  														ifTrue: [5]
  														ifFalse: [6]]].
  		[CmpCqR]		-> [^(self isQuick: (operands at: 0))
  											ifTrue: [3]
+ 											ifFalse: [(operands at: 1) = EAX
- 											ifFalse: [(self concreteRegister: (operands at: 1)) = EAX
  														ifTrue: [5]
  														ifFalse: [6]]].
  		[OrCqR]			-> [^(self isQuick: (operands at: 0))
  											ifTrue: [3]
+ 											ifFalse: [(operands at: 1) = EAX
- 											ifFalse: [(self concreteRegister: (operands at: 1)) = EAX
  														ifTrue: [5]
  														ifFalse: [6]]].
  		[SubCqR]		-> [^(self isQuick: (operands at: 0))
  											ifTrue: [3]
+ 											ifFalse: [(operands at: 1) = EAX
- 											ifFalse: [(self concreteRegister: (operands at: 1)) = EAX
  														ifTrue: [5]
  														ifFalse: [6]]].
+ 		[TstCqR]		-> [^((self isQuick: (operands at: 0)) and: [(operands at: 1) < 4])
- 		[TstCqR]		-> [^((self isQuick: (operands at: 0)) and: [(self concreteRegister: (operands at: 1)) < 4])
  											ifTrue: [3]
+ 											ifFalse: [(operands at: 1) = EAX
- 											ifFalse: [(self concreteRegister: (operands at: 1)) = EAX
  														ifTrue: [5]
  														ifFalse: [6]]].
+ 		[AddCwR]		-> [^(operands at: 1) = EAX ifTrue: [5] ifFalse: [6]].
+ 		[AndCwR]		-> [^(operands at: 1) = EAX ifTrue: [5] ifFalse: [6]].
+ 		[CmpCwR]		-> [^(operands at: 1) = EAX ifTrue: [5] ifFalse: [6]].
+ 		[OrCwR]		-> [^(operands at: 1) = EAX ifTrue: [5] ifFalse: [6]].
+ 		[SubCwR]		-> [^(operands at: 1) = EAX ifTrue: [5] ifFalse: [6]].
+ 		[XorCwR]		-> [^(operands at: 1) = EAX ifTrue: [5] ifFalse: [6]].
- 		[AddCwR]		-> [^(self concreteRegister: (operands at: 1)) = EAX ifTrue: [5] ifFalse: [6]].
- 		[AndCwR]		-> [^(self concreteRegister: (operands at: 1)) = EAX ifTrue: [5] ifFalse: [6]].
- 		[CmpCwR]		-> [^(self concreteRegister: (operands at: 1)) = EAX ifTrue: [5] ifFalse: [6]].
- 		[OrCwR]		-> [^(self concreteRegister: (operands at: 1)) = EAX ifTrue: [5] ifFalse: [6]].
- 		[SubCwR]		-> [^(self concreteRegister: (operands at: 1)) = EAX ifTrue: [5] ifFalse: [6]].
- 		[XorCwR]		-> [^(self concreteRegister: (operands at: 1)) = EAX ifTrue: [5] ifFalse: [6]].
  		[AddRR]			-> [^2].
  		[AndRR]			-> [^2].
  		[CmpRR]		-> [^2].
  		[OrRR]			-> [^2].
  		[XorRR]			-> [^2].
  		[SubRR]			-> [^2].
  		[NegateR]		-> [^2].
  		[LoadEffectiveAddressMwrR]
  						-> [^((self isQuick: (operands at: 0))
  											ifTrue: [3]
  											ifFalse: [6])
+ 										+ ((operands at: 1) = ESP
- 										+ ((self concreteRegister: (operands at: 1)) = ESP
  											ifTrue: [1]
  											ifFalse: [0])].
  		[LogicalShiftLeftCqR]		-> [^(operands at: 0) = 1 ifTrue: [2] ifFalse: [3]].
  		[LogicalShiftRightCqR]		-> [^(operands at: 0) = 1 ifTrue: [2] ifFalse: [3]].
  		[ArithmeticShiftRightCqR]	-> [^(operands at: 0) = 1 ifTrue: [2] ifFalse: [3]].
  		[LogicalShiftLeftRR]			-> [^self computeShiftRRSize].
  		[LogicalShiftRightRR]		-> [^self computeShiftRRSize].
  		[ArithmeticShiftRightRR]		-> [^self computeShiftRRSize].
  		[AddRdRd]					-> [^4].
  		[CmpRdRd]					-> [^4].
  		[SubRdRd]					-> [^4].
  		[MulRdRd]					-> [^4].
  		[DivRdRd]					-> [^4].
  		[SqrtRd]					-> [^4].
  		"Data Movement"
  		[MoveCqR]		-> [^(operands at: 0) = 0 ifTrue: [2] ifFalse: [5]].
  		[MoveCwR]		-> [^5].
  		[MoveRR]		-> [^2].
  		[MoveRdRd]		-> [^4].
+ 		[MoveAwR]		-> [^(operands at: 1) = EAX ifTrue: [5] ifFalse: [6]].
+ 		[MoveRAw]		-> [^(operands at: 0) = EAX ifTrue: [5] ifFalse: [6]].
- 		[MoveAwR]		-> [^(self concreteRegister: (operands at: 1)) = EAX ifTrue: [5] ifFalse: [6]].
- 		[MoveRAw]		-> [^(self concreteRegister: (operands at: 0)) = EAX ifTrue: [5] ifFalse: [6]].
  		[MoveAbR]		-> [^7].
+ 		[MoveRAb]		-> [^(operands at: 0) = EAX ifTrue: [5] ifFalse: [6]].
- 		[MoveRAb]		-> [^(self concreteRegister: (operands at: 0)) = EAX ifTrue: [5] ifFalse: [6]].
  		[MoveRMwr]	-> [^((self isQuick: (operands at: 1))
  									ifTrue: [((operands at: 1) = 0
+ 											and: [(operands at: 2) ~= EBP])
- 											and: [(self concreteRegister: (operands at: 2)) ~= EBP])
  												ifTrue: [2]
  												ifFalse: [3]]
  									ifFalse: [6])
+ 								+ ((operands at: 2) = ESP
- 								+ ((self concreteRegister: (operands at: 2)) = ESP
  									ifTrue: [1]
  									ifFalse: [0])].
  		[MoveRdM64r]	-> [^((self isQuick: (operands at: 1))
  											ifTrue: [5]
  											ifFalse: [8])
+ 										+ ((operands at: 2) = ESP
- 										+ ((self concreteRegister: (operands at: 2)) = ESP
  											ifTrue: [1]
  											ifFalse: [0])].
+ 		[MoveMbrR]		-> [^(operands at: 1) = ESP
- 		[MoveMbrR]		-> [^(self concreteRegister: (operands at: 1)) = ESP
  								ifTrue: [(self isQuick: (operands at: 0)) ifTrue: [5] ifFalse: [8]]
  								ifFalse: [(self isQuick: (operands at: 0)) ifTrue: [4] ifFalse: [7]]].
+ 		[MoveRMbr]		-> [^(operands at: 2) = ESP
- 		[MoveRMbr]		-> [^(self concreteRegister: (operands at: 2)) = ESP
  								ifTrue: [7]
  								ifFalse: [(self isQuick: (operands at: 1)) ifTrue: [3] ifFalse: [6]]].
+ 		[MoveM16rR]	-> [^(operands at: 1) = ESP
- 		[MoveM16rR]	-> [^(self concreteRegister: (operands at: 1)) = ESP
  								ifTrue: [(self isQuick: (operands at: 0)) ifTrue: [5] ifFalse: [8]]
  								ifFalse: [(self isQuick: (operands at: 0)) ifTrue: [4] ifFalse: [7]]].
  		[MoveM64rRd]	-> [^((self isQuick: (operands at: 0))
  											ifTrue: [5]
  											ifFalse: [8])
+ 										+ ((operands at: 1) = ESP
- 										+ ((self concreteRegister: (operands at: 1)) = ESP
  											ifTrue: [1]
  											ifFalse: [0])].
  		[MoveMwrR]		-> [^((self isQuick: (operands at: 0))
  									ifTrue: [((operands at: 0) = 0
+ 											and: [(operands at: 1) ~= EBP])
- 											and: [(self concreteRegister: (operands at: 1)) ~= EBP])
  												ifTrue: [2]
  												ifFalse: [3]]
  									ifFalse: [6])
+ 								+ ((operands at: 1) = ESP
- 								+ ((self concreteRegister: (operands at: 1)) = ESP
  									ifTrue: [1]
  									ifFalse: [0])].
+ 		[MoveXbrRR]	-> [self assert: (operands at: 0) ~= ESP.
+ 							^(operands at: 1) = EBP
- 		[MoveXbrRR]	-> [self assert: (self concreteRegister: (operands at: 0)) ~= ESP.
- 							^(self concreteRegister: (operands at: 1)) = EBP
  											ifTrue: [5]
  											ifFalse: [4]].
+ 		[MoveRXbrR]	->	[self assert: (operands at: 1) ~= ESP.
+ 							^((operands at: 2) = EBP
- 		[MoveRXbrR]	->	[self assert: (self concreteRegister: (operands at: 1)) ~= ESP.
- 							^((self concreteRegister: (operands at: 2)) = EBP
  											ifTrue: [4]
  											ifFalse: [3])
+ 										+ ((operands at: 0) >= 4
- 										+ ((self concreteRegister: (operands at: 0)) >= 4
  											ifTrue: [2]
  											ifFalse: [0])].
+ 		[MoveXwrRR]	-> [self assert: (operands at: 0) ~= ESP.
+ 							^(operands at: 1) = EBP
- 		[MoveXwrRR]	-> [self assert: (self concreteRegister: (operands at: 0)) ~= ESP.
- 							^(self concreteRegister: (operands at: 1)) = EBP
  											ifTrue: [4]
  											ifFalse: [3]].
+ 		[MoveRXwrR]	-> [self assert: (operands at: 1) ~= ESP.
+ 							^(operands at: 2) = EBP
- 		[MoveRXwrR]	-> [self assert: (self concreteRegister: (operands at: 1)) ~= ESP.
- 							^(self concreteRegister: (operands at: 2)) = EBP
  											ifTrue: [4]
  											ifFalse: [3]].
  		[PopR]			-> [^1].
  		[PushR]			-> [^1].
  		[PushCq]		-> [^(self isQuick: (operands at: 0)) ifTrue: [2] ifFalse: [5]].
  		[PushCw]		-> [^5].
  		[PrefetchAw]	-> [^self hasSSEInstructions ifTrue: [7] ifFalse: [0]].
  		"Conversion"
  		[ConvertRRd]	-> [^4] }.
  	^0 "to keep C compiler quiet"!

Item was changed:
  ----- Method: CogIA32Compiler>>computeShiftRRSize (in category 'generate machine code') -----
  computeShiftRRSize
  	"On the x86 the only instructions that shift by the value of a
  	 register require the shift count to be  in %ecx.  So we may
  	 have to use swap instructions to get the count into ecx."
  	| shiftCountReg |
+ 	shiftCountReg := operands at: 0.
- 	shiftCountReg := self concreteRegister: (operands at: 0).
  	shiftCountReg = ECX ifTrue:
  		[^maxSize := 2].
  	^maxSize := shiftCountReg = EAX
  					ifTrue: [1 "XCHG EAX,r2" + 2 "Sxx" + 1 "XCHG EAX,r2"]
  					ifFalse: [2 "XCHG r1,r2" + 2 "Sxx" + 2 "XCHG r1,r2"]!

Item was changed:
  ----- Method: CogIA32Compiler>>concretizeAddCqR (in category 'generate machine code') -----
  concretizeAddCqR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| value reg |
  	value := operands at: 0.
+ 	reg := operands at: 1.
- 	reg := self concreteRegister: (operands at: 1).
  	(self isQuick: value) ifTrue:
  		[machineCode
  			at: 0 put: 16r83;
  			at: 1 put: (self mod: ModReg RM: reg RO: 0);
  			at: 2 put: (value bitAnd: 16rFF).
  		 ^machineCodeSize := 3].
  	reg = EAX ifTrue:
  		[machineCode
  			at: 0 put: 16r05;
  			at: 1 put: (value bitAnd: 16rFF);
  			at: 2 put: (value >> 8 bitAnd: 16rFF);
  			at: 3 put: (value >> 16 bitAnd: 16rFF);
  			at: 4 put: (value >> 24 bitAnd: 16rFF).
  		 ^machineCodeSize := 5].
  	machineCode
  		at: 0 put: 16r81;
  		at: 1 put: (self mod: ModReg RM: reg RO: 0);
  		at: 2 put: (value bitAnd: 16rFF);
  		at: 3 put: (value >> 8 bitAnd: 16rFF);
  		at: 4 put: (value >> 16 bitAnd: 16rFF);
  		at: 5 put: (value >> 24 bitAnd: 16rFF).
  	 ^machineCodeSize := 6!

Item was changed:
  ----- Method: CogIA32Compiler>>concretizeAddCwR (in category 'generate machine code') -----
  concretizeAddCwR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| value reg |
  	value := operands at: 0.
+ 	reg := operands at: 1.
- 	reg := self concreteRegister: (operands at: 1).
  	reg = EAX ifTrue:
  		[machineCode
  			at: 0 put: 16r05;
  			at: 1 put: (value bitAnd: 16rFF);
  			at: 2 put: (value >> 8 bitAnd: 16rFF);
  			at: 3 put: (value >> 16 bitAnd: 16rFF);
  			at: 4 put: (value >> 24 bitAnd: 16rFF).
  		 ^machineCodeSize := 5].
  	machineCode
  		at: 0 put: 16r81;
  		at: 1 put: (self mod: ModReg RM: reg RO: 0);
  		at: 2 put: (value bitAnd: 16rFF);
  		at: 3 put: (value >> 8 bitAnd: 16rFF);
  		at: 4 put: (value >> 16 bitAnd: 16rFF);
  		at: 5 put: (value >> 24 bitAnd: 16rFF).
  	 ^machineCodeSize := 6!

Item was changed:
  ----- Method: CogIA32Compiler>>concretizeAndCqR (in category 'generate machine code') -----
  concretizeAndCqR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| mask reg |
  	mask := operands at: 0.
+ 	reg := operands at: 1.
- 	reg := self concreteRegister: (operands at: 1).
  	(self isQuick: mask) ifTrue:
  		[machineCode
  			at: 0 put: 16r83;
  			at: 1 put: (self mod: ModReg RM: reg RO: 4);
  			at: 2 put: (mask bitAnd: 16rFF).
  		 ^machineCodeSize := 3].
  	reg = EAX ifTrue:
  		[machineCode
  			at: 0 put: 16r25;
  			at: 1 put: (mask bitAnd: 16rFF);
  			at: 2 put: (mask >> 8 bitAnd: 16rFF);
  			at: 3 put: (mask >> 16 bitAnd: 16rFF);
  			at: 4 put: (mask >> 24 bitAnd: 16rFF).
  		 ^machineCodeSize := 5].
  	machineCode
  		at: 0 put: 16r81;
  		at: 1 put: (self mod: ModReg RM: reg RO: 4);
  		at: 2 put: (mask bitAnd: 16rFF);
  		at: 3 put: (mask >> 8 bitAnd: 16rFF);
  		at: 4 put: (mask >> 16 bitAnd: 16rFF);
  		at: 5 put: (mask >> 24 bitAnd: 16rFF).
  	 ^machineCodeSize := 6!

Item was changed:
  ----- Method: CogIA32Compiler>>concretizeAndCwR (in category 'generate machine code') -----
  concretizeAndCwR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| value reg |
  	value := operands at: 0.
+ 	reg := operands at: 1.
- 	reg := self concreteRegister: (operands at: 1).
  	reg = EAX ifTrue:
  		[machineCode
  			at: 0 put: 16r25;
  			at: 1 put: (value bitAnd: 16rFF);
  			at: 2 put: (value >> 8 bitAnd: 16rFF);
  			at: 3 put: (value >> 16 bitAnd: 16rFF);
  			at: 4 put: (value >> 24 bitAnd: 16rFF).
  		 ^machineCodeSize := 5].
  	machineCode
  		at: 0 put: 16r83;
  		at: 1 put: (self mod: ModReg RM: reg RO: 4);
  		at: 2 put: (value bitAnd: 16rFF);
  		at: 3 put: (value >> 8 bitAnd: 16rFF);
  		at: 4 put: (value >> 16 bitAnd: 16rFF);
  		at: 5 put: (value >> 24 bitAnd: 16rFF).
  	 ^machineCodeSize := 6!

Item was changed:
  ----- Method: CogIA32Compiler>>concretizeArithmeticShiftRightCqR (in category 'generate machine code') -----
  concretizeArithmeticShiftRightCqR
  	<inline: true>
  	| shiftCount reg |
  	shiftCount := (operands at: 0) min: 31.
+ 	reg := operands at: 1.
- 	reg := self concreteRegister: (operands at: 1).
  	shiftCount = 1 ifTrue:
  		[machineCode
  			at: 0 put: 16rD1;
  			at: 1 put: (self mod: ModReg RM: reg RO: 7).
  		^machineCodeSize := 2].
  
  	machineCode
  		at: 0 put: 16rC1;
  		at: 1 put: (self mod: ModReg RM: reg RO: 7);
  		at: 2 put: shiftCount.
  	^machineCodeSize := 3!

Item was changed:
  ----- Method: CogIA32Compiler>>concretizeArithmeticShiftRightRR (in category 'generate machine code') -----
  concretizeArithmeticShiftRightRR
  	"On the x86 the only instructions that shift by the value of a
  	 register require the shift count to be  in %ecx.  So we may
  	 have to use swap instructions to get the count into %ecx."
  	<inline: true>
  	| shiftCountReg destReg regToShift |
+ 	shiftCountReg := operands at: 0.
+ 	destReg := operands at: 1.
- 	shiftCountReg := self concreteRegister: (operands at: 0).
- 	destReg := self concreteRegister: (operands at: 1).
  	shiftCountReg = ECX ifTrue:
  		[machineCode
  			at: 0 put: 16rD3;
  			at: 1 put: (self mod: ModReg RM: destReg RO: 7).
  		 ^machineCodeSize := 2].
  	regToShift := destReg == shiftCountReg
  					ifTrue: [ECX]
  					ifFalse: [destReg = ECX
  								ifTrue: [shiftCountReg]
  								ifFalse: [destReg]].
  	shiftCountReg = EAX ifTrue:
  		[machineCode
  			at: 0 put: 16r90 + ECX; "XCHG EAX,ECX"
  			at: 1 put: 16rD3;			"SAR ECX,EAX"
  			at: 2 put: (self mod: ModReg RM: regToShift RO: 7);
  			at: 3 put: 16r90 + ECX. "XCHG EAX,ECX"
  		 ^machineCodeSize := 4].
  	machineCode
  		at: 0 put: 16r87;		"XCHG E?X,ECX"
  		at: 1 put: (self mod: ModReg RM: ECX RO: shiftCountReg);
  		at: 2 put: 16rD3;		"SAR ECX,E!!X"
  		at: 3 put: (self mod: ModReg RM: regToShift RO: 7);
  		at: 4 put: 16r87;		"XCHG E?X,ECX"
  		at: 5 put: (self mod: ModReg RM: ECX RO: shiftCountReg).
  	^machineCodeSize := 6!

Item was changed:
  ----- Method: CogIA32Compiler>>concretizeCMPXCHGAwR (in category 'generate machine code') -----
  concretizeCMPXCHGAwR
  	<inline: true>
  	| addressOperand reg |
  	addressOperand := operands at: 0.
+ 	reg := operands at: 1.
- 	reg := self concreteRegister: (operands at: 1).
  	machineCode
  		at: 0 put: 16r0F;
  		at: 1 put: 16rB1;
  		at: 2 put: (self mod: ModRegInd RM: 5 RO: reg);
  		at: 3 put: (addressOperand bitAnd: 16rFF);
  		at: 4 put: (addressOperand >> 8 bitAnd: 16rFF);
  		at: 5 put: (addressOperand >> 16 bitAnd: 16rFF);
  		at: 6 put: (addressOperand >> 24 bitAnd: 16rFF).
  	^machineCodeSize := 7!

Item was changed:
  ----- Method: CogIA32Compiler>>concretizeCMPXCHGMwrR (in category 'generate machine code') -----
  concretizeCMPXCHGMwrR
  	<inline: true>
  	| srcReg offset destReg |
  	offset := operands at: 0.
+ 	srcReg := operands at: 1.
+ 	destReg := operands at: 2.
- 	srcReg := self concreteRegister: (operands at: 1).
- 	destReg := self concreteRegister: (operands at: 2).
  	srcReg ~= ESP ifTrue:
  		[(self isQuick: offset) ifTrue:
  			[machineCode
  				at: 0 put: 16r0F;
  				at: 1 put: 16rB1;
  				at: 2 put: (self mod: ModRegRegDisp8 RM: srcReg RO: destReg);
  				at: 3 put: (offset bitAnd: 16rFF).
  			 ^machineCodeSize := 4].
  		machineCode
  			at: 0 put: 16r0F;
  			at: 1 put: 16rB1;
  			at: 2 put: (self mod: ModRegRegDisp32 RM: srcReg RO: destReg);
  			at: 3 put: (offset bitAnd: 16rFF);
  			at: 4 put: (offset >> 8 bitAnd: 16rFF);
  			at: 5 put: (offset >> 16 bitAnd: 16rFF);
  			at: 6 put: (offset >> 24 bitAnd: 16rFF).
  		^machineCodeSize := 7].
  	"ESP:"
  	(self isQuick: offset) ifTrue:
  		[machineCode
  			at: 0 put: 16r0F;
  			at: 1 put: 16rB1;
  			at: 2 put: (self mod: ModRegRegDisp8 RM: srcReg RO: destReg);
  			at: 3 put: (self s: SIB1 i: 4 b: srcReg);
  			at: 4 put: (offset bitAnd: 16rFF).
  		 ^machineCodeSize := 5].
  	machineCode
  		at: 0 put: 16r0F;
  		at: 1 put: 16rB1;
  		at: 2 put: (self mod: ModRegRegDisp32 RM: srcReg RO: destReg);
  		at: 3 put: (self s: SIB1 i: 4 b: srcReg);
  		at: 4 put: (offset bitAnd: 16rFF);
  		at: 5 put: (offset >> 8 bitAnd: 16rFF);
  		at: 6 put: (offset >> 16 bitAnd: 16rFF);
  		at: 7 put: (offset >> 24 bitAnd: 16rFF).
  	^machineCodeSize := 8!

Item was changed:
  ----- Method: CogIA32Compiler>>concretizeCmpCqR (in category 'generate machine code') -----
  concretizeCmpCqR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| value reg |
  	value := operands at: 0.
+ 	reg := operands at: 1.
- 	reg := self concreteRegister: (operands at: 1).
  	(self isQuick: value) ifTrue:
  		[machineCode
  			at: 0 put: 16r83;
  			at: 1 put: (self mod: ModReg RM: reg RO: 7);
  			at: 2 put: (value bitAnd: 16rFF).
  		 ^machineCodeSize := 3].
  	reg = EAX ifTrue:
  		[machineCode
  			at: 0 put: 16r3D;
  			at: 1 put: (value bitAnd: 16rFF);
  			at: 2 put: (value >> 8 bitAnd: 16rFF);
  			at: 3 put: (value >> 16 bitAnd: 16rFF);
  			at: 4 put: (value >> 24 bitAnd: 16rFF).
  		 ^machineCodeSize := 5].
  	machineCode
  		at: 0 put: 16r81;
  		at: 1 put: (self mod: ModReg RM: reg RO: 7);
  		at: 2 put: (value bitAnd: 16rFF);
  		at: 3 put: (value >> 8 bitAnd: 16rFF);
  		at: 4 put: (value >> 16 bitAnd: 16rFF);
  		at: 5 put: (value >> 24 bitAnd: 16rFF).
  	 ^machineCodeSize := 6!

Item was changed:
  ----- Method: CogIA32Compiler>>concretizeCmpCwR (in category 'generate machine code') -----
  concretizeCmpCwR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| value reg |
  	value := operands at: 0.
+ 	reg := operands at: 1.
- 	reg := self concreteRegister: (operands at: 1).
  	reg = EAX ifTrue:
  		[machineCode
  			at: 0 put: 16r3D;
  			at: 1 put: (value bitAnd: 16rFF);
  			at: 2 put: (value >> 8 bitAnd: 16rFF);
  			at: 3 put: (value >> 16 bitAnd: 16rFF);
  			at: 4 put: (value >> 24 bitAnd: 16rFF).
  		 ^machineCodeSize := 5].
  	machineCode
  		at: 0 put: 16r81;
  		at: 1 put: (self mod: ModReg RM: reg RO: 7);
  		at: 2 put: (value bitAnd: 16rFF);
  		at: 3 put: (value >> 8 bitAnd: 16rFF);
  		at: 4 put: (value >> 16 bitAnd: 16rFF);
  		at: 5 put: (value >> 24 bitAnd: 16rFF).
  	 ^machineCodeSize := 6!

Item was changed:
  ----- Method: CogIA32Compiler>>concretizeCmpRdRd (in category 'generate machine code') -----
  concretizeCmpRdRd
  	"Will get inlined into concretizeAt: switch.
  	 We use UCOMISD (see p 4-260 [2])"
  	<inline: true>
  	| regLHS regRHS |
  	"CmpRR RHS LHS computes LHS - RHS, i.e. apparently reversed.  You have to think subtract."
+ 	regRHS := operands at: 0.
+ 	regLHS := operands at: 1.
- 	regRHS := self concreteDPFPRegister: (operands at: 0).
- 	regLHS := self concreteDPFPRegister: (operands at: 1).
  	machineCode
  		at: 0 put: 16r66;
  		at: 1 put: 16r0F;
  		at: 2 put: 16r2E;
  		at: 3 put: (self mod: ModReg RM: regRHS RO: regLHS).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogIA32Compiler>>concretizeConvertRRd (in category 'generate machine code') -----
  concretizeConvertRRd
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| srcReg destReg |
+ 	srcReg := operands at:0.
+ 	destReg := operands at: 1.
- 	srcReg := self concreteRegister: (operands at:0).
- 	destReg := self concreteDPFPRegister: (operands at: 1).
  	machineCode
  		at: 0 put: 16rF2;
  		at: 1 put: 16r0F;
  		at: 2 put: 16r2A;
  		at: 3 put: (self mod: ModReg RM: srcReg RO: destReg).
  	 ^machineCodeSize := 4!

Item was changed:
  ----- Method: CogIA32Compiler>>concretizeIDIVR (in category 'generate machine code') -----
  concretizeIDIVR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| regDivisor |
+ 	regDivisor := operands at: 0.
- 	regDivisor := self concreteRegister: (operands at: 0).
  	machineCode
  		at: 0 put: 16rF7;
  		at: 1 put: (self mod: ModReg RM: regDivisor RO: 7).
  	^machineCodeSize := 2!

Item was changed:
  ----- Method: CogIA32Compiler>>concretizeJumpR (in category 'generate machine code') -----
  concretizeJumpR
  	<inline: true>
  	| reg |
+ 	reg := operands at: 0.
- 	reg := self concreteRegister: (operands at: 0).
  	machineCode
  		at: 0 put: 16rFF;
  		at: 1 put: (self mod: ModReg RM: reg RO: 4).
  	^machineCodeSize := 2!

Item was changed:
  ----- Method: CogIA32Compiler>>concretizeLoadEffectiveAddressMwrR (in category 'generate machine code') -----
  concretizeLoadEffectiveAddressMwrR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| srcReg offset destReg |
  	offset := operands at: 0.
+ 	srcReg := operands at: 1.
+ 	destReg := operands at: 2.
- 	srcReg := self concreteRegister: (operands at: 1).
- 	destReg := self concreteRegister: (operands at: 2).
  	srcReg ~= ESP ifTrue:
  		[(self isQuick: offset) ifTrue:
  			[machineCode
  				at: 0 put: 16r8D;
  				at: 1 put: (self mod: ModRegRegDisp8 RM: srcReg RO: destReg);
  				at: 2 put: (offset bitAnd: 16rFF).
  			 ^machineCodeSize := 3].
  		machineCode
  			at: 0 put: 16r8D;
  			at: 1 put: (self mod: ModRegRegDisp32 RM: srcReg RO: destReg);
  			at: 2 put: (offset bitAnd: 16rFF);
  			at: 3 put: (offset >> 8 bitAnd: 16rFF);
  			at: 4 put: (offset >> 16 bitAnd: 16rFF);
  			at: 5 put: (offset >> 24 bitAnd: 16rFF).
  		^machineCodeSize := 6].
  	"ESP:"
  	(self isQuick: offset) ifTrue:
  		[machineCode
  			at: 0 put: 16r8D;
  			at: 1 put: (self mod: ModRegRegDisp8 RM: srcReg RO: destReg);
  			at: 2 put: (self s: SIB1 i: 4 b: srcReg);
  			at: 3 put: (offset bitAnd: 16rFF).
  		 ^machineCodeSize := 4].
  	machineCode
  		at: 0 put: 16r8D;
  		at: 1 put: (self mod: ModRegRegDisp32 RM: srcReg RO: destReg);
  		at: 2 put: (self s: SIB1 i: 4 b: srcReg);
  		at: 3 put: (offset bitAnd: 16rFF);
  		at: 4 put: (offset >> 8 bitAnd: 16rFF);
  		at: 5 put: (offset >> 16 bitAnd: 16rFF);
  		at: 6 put: (offset >> 24 bitAnd: 16rFF).
  	^machineCodeSize := 7!

Item was changed:
  ----- Method: CogIA32Compiler>>concretizeLogicalShiftLeftCqR (in category 'generate machine code') -----
  concretizeLogicalShiftLeftCqR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| distance reg |
  	distance := (operands at: 0) min: 31.
+ 	reg := operands at: 1.
- 	reg := self concreteRegister: (operands at: 1).
  	distance = 1 ifTrue:
  		[machineCode
  			at: 0 put: 16rD1;
  			at: 1 put: (self mod: ModReg RM: reg RO: 4).
  		 ^machineCodeSize := 2].
  	machineCode
  		at: 0 put: 16rC1;
  		at: 1 put: (self mod: ModReg RM: reg RO: 4);
  		at: 2 put: distance.
  	^machineCodeSize := 3!

Item was changed:
  ----- Method: CogIA32Compiler>>concretizeLogicalShiftLeftRR (in category 'generate machine code') -----
  concretizeLogicalShiftLeftRR
  	<inline: true>
  	"On the x86 the only instructions that shift by the value of a
  	 register require the shift count to be  in %ecx.  So we may
  	 have to use swap instructions to get the count into %ecx."
  	| shiftCountReg destReg regToShift |
+ 	shiftCountReg := operands at: 0.
+ 	destReg := operands at: 1.
- 	shiftCountReg := self concreteRegister: (operands at: 0).
- 	destReg := self concreteRegister: (operands at: 1).
  	shiftCountReg = ECX ifTrue:
  		[machineCode
  			at: 0 put: 16rD3;
  			at: 1 put: (self mod: ModReg RM: destReg RO: 4).
  		 ^machineCodeSize := 2].
  	regToShift := destReg == shiftCountReg
  					ifTrue: [ECX]
  					ifFalse: [destReg = ECX
  								ifTrue: [shiftCountReg]
  								ifFalse: [destReg]].
  	shiftCountReg = EAX ifTrue:
  		[machineCode
  			at: 0 put: 16r90 + ECX; "XCHG EAX,ECX"
  			at: 1 put: 16rD3;			"SAR ECX,EAX"
  			at: 2 put: (self mod: ModReg RM: regToShift RO: 4);
  			at: 3 put: 16r90 + ECX. "XCHG EAX,ECX"
  		 ^machineCodeSize := 4].
  	machineCode
  		at: 0 put: 16r87;		"XCHG E?X,ECX"
  		at: 1 put: (self mod: ModReg RM: ECX RO: shiftCountReg);
  		at: 2 put: 16rD3;		"SAR ECX,E!!X"
  		at: 3 put: (self mod: ModReg RM: regToShift RO: 4);
  		at: 4 put: 16r87;		"XCHG E?X,ECX"
  		at: 5 put: (self mod: ModReg RM: ECX RO: shiftCountReg).
  	^machineCodeSize := 6!

Item was changed:
  ----- Method: CogIA32Compiler>>concretizeLogicalShiftRightCqR (in category 'generate machine code') -----
  concretizeLogicalShiftRightCqR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| distance reg |
  	distance := (operands at: 0) min: 31.
+ 	reg := operands at: 1.
- 	reg := self concreteRegister: (operands at: 1).
  	distance = 1 ifTrue:
  		[machineCode
  			at: 0 put: 16rD1;
  			at: 1 put: (self mod: ModReg RM: reg RO: 5).
  		 ^machineCodeSize := 2].
  	machineCode
  		at: 0 put: 16rC1;
  		at: 1 put: (self mod: ModReg RM: reg RO: 5);
  		at: 2 put: distance.
  	^machineCodeSize := 3!

Item was changed:
  ----- Method: CogIA32Compiler>>concretizeMoveAbR (in category 'generate machine code') -----
  concretizeMoveAbR
  	"N.B. we zero-extend because we state byteReadsZeroExtend."
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| addressOperand reg |
  	addressOperand := operands at: 0.
  	(self isAnInstruction: (cogit cCoerceSimple: addressOperand to: #'AbstractInstruction *')) ifTrue:
  		[addressOperand := (cogit cCoerceSimple: addressOperand to: #'AbstractInstruction *') address].
+ 	reg := operands at: 1.
- 	reg := self concreteRegister: (operands at: 1).
  	machineCode
  		at: 0 put: 16r0F;
  		at: 1 put: 16rB6;
  		at: 2 put: (self mod: ModRegInd RM: 5 RO: reg);
  		at: 3 put: (addressOperand bitAnd: 16rFF);
  		at: 4 put: (addressOperand >> 8 bitAnd: 16rFF);
  		at: 5 put: (addressOperand >> 16 bitAnd: 16rFF);
  		at: 6 put: (addressOperand >> 24 bitAnd: 16rFF).
  	^machineCodeSize := 7!

Item was changed:
  ----- Method: CogIA32Compiler>>concretizeMoveAwR (in category 'generate machine code') -----
  concretizeMoveAwR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| addressOperand reg |
  	addressOperand := operands at: 0.
  	(self isAnInstruction: (cogit cCoerceSimple: addressOperand to: #'AbstractInstruction *')) ifTrue:
  		[addressOperand := (cogit cCoerceSimple: addressOperand to: #'AbstractInstruction *') address].
+ 	reg := operands at: 1.
- 	reg := self concreteRegister: (operands at: 1).
  	reg = EAX ifTrue:
  		[machineCode
  			at: 0 put: 16rA1;
  			at: 1 put: (addressOperand bitAnd: 16rFF);
  			at: 2 put: (addressOperand >> 8 bitAnd: 16rFF);
  			at: 3 put: (addressOperand >> 16 bitAnd: 16rFF);
  			at: 4 put: (addressOperand >> 24 bitAnd: 16rFF).
  			^machineCodeSize := 5].
  	machineCode
  		at: 0 put: 16r8B;
  		at: 1 put: (self mod: ModRegInd RM: 5 RO: reg);
  		at: 2 put: (addressOperand bitAnd: 16rFF);
  		at: 3 put: (addressOperand >> 8 bitAnd: 16rFF);
  		at: 4 put: (addressOperand >> 16 bitAnd: 16rFF);
  		at: 5 put: (addressOperand >> 24 bitAnd: 16rFF).
  	^machineCodeSize := 6!

Item was changed:
  ----- Method: CogIA32Compiler>>concretizeMoveCqR (in category 'generate machine code') -----
  concretizeMoveCqR
  	"Will get inlined into concretizeAt: switch.
  	 Note that for quick constants, xor reg,reg, movq r8 may be shorter.  But
  	 we don't consider it worthwhile and so just provide concretizeMoveCwR."
  	<inline: true>
  	| reg |
  	(operands at: 0) ~= 0 ifTrue:
  		[^self concretizeMoveCwR].
+ 	reg := operands at: 1.
- 	reg := self concreteRegister: (operands at: 1).
  	machineCode
  		at: 0 put: 16r31;
  		at: 1 put: (self mod: ModReg RM: reg RO: reg).
  	^machineCodeSize := 2!

Item was changed:
  ----- Method: CogIA32Compiler>>concretizeMoveCwR (in category 'generate machine code') -----
  concretizeMoveCwR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| value |
  	value := operands at: 0.
  	machineCode
+ 		at: 0 put: 16rB8 + (operands at: 1);
- 		at: 0 put: 16rB8 + (self concreteRegister: (operands at: 1));
  		at: 1 put: (value bitAnd: 16rFF);
  		at: 2 put: (value >> 8 bitAnd: 16rFF);
  		at: 3 put: (value >> 16 bitAnd: 16rFF);
  		at: 4 put: (value >> 24 bitAnd: 16rFF).
  	^machineCodeSize := 5!

Item was changed:
  ----- Method: CogIA32Compiler>>concretizeMoveM16rR (in category 'generate machine code') -----
  concretizeMoveM16rR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| srcReg offset destReg |
  	offset := operands at: 0.
+ 	srcReg := operands at: 1.
+ 	destReg := operands at: 2.
- 	srcReg := self concreteRegister: (operands at: 1).
- 	destReg := self concreteRegister: (operands at: 2).
  	srcReg ~= ESP ifTrue:
  		[(self isQuick: offset) ifTrue:
  			[machineCode
  				at: 0 put: 16r0F;
  				at: 1 put: 16rB7;
  				at: 2 put: (self mod: ModRegRegDisp8 RM: srcReg RO: destReg);
  				at: 3 put: (offset bitAnd: 16rFF).
  			 ^machineCodeSize := 4].
  		machineCode
  			at: 0 put: 16r0F;
  			at: 1 put: 16rB7;
  			at: 2 put: (self mod: ModRegRegDisp32 RM: srcReg RO: destReg);
  			at: 3 put: (offset bitAnd: 16rFF);
  			at: 4 put: (offset >> 8 bitAnd: 16rFF);
  			at: 5 put: (offset >> 16 bitAnd: 16rFF);
  			at: 6 put: (offset >> 24 bitAnd: 16rFF).
  		^machineCodeSize := 7].
  	"ESP:"
  	(self isQuick: offset) ifTrue:
  		[machineCode
  			at: 0 put: 16r0F;
  			at: 1 put: 16rB7;
  			at: 2 put: (self mod: ModRegRegDisp8 RM: srcReg RO: destReg);
  			at: 3 put: (self s: SIB1 i: 4 b: srcReg);
  			at: 4 put: (offset bitAnd: 16rFF).
  		 ^machineCodeSize := 5].
  	machineCode
  		at: 0 put: 16r0F;
  		at: 1 put: 16rB7;
  		at: 2 put: (self mod: ModRegRegDisp32 RM: srcReg RO: destReg);
  		at: 3 put: (self s: SIB1 i: 4 b: srcReg);
  		at: 4 put: (offset bitAnd: 16rFF);
  		at: 5 put: (offset >> 8 bitAnd: 16rFF);
  		at: 6 put: (offset >> 16 bitAnd: 16rFF);
  		at: 7 put: (offset >> 24 bitAnd: 16rFF).
  	^machineCodeSize := 8!

Item was changed:
  ----- Method: CogIA32Compiler>>concretizeMoveM64rRd (in category 'generate machine code') -----
  concretizeMoveM64rRd
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| srcReg offset destReg |
  	offset := operands at: 0.
+ 	srcReg := operands at: 1.
+ 	destReg := operands at: 2.
- 	srcReg := self concreteRegister: (operands at: 1).
- 	destReg := self concreteDPFPRegister: (operands at: 2).
  	srcReg ~= ESP ifTrue:
  		[(self isQuick: offset) ifTrue:
  			[machineCode
  				at: 0 put: 16rF2;
  				at: 1 put: 16r0F;
  				at: 2 put: 16r10;
  				at: 3 put: (self mod: ModRegRegDisp8 RM: srcReg RO: destReg);
  				at: 4 put: (offset bitAnd: 16rFF).
  			 ^machineCodeSize := 5].
  		machineCode
  			at: 0 put: 16rF2;
  			at: 1 put: 16r0F;
  			at: 2 put: 16r10;
  			at: 3 put: (self mod: ModRegRegDisp32 RM: srcReg RO: destReg);
  			at: 4 put: (offset bitAnd: 16rFF);
  			at: 5 put: (offset >> 8 bitAnd: 16rFF);
  			at: 6 put: (offset >> 16 bitAnd: 16rFF);
  			at: 7 put: (offset >> 24 bitAnd: 16rFF).
  		^machineCodeSize := 8].
  	"ESP:"
  	(self isQuick: offset) ifTrue:
  		[machineCode
  			at: 0 put: 16rF2;
  			at: 1 put: 16r0F;
  			at: 2 put: 16r10;
  			at: 3 put: (self mod: ModRegRegDisp8 RM: srcReg RO: destReg);
  			at: 4 put: (self s: SIB1 i: 4 b: srcReg);
  			at: 5 put: (offset bitAnd: 16rFF).
  		 ^machineCodeSize := 6].
  	machineCode
  		at: 0 put: 16rF2;
  		at: 1 put: 16r0F;
  		at: 2 put: 16r10;
  		at: 3 put: (self mod: ModRegRegDisp32 RM: srcReg RO: destReg);
  		at: 4 put: (self s: SIB1 i: 4 b: srcReg);
  		at: 5 put: (offset bitAnd: 16rFF);
  		at: 6 put: (offset >> 8 bitAnd: 16rFF);
  		at: 7 put: (offset >> 16 bitAnd: 16rFF);
  		at: 8 put: (offset >> 24 bitAnd: 16rFF).
  	^machineCodeSize := 9!

Item was changed:
  ----- Method: CogIA32Compiler>>concretizeMoveMbrR (in category 'generate machine code') -----
  concretizeMoveMbrR
  	"N.B. we zero-extend because we state byteReadsZeroExtend."
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| srcReg offset destReg |
  	offset := operands at: 0.
+ 	srcReg := operands at: 1.
+ 	destReg := operands at: 2.
- 	srcReg := self concreteRegister: (operands at: 1).
- 	destReg := self concreteRegister: (operands at: 2).
  	srcReg ~= ESP ifTrue:
  		[(self isQuick: offset) ifTrue:
  			[machineCode
  				at: 0 put: 16r0f;
  				at: 1 put: 16rb6;
  				at: 2 put: (self mod: ModRegRegDisp8 RM: srcReg RO: destReg);
  				at: 3 put: (offset bitAnd: 16rFF).
  			 ^machineCodeSize := 4].
  		machineCode
  			at: 0 put: 16r0f;
  			at: 1 put: 16rb6;
  			at: 2 put: (self mod: ModRegRegDisp32 RM: srcReg RO: destReg);
  			at: 3 put: (offset bitAnd: 16rFF);
  			at: 4 put: (offset >> 8 bitAnd: 16rFF);
  			at: 5 put: (offset >> 16 bitAnd: 16rFF);
  			at: 6 put: (offset >> 24 bitAnd: 16rFF).
  		^machineCodeSize := 7].
  	"ESP:"
  	(self isQuick: offset) ifTrue:
  		[machineCode
  			at: 0 put: 16r0f;
  			at: 1 put: 16rb6;
  			at: 2 put: (self mod: ModRegRegDisp8 RM: srcReg RO: destReg);
  			at: 3 put: (self s: SIB1 i: 4 b: srcReg);
  			at: 4 put: (offset bitAnd: 16rFF).
  		 ^machineCodeSize := 5].
  	machineCode
  		at: 0 put: 16r0f;
  		at: 1 put: 16rb6;
  		at: 2 put: (self mod: ModRegRegDisp32 RM: srcReg RO: destReg);
  		at: 3 put: (self s: SIB1 i: 4 b: srcReg);
  		at: 4 put: (offset bitAnd: 16rFF);
  		at: 5 put: (offset >> 8 bitAnd: 16rFF);
  		at: 6 put: (offset >> 16 bitAnd: 16rFF);
  		at: 7 put: (offset >> 24 bitAnd: 16rFF).
  	^machineCodeSize := 8!

Item was changed:
  ----- Method: CogIA32Compiler>>concretizeMoveMwrR (in category 'generate machine code') -----
  concretizeMoveMwrR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| srcReg offset destReg |
  	offset := operands at: 0.
+ 	srcReg := operands at: 1.
+ 	destReg := operands at: 2.
- 	srcReg := self concreteRegister: (operands at: 1).
- 	destReg := self concreteRegister: (operands at: 2).
  	srcReg ~= ESP ifTrue:
  		[(offset = 0 and: [srcReg ~= EBP]) ifTrue:
  			[machineCode
  				at: 0 put: 16r8B;
  				at: 1 put: (self mod: ModRegInd RM: srcReg RO: destReg).
  			 ^machineCodeSize := 2].
  		(self isQuick: offset) ifTrue:
  			[machineCode
  				at: 0 put: 16r8B;
  				at: 1 put: (self mod: ModRegRegDisp8 RM: srcReg RO: destReg);
  				at: 2 put: (offset bitAnd: 16rFF).
  			 ^machineCodeSize := 3].
  		machineCode
  			at: 0 put: 16r8B;
  			at: 1 put: (self mod: ModRegRegDisp32 RM: srcReg RO: destReg);
  			at: 2 put: (offset bitAnd: 16rFF);
  			at: 3 put: (offset >> 8 bitAnd: 16rFF);
  			at: 4 put: (offset >> 16 bitAnd: 16rFF);
  			at: 5 put: (offset >> 24 bitAnd: 16rFF).
  		^machineCodeSize := 6].
  	"ESP:"
  	offset = 0 ifTrue:
  		[machineCode
  			at: 0 put: 16r8B;
  			at: 1 put: (self mod: ModRegInd RM: srcReg RO: destReg);
  			at: 2 put: (self s: SIB1 i: 4 b: srcReg).
  		 ^machineCodeSize := 3].
  	(self isQuick: offset) ifTrue:
  		[machineCode
  			at: 0 put: 16r8B;
  			at: 1 put: (self mod: ModRegRegDisp8 RM: srcReg RO: destReg);
  			at: 2 put: (self s: SIB1 i: 4 b: srcReg);
  			at: 3 put: (offset bitAnd: 16rFF).
  		 ^machineCodeSize := 4].
  	machineCode
  		at: 0 put: 16r8B;
  		at: 1 put: (self mod: ModRegRegDisp32 RM: srcReg RO: destReg);
  		at: 2 put: (self s: SIB1 i: 4 b: srcReg);
  		at: 3 put: (offset bitAnd: 16rFF);
  		at: 4 put: (offset >> 8 bitAnd: 16rFF);
  		at: 5 put: (offset >> 16 bitAnd: 16rFF);
  		at: 6 put: (offset >> 24 bitAnd: 16rFF).
  	^machineCodeSize := 7!

Item was changed:
  ----- Method: CogIA32Compiler>>concretizeMoveRAb (in category 'generate machine code') -----
  concretizeMoveRAb
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| addressOperand reg |
+ 	reg := operands at: 0.
- 	reg := self concreteRegister: (operands at: 0).
  	addressOperand := operands at: 1.
  	(self isAnInstruction: (cogit cCoerceSimple: addressOperand to: #'AbstractInstruction *')) ifTrue:
  		[addressOperand := (cogit cCoerceSimple: addressOperand to: #'AbstractInstruction *') address].
  	reg = EAX ifTrue:
  		[machineCode
  			at: 0 put: 16rA2;
  			at: 1 put: (addressOperand bitAnd: 16rFF);
  			at: 2 put: (addressOperand >> 8 bitAnd: 16rFF);
  			at: 3 put: (addressOperand >> 16 bitAnd: 16rFF);
  			at: 4 put: (addressOperand >> 24 bitAnd: 16rFF).
  			^machineCodeSize := 5].
  	machineCode
  		at: 0 put: 16r88;
  		at: 1 put: (self mod: ModRegInd RM: 5 RO: reg);
  		at: 2 put: (addressOperand bitAnd: 16rFF);
  		at: 3 put: (addressOperand >> 8 bitAnd: 16rFF);
  		at: 4 put: (addressOperand >> 16 bitAnd: 16rFF);
  		at: 5 put: (addressOperand >> 24 bitAnd: 16rFF).
  	^machineCodeSize := 6!

Item was changed:
  ----- Method: CogIA32Compiler>>concretizeMoveRAw (in category 'generate machine code') -----
  concretizeMoveRAw
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| addressOperand reg |
+ 	reg := operands at: 0.
- 	reg := self concreteRegister: (operands at: 0).
  	addressOperand := operands at: 1.
  	(self isAnInstruction: (cogit cCoerceSimple: addressOperand to: #'AbstractInstruction *')) ifTrue:
  		[addressOperand := (cogit cCoerceSimple: addressOperand to: #'AbstractInstruction *') address].
  	reg = EAX ifTrue:
  		[machineCode
  			at: 0 put: 16rA3;
  			at: 1 put: (addressOperand bitAnd: 16rFF);
  			at: 2 put: (addressOperand >> 8 bitAnd: 16rFF);
  			at: 3 put: (addressOperand >> 16 bitAnd: 16rFF);
  			at: 4 put: (addressOperand >> 24 bitAnd: 16rFF).
  			^machineCodeSize := 5].
  	machineCode
  		at: 0 put: 16r89;
  		at: 1 put: (self mod: ModRegInd RM: 5 RO: reg);
  		at: 2 put: (addressOperand bitAnd: 16rFF);
  		at: 3 put: (addressOperand >> 8 bitAnd: 16rFF);
  		at: 4 put: (addressOperand >> 16 bitAnd: 16rFF);
  		at: 5 put: (addressOperand >> 24 bitAnd: 16rFF).
  	^machineCodeSize := 6!

Item was changed:
  ----- Method: CogIA32Compiler>>concretizeMoveRMbr (in category 'generate machine code') -----
  concretizeMoveRMbr
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| srcReg offset destReg |
  	offset := operands at: 1.
+ 	srcReg := operands at: 0.
+ 	destReg := operands at: 2.
- 	srcReg := self concreteRegister: (operands at: 0).
- 	destReg := self concreteRegister: (operands at: 2).
  	srcReg >= 4 ifTrue: [self error: 'invalid register'].
  	destReg ~= ESP ifTrue:
  		[(self isQuick: offset) ifTrue:
  			[machineCode
  				at: 0 put: 16r88;
  				at: 1 put: (self mod: ModRegRegDisp8 RM: destReg RO: srcReg);
  				at: 2 put: (offset bitAnd: 16rFF).
  			 ^machineCodeSize := 3].
  		machineCode
  			at: 0 put: 16r88;
  			at: 1 put: (self mod: ModRegRegDisp32 RM: destReg RO: srcReg);
  			at: 2 put: (offset bitAnd: 16rFF);
  			at: 3 put: (offset >> 8 bitAnd: 16rFF);
  			at: 4 put: (offset >> 16 bitAnd: 16rFF);
  			at: 5 put: (offset >> 24 bitAnd: 16rFF).
  		^machineCodeSize := 6].
  	machineCode
  		at: 0 put: 16r88;
  		at: 1 put: (self mod: ModRegRegDisp32 RM: destReg RO: srcReg);
  		at: 2 put: (self s: SIB1 i: 4 b: destReg);
  		at: 3 put: (offset bitAnd: 16rFF);
  		at: 4 put: (offset >> 8 bitAnd: 16rFF);
  		at: 5 put: (offset >> 16 bitAnd: 16rFF);
  		at: 6 put: (offset >> 24 bitAnd: 16rFF).
  	^machineCodeSize := 7!

Item was changed:
  ----- Method: CogIA32Compiler>>concretizeMoveRMwr (in category 'generate machine code') -----
  concretizeMoveRMwr
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| srcReg offset destReg |
+ 	srcReg := operands at: 0.
- 	srcReg := self concreteRegister: (operands at: 0).
  	offset := operands at: 1.
+ 	destReg := operands at: 2.
- 	destReg := self concreteRegister: (operands at: 2).
  	destReg ~= ESP ifTrue:
  		[(offset = 0 and: [destReg ~= EBP]) ifTrue:
  			[machineCode
  				at: 0 put: 16r89;
  				at: 1 put: (self mod: ModRegInd RM: destReg RO: srcReg).
  			 ^machineCodeSize := 2].
  		 (self isQuick: offset) ifTrue:
  			[machineCode
  				at: 0 put: 16r89;
  				at: 1 put: (self mod: ModRegRegDisp8 RM: destReg RO: srcReg);
  				at: 2 put: (offset bitAnd: 16rFF).
  			 ^machineCodeSize := 3].
  		machineCode
  			at: 0 put: 16r89;
  			at: 1 put: (self mod: ModRegRegDisp32 RM: destReg RO: srcReg);
  			at: 2 put: (offset bitAnd: 16rFF);
  			at: 3 put: (offset >> 8 bitAnd: 16rFF);
  			at: 4 put: (offset >> 16 bitAnd: 16rFF);
  			at: 5 put: (offset >> 24 bitAnd: 16rFF).
  		^machineCodeSize := 6].
  	"ESP:"
  	offset = 0 ifTrue:
  		[machineCode
  			at: 0 put: 16r89;
  			at: 1 put: (self mod: ModRegInd RM: destReg RO: srcReg);
  			at: 2 put: (self s: SIB1 i: 4 b: destReg).
  		 ^machineCodeSize := 3].
  	(self isQuick: offset) ifTrue:
  		[machineCode
  			at: 0 put: 16r89;
  			at: 1 put: (self mod: ModRegRegDisp8 RM: destReg RO: srcReg);
  			at: 2 put: (self s: SIB1 i: 4 b: destReg);
  			at: 3 put: (offset bitAnd: 16rFF).
  		 ^machineCodeSize := 4].
  	machineCode
  		at: 0 put: 16r89;
  		at: 1 put: (self mod: ModRegRegDisp32 RM: destReg RO: srcReg);
  		at: 2 put: (self s: SIB1 i: 4 b: destReg);
  		at: 3 put: (offset bitAnd: 16rFF);
  		at: 4 put: (offset >> 8 bitAnd: 16rFF);
  		at: 5 put: (offset >> 16 bitAnd: 16rFF);
  		at: 6 put: (offset >> 24 bitAnd: 16rFF).
  	^machineCodeSize := 7!

Item was changed:
  ----- Method: CogIA32Compiler>>concretizeMoveRXbrR (in category 'generate machine code') -----
  concretizeMoveRXbrR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| src index base swapreg mcIdx |
+ 	src := operands at: 0.
+ 	index := operands at: 1.
+ 	base := operands at: 2.
- 	src := self concreteRegister: (operands at: 0).
- 	index := self concreteRegister: (operands at: 1).
- 	base := self concreteRegister: (operands at: 2).
  	mcIdx := 0.
  	swapreg := NoReg.
  	src >= 4 ifTrue: "x86 allows movb %rl, mem only with %al, %bl, %cl, %dl, so swap with the first one that isn't used."
  		[swapreg := src.
  		 index = EAX ifTrue: [index := swapreg].
  		 base = EAX ifTrue: [base := swapreg].
  		 src := EAX. 
  		 mcIdx := 1.
  		 machineCode at: 0 put: 16r90 + swapreg].
  	base ~= EBP ifTrue:
  		[machineCode
  			at: mcIdx + 0 put: 16r88;
  			at: mcIdx + 1 put: (self mod: ModRegInd RM: 4 RO: src);
  			at: mcIdx + 2 put: (self s: SIB1 i: index b: base).
  		 swapreg ~= NoReg ifTrue:
  			[machineCode at: mcIdx + 3 put: 16r90 + swapreg].
  		 ^machineCodeSize := 3 + (2 * mcIdx)].
  	machineCode
  		at: mcIdx + 0 put: 16r88;
  		at: mcIdx + 1 put: (self mod: ModRegRegDisp8 RM: 4 RO: src);
  		at: mcIdx + 2 put: (self s: SIB1 i: index b: base);
  		at: mcIdx + 3 put: 0.
  	swapreg ~= NoReg ifTrue:
  		[machineCode at: mcIdx + 4 put: 16r90 + swapreg].
  	 ^machineCodeSize := 4 + (2 * mcIdx)!

Item was changed:
  ----- Method: CogIA32Compiler>>concretizeMoveRXwrR (in category 'generate machine code') -----
  concretizeMoveRXwrR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| index base src |
+ 	src := operands at: 0.
+ 	index := operands at: 1.
+ 	base := operands at: 2.
- 	src := self concreteRegister: (operands at: 0).
- 	index := self concreteRegister: (operands at: 1).
- 	base := self concreteRegister: (operands at: 2).
  	base ~= EBP ifTrue:
  		[machineCode
  			at: 0 put: 16r89;
  			at: 1 put: (self mod: ModRegInd RM: 4 RO: src);
  			at: 2 put: (self s: SIB4 i: index b: base).
  		 ^machineCodeSize := 3].
  	machineCode
  		at: 0 put: 16r89;
  		at: 1 put: (self mod: ModRegRegDisp8 RM: 4 RO: src);
  		at: 2 put: (self s: SIB4 i: index b: base);
  		at: 3 put: 0.
  	 ^machineCodeSize := 4!

Item was changed:
  ----- Method: CogIA32Compiler>>concretizeMoveRdM64r (in category 'generate machine code') -----
  concretizeMoveRdM64r
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| srcReg offset destReg |
+ 	srcReg := operands at: 0.
- 	srcReg := self concreteDPFPRegister: (operands at: 0).
  	offset := operands at: 1.
+ 	destReg := operands at: 2.
- 	destReg := self concreteRegister: (operands at: 2).
  	destReg ~= ESP ifTrue:
  		[(self isQuick: offset) ifTrue:
  			[machineCode
  				at: 0 put: 16rF2;
  				at: 1 put: 16r0F;
  				at: 2 put: 16r11;
  				at: 3 put: (self mod: ModRegRegDisp8 RM: destReg RO: srcReg);
  				at: 4 put: (offset bitAnd: 16rFF).
  			 ^machineCodeSize := 5].
  		machineCode
  			at: 0 put: 16rF2;
  			at: 1 put: 16r0F;
  			at: 2 put: 16r11;
  			at: 3 put: (self mod: ModRegRegDisp32 RM: destReg RO: srcReg);
  			at: 4 put: (offset bitAnd: 16rFF);
  			at: 5 put: (offset >> 8 bitAnd: 16rFF);
  			at: 6 put: (offset >> 16 bitAnd: 16rFF);
  			at: 7 put: (offset >> 24 bitAnd: 16rFF).
  		^machineCodeSize := 8].
  	"ESP:"
  	(self isQuick: offset) ifTrue:
  		[machineCode
  			at: 0 put: 16rF2;
  			at: 1 put: 16r0F;
  			at: 2 put: 16r11;
  			at: 3 put: (self mod: ModRegRegDisp8 RM: destReg RO: srcReg);
  			at: 4 put: (self s: SIB1 i: 4 b: destReg);
  			at: 5 put: (offset bitAnd: 16rFF).
  		 ^machineCodeSize := 6].
  	machineCode
  		at: 0 put: 16rF2;
  		at: 1 put: 16r0F;
  		at: 2 put: 16r11;
  		at: 3 put: (self mod: ModRegRegDisp32 RM: destReg RO: srcReg);
  		at: 4 put: (self s: SIB1 i: 4 b: destReg);
  		at: 5 put: (offset bitAnd: 16rFF);
  		at: 6 put: (offset >> 8 bitAnd: 16rFF);
  		at: 7 put: (offset >> 16 bitAnd: 16rFF);
  		at: 8 put: (offset >> 24 bitAnd: 16rFF).
  	^machineCodeSize := 9!

Item was changed:
  ----- Method: CogIA32Compiler>>concretizeMoveXbrRR (in category 'generate machine code') -----
  concretizeMoveXbrRR
  	"N.B. we zero-extend because we state byteReadsZeroExtend."
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| index base dest |
+ 	index := operands at: 0.
+ 	base := operands at: 1.
+ 	dest := operands at: 2.
- 	index := self concreteRegister: (operands at: 0).
- 	base := self concreteRegister: (operands at: 1).
- 	dest := self concreteRegister: (operands at: 2).
  	base ~= EBP ifTrue:
  		[machineCode
  			at: 0 put: 16r0F;
  			at: 1 put: 16rB6;
  			at: 2 put: (self mod: ModRegInd RM: 4 RO: dest);
  			at: 3 put: (self s: SIB1 i: index b: base).
  		 ^machineCodeSize := 4].
  	machineCode
  			at: 0 put: 16r0F;
  			at: 1 put: 16rB6;
  		at: 2 put: (self mod: ModRegRegDisp8 RM: 4 RO: dest);
  		at: 3 put: (self s: SIB1 i: index b: base);
  		at: 4 put: 0.
  	 ^machineCodeSize := 5!

Item was changed:
  ----- Method: CogIA32Compiler>>concretizeMoveXwrRR (in category 'generate machine code') -----
  concretizeMoveXwrRR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| index base dest |
+ 	index := operands at: 0.
+ 	base := operands at: 1.
+ 	dest := operands at: 2.
- 	index := self concreteRegister: (operands at: 0).
- 	base := self concreteRegister: (operands at: 1).
- 	dest := self concreteRegister: (operands at: 2).
  	base ~= EBP ifTrue:
  		[machineCode
  			at: 0 put: 16r8B;
  			at: 1 put: (self mod: ModRegInd RM: 4 RO: dest);
  			at: 2 put: (self s: SIB4 i: index b: base).
  		 ^machineCodeSize := 3].
  	machineCode
  		at: 0 put: 16r8B;
  		at: 1 put: (self mod: ModRegRegDisp8 RM: 4 RO: dest);
  		at: 2 put: (self s: SIB4 i: index b: base);
  		at: 3 put: 0.
  	 ^machineCodeSize := 4!

Item was changed:
  ----- Method: CogIA32Compiler>>concretizeMulRR (in category 'generate machine code') -----
  concretizeMulRR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| reg1 reg2 |
+ 	reg1 := operands at: 0.
+ 	reg2 := operands at: 1.
- 	reg1 := self concreteRegister: (operands at: 0).
- 	reg2 := self concreteRegister: (operands at: 1).
  	machineCode
  		at: 0 put: 16r0F;
  		at: 1 put: 16rAF;
  		at: 2 put: (self mod: ModReg RM: reg1 RO: reg2).
  	^machineCodeSize := 3!

Item was changed:
  ----- Method: CogIA32Compiler>>concretizeNegateR (in category 'generate machine code') -----
  concretizeNegateR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| reg |
+ 	reg := operands at: 0.
- 	reg := self concreteRegister: (operands at: 0).
  	machineCode
  		at: 0 put: 16rF7;
  		at: 1 put: (self mod: ModReg RM: reg RO: 3).
  	^machineCodeSize := 2!

Item was changed:
  ----- Method: CogIA32Compiler>>concretizeOpRR: (in category 'generate machine code') -----
  concretizeOpRR: x86opcode
  	| regLHS regRHS |
+ 	regLHS := operands at: 0.
+ 	regRHS := operands at: 1.
- 	regLHS := self concreteRegister: (operands at: 0).
- 	regRHS := self concreteRegister: (operands at: 1).
  	machineCode
  		at: 0 put: x86opcode;
  		at: 1 put: (self mod: ModReg RM: regLHS RO: regRHS).
  	^machineCodeSize := 2!

Item was changed:
  ----- Method: CogIA32Compiler>>concretizeOrCqR (in category 'generate machine code') -----
  concretizeOrCqR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| mask reg |
  	mask := operands at: 0.
+ 	reg := operands at: 1.
- 	reg := self concreteRegister: (operands at: 1).
  	(self isQuick: mask) ifTrue:
  		[machineCode
  			at: 0 put: 16r83;
  			at: 1 put: (self mod: ModReg RM: reg RO: 1);
  			at: 2 put: (mask bitAnd: 16rFF).
  		 ^machineCodeSize := 3].
  	reg = EAX ifTrue:
  		[machineCode
  			at: 0 put: 16r0D;
  			at: 1 put: (mask bitAnd: 16rFF);
  			at: 2 put: (mask >> 8 bitAnd: 16rFF);
  			at: 3 put: (mask >> 16 bitAnd: 16rFF);
  			at: 4 put: (mask >> 24 bitAnd: 16rFF).
  		 ^machineCodeSize := 5].
  	machineCode
  		at: 0 put: 16r81;
  		at: 1 put: (self mod: ModReg RM: reg RO: 1);
  		at: 2 put: (mask bitAnd: 16rFF);
  		at: 3 put: (mask >> 8 bitAnd: 16rFF);
  		at: 4 put: (mask >> 16 bitAnd: 16rFF);
  		at: 5 put: (mask >> 24 bitAnd: 16rFF).
  	 ^machineCodeSize := 6!

Item was changed:
  ----- Method: CogIA32Compiler>>concretizeOrCwR (in category 'generate machine code') -----
  concretizeOrCwR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| value reg |
  	value := operands at: 0.
+ 	reg := operands at: 1.
- 	reg := self concreteRegister: (operands at: 1).
  	reg = EAX ifTrue:
  		[machineCode
  			at: 0 put: 16r0D;
  			at: 1 put: (value bitAnd: 16rFF);
  			at: 2 put: (value >> 8 bitAnd: 16rFF);
  			at: 3 put: (value >> 16 bitAnd: 16rFF);
  			at: 4 put: (value >> 24 bitAnd: 16rFF).
  		 ^machineCodeSize := 5].
  	machineCode
  		at: 0 put: 16r83;
  		at: 1 put: (self mod: ModReg RM: reg RO: 1);
  		at: 2 put: (value bitAnd: 16rFF);
  		at: 3 put: (value >> 8 bitAnd: 16rFF);
  		at: 4 put: (value >> 16 bitAnd: 16rFF);
  		at: 5 put: (value >> 24 bitAnd: 16rFF).
  	 ^machineCodeSize := 6!

Item was changed:
  ----- Method: CogIA32Compiler>>concretizePopR (in category 'generate machine code') -----
  concretizePopR
  	<inline: true>
+ 	machineCode at: 0 put: 16r58 + (operands at: 0).
- 	machineCode at: 0 put: 16r58 + (self concreteRegister: (operands at: 0)).
  	^machineCodeSize := 1!

Item was changed:
  ----- Method: CogIA32Compiler>>concretizePushR (in category 'generate machine code') -----
  concretizePushR
  	<inline: true>
+ 	machineCode at: 0 put: 16r50 + (operands at: 0).
- 	machineCode at: 0 put: 16r50 + (self concreteRegister: (operands at: 0)).
  	^machineCodeSize := 1!

Item was changed:
  ----- Method: CogIA32Compiler>>concretizeReverseOpRR: (in category 'generate machine code') -----
  concretizeReverseOpRR: x86opcode
  	| regLHS regRHS |
+ 	regRHS := operands at: 0.
+ 	regLHS := operands at: 1.
- 	regRHS := self concreteRegister: (operands at: 0).
- 	regLHS := self concreteRegister: (operands at: 1).
  	machineCode
  		at: 0 put: x86opcode;
  		at: 1 put: (self mod: ModReg RM: regLHS RO: regRHS).
  	^machineCodeSize := 2!

Item was changed:
  ----- Method: CogIA32Compiler>>concretizeSEE2OpRdRd: (in category 'generate machine code') -----
  concretizeSEE2OpRdRd: opCode
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| regLHS regRHS |
+ 	regRHS := operands at: 0.
+ 	regLHS := operands at: 1.
- 	regRHS := self concreteDPFPRegister: (operands at: 0).
- 	regLHS := self concreteDPFPRegister: (operands at: 1).
  	machineCode
  		at: 0 put: 16rF2;
  		at: 1 put: 16r0F;
  		at: 2 put: opCode;
  		at: 3 put: (self mod: ModReg RM: regRHS RO: regLHS).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogIA32Compiler>>concretizeSqrtRd (in category 'generate machine code') -----
  concretizeSqrtRd
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| reg |
+ 	reg := operands at: 0.
- 	reg := self concreteDPFPRegister: (operands at: 0).
  	machineCode
  		at: 0 put: 16rF2;
  		at: 1 put: 16r0F;
  		at: 2 put: 16r51;
  		at: 3 put: (self mod: ModReg RM: reg RO: reg).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogIA32Compiler>>concretizeSubCqR (in category 'generate machine code') -----
  concretizeSubCqR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| value reg |
  	value := operands at: 0.
+ 	reg := operands at: 1.
- 	reg := self concreteRegister: (operands at: 1).
  	(self isQuick: value) ifTrue:
  		[machineCode
  			at: 0 put: 16r83;
  			at: 1 put: (self mod: ModReg RM: reg RO: 5);
  			at: 2 put: (value bitAnd: 16rFF).
  		 ^machineCodeSize := 3].
  	reg = EAX ifTrue:
  		[machineCode
  			at: 0 put: 16r2D;
  			at: 1 put: (value bitAnd: 16rFF);
  			at: 2 put: (value >> 8 bitAnd: 16rFF);
  			at: 3 put: (value >> 16 bitAnd: 16rFF);
  			at: 4 put: (value >> 24 bitAnd: 16rFF).
  		 ^machineCodeSize := 5].
  	machineCode
  		at: 0 put: 16r81;
  		at: 1 put: (self mod: ModReg RM: reg RO: 5);
  		at: 2 put: (value bitAnd: 16rFF);
  		at: 3 put: (value >> 8 bitAnd: 16rFF);
  		at: 4 put: (value >> 16 bitAnd: 16rFF);
  		at: 5 put: (value >> 24 bitAnd: 16rFF).
  	 ^machineCodeSize := 6!

Item was changed:
  ----- Method: CogIA32Compiler>>concretizeSubCwR (in category 'generate machine code') -----
  concretizeSubCwR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| value reg |
  	value := operands at: 0.
+ 	reg := operands at: 1.
- 	reg := self concreteRegister: (operands at: 1).
  	reg = EAX ifTrue:
  		[machineCode
  			at: 0 put: 16r2D;
  			at: 1 put: (value bitAnd: 16rFF);
  			at: 2 put: (value >> 8 bitAnd: 16rFF);
  			at: 3 put: (value >> 16 bitAnd: 16rFF);
  			at: 4 put: (value >> 24 bitAnd: 16rFF).
  		 ^machineCodeSize := 5].
  	machineCode
  		at: 0 put: 16r81;
  		at: 1 put: (self mod: ModReg RM: reg RO: 5);
  		at: 2 put: (value bitAnd: 16rFF);
  		at: 3 put: (value >> 8 bitAnd: 16rFF);
  		at: 4 put: (value >> 16 bitAnd: 16rFF);
  		at: 5 put: (value >> 24 bitAnd: 16rFF).
  	 ^machineCodeSize := 6!

Item was changed:
  ----- Method: CogIA32Compiler>>concretizeTstCqR (in category 'generate machine code') -----
  concretizeTstCqR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| mask reg |
  	mask := operands at: 0.
+ 	reg := operands at: 1.
- 	reg := self concreteRegister: (operands at: 1).
  	((self isQuick: mask) and: [reg < 4]) ifTrue:
  		[machineCode
  			at: 0 put: 16rF6;
  			at: 1 put: (self mod: ModReg RM: reg RO: 0);
  			at: 2 put: (mask bitAnd: 16rFF).
  		 ^machineCodeSize := 3].
  	reg = EAX ifTrue:
  		[machineCode
  			at: 0 put: 16rA9;
  			at: 1 put: (mask bitAnd: 16rFF);
  			at: 2 put: (mask >> 8 bitAnd: 16rFF);
  			at: 3 put: (mask >> 16 bitAnd: 16rFF);
  			at: 4 put: (mask >> 24 bitAnd: 16rFF).
  		 ^machineCodeSize := 5].
  	machineCode
  		at: 0 put: 16rF7;
  		at: 1 put: (self mod: ModReg RM: reg RO: 0);
  		at: 2 put: (mask bitAnd: 16rFF);
  		at: 3 put: (mask >> 8 bitAnd: 16rFF);
  		at: 4 put: (mask >> 16 bitAnd: 16rFF);
  		at: 5 put: (mask >> 24 bitAnd: 16rFF).
  	 ^machineCodeSize := 6!

Item was changed:
  ----- Method: CogIA32Compiler>>concretizeXCHGAwR (in category 'generate machine code') -----
  concretizeXCHGAwR
  	<inline: true>
  	| addressOperand reg |
  	addressOperand := operands at: 0.
+ 	reg := operands at: 1.
- 	reg := self concreteRegister: (operands at: 1).
  	machineCode
  		at: 0 put: 16r87;
  		at: 1 put: (self mod: ModRegInd RM: 5 RO: reg);
  		at: 2 put: (addressOperand bitAnd: 16rFF);
  		at: 3 put: (addressOperand >> 8 bitAnd: 16rFF);
  		at: 4 put: (addressOperand >> 16 bitAnd: 16rFF);
  		at: 5 put: (addressOperand >> 24 bitAnd: 16rFF).
  	^machineCodeSize := 6!

Item was changed:
  ----- Method: CogIA32Compiler>>concretizeXCHGMwrR (in category 'generate machine code') -----
  concretizeXCHGMwrR
  	<inline: true>
  	| srcReg offset destReg |
  	offset := operands at: 0.
+ 	srcReg := operands at: 1.
+ 	destReg := operands at: 2.
- 	srcReg := self concreteRegister: (operands at: 1).
- 	destReg := self concreteRegister: (operands at: 2).
  	srcReg ~= ESP ifTrue:
  		[(self isQuick: offset) ifTrue:
  			[machineCode
  				at: 0 put: 16r87;
  				at: 1 put: (self mod: ModRegRegDisp8 RM: srcReg RO: destReg);
  				at: 2 put: (offset bitAnd: 16rFF).
  			 ^machineCodeSize := 3].
  		machineCode
  			at: 0 put: 16r87;
  			at: 1 put: (self mod: ModRegRegDisp32 RM: srcReg RO: destReg);
  			at: 2 put: (offset bitAnd: 16rFF);
  			at: 3 put: (offset >> 8 bitAnd: 16rFF);
  			at: 4 put: (offset >> 16 bitAnd: 16rFF);
  			at: 5 put: (offset >> 24 bitAnd: 16rFF).
  		^machineCodeSize := 6].
  	"ESP:"
  	(self isQuick: offset) ifTrue:
  		[machineCode
  			at: 0 put: 16r87;
  			at: 1 put: (self mod: ModRegRegDisp8 RM: srcReg RO: destReg);
  			at: 2 put: (self s: SIB1 i: 4 b: srcReg);
  			at: 3 put: (offset bitAnd: 16rFF).
  		 ^machineCodeSize := 4].
  	machineCode
  		at: 0 put: 16r87;
  		at: 1 put: (self mod: ModRegRegDisp32 RM: srcReg RO: destReg);
  		at: 2 put: (self s: SIB1 i: 4 b: srcReg);
  		at: 3 put: (offset bitAnd: 16rFF);
  		at: 4 put: (offset >> 8 bitAnd: 16rFF);
  		at: 5 put: (offset >> 16 bitAnd: 16rFF);
  		at: 6 put: (offset >> 24 bitAnd: 16rFF).
  	^machineCodeSize := 7!

Item was changed:
  ----- Method: CogIA32Compiler>>concretizeXCHGRR (in category 'generate machine code') -----
  concretizeXCHGRR
  	<inline: true>
  	| reg1 reg2 |
+ 	reg1 := operands at: 0.
+ 	reg2 := operands at: 1.
- 	reg1 := self concreteRegister: (operands at: 0).
- 	reg2 := self concreteRegister: (operands at: 1).
  	reg2 = EAX ifTrue:
  		[reg2 := reg1.
  		 reg1 := EAX].
  	reg1 = EAX ifTrue:
  		[machineCode at: 0 put: 16r90 + reg2.
  		 ^machineCodeSize := 1].
  	machineCode
  		at: 0 put: 16r87;
  		at: 1 put: (self mod: ModReg RM: reg1 RO: reg2).
  	^machineCodeSize := 2!

Item was changed:
  ----- Method: CogIA32Compiler>>concretizeXorCwR (in category 'generate machine code') -----
  concretizeXorCwR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| value reg |
  	value := operands at: 0.
+ 	reg := operands at: 1.
- 	reg := self concreteRegister: (operands at: 1).
  	reg = EAX ifTrue:
  		[machineCode
  			at: 0 put: 16r35;
  			at: 1 put: (value bitAnd: 16rFF);
  			at: 2 put: (value >> 8 bitAnd: 16rFF);
  			at: 3 put: (value >> 16 bitAnd: 16rFF);
  			at: 4 put: (value >> 24 bitAnd: 16rFF).
  		 ^machineCodeSize := 5].
  	machineCode
  		at: 0 put: 16r81;
  		at: 1 put: (self mod: ModReg RM: reg RO: 6);
  		at: 2 put: (value bitAnd: 16rFF);
  		at: 3 put: (value >> 8 bitAnd: 16rFF);
  		at: 4 put: (value >> 16 bitAnd: 16rFF);
  		at: 5 put: (value >> 24 bitAnd: 16rFF).
  	 ^machineCodeSize := 6!

Item was changed:
  ----- Method: CogIA32Compiler>>genDivR:R:Quo:Rem: (in category 'abstract instructions') -----
  genDivR: abstractRegDivisor R: abstractRegDividend Quo: abstractRegQuotient Rem: abstractRegRemainder
  	| rDividend rDivisor rQuotient rRemainder saveRestoreEAX saveRestoreEDX saveRestoreExchanged |
  	self assert: abstractRegDividend ~= abstractRegDivisor.
  	self assert: abstractRegQuotient ~= abstractRegRemainder.
+ 	rDividend := abstractRegDividend.
+ 	rDivisor := abstractRegDivisor.
+ 	rQuotient := abstractRegQuotient.
+ 	rRemainder := abstractRegRemainder.
- 	rDividend := self concreteRegister: abstractRegDividend.
- 	rDivisor := self concreteRegister: abstractRegDivisor.
- 	rQuotient := self concreteRegister: abstractRegQuotient.
- 	rRemainder := self concreteRegister: abstractRegRemainder.
  	"IDIV r does a signed divide of EDX:EAX by r, EAX := Quotient, EDX := Remainder.
  	 Since we must sign extend the dividend into EDX we must substitute another register if EDX is an input"
  	(rDividend = EDX or: [rDivisor = EDX]) ifTrue:
  		[| rUnused |
  		"Slang, sigh..."
  		rUnused := EAX.
  		[rUnused <= EDI] whileTrue:
  			[(rUnused ~= ESP and: [rUnused ~= EBP and: [rUnused ~= EDX
  			  and: [rUnused ~= rDividend and: [rUnused ~= rDivisor
  			  and: [rUnused ~= rQuotient and: [rUnused ~= rRemainder]]]]]]) ifTrue:
  				[cogit PushR: rUnused.
  				cogit MoveR: EDX R: rUnused.
  				rDividend = EDX
  					ifTrue: [self genDivR: rDivisor R: rUnused Quo: rQuotient Rem: rRemainder]
  					ifFalse: [self genDivR: rUnused R: rDividend Quo: rQuotient Rem: rRemainder].
  				cogit PopR: rUnused.
  				^self].
  			  rUnused := rUnused + 1].
  		self error: 'couldn''t find unused register in genDivR:R:Quo:Rem:'].
  	"If either output does not include EAX or EDX we must save and restore EAX and/or EDX."
  	(saveRestoreEAX := rQuotient ~= EAX and: [rRemainder ~= EAX]) ifTrue:
  		[cogit PushR: EAX].
  	(saveRestoreEDX := rQuotient ~= EDX and: [rRemainder ~= EDX]) ifTrue:
  		[cogit PushR: EDX].
  	saveRestoreExchanged := -1.
  	rDividend ~= EAX ifTrue:
  		[rDivisor = EAX
  			ifTrue: [((rDividend ~= rQuotient and: [rDividend ~= rRemainder])
  					and: [rDividend ~= EDX or: [saveRestoreEDX not]]) ifTrue:
  						[cogit PushR: (saveRestoreExchanged := rDividend)].
  					cogit gen: XCHGRR operand: rDivisor operand: rDividend]
  			ifFalse: [cogit MoveR: rDividend R: EAX]].
  	"CDQ sign-extends EAX into EDX as required for IDIV"
  	cogit gen: CDQ.
  	cogit gen: IDIVR operand: (rDivisor = EAX ifTrue: [rDividend] ifFalse: [rDivisor]).
  	"Must not overwrite result while juggling"
  	(rQuotient = EDX and: [rRemainder = EAX])
  		ifTrue: [cogit gen: XCHGRR operand: rQuotient operand: rRemainder]
  		ifFalse:
  			[rQuotient = EDX
  				ifTrue:
  					[rRemainder ~= EDX ifTrue:
  						[cogit MoveR: EDX R: rRemainder].
  					rQuotient ~= EAX ifTrue:
  						[cogit MoveR: EAX R: rQuotient]]
  				ifFalse:
  					[rQuotient ~= EAX ifTrue:
  						[cogit MoveR: EAX R: rQuotient].
  					rRemainder ~= EDX ifTrue:
  						[cogit MoveR: EDX R: rRemainder]]].
  	saveRestoreExchanged >= 0 ifTrue:
  		[cogit PopR: saveRestoreExchanged].
  	saveRestoreEDX ifTrue:
  		[cogit PopR: EDX].
  	saveRestoreEAX ifTrue:
  		[cogit PopR: EAX]!

Item was changed:
  ----- Method: CogIA32Compiler>>genRestoreRegsExcept: (in category 'abi') -----
+ genRestoreRegsExcept: preservedReg
- genRestoreRegsExcept: abstractReg
- 	| realReg |
- 	realReg := self concreteRegister: abstractReg.
  	self assert: (EDI > EAX and: [EDI - EAX + 1 = 6]).
  	EAX to: EDI do:
  		[:reg|
  		(reg between: ESP and: EBP) ifFalse:
+ 			[preservedReg = reg
- 			[realReg = reg
  				ifTrue: [cogit AddCq: 4 R: ESP]
  				ifFalse: [cogit PopR: reg]]].
  	^0!

Item was changed:
  CogX64Compiler subclass: #CogInLineLiteralsX64Compiler
  	instanceVariableNames: ''
+ 	classVariableNames: ''
- 	classVariableNames: 'ConcreteRISCTempReg'
  	poolDictionaries: ''
  	category: 'VMMaker-JIT'!

Item was removed:
- ----- Method: CogInLineLiteralsX64Compiler class>>initialize (in category 'class initialization') -----
- initialize
- 	ConcreteRISCTempReg := self basicNew concreteRegister: RISCTempReg!

Item was removed:
- ----- Method: CogInLineLiteralsX64Compiler class>>isConcreteRISCTempRegister: (in category 'testing') -----
- isConcreteRISCTempRegister: concreteRegister
- 	"For tests to filter-out bogus values left in the ConcreteRISCTempRegister, if any."
- 	^concreteRegister = ConcreteRISCTempReg!

Item was added:
+ ----- Method: CogInLineLiteralsX64Compiler class>>isRISCTempRegister: (in category 'testing') -----
+ isRISCTempRegister: reg
+ 	"For tests to filter-out bogus values left in the RISCTempRegister, if any."
+ 	^reg = RISCTempReg!

Item was changed:
  ----- Method: CogInLineLiteralsX64Compiler>>computeSizeOfArithCqR (in category 'generate machine code') -----
  computeSizeOfArithCqR
  	"With CqR we assume constants are 32-bits or less."
  	<inline: true>
  	(self isQuick: (operands at: 0)) ifTrue:
  		[^4].
  	(self isSignExtendedFourByteValue: (operands at: 0)) ifTrue:
+ 		[^(operands at: 1) = RAX ifTrue: [6] ifFalse: [7]].
- 		[^(self concreteRegister: (operands at: 1)) = RAX
- 			ifTrue: [6]
- 			ifFalse: [7]].
  	^10 "movabsq" + 3 "r op r"!

Item was changed:
  ----- Method: CogInLineLiteralsX64Compiler>>concretizeArithCwR: (in category 'generate machine code') -----
  concretizeArithCwR: x64opcode
  	| value reg reverse |
  	value := operands at: 0.
+ 	reg := operands at: 1.
- 	reg := self concreteRegister: (operands at: 1).
  	reverse := x64opcode = 16r85 or: [x64opcode = 16r39]. "Tst & Cmp; backwards"
  	machineCode
+ 		at:  0 put: (self rexR: RISCTempReg x: 0 b: RISCTempReg);
+ 		at:  1 put: 16rB8 + (RISCTempReg bitAnd: 7);
- 		at:  0 put: (self rexR: ConcreteRISCTempReg x: 0 b: ConcreteRISCTempReg);
- 		at:  1 put: 16rB8 + (ConcreteRISCTempReg bitAnd: 7);
  		at:  2 put: (value bitAnd: 16rFF);
  		at:  3 put: (value >> 8 bitAnd: 16rFF);
  		at:  4 put: (value >> 16 bitAnd: 16rFF);
  		at:  5 put: (value >> 24 bitAnd: 16rFF);
  		at:  6 put: (value >> 32 bitAnd: 16rFF);
  		at:  7 put: (value >> 40 bitAnd: 16rFF);
  		at:  8 put: (value >> 48 bitAnd: 16rFF);
  		at:  9 put: (value >> 56 bitAnd: 16rFF);
  		at: 10 put: (reverse
+ 					ifTrue: [self rexR: RISCTempReg x: 0 b: reg]
+ 					ifFalse: [self rexR: reg x: 0 b: RISCTempReg]);
- 					ifTrue: [self rexR: ConcreteRISCTempReg x: 0 b: reg]
- 					ifFalse: [self rexR: reg x: 0 b: ConcreteRISCTempReg]);
  		at: 11 put: x64opcode;
  		at: 12 put: (reverse
+ 					ifTrue: [self mod: ModReg RM: reg RO: RISCTempReg]
+ 					ifFalse: [self mod: ModReg RM: RISCTempReg RO: reg]).
- 					ifTrue: [self mod: ModReg RM: reg RO: ConcreteRISCTempReg]
- 					ifFalse: [self mod: ModReg RM: ConcreteRISCTempReg RO: reg]).
  	^machineCodeSize := 13!

Item was changed:
  ----- Method: CogInLineLiteralsX64Compiler>>concretizeMoveCwR (in category 'generate machine code') -----
  concretizeMoveCwR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| value reg offset |
  	value := operands at: 0.
+ 	reg := operands at: 1.
- 	reg := self concreteRegister: (operands at: 1).
  	(self isAnInstruction: (cogit cCoerceSimple: value to: #'AbstractInstruction *')) ifTrue:
  		[value := (cogit cCoerceSimple: value to: #'AbstractInstruction *') address].
  	(cogit addressIsInCurrentCompilation: value) ifTrue:
  		[offset := value - (address + 7).
  		 machineCode
  			at: 0 put: (self rexR: reg x: 0 b: 0);
  			at: 1 put: 16r8D; "LoadEffectiveAddress"
  			at: 2 put: (self mod: ModRegInd RM: 5 RO: reg);
  			at: 3 put: (offset bitAnd: 16rFF);
  			at: 4 put: (offset >> 8 bitAnd: 16rFF);
  			at: 5 put: (offset >> 16 bitAnd: 16rFF);
  			at: 6 put: (offset >> 24 bitAnd: 16rFF).
  		^machineCodeSize := 7].
  	machineCode
  		at:  0 put: (self rexR: 0 x: 0 b: reg);
  		at:  1 put: 16rB8 + (reg bitAnd: 7);
  		at:  2 put: (value bitAnd: 16rFF);
  		at:  3 put: (value >> 8 bitAnd: 16rFF);
  		at:  4 put: (value >> 16 bitAnd: 16rFF);
  		at:  5 put: (value >> 24 bitAnd: 16rFF);
  		at:  6 put: (value >> 32 bitAnd: 16rFF);
  		at:  7 put: (value >> 40 bitAnd: 16rFF);
  		at:  8 put: (value >> 48 bitAnd: 16rFF);
  		at:  9 put: (value >> 56 bitAnd: 16rFF).
  	opcode = MoveCqR ifTrue:
  		[^machineCodeSize := 10].
  	"Add a nop to disambiguate between MoveCwR/PushCwR and ArithCwR, which ends with a (self mod: ModReg RM: 0 RO: 0)"
  	machineCode at: 10 put: 16r90.
  	self assert: (self mod: ModReg RM: 0 RO: 0) > 16r90.
  	^machineCodeSize := 11!

Item was changed:
  ----- Method: CogInLineLiteralsX64Compiler>>concretizePushCw (in category 'generate machine code') -----
  concretizePushCw
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| value offset |
  	value := operands at: 0.
  	(self isAnInstruction: (cogit cCoerceSimple: value to: #'AbstractInstruction *')) ifTrue:
  		[value := (cogit cCoerceSimple: value to: #'AbstractInstruction *') address].
  	(cogit addressIsInCurrentCompilation: value) ifTrue:
  		[offset := value - (address + 7).
  		 machineCode
+ 			at: 0 put: (self rexR: RISCTempReg x: 0 b: 0);
- 			at: 0 put: (self rexR: ConcreteRISCTempReg x: 0 b: 0);
  			at: 1 put: 16r8D; "LoadEffectiveAddress"
+ 			at: 2 put: (self mod: ModRegInd RM: 5 RO: RISCTempReg);
- 			at: 2 put: (self mod: ModRegInd RM: 5 RO: ConcreteRISCTempReg);
  			at: 3 put: (offset bitAnd: 16rFF);
  			at: 4 put: (offset >> 8 bitAnd: 16rFF);
  			at: 5 put: (offset >> 16 bitAnd: 16rFF);
  			at: 6 put: (offset >> 24 bitAnd: 16rFF);
  			at: 7 put: 16r41;
+ 			at: 8 put: 16r48 + RISCTempReg.
- 			at: 8 put: 16r48 + ConcreteRISCTempReg.
  		^machineCodeSize := 9].
  	machineCode
+ 		at:  0 put: (self rexR: RISCTempReg x: 0 b: RISCTempReg);
+ 		at:  1 put: 16rB8 + (RISCTempReg bitAnd: 7);
- 		at:  0 put: (self rexR: ConcreteRISCTempReg x: 0 b: ConcreteRISCTempReg);
- 		at:  1 put: 16rB8 + (ConcreteRISCTempReg bitAnd: 7);
  		at:  2 put: (value bitAnd: 16rFF);
  		at:  3 put: (value >> 8 bitAnd: 16rFF);
  		at:  4 put: (value >> 16 bitAnd: 16rFF);
  		at:  5 put: (value >> 24 bitAnd: 16rFF);
  		at:  6 put: (value >> 32 bitAnd: 16rFF);
  		at:  7 put: (value >> 40 bitAnd: 16rFF);
  		at:  8 put: (value >> 48 bitAnd: 16rFF);
  		at:  9 put: (value >> 56 bitAnd: 16rFF);
  		at: 10 put: 16r41;
+ 		at: 11 put: 16r48 + RISCTempReg. "The 48 will disambiguate between MoveCwR, PushCwR and ArithCwR, which ends with a (self mod: ModReg RM: 0 RO: 0)"
+ 		self assert: RISCTempReg >= 8.
- 		at: 11 put: 16r48 + ConcreteRISCTempReg. "The 48 will disambiguate between MoveCwR, PushCwR and ArithCwR, which ends with a (self mod: ModReg RM: 0 RO: 0)"
- 		self assert: ConcreteRISCTempReg >= 8.
  	self assert: (self mod: ModReg RM: 0 RO: 0) > 16r57.
  	^machineCodeSize := 12!

Item was changed:
  ----- Method: CogMIPSELCompiler>>cResultRegister (in category 'generate machine code') -----
  cResultRegister
+ 	"Answer the register through which C funcitons return integral results."
+ 	<inline: true>
- 	"Answer the abstract register for the C result register."
  	^V0!

Item was changed:
  ----- Method: CogMIPSELCompiler>>callerSavedRegisterMask (in category 'accessing') -----
  callerSavedRegisterMask
  	"See MIPSConstants initializeRegisters."
- 	| mask |
  	self flag: #OABI.
+ 	^cogit
+ 		registerMaskFor: S0
+ 		and: S1
+ 		and: S2
+ 		and: S3
+ 		and: S4
+ 		and: S5
+ 		and: S6
+ 		and: S7!
- 	mask := 0.
- 	mask := mask bitOr: 1 << S0.
- 	mask := mask bitOr: 1 << S1.
- 	mask := mask bitOr: 1 << S2.
- 	mask := mask bitOr: 1 << S3.
- 	mask := mask bitOr: 1 << S4.
- 	mask := mask bitOr: 1 << S5.
- 	mask := mask bitOr: 1 << S6.
- 	mask := mask bitOr: 1 << S7.
- 	^mask!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeAddCheckOverflowCqR (in category 'generate machine code - concretize') -----
  concretizeAddCheckOverflowCqR
  	| destReg leftReg rightImm |
  	rightImm := operands at: 0.
+ 	destReg := leftReg := operands at: 1.
- 	destReg := leftReg := self concreteRegister: (operands at: 1).
  
  	self machineCodeAt: 0 put: (self luiR: AT C: (self high16BitsOf: rightImm)).
  	self machineCodeAt: 4 put: (self oriR: AT R: AT C: (self low16BitsOf: rightImm)).
  
  	"Save original LHS"
  	self machineCodeAt: 8 put: (self adduR: OverflowTemp1 R: leftReg R: ZR). 
  	
  	"The actual addition"
  	self machineCodeAt: 12 put: (self adduR: destReg R: leftReg R: AT). 
  
  	"Set sign bit of OverflowTemp2 if sign of result differs from sign of RHS."
  	self machineCodeAt: 16 put: (self xorR: OverflowTemp2 R: destReg R: AT).
  	"Set sign bit of OverflowTemp1 if sign of result differs from sign of LHS."
  	self machineCodeAt: 20 put: (self xorR: OverflowTemp1 R: destReg R: OverflowTemp1).
  	"Set sign bit of Overflow if sign of result differs from both LHS and RHS, which indicates overflow."
  	self machineCodeAt: 24 put: (self andR: Overflow R: OverflowTemp1 R: OverflowTemp2).
  	^machineCodeSize := 28!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeAddCheckOverflowRR (in category 'generate machine code - concretize') -----
  concretizeAddCheckOverflowRR
  	| destReg leftReg rightReg |
+ 	rightReg := operands at: 0.
+ 	destReg := leftReg := operands at: 1.
- 	rightReg := self concreteRegister: (operands at: 0).
- 	destReg := leftReg := self concreteRegister: (operands at: 1).
  
  	"Save original LHS"
  	self machineCodeAt: 0 put: (self adduR: OverflowTemp1 R: leftReg R: ZR). 
  	
  	"The actual addition"
  	self machineCodeAt: 4 put: (self adduR: destReg R: leftReg R: rightReg). 
  
  	"Set sign bit of OverflowTemp2 if sign of result differs from sign of RHS."
  	self machineCodeAt: 8 put: (self xorR: OverflowTemp2 R: destReg R: rightReg).
  	"Set sign bit of OverflowTemp1 if sign of result differs from sign of LHS."
  	self machineCodeAt: 12 put: (self xorR: OverflowTemp1 R: destReg R: OverflowTemp1).
  	"Set sign bit of Overflow if sign of result differs from both LHS and RHS, which indicates overflow."
  	self machineCodeAt: 16 put: (self andR: Overflow R: OverflowTemp1 R: OverflowTemp2).
  	^machineCodeSize := 20!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeAddCqR (in category 'generate machine code - concretize') -----
  concretizeAddCqR
  	| destReg leftReg rightImm |
  	rightImm := operands at: 0.
+ 	destReg := leftReg := operands at: 1.
- 	destReg := leftReg := self concreteRegister: (operands at: 1).
  	
  	(rightImm between: -16r8000 and: 16r7FFF) ifFalse: [^self concretizeAddCwR].
  	
  	self machineCodeAt: 0 put: (self addiuR: destReg R: leftReg C: rightImm).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeAddCwR (in category 'generate machine code - concretize') -----
  concretizeAddCwR
  	| destReg leftReg rightImm |
  	rightImm := operands at: 0.
+ 	destReg := leftReg := operands at: 1.
- 	destReg := leftReg := self concreteRegister: (operands at: 1).
  	self machineCodeAt: 0 put: (self luiR: AT C: (self high16BitsOf: rightImm)).
  	self machineCodeAt: 4 put: (self oriR: AT R: AT C: (self low16BitsOf: rightImm)).
  	self machineCodeAt: 8 put: (self adduR: destReg R: leftReg R: AT).
  	^machineCodeSize := 12!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeAddRR (in category 'generate machine code - concretize') -----
  concretizeAddRR
  	| destReg leftReg rightReg |
+ 	rightReg := operands at: 0.
+ 	destReg := leftReg := operands at: 1.
- 	rightReg := self concreteRegister: (operands at: 0).
- 	destReg := leftReg := self concreteRegister: (operands at: 1).
  	self machineCodeAt: 0 put: (self adduR: destReg R: leftReg R: rightReg).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeAndCqR (in category 'generate machine code - concretize') -----
  concretizeAndCqR
  	| destReg leftReg rightImm |
  	rightImm := operands at: 0.
+ 	destReg := leftReg := operands at: 1.
- 	destReg := leftReg := self concreteRegister: (operands at: 1).
  	
  	(rightImm between: -16r8000 and: 16r7FFF) ifFalse: [^self concretizeAndCwR].
  	
  	self machineCodeAt: 0 put: (self andiR: destReg R: leftReg C: rightImm).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeAndCqRR (in category 'generate machine code - concretize') -----
  concretizeAndCqRR
  	| value srcReg dstReg |
  	value := operands at: 0.
+ 	srcReg := operands at: 1.
+ 	dstReg := operands at: 2.
- 	srcReg := self concreteRegister: (operands at: 1).
- 	dstReg := self concreteRegister: (operands at: 2).
  	self machineCodeAt: 0 put: (self luiR: AT C: (self high16BitsOf: value)).
  	self machineCodeAt: 4 put: (self oriR: AT R: AT C: (self low16BitsOf: value)).
  	self machineCodeAt: 8 put: (self andR: dstReg R: srcReg R: AT).
  	^machineCodeSize := 12!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeAndCwR (in category 'generate machine code - concretize') -----
  concretizeAndCwR
  	| destReg leftReg rightImm |
  	rightImm := operands at: 0.
+ 	destReg := leftReg := operands at: 1.
- 	destReg := leftReg := self concreteRegister: (operands at: 1).
  	self machineCodeAt: 0 put: (self luiR: AT C: (self high16BitsOf: rightImm)).
  	self machineCodeAt: 4 put: (self oriR: AT R: AT C: (self low16BitsOf: rightImm)).
  	self machineCodeAt: 8 put: (self andR: destReg R: leftReg R: AT).
  	^machineCodeSize := 12!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeAndRR (in category 'generate machine code - concretize') -----
  concretizeAndRR
  	| destReg leftReg rightReg |
+ 	rightReg := operands at: 0.
+ 	destReg := leftReg := operands at: 1.
- 	rightReg := self concreteRegister: (operands at: 0).
- 	destReg := leftReg := self concreteRegister: (operands at: 1).
  	self machineCodeAt: 0 put: (self andR: destReg R: leftReg R: rightReg).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeArithmeticShiftRightCqR (in category 'generate machine code - concretize') -----
  concretizeArithmeticShiftRightCqR
  	| distance reg |
  	distance := (operands at: 0) min: 31.
+ 	reg := operands at: 1.
- 	reg := self concreteRegister: (operands at: 1).
  	self machineCodeAt: 0 put: (self sraR: reg R: reg C: distance).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeArithmeticShiftRightRR (in category 'generate machine code - concretize') -----
  concretizeArithmeticShiftRightRR
  	| destReg distReg |
+ 	distReg := operands at: 0.
+ 	destReg := operands at: 1.
- 	distReg := self concreteRegister: (operands at: 0).
- 	destReg := self concreteRegister: (operands at: 1).
  	self machineCodeAt: 0 put: (self sravR: destReg R: destReg R: distReg).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeBrEqualRR (in category 'generate machine code - concretize') -----
  concretizeBrEqualRR
  	| offset leftReg rightReg |
  	offset := self computeJumpTargetOffsetPlus: 4.
+ 	leftReg := operands at: 1.
+ 	rightReg := operands at: 2.
- 	leftReg := self concreteRegister: (operands at: 1).
- 	rightReg := self concreteRegister: (operands at: 2).
  	self machineCodeAt: 0 put: (self beqR: leftReg R: rightReg offset: offset).
  	self machineCodeAt: 4 put: (self nop). "Delay slot"
  	^machineCodeSize := 8!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeBrLongEqualRR (in category 'generate machine code - concretize') -----
  concretizeBrLongEqualRR
  	| jumpTargetInstruction jumpTargetAddr leftReg rightReg |
  	<var: #jumpTargetInstruction type: #'AbstractInstruction *'>
  	jumpTargetInstruction := self longJumpTargetAddress.
  	self flag: #todo. "Check not crossing 256MB block."
  	jumpTargetAddr := jumpTargetInstruction asUnsignedInteger bitAnd: 16rFFFFFFF.
+ 	leftReg := operands at: 1.
+ 	rightReg := operands at: 2.
- 	leftReg := self concreteRegister: (operands at: 1).
- 	rightReg := self concreteRegister: (operands at: 2).
  
  	self machineCodeAt: 0 put: (self bneR: leftReg R: rightReg offset: 12).
  	self machineCodeAt: 4 put: (self nop). "Delay slot"
  	self machineCodeAt: 8 put: (self jA: jumpTargetAddr).
  	self machineCodeAt: 12 put: self nop. "Delay slot"
  	^machineCodeSize := 16!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeBrLongNotEqualRR (in category 'generate machine code - concretize') -----
  concretizeBrLongNotEqualRR
  	| jumpTargetInstruction jumpTargetAddr leftReg rightReg |
  	<var: #jumpTargetInstruction type: #'AbstractInstruction *'>
  	jumpTargetInstruction := self longJumpTargetAddress.
  	self flag: #todo. "Check not crossing 256MB block."
  	jumpTargetAddr := jumpTargetInstruction asUnsignedInteger bitAnd: 16rFFFFFFF.
+ 	leftReg := operands at: 1.
+ 	rightReg := operands at: 2.
- 	leftReg := self concreteRegister: (operands at: 1).
- 	rightReg := self concreteRegister: (operands at: 2).
  
  	self machineCodeAt: 0 put: (self beqR: leftReg R: rightReg offset: 12).
  	self machineCodeAt: 4 put: (self nop). "Delay slot"
  	self machineCodeAt: 8 put: (self jA: jumpTargetAddr).
  	self machineCodeAt: 12 put: self nop. "Delay slot"
  	^machineCodeSize := 16!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeBrNotEqualRR (in category 'generate machine code - concretize') -----
  concretizeBrNotEqualRR
  	| offset leftReg rightReg |
  	offset := self computeJumpTargetOffsetPlus: 4.
+ 	leftReg := operands at: 1.
+ 	rightReg := operands at: 2.
- 	leftReg := self concreteRegister: (operands at: 1).
- 	rightReg := self concreteRegister: (operands at: 2).
  	self machineCodeAt: 0 put: (self bneR: leftReg R: rightReg offset: offset).
  	self machineCodeAt: 4 put: (self nop). "Delay slot"
  	^machineCodeSize := 8!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeBrSignedGreaterEqualRR (in category 'generate machine code - concretize') -----
  concretizeBrSignedGreaterEqualRR
  	| offset leftReg rightReg |
  	offset := self computeJumpTargetOffsetPlus: 8. "Relative to delay slot"
+ 	leftReg := operands at: 1.
+ 	rightReg := operands at: 2.
- 	leftReg := self concreteRegister: (operands at: 1).
- 	rightReg := self concreteRegister: (operands at: 2).
  	self assert: leftReg ~= BranchTemp.
  	self assert: rightReg ~= BranchTemp.
  	self machineCodeAt: 0 put: (self sltR: BranchTemp R: leftReg R: rightReg).
  	self machineCodeAt: 4 put: (self beqR: BranchTemp R: ZR offset: offset).
  	self machineCodeAt: 8 put: (self nop). "Delay slot"
  	^machineCodeSize := 12!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeBrSignedGreaterRR (in category 'generate machine code - concretize') -----
  concretizeBrSignedGreaterRR
  	| offset leftReg rightReg |
  	offset := self computeJumpTargetOffsetPlus: 8. "Relative to delay slot"
+ 	leftReg := operands at: 1.
+ 	rightReg := operands at: 2.
- 	leftReg := self concreteRegister: (operands at: 1).
- 	rightReg := self concreteRegister: (operands at: 2).
  	self assert: leftReg ~= BranchTemp.
  	self assert: rightReg ~= BranchTemp.
  	self machineCodeAt: 0 put: (self sltR: BranchTemp R: rightReg R: leftReg).
  	self machineCodeAt: 4 put: (self bneR: BranchTemp R: ZR offset: offset).
  	self machineCodeAt: 8 put: (self nop). "Delay slot"
  	^machineCodeSize := 12!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeBrSignedLessEqualRR (in category 'generate machine code - concretize') -----
  concretizeBrSignedLessEqualRR
  	| offset leftReg rightReg |
  	offset := self computeJumpTargetOffsetPlus: 8. "Relative to delay slot"
+ 	leftReg := operands at: 1.
+ 	rightReg := operands at: 2.
- 	leftReg := self concreteRegister: (operands at: 1).
- 	rightReg := self concreteRegister: (operands at: 2).
  	self assert: leftReg ~= BranchTemp.
  	self assert: rightReg ~= BranchTemp.
  	self machineCodeAt: 0 put: (self sltR: BranchTemp R: rightReg R: leftReg).
  	self machineCodeAt: 4 put: (self beqR: BranchTemp R: ZR offset: offset).
  	self machineCodeAt: 8 put: (self nop). "Delay slot"
  	^machineCodeSize := 12!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeBrSignedLessRR (in category 'generate machine code - concretize') -----
  concretizeBrSignedLessRR
  	| offset leftReg rightReg |
  	offset := self computeJumpTargetOffsetPlus: 8. "Relative to delay slot"
+ 	leftReg := operands at: 1.
+ 	rightReg := operands at: 2.
- 	leftReg := self concreteRegister: (operands at: 1).
- 	rightReg := self concreteRegister: (operands at: 2).
  	self assert: leftReg ~= BranchTemp.
  	self assert: rightReg ~= BranchTemp.
  	self machineCodeAt: 0 put: (self sltR: BranchTemp R: leftReg R: rightReg).
  	self machineCodeAt: 4 put: (self bneR: BranchTemp R: ZR offset: offset).
  	self machineCodeAt: 8 put: (self nop). "Delay slot"
  	^machineCodeSize := 12!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeBrUnsignedGreaterEqualRR (in category 'generate machine code - concretize') -----
  concretizeBrUnsignedGreaterEqualRR
  	| offset leftReg rightReg |
  	offset := self computeJumpTargetOffsetPlus: 8. "Relative to delay slot"
+ 	leftReg := operands at: 1.
+ 	rightReg := operands at: 2.
- 	leftReg := self concreteRegister: (operands at: 1).
- 	rightReg := self concreteRegister: (operands at: 2).
  	self assert: leftReg ~= BranchTemp.
  	self assert: rightReg ~= BranchTemp.
  	self machineCodeAt: 0 put: (self sltuR: BranchTemp R: leftReg R: rightReg).
  	self machineCodeAt: 4 put: (self beqR: BranchTemp R: ZR offset: offset).
  	self machineCodeAt: 8 put: (self nop). "Delay slot"
  	^machineCodeSize := 12!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeBrUnsignedGreaterRR (in category 'generate machine code - concretize') -----
  concretizeBrUnsignedGreaterRR
  	| offset leftReg rightReg |
  	offset := self computeJumpTargetOffsetPlus: 8. "Relative to delay slot"
+ 	leftReg := operands at: 1.
+ 	rightReg := operands at: 2.
- 	leftReg := self concreteRegister: (operands at: 1).
- 	rightReg := self concreteRegister: (operands at: 2).
  	self assert: leftReg ~= BranchTemp.
  	self assert: rightReg ~= BranchTemp.
  	self machineCodeAt: 0 put: (self sltuR: BranchTemp R: rightReg R: leftReg).
  	self machineCodeAt: 4 put: (self bneR: BranchTemp R: ZR offset: offset).
  	self machineCodeAt: 8 put: (self nop). "Delay slot"
  	^machineCodeSize := 12!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeBrUnsignedLessEqualRR (in category 'generate machine code - concretize') -----
  concretizeBrUnsignedLessEqualRR
  	| offset leftReg rightReg |
  	offset := self computeJumpTargetOffsetPlus: 8. "Relative to delay slot"
+ 	leftReg := operands at: 1.
+ 	rightReg := operands at: 2.
- 	leftReg := self concreteRegister: (operands at: 1).
- 	rightReg := self concreteRegister: (operands at: 2).
  	self assert: leftReg ~= BranchTemp.
  	self assert: rightReg ~= BranchTemp.
  	self machineCodeAt: 0 put: (self sltuR: BranchTemp R: rightReg R: leftReg).
  	self machineCodeAt: 4 put: (self beqR: BranchTemp R: ZR offset: offset).
  	self machineCodeAt: 8 put: (self nop). "Delay slot"
  	^machineCodeSize := 12!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeBrUnsignedLessRR (in category 'generate machine code - concretize') -----
  concretizeBrUnsignedLessRR
  	| offset leftReg rightReg |
  	offset := self computeJumpTargetOffsetPlus: 8. "Relative to delay slot"
+ 	leftReg := operands at: 1.
+ 	rightReg := operands at: 2.
- 	leftReg := self concreteRegister: (operands at: 1).
- 	rightReg := self concreteRegister: (operands at: 2).
  	self assert: leftReg ~= BranchTemp.
  	self assert: rightReg ~= BranchTemp.
  	self machineCodeAt: 0 put: (self sltuR: BranchTemp R: leftReg R: rightReg).
  	self machineCodeAt: 4 put: (self bneR: BranchTemp R: ZR offset: offset).
  	self machineCodeAt: 8 put: (self nop). "Delay slot"
  	^machineCodeSize := 12!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeDivRR (in category 'generate machine code - concretize') -----
  concretizeDivRR
  	| dividendReg divisorReg |
+ 	dividendReg := operands at: 0.
+ 	divisorReg := operands at: 1.
- 	dividendReg := self concreteRegister: (operands at: 0).
- 	divisorReg := self concreteRegister: (operands at: 1).
  	self machineCodeAt: 0 put: (self divR: dividendReg R: divisorReg).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeJumpR (in category 'generate machine code - concretize') -----
  concretizeJumpR
  	| reg |
  	self flag: #OABI. "Does this ever target C code? If so we should move the target into TargetReg first."
+ 	reg := operands at: 0.
- 	reg := self concreteRegister: (operands at: 0).
  	self machineCodeAt: 0 put: (self jR: reg).
  	self machineCodeAt: 4 put: self nop. "Delay slot"
  	^machineCodeSize := 8!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeLoadEffectiveAddressMwrR (in category 'generate machine code - concretize') -----
  concretizeLoadEffectiveAddressMwrR
  	<var: #offset type: #sqInt>
  	| baseReg offset destReg |
  	offset := operands at: 0.
+ 	baseReg := operands at: 1.
+ 	destReg := operands at: 2.
- 	baseReg := self concreteRegister: (operands at: 1).
- 	destReg := self concreteRegister: (operands at: 2).
  	(self isShortOffset: offset) ifTrue:
  		[self machineCodeAt: 0 put: (self addiuR: destReg R: baseReg C: offset).
  		^machineCodeSize := 4].
  	
  	self machineCodeAt: 0 put: (self luiR: AT C: (self high16BitsOf: offset)).
  	self machineCodeAt: 4 put: (self oriR: AT R: AT C: (self low16BitsOf: offset)).
  	self machineCodeAt: 8 put: (self adduR: destReg R: baseReg R: AT).
  	^machineCodeSize := 12.
  !

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeLogicalShiftLeftCqR (in category 'generate machine code - concretize') -----
  concretizeLogicalShiftLeftCqR
  	| distance reg |
  	distance := (operands at: 0) min: 31.
+ 	reg := operands at: 1.
- 	reg := self concreteRegister: (operands at: 1).
  	self machineCodeAt: 0 put: (self sllR: reg R: reg C: distance).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeLogicalShiftLeftRR (in category 'generate machine code - concretize') -----
  concretizeLogicalShiftLeftRR
  	| destReg distReg |
+ 	distReg := operands at: 0.
+ 	destReg := operands at: 1.
- 	distReg := self concreteRegister: (operands at: 0).
- 	destReg := self concreteRegister: (operands at: 1).
  	self machineCodeAt: 0 put: (self sllvR: destReg R: destReg R: distReg).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeLogicalShiftRightCqR (in category 'generate machine code - concretize') -----
  concretizeLogicalShiftRightCqR
  	| distance reg |
  	distance := (operands at: 0) min: 31.
+ 	reg := operands at: 1.
- 	reg := self concreteRegister: (operands at: 1).
  	self machineCodeAt: 0 put: (self srlR: reg R: reg C: distance).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeLogicalShiftRightRR (in category 'generate machine code - concretize') -----
  concretizeLogicalShiftRightRR
  	| destReg distReg |
+ 	distReg := operands at: 0.
+ 	destReg := operands at: 1.
- 	distReg := self concreteRegister: (operands at: 0).
- 	destReg := self concreteRegister: (operands at: 1).
  	self machineCodeAt: 0 put: (self srlvR: destReg R: destReg R: distReg).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeMoveAbR (in category 'generate machine code - concretize') -----
  concretizeMoveAbR
  	| srcAddr destReg |
  	srcAddr := operands at: 0.
+ 	destReg := operands at: 1.
- 	destReg := self concreteRegister: (operands at: 1).
  
  	(self isAddressRelativeToVarBase: srcAddr) ifTrue:
  		[self machineCodeAt: 0 put: (self lwR: destReg base: ConcreteVarBaseReg offset: srcAddr - cogit varBaseAddress).
  		 ^machineCodeSize := 4].
  
  	self machineCodeAt: 0 put: (self luiR: AT C: (self high16BitsOf: srcAddr)).
  	self machineCodeAt: 4 put: (self oriR: AT R: AT C: (self low16BitsOf: srcAddr)).
  	self machineCodeAt: 8 put: (self lbuR: destReg base: AT offset: 0).
  	^machineCodeSize := 12!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeMoveAwR (in category 'generate machine code - concretize') -----
  concretizeMoveAwR
  	| srcAddr destReg |
  	srcAddr := operands at: 0.
+ 	destReg := operands at: 1.
- 	destReg := self concreteRegister: (operands at: 1).
  
  	(self isAddressRelativeToVarBase: srcAddr) ifTrue:
  		[self machineCodeAt: 0 put: (self lwR: destReg base: ConcreteVarBaseReg offset: srcAddr - cogit varBaseAddress).
  		 ^machineCodeSize := 4].
  
  	self machineCodeAt: 0 put: (self luiR: AT C: (self high16BitsOf: srcAddr)).
  	self machineCodeAt: 4 put: (self oriR: AT R: AT C: (self low16BitsOf: srcAddr)).
  	self machineCodeAt: 8 put: (self lwR: destReg base: AT offset: 0).
  	^machineCodeSize := 12!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeMoveCqR (in category 'generate machine code - concretize') -----
  concretizeMoveCqR
  	<var: #word type: #sqInt>
  	| word reg |
  	word := operands at: 0.
+ 	reg := operands at: 1.
- 	reg := self concreteRegister: (operands at: 1).
  	
  	(word between: -16r8000 and: 16r7FFF) ifFalse: [^self concretizeMoveCwR].
  	"Could also load up to 16rFFFF with ori or 16rXXXX0000 with lui"
  	
  	self machineCodeAt: 0 put: (self addiuR: reg R: ZR C: word).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeMoveCwR (in category 'generate machine code - concretize') -----
  concretizeMoveCwR
  	<var: #word type: #sqInt>
  	| word reg |
  	word := operands at: 0.
+ 	reg := operands at: 1.
- 	reg := self concreteRegister: (operands at: 1).	
  	self machineCodeAt: 0 put: (self luiR: reg C: (self high16BitsOf: word)).
  	self machineCodeAt: 4 put: (self oriR: reg R: reg C: (self low16BitsOf: word)).
  	^machineCodeSize := 8!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeMoveHighR (in category 'generate machine code - concretize') -----
  concretizeMoveHighR
  	| destReg |
+ 	destReg := operands at: 0.
- 	destReg := self concreteRegister: (operands at: 0).
  	self machineCodeAt: 0 put: (self mfhiR: destReg).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeMoveLowR (in category 'generate machine code - concretize') -----
  concretizeMoveLowR
  	| destReg |
+ 	destReg := operands at: 0.
- 	destReg := self concreteRegister: (operands at: 0).
  	self machineCodeAt: 0 put: (self mfloR: destReg).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeMoveM16rR (in category 'generate machine code - concretize') -----
  concretizeMoveM16rR
  	<var: #offset type: #sqInt>
  	| srcReg offset destReg |
  	offset := operands at: 0.
+ 	srcReg := operands at: 1.
+ 	destReg := operands at: 2.
- 	srcReg := self concreteRegister: (operands at: 1).
- 	destReg := self concreteRegister: (operands at: 2).
  	self machineCodeAt: 0 put: (self lhuR: destReg base: srcReg offset: offset).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeMoveMbrR (in category 'generate machine code - concretize') -----
  concretizeMoveMbrR
  	<var: #offset type: #sqInt>
  	| srcReg offset destReg |
  	offset := operands at: 0.
+ 	srcReg := operands at: 1.
+ 	destReg := operands at: 2.
- 	srcReg := self concreteRegister: (operands at: 1).
- 	destReg := self concreteRegister: (operands at: 2).
  	self machineCodeAt: 0 put: (self lbuR: destReg base: srcReg offset: offset).
  	^machineCodeSize := 4
  	!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeMoveMwrR (in category 'generate machine code - concretize') -----
  concretizeMoveMwrR
  	<var: #offset type: #sqInt>
  	| baseReg offset destReg |
  	offset := operands at: 0.
+ 	baseReg := operands at: 1.
+ 	destReg := operands at: 2.
- 	baseReg := self concreteRegister: (operands at: 1).
- 	destReg := self concreteRegister: (operands at: 2).
  	(self isShortOffset: offset) ifTrue:
  		[self machineCodeAt: 0 put: (self lwR: destReg base: baseReg offset: offset).
  		^machineCodeSize := 4].
  	
  	self machineCodeAt: 0 put: (self luiR: AT C: (self high16BitsOf: offset)).
  	self machineCodeAt: 4 put: (self oriR: AT R: AT C: (self low16BitsOf: offset)).
  	self machineCodeAt: 8 put: (self adduR: AT R: baseReg R: AT).
  	self machineCodeAt: 12 put: (self lwR: destReg base: AT offset: 0).
  	^machineCodeSize := 16.
  !

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeMoveRAb (in category 'generate machine code - concretize') -----
  concretizeMoveRAb
  	| srcReg destAddr |
+ 	srcReg := operands at: 0.
- 	srcReg := self concreteRegister: (operands at: 0).
  	destAddr := operands at: 1.
  
  	(self isAddressRelativeToVarBase: destAddr) ifTrue:
  		[self machineCodeAt: 0 put: (self swR: srcReg base: ConcreteVarBaseReg offset: destAddr - cogit varBaseAddress).
  		 ^machineCodeSize := 4].
  
  	self machineCodeAt: 0 put: (self luiR: AT C: (self high16BitsOf: destAddr)).
  	self machineCodeAt: 4 put: (self oriR: AT R: AT C: (self low16BitsOf: destAddr)).
  	self machineCodeAt: 8 put: (self sbR: srcReg base: AT offset: 0).
  	^machineCodeSize := 12!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeMoveRAw (in category 'generate machine code - concretize') -----
  concretizeMoveRAw
  	| srcReg destAddr |
+ 	srcReg := operands at: 0.
- 	srcReg := self concreteRegister: (operands at: 0).
  	destAddr := operands at: 1.
  
  	(self isAddressRelativeToVarBase: destAddr) ifTrue:
  		[self machineCodeAt: 0 put: (self swR: srcReg base: ConcreteVarBaseReg offset: destAddr - cogit varBaseAddress).
  		 ^machineCodeSize := 4].
  
  	self machineCodeAt: 0 put: (self luiR: AT C: (self high16BitsOf: destAddr)).
  	self machineCodeAt: 4 put: (self oriR: AT R: AT C: (self low16BitsOf: destAddr)).
  	self machineCodeAt: 8 put: (self swR: srcReg base: AT offset: 0).
  	^machineCodeSize := 12!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeMoveRMwr (in category 'generate machine code - concretize') -----
  concretizeMoveRMwr
  	<var: #offset type: #sqInt>
  	| srcReg offset baseReg |
+ 	srcReg := operands at: 0.
- 	srcReg := self concreteRegister: (operands at: 0).
  	offset := operands at: 1.
+ 	baseReg := operands at: 2.
- 	baseReg := self concreteRegister: (operands at: 2).
  	self machineCodeAt: 0 put: (self swR: srcReg base: baseReg offset: offset).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeMoveRR (in category 'generate machine code - concretize') -----
  concretizeMoveRR
  	| srcReg destReg |
+ 	srcReg := operands at: 0.
+ 	destReg := operands at: 1.
- 	srcReg := self concreteRegister: (operands at: 0).
- 	destReg := self concreteRegister: (operands at: 1).
  	self machineCodeAt: 0 put: (self adduR: destReg R: srcReg R: ZR).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeMoveRXbrR (in category 'generate machine code - concretize') -----
  concretizeMoveRXbrR
  	| srcReg indexReg baseReg |
+ 	srcReg := operands at: 0.
+ 	indexReg := operands at: 1.
+ 	baseReg := operands at: 2.
- 	srcReg := self concreteRegister: (operands at: 0).
- 	indexReg := self concreteRegister: (operands at: 1).
- 	baseReg := self concreteRegister: (operands at: 2).
  	self machineCodeAt: 0 put: (self adduR: AT R: baseReg R: indexReg).
  	self machineCodeAt: 4 put: (self sbR: srcReg base: AT offset: 0).
  	^machineCodeSize := 8!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeMoveRXwrR (in category 'generate machine code - concretize') -----
  concretizeMoveRXwrR
  	| srcReg indexReg baseReg |
+ 	srcReg := operands at: 0.
+ 	indexReg := operands at: 1.
+ 	baseReg := operands at: 2.
- 	srcReg := self concreteRegister: (operands at: 0).
- 	indexReg := self concreteRegister: (operands at: 1).
- 	baseReg := self concreteRegister: (operands at: 2).
  	self machineCodeAt: 0 put: (self sllR: AT R: indexReg C: 2). "index is number of words"
  	self machineCodeAt: 4 put: (self adduR: AT R: baseReg R: AT).
  	self machineCodeAt: 8 put: (self swR: srcReg base: AT offset: 0).
  	^machineCodeSize := 12!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeMoveXbrRR (in category 'generate machine code - concretize') -----
  concretizeMoveXbrRR
  	| indexReg baseReg destReg |
+ 	indexReg := operands at: 0. "index is number of *bytes*"
+ 	baseReg := operands at: 1.
+ 	destReg := operands at: 2.
- 	indexReg := self concreteRegister: (operands at: 0). "index is number of *bytes*"
- 	baseReg := self concreteRegister: (operands at: 1).
- 	destReg := self concreteRegister: (operands at: 2).
  	self machineCodeAt: 0 put: (self adduR: AT R: baseReg R: indexReg).
  	self machineCodeAt: 4 put: (self lbuR: destReg base: AT offset: 0).
  	^machineCodeSize := 8!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeMoveXwrRR (in category 'generate machine code - concretize') -----
  concretizeMoveXwrRR
  	| indexReg baseReg destReg |
+ 	indexReg := operands at: 0.
+ 	baseReg := operands at: 1.
+ 	destReg := operands at: 2.
- 	indexReg := self concreteRegister: (operands at: 0).
- 	baseReg := self concreteRegister: (operands at: 1).
- 	destReg := self concreteRegister: (operands at: 2).
  	self machineCodeAt: 0 put: (self sllR: AT R: indexReg C: 2). "index is in words"
  	self machineCodeAt: 4 put: (self adduR: AT R: baseReg R: AT).
  	self machineCodeAt: 8 put: (self lwR: destReg base: AT offset: 0).
  	^machineCodeSize := 12!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeMulCheckOverflowRR (in category 'generate machine code - concretize') -----
  concretizeMulCheckOverflowRR
  	| destReg leftReg rightReg |
+ 	rightReg := operands at: 0.
+ 	destReg := leftReg := operands at: 1.
- 	rightReg := self concreteRegister: (operands at: 0).
- 	destReg := leftReg := self concreteRegister: (operands at: 1).
  
  	"Overflow occured if the sign bit of the low part is different from the high part."
  	self machineCodeAt: 0 put: (self multR: leftReg R: rightReg).
  	self machineCodeAt: 4 put: (self mfloR: destReg).
  	self machineCodeAt: 8 put: (self sraR: OverflowTemp1 R: destReg C: 31).
  	self machineCodeAt: 12 put: (self mfhiR: OverflowTemp2).
  	^machineCodeSize := 16!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeNegateR (in category 'generate machine code - concretize') -----
  concretizeNegateR
  	| reg |
+ 	reg := operands at: 0.
- 	reg := self concreteRegister: (operands at: 0).
  	self machineCodeAt: 0 put: (self subuR: reg R: ZR R: reg).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeOrCqR (in category 'generate machine code - concretize') -----
  concretizeOrCqR
  	| destReg leftReg rightImm |
  	rightImm := operands at: 0.
+ 	destReg := leftReg := operands at: 1.
- 	destReg := leftReg := self concreteRegister: (operands at: 1).
  
  	(rightImm between: 0 and: 16rFFFF) ifFalse: [^self concretizeOrCwR].
  	
  	self machineCodeAt: 0 put: (self oriR: destReg R: leftReg C: rightImm).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeOrCwR (in category 'generate machine code - concretize') -----
  concretizeOrCwR
  	| destReg leftReg rightImm |
  	rightImm := operands at: 0.
+ 	destReg := leftReg := operands at: 1.
- 	destReg := leftReg := self concreteRegister: (operands at: 1).
  	self machineCodeAt: 0 put: (self luiR: AT C: (self high16BitsOf: rightImm)).
  	self machineCodeAt: 4 put: (self oriR: AT R: AT C: (self low16BitsOf: rightImm)).
  	self machineCodeAt: 8 put: (self orR: destReg R: leftReg R: AT).
  	^machineCodeSize := 12!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeOrRR (in category 'generate machine code - concretize') -----
  concretizeOrRR
  	| destReg leftReg rightReg |
+ 	rightReg := operands at: 0.
+ 	destReg := leftReg := operands at: 1.
- 	rightReg := self concreteRegister: (operands at: 0).
- 	destReg := leftReg := self concreteRegister: (operands at: 1).
  	self machineCodeAt: 0 put: (self orR: destReg R: leftReg R: rightReg).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizePopR (in category 'generate machine code - concretize') -----
  concretizePopR
  	| destReg |
+ 	destReg := operands at: 0.
- 	destReg := self concreteRegister: (operands at: 0).
  	self machineCodeAt: 0 put: (self lwR: destReg base: SP offset: 0).
  	self machineCodeAt: 4 put: (self addiuR: SP R: SP C: 4).
  	^machineCodeSize := 8!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizePushR (in category 'generate machine code - concretize') -----
  concretizePushR
  	| srcReg |
+ 	srcReg := operands at: 0.
- 	srcReg := self concreteRegister: (operands at: 0).
  	self machineCodeAt: 0 put: (self addiuR: SP R: SP C: -4).
  	self machineCodeAt: 4 put: (self swR: srcReg base: SP offset: 0).
  	^machineCodeSize := 8!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeSubCheckOverflowCqR (in category 'generate machine code - concretize') -----
  concretizeSubCheckOverflowCqR
  	| destReg leftReg rightImm |
  	rightImm := operands at: 0.
+ 	destReg := leftReg := operands at: 1.
- 	destReg := leftReg := self concreteRegister: (operands at: 1).
  
  	self machineCodeAt: 0 put: (self luiR: AT C: (self high16BitsOf: rightImm)).
  	self machineCodeAt: 4 put: (self oriR: AT R: AT C: (self low16BitsOf: rightImm)).
  
  	"Save original LHS"
  	self machineCodeAt: 8 put: (self adduR: OverflowTemp1 R: leftReg R: ZR). 
  	
  	"The actual subtraction"
  	self machineCodeAt: 12 put: (self subuR: destReg R: leftReg R: AT). 
  
  	"Set sign bit of OverflowTemp2 if sign of result differs from sign of RHS."
  	self machineCodeAt: 16 put: (self xorR: OverflowTemp2 R: destReg R: AT).
  	"Set sign bit of OverflowTemp1 if sign of result differs from sign of LHS."
  	self machineCodeAt: 20 put: (self xorR: OverflowTemp1 R: destReg R: OverflowTemp1).
  	"Set sign bit of Overflow if sign of result differs from both LHS and RHS, which indicates overflow."
  	self machineCodeAt: 24 put: (self andR: Overflow R: OverflowTemp1 R: OverflowTemp2).
  	^machineCodeSize := 28!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeSubCheckOverflowRR (in category 'generate machine code - concretize') -----
  concretizeSubCheckOverflowRR
  	| destReg leftReg rightReg |
+ 	rightReg := operands at: 0.
+ 	destReg := leftReg := operands at: 1.
- 	rightReg := self concreteRegister: (operands at: 0).
- 	destReg := leftReg := self concreteRegister: (operands at: 1).
  
  	"Save original LHS"
  	self machineCodeAt: 0 put: (self adduR: OverflowTemp1 R: leftReg R: ZR). 
  	
  	"The actual subtraction"
  	self machineCodeAt: 4 put: (self subuR: destReg R: leftReg R: rightReg). 
  
  	"Set sign bit of OverflowTemp2 if sign of result differs from sign of RHS."
  	self machineCodeAt: 8 put: (self xorR: OverflowTemp2 R: destReg R: rightReg).
  	"Set sign bit of OverflowTemp1 if sign of result differs from sign of LHS."
  	self machineCodeAt: 12 put: (self xorR: OverflowTemp1 R: destReg R: OverflowTemp1).
  	"Set sign bit of Overflow if sign of result differs from both LHS and RHS, which indicates overflow."
  	self machineCodeAt: 16 put: (self andR: Overflow R: OverflowTemp1 R: OverflowTemp2).
  	^machineCodeSize := 20!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeSubCqR (in category 'generate machine code - concretize') -----
  concretizeSubCqR
  	| destReg leftReg rightImm |
  	rightImm := operands at: 0.
+ 	destReg := leftReg := operands at: 1.
- 	destReg := leftReg := self concreteRegister: (operands at: 1).
  	
  	(rightImm negated between: -16r8000 and: 16r7FFF) ifFalse: [^self concretizeSubCwR].
  	
  	self machineCodeAt: 0 put: (self addiuR: destReg R: leftReg C: rightImm negated).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeSubCwR (in category 'generate machine code - concretize') -----
  concretizeSubCwR
  	| destReg leftReg rightImm |
  	rightImm := operands at: 0.
+ 	destReg := leftReg := operands at: 1.
- 	destReg := leftReg := self concreteRegister: (operands at: 1).
  	self machineCodeAt: 0 put: (self luiR: AT C: (self high16BitsOf: rightImm)).
  	self machineCodeAt: 4 put: (self oriR: AT R: AT C: (self low16BitsOf: rightImm)).
  	self machineCodeAt: 8 put: (self subuR: destReg R: leftReg R: AT).
  	^machineCodeSize := 12!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeSubRR (in category 'generate machine code - concretize') -----
  concretizeSubRR
  	| destReg leftReg rightReg |
+ 	rightReg := operands at: 0.
+ 	destReg := leftReg := operands at: 1.
- 	rightReg := self concreteRegister: (operands at: 0).
- 	destReg := leftReg := self concreteRegister: (operands at: 1).
  	self machineCodeAt: 0 put: (self subuR: destReg R: leftReg R: rightReg).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeTstCqR (in category 'generate machine code - concretize') -----
  concretizeTstCqR
  	| leftReg rightImm |
  	rightImm := operands at: 0.
+ 	leftReg := operands at: 1.
- 	leftReg := self concreteRegister: (operands at: 1).
  	
  	(rightImm between: -16r8000 and: 16r7FFF) ifFalse: [^self concretizeTstCwR].
  	
  	self machineCodeAt: 0 put: (self andiR: Cmp R: leftReg C: rightImm).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeTstCwR (in category 'generate machine code - concretize') -----
  concretizeTstCwR
  	| leftReg rightImm |
  	rightImm := operands at: 0.
+ 	leftReg := operands at: 1.
- 	leftReg := self concreteRegister: (operands at: 1).
  	self machineCodeAt: 0 put: (self luiR: AT C: (self high16BitsOf: rightImm)).
  	self machineCodeAt: 4 put: (self oriR: AT R: AT C: (self low16BitsOf: rightImm)).
  	self machineCodeAt: 8 put: (self andR: Cmp R: leftReg R: AT).
  	^machineCodeSize := 12!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeXorCwR (in category 'generate machine code - concretize') -----
  concretizeXorCwR
  	| destReg leftReg rightImm |
  	rightImm := operands at: 0.
+ 	destReg := leftReg := operands at: 1.
- 	destReg := leftReg := self concreteRegister: (operands at: 1).
  	self machineCodeAt: 0 put: (self luiR: AT C: (self high16BitsOf: rightImm)).
  	self machineCodeAt: 4 put: (self oriR: AT R: AT C: (self low16BitsOf: rightImm)).
  	self machineCodeAt: 8 put: (self xorR: destReg R: leftReg R: AT).
  	^machineCodeSize := 12!

Item was changed:
  ----- Method: CogMIPSELCompiler>>concretizeXorRR (in category 'generate machine code - concretize') -----
  concretizeXorRR
  	| destReg leftReg rightReg |
+ 	rightReg := operands at: 0.
+ 	destReg := leftReg := operands at: 1.
- 	rightReg := self concreteRegister: (operands at: 0).
- 	destReg := leftReg := self concreteRegister: (operands at: 1).
  	self machineCodeAt: 0 put: (self xorR: destReg R: leftReg R: rightReg).
  	^machineCodeSize := 4!

Item was removed:
- ----- Method: CogMIPSELCompilerForTests class>>isConcreteRISCTempRegister: (in category 'as yet unclassified') -----
- isConcreteRISCTempRegister: concreteRegister
- 	"For tests to filter-out bogus values left in the ConcreteRISCTempRegister, if any."
- 	^concreteRegister = AT
- 		or: [concreteRegister = Cmp
- 		or: [concreteRegister = Overflow
- 		or: [concreteRegister = BranchTemp]]]!

Item was added:
+ ----- Method: CogMIPSELCompilerForTests class>>isRISCTempRegister: (in category 'as yet unclassified') -----
+ isRISCTempRegister: reg
+ 	"For tests to filter-out bogus values left in the RISCTempRegister, if any."
+ 	^reg = AT
+ 		or: [reg = Cmp
+ 		or: [reg = Overflow
+ 		or: [reg = BranchTemp]]]!

Item was changed:
  ----- Method: CogObjectRepresentationFor64BitSpur>>genInnerPrimitiveNewWithArg: (in category 'primitive generators') -----
  genInnerPrimitiveNewWithArg: retNoffset
  	"Implement primitiveNewWithArg for convenient cases:
  	- the receiver has a hash
  	- the receiver is variable and not compiled method
  	- single word header/num slots < numSlotsMask
  	- the result fits in eden
  	See superclass method for dynamic frequencies of formats.
  	For the moment we implement only arrayFormat, firstByteFormat & firstLongFormat"
  
  	| headerReg fillReg instSpecReg byteSizeReg maxSlots
  	  jumpArrayTooBig jumpByteTooBig jumpLongTooBig
  	  jumpArrayFormat jumpByteFormat jumpBytePrepDone jumpLongPrepDone
  	  jumpUnhashed jumpNElementsNonInt jumpFailCuzFixed jumpNoSpace jumpHasSlots fillLoop skip |
  	<var: 'skip' type: #'AbstractInstruction *'>
  	<var: 'fillLoop' type: #'AbstractInstruction *'>	
  	<var: 'jumpHasSlots' type: #'AbstractInstruction *'>
  	<var: 'jumpNoSpace' type: #'AbstractInstruction *'>
  	<var: 'jumpUnhashed' type: #'AbstractInstruction *'>
  	<var: 'jumpByteFormat' type: #'AbstractInstruction *'>
  	<var: 'jumpByteTooBig' type: #'AbstractInstruction *'>
  	<var: 'jumpLongTooBig' type: #'AbstractInstruction *'>
  	<var: 'jumpArrayFormat' type: #'AbstractInstruction *'>
  	<var: 'jumpArrayTooBig' type: #'AbstractInstruction *'>
  	<var: 'jumpFailCuzFixed' type: #'AbstractInstruction *'>
  	<var: 'jumpBytePrepDone' type: #'AbstractInstruction *'>
  	<var: 'jumpLongPrepDone' type: #'AbstractInstruction *'>
  	<var: 'jumpNElementsNonInt' type: #'AbstractInstruction *'>
  
  	"header will contain classIndex/class's hash & format & numSlots/fixed size"
  	headerReg := SendNumArgsReg.
+ 	"Assume there's an available scratch register on 64-bit machines.  This holds the saved numFixedFields and then the value to fill with"
- 	"Assume there's an available scratch register on 64-bit machines.  This holds the saved numFixedFileds and then the value to fill with"
  	fillReg := Scratch0Reg.
+ 	self assert: fillReg > 0.
- 	self assert: (cogit backEnd concreteRegister: fillReg) > 0.
  	"inst spec will hold class's instance specification and then byte size"
  	instSpecReg := byteSizeReg := ClassReg.
  	"The max slots we'll allocate here are those for a single header"
  	maxSlots := objectMemory numSlotsMask - 1.
  
  	"get freeStart as early as possible so as not to wait later..."
  	cogit MoveAw: objectMemory freeStartAddress R: Arg1Reg.
  	"get class's hash & fail if 0"
  	self genGetHashFieldNonImmOf: ReceiverResultReg into: headerReg.
  	jumpUnhashed := cogit JumpZero: 0.
  	"get index and fail if not a +ve integer"
  	jumpNElementsNonInt := self genJumpNotSmallInteger: Arg0Reg scratchReg: TempReg.
  	"get class's format inst var for inst spec (format field)"
  	self genLoadSlot: InstanceSpecificationIndex sourceReg: ReceiverResultReg destReg: instSpecReg.
  	cogit LogicalShiftRightCq: objectMemory fixedFieldsFieldWidth + self numSmallIntegerTagBits R: instSpecReg.
  	cogit AndCq: objectMemory formatMask R: instSpecReg.
  	"Add format to classIndex/format header now"
  	cogit MoveR: instSpecReg R: TempReg.
  	cogit LogicalShiftLeftCq: objectMemory formatShift R: TempReg.
  	cogit AddR: TempReg R: headerReg.
  	"get integer value of num fields in fillReg now"
  	cogit MoveR: Arg0Reg R: fillReg.
  	self genConvertSmallIntegerToIntegerInReg: fillReg.
  	"dispatch on format, failing if not variable or if compiled method"
  	cogit CmpCq: objectMemory arrayFormat R: instSpecReg.
  	jumpArrayFormat := cogit JumpZero: 0.
  	cogit CmpCq: objectMemory firstByteFormat R: instSpecReg.
  	jumpByteFormat := cogit JumpZero: 0.
  	cogit CmpCq: objectMemory firstLongFormat R: instSpecReg.
  	jumpFailCuzFixed := cogit JumpNonZero: 0.
  
  	cogit CmpCq: (objectMemory integerObjectOf: maxSlots * 2) R: Arg0Reg.
  	jumpLongTooBig := cogit JumpAbove: 0.
  	"save num elements/slot size to instSpecReg"
  	cogit MoveR: fillReg R: instSpecReg.
  	"compute odd bits and add into headerReg; oddBits := 2 - nElements bitAnd: 1"
  	cogit MoveCq: objectMemory wordSize / 4 R: TempReg.
  	cogit SubR: instSpecReg R: TempReg.
  	cogit AndCq: objectMemory wordSize / 4 - 1 R: TempReg.
  	cogit LogicalShiftLeftCq: objectMemory formatShift R: TempReg.
  	cogit AddR: TempReg R: headerReg.
  	"round up num elements to numSlots in instSpecReg"
  	cogit AddCq: objectMemory wordSize / 4 - 1 R: instSpecReg.
  	cogit LogicalShiftRightCq: objectMemory shiftForWord - 2 R: instSpecReg.
  	cogit MoveCq: 0 R: fillReg.
  	jumpLongPrepDone := cogit Jump: 0. "go allocate"
  
  	jumpByteFormat jmpTarget:
  	(cogit CmpCq: (objectMemory integerObjectOf: maxSlots * objectMemory wordSize) R: Arg0Reg).
  	jumpByteTooBig := cogit JumpAbove: 0.
  	"save num elements to instSpecReg"
  	cogit MoveR: fillReg R: instSpecReg.
  	"compute odd bits and add into headerReg; oddBits := 4 - nElements bitAnd: 3"
  	cogit MoveCq: objectMemory wordSize R: TempReg.
  	cogit SubR: instSpecReg R: TempReg.
  	cogit AndCq: objectMemory wordSize - 1 R: TempReg.
  	cogit LogicalShiftLeftCq: objectMemory formatShift R: TempReg.
  	cogit AddR: TempReg R: headerReg.
  	"round up num elements to numSlots in instSpecReg"
  	cogit AddCq: objectMemory wordSize - 1 R: instSpecReg.
  	cogit LogicalShiftRightCq: objectMemory shiftForWord R: instSpecReg.
  	cogit MoveCq: 0 R: fillReg.
  	jumpBytePrepDone := cogit Jump: 0. "go allocate"
  
  	jumpArrayFormat jmpTarget:
  		(cogit CmpCq: (objectMemory integerObjectOf: maxSlots) R: Arg0Reg).
  	jumpArrayTooBig := cogit JumpAbove: 0.
  	"save num elements/slot size to instSpecReg"
  	cogit MoveR: fillReg R: instSpecReg.
  	cogit MoveCq: objectMemory nilObject R: fillReg.
  	"fall through to allocate"
  
  	jumpBytePrepDone jmpTarget:
  	(jumpLongPrepDone jmpTarget: cogit Label).
  
  	"store numSlots to headerReg"
  	cogit MoveR: instSpecReg R: TempReg.
  	cogit LogicalShiftLeftCq: objectMemory numSlotsFullShift R: TempReg.
  	cogit AddR: TempReg R: headerReg.
  	"compute byte size; remember 0-sized objects still need 1 slot."
  	cogit CmpCq: 0 R: byteSizeReg. "a.k.a. instSpecReg"
  	jumpHasSlots := cogit JumpNonZero: 0.
  	cogit MoveCq: objectMemory baseHeaderSize * 2 R: byteSizeReg.
  	skip := cogit Jump: 0.
  	jumpHasSlots jmpTarget:
  	(cogit AddCq: objectMemory baseHeaderSize / objectMemory wordSize R: byteSizeReg).
  	cogit LogicalShiftLeftCq: objectMemory shiftForWord R: byteSizeReg.
  	skip jmpTarget:
  	"check if allocation fits"
  	(cogit AddR: Arg1Reg R: byteSizeReg).
  	cogit CmpCq: objectMemory getScavengeThreshold R: byteSizeReg.
  	jumpNoSpace := cogit JumpAboveOrEqual: 0.
  	"get result, increment freeStart and write it back. Arg1Reg holds new freeStart, the limit of the object"
  	cogit MoveR: Arg1Reg R: ReceiverResultReg.
  	cogit MoveR: byteSizeReg Aw: objectMemory freeStartAddress.
  	"write other half of header (numSlots/0 identityHash)"
  	cogit MoveR: headerReg Mw: 0 r: ReceiverResultReg.
  	"now fill"
  	cogit LoadEffectiveAddressMw: objectMemory baseHeaderSize r: ReceiverResultReg R: Arg1Reg.
  	fillLoop := 
  	cogit MoveR: fillReg Mw: 0 r: Arg1Reg.
  	cogit AddCq: 8 R: Arg1Reg.
  	cogit CmpR: Arg1Reg R: byteSizeReg.
  	cogit JumpAbove: fillLoop.
  	cogit RetN: retNoffset.
  	
  	jumpNoSpace jmpTarget:
  	(jumpUnhashed jmpTarget:
  	(jumpFailCuzFixed jmpTarget:
  	(jumpArrayTooBig jmpTarget:
  	(jumpByteTooBig jmpTarget:
  	(jumpLongTooBig jmpTarget:
  	(jumpNElementsNonInt jmpTarget: cogit Label)))))).
  
  	^0!

Item was removed:
- ----- Method: CogOutOfLineLiteralsX64Compiler class>>isConcreteRISCTempRegister: (in category 'testing') -----
- isConcreteRISCTempRegister: concreteRegister
- 	"For tests to filter-out bogus values left in the ConcreteRISCTempRegister, if any."
- 	^false!

Item was added:
+ ----- Method: CogOutOfLineLiteralsX64Compiler class>>isRISCTempRegister: (in category 'testing') -----
+ isRISCTempRegister: reg
+ 	"For tests to filter-out bogus values left in the RISCTempRegister, if any."
+ 	^false!

Item was changed:
  CogAbstractInstruction subclass: #CogX64Compiler
  	instanceVariableNames: ''
+ 	classVariableNames: 'ABI CDQ CMPXCHGAwR CMPXCHGMwrR CPUID IDIVR IMULRR LFENCE LOCK MFENCE ModReg ModRegInd ModRegIndDisp32 ModRegIndSIB ModRegRegDisp32 ModRegRegDisp8 R10 R11 R12 R13 R14 R15 R8 R9 RAX RBP RBX RCX RDI RDX RSI RSP SFENCE SIB1 SIB2 SIB4 SIB8 XCHGAwR XCHGMwrR XCHGRR XMM0L XMM10L XMM11L XMM12L XMM13L XMM14L XMM15L XMM1L XMM2L XMM3L XMM4L XMM5L XMM6L XMM7L XMM8L XMM9L'
- 	classVariableNames: 'ABI CDQ CMPXCHGAwR CMPXCHGMwrR CPUID IDIVR IMULRR LFENCE LOCK MFENCE ModReg ModRegInd ModRegIndDisp32 ModRegIndSIB ModRegRegDisp32 ModRegRegDisp8 R10 R11 R12 R13 R14 R15 R8 R9 RAX RBP RBX RCX RDI RDX RSI RSP SFENCE SIB1 SIB2 SIB4 SIB8 XCHGAwR XCHGMwrR XCHGRR XMM0H XMM0L XMM10H XMM10L XMM11H XMM11L XMM12H XMM12L XMM13H XMM13L XMM14H XMM14L XMM15H XMM15L XMM1H XMM1L XMM2H XMM2L XMM3H XMM3L XMM4H XMM4L XMM5H XMM5L XMM6H XMM6L XMM7H XMM7L XMM8H XMM8L XMM9H XMM9L'
  	poolDictionaries: ''
  	category: 'VMMaker-JIT'!
  
  !CogX64Compiler commentStamp: 'eem 9/14/2015 17:12' prior: 0!
  I generate x64 (x86-64) instructions from CogAbstractInstructions.  For reference see
  1. IA-32 Intel® Architecture Software Developer's Manual Volume 2A: Instruction Set Reference, A-M
  2. IA-32 Intel® Architecture Software Developer's Manual Volume 2A: Instruction Set Reference, N-Z
  	http://www.intel.com/products/processor/manuals/
  or
  AMD64 Architecture Programmer's Manual Volume 3: General-Purpose and System Instructions
  AMD64 Architecture Programmer's Manual Volume 4: 128-bit Media Instructions
  AMD64 Architecture Programmer's Manual Volume 5: 64-bit Media and x87 Floating Point Instructions
  	http://developer.amd.com/resources/documentation-articles/developer-guides-manuals/
  (® is supposed to be the Unicode "registered  sign").!

Item was changed:
  ----- Method: CogX64Compiler class>>initialize (in category 'class initialization') -----
  initialize
  	"Initialize various x64 instruction-related constants.
  	 [1] IA-32 Intel® Architecture Software Developer's Manual Volume 2A: Instruction Set Reference, A-M"
  
  	"CogX64Compiler initialize"
  
  	self ~~ CogX64Compiler ifTrue: [^self].
  
  	ABI ifNil:
  		[ABI := #SysV]. "Default ABI; other choice is #MSVC"
  
  	RAX := 0.
  	RCX := 1.  "Were they completely mad or simply sadistic?"
  	RDX := 2.
  	RBX := 3.
  	RSP := 4.
  	RBP := 5.
  	RSI := 6.
  	RDI := 7.
  	R8 := 8.
  	R9 := 9.
  	R10 := 10.
  	R11 := 11.
  	R12 := 12.
  	R13 := 13.
  	R14 := 14.
  	R15 := 15.
  
  	XMM0L := 0.
+ 	XMM1L := 1.
+ 	XMM2L := 2.
+ 	XMM3L := 3.
+ 	XMM4L := 4.
+ 	XMM5L := 5.
+ 	XMM6L := 6.
+ 	XMM7L := 7.
+ 	XMM8L := 8.
+ 	XMM9L := 9.
+ 	XMM10L := 10.
+ 	XMM11L := 11.
+ 	XMM12L := 12.
+ 	XMM13L := 13.
+ 	XMM14L := 14.
+ 	XMM15L := 15.
- 	XMM1L := 2.
- 	XMM2L := 4.
- 	XMM3L := 6.
- 	XMM4L := 8.
- 	XMM5L := 10.
- 	XMM6L := 12.
- 	XMM7L := 14.
- 	XMM8L := 16.
- 	XMM9L := 18.
- 	XMM10L := 20.
- 	XMM11L := 22.
- 	XMM12L := 24.
- 	XMM13L := 26.
- 	XMM14L := 28.
- 	XMM15L := 30.
  
- 	XMM0H := 1.
- 	XMM1H := 3.
- 	XMM2H := 5.
- 	XMM3H := 7.
- 	XMM4H := 9.
- 	XMM5H := 11.
- 	XMM6H := 13.
- 	XMM7H := 15.
- 	XMM8H := 17.
- 	XMM9H := 19.
- 	XMM10H := 21.
- 	XMM11H := 23.
- 	XMM12H := 25.
- 	XMM13H := 27.
- 	XMM14H := 29.
- 	XMM15H := 31.
- 
  	"Mod R/M Mod fields.  See [1] Sec 2.4, 2.5 & 2.6 & Table 2-2"
  	ModRegInd := 0.
  		ModRegIndSIB := 4.
  		ModRegIndDisp32 := 5.
  	ModRegRegDisp8 := 1.
  	ModRegRegDisp32 := 2.
  	ModReg := 3.
  
  	"SIB Scaled Index modes.  See [1] Sec 2.4, 2.5 & 2.6 & Table 2-3"
  	SIB1 := 0.
  	SIB2 := 1.
  	SIB4 := 2.
  	SIB8 := 3.
  
  	"Specific instructions"
  	self
  		initializeSpecificOpcodes: #(CDQ IDIVR IMULRR CPUID LFENCE MFENCE SFENCE LOCK CMPXCHGAwR CMPXCHGMwrR XCHGAwR XCHGMwrR XCHGRR)
  		in: thisContext method!

Item was changed:
  ----- Method: CogX64Compiler>>cResultRegister (in category 'accessing') -----
  cResultRegister
+ 	"Answer the register through which C funcitons return integral results."
+ 	<inline: true>
+ 	^RAX!
- 	"Answer the abstract register for the C result register.
- 	 Only partially implemented.  Works on x64 since TempReg = RAX = C result reg."
- 	^self abstractRegisterForConcreteRegister: RAX!

Item was changed:
  ----- Method: CogX64Compiler>>callerSavedRegisterMask (in category 'accessing') -----
  callerSavedRegisterMask
  	"See e.g. Figure 3.4 Register Usage in
  		System V Application Binary Interface
  		AMD64 Architecture Processor Supplement
  	 N.B.  We are playing fast and loose here being processor-specific.
  	 Soon enough this needs to be OS-specific."
  	^cogit
+ 		registerMaskFor: RAX
+ 		and: RCX
+ 		and: RDX
+ 		and: RSI
+ 		and: RDI
+ 		and: R8
+ 		and: R9
+ 		and: R10
+ 		and: R11!
- 		registerMaskFor: (self abstractRegisterForConcreteRegister: RAX)
- 		and: (self abstractRegisterForConcreteRegister: RCX)
- 		and: (self abstractRegisterForConcreteRegister: RDX)
- 		and: (self abstractRegisterForConcreteRegister: RSI)
- 		and: (self abstractRegisterForConcreteRegister: RDI)
- 		and: (self abstractRegisterForConcreteRegister: R8)
- 		and: (self abstractRegisterForConcreteRegister: R9)
- 		and: (self abstractRegisterForConcreteRegister: R10)
- 		and: (self abstractRegisterForConcreteRegister: R11)!

Item was changed:
  ----- Method: CogX64Compiler>>computeMaximumSize (in category 'generate machine code') -----
(excessive size, no diff calculated)

Item was changed:
  ----- Method: CogX64Compiler>>computeShiftRRSize (in category 'generate machine code') -----
  computeShiftRRSize
  	"On the x86 the only instructions that shift by the value of a
  	 register require the shift count to be  in %ecx.  So we may
  	 have to use swap instructions to get the count into ecx."
  	| shiftCountReg |
+ 	shiftCountReg := operands at: 0.
- 	shiftCountReg := self concreteRegister: (operands at: 0).
  	shiftCountReg = RCX ifTrue:
  		[^maxSize := 3].
  	^maxSize := shiftCountReg = RAX
  					ifTrue: [2 "XCHG RAX,r2" + 3 "Sxx" + 2 "XCHG RAX,r2"]
  					ifFalse: [3 "XCHG r1,r2" + 3 "Sxx" + 3 "XCHG r1,r2"]!

Item was changed:
  ----- Method: CogX64Compiler>>concretizeArithCqRWithRO:raxOpcode: (in category 'generate machine code') -----
  concretizeArithCqRWithRO: regOpcode raxOpcode: raxOpcode
  	"Will get inlined into concretizeAt: switch."
  	<inline: false>
  	| value reg |
  	value := operands at: 0.
+ 	reg := operands at: 1.
- 	reg := self concreteRegister: (operands at: 1).
  	machineCode
  		at: 0 put: (self rexR: 0 x: 0 b: reg).
  	(self isQuick: value) ifTrue:
  		[machineCode
  			at: 1 put: 16r83;
  			at: 2 put: (self mod: ModReg RM: reg RO: regOpcode);
  			at: 3 put: (value bitAnd: 16rFF).
  		 ^machineCodeSize := 4].
  	(self isSignExtendedFourByteValue: value) ifTrue:
  		[reg = RAX ifTrue:
  			[machineCode
  				at: 1 put: raxOpcode;
  				at: 2 put: (value bitAnd: 16rFF);
  				at: 3 put: (value >> 8 bitAnd: 16rFF);
  				at: 4 put: (value >> 16 bitAnd: 16rFF);
  				at: 5 put: (value >> 24 bitAnd: 16rFF).
  			 ^machineCodeSize := 6].
  		machineCode
  			at: 1 put: 16r81;
  			at: 2 put: (self mod: ModReg RM: reg RO: regOpcode);
  			at: 3 put: (value bitAnd: 16rFF);
  			at: 4 put: (value >> 8 bitAnd: 16rFF);
  			at: 5 put: (value >> 16 bitAnd: 16rFF);
  			at: 6 put: (value >> 24 bitAnd: 16rFF).
  		 ^machineCodeSize := 7].
  	^self concretizeArithCwR: (raxOpcode = 16r3D "Cmp" ifTrue: [16r39] ifFalse: [raxOpcode - 2])!

Item was changed:
  ----- Method: CogX64Compiler>>concretizeCmpC32R (in category 'generate machine code') -----
  concretizeCmpC32R
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| value reg |
  	value := operands at: 0.
+ 	reg := operands at: 1.
- 	reg := self concreteRegister: (operands at: 1).
  	reg = RAX ifTrue:
  		[machineCode
  			at: 0 put: 16r48;
  			at: 1 put: 16r3D;
  			at: 2 put: (value bitAnd: 16rFF);
  			at: 3 put: (value >> 8 bitAnd: 16rFF);
  			at: 4 put: (value >> 16 bitAnd: 16rFF);
  			at: 5 put: (value >> 24 bitAnd: 16rFF).
  		 ^machineCodeSize := 6].
  	machineCode
  		at: 0 put: 16r49;
  		at: 1 put: 16r81;
  		at: 2 put: (self mod: ModReg RM: reg RO: 7);
  		at: 3 put: (value bitAnd: 16rFF);
  		at: 4 put: (value >> 8 bitAnd: 16rFF);
  		at: 5 put: (value >> 16 bitAnd: 16rFF);
  		at: 6 put: (value >> 24 bitAnd: 16rFF).
  	 ^machineCodeSize := 7!

Item was changed:
  ----- Method: CogX64Compiler>>concretizeCmpRdRd (in category 'generate machine code') -----
  concretizeCmpRdRd
  	"Will get inlined into concretizeAt: switch.
  	 We use UCOMISD (see p 4-260 [2])"
  	<inline: true>
  	| regLHS regRHS |
  	"CmpRR RHS LHS computes LHS - RHS, i.e. apparently reversed.  You have to think subtract."
+ 	regRHS := operands at: 0.
+ 	regLHS := operands at: 1.
- 	regRHS := self concreteDPFPRegister: (operands at: 0).
- 	regLHS := self concreteDPFPRegister: (operands at: 1).
  	machineCode
  		at: 0 put: 16r66;
  		at: 1 put: 16r0F;
  		at: 2 put: 16r2E;
  		at: 3 put: (self mod: ModReg RM: regRHS RO: regLHS).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogX64Compiler>>concretizeConvertRRd (in category 'generate machine code') -----
  concretizeConvertRRd
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| srcReg destReg |
+ 	srcReg := operands at:0.
+ 	destReg := operands at: 1.
- 	srcReg := self concreteRegister: (operands at:0).
- 	destReg := self concreteDPFPRegister: (operands at: 1).
  	machineCode
  		at: 0 put: 16rF2;
  		at: 1 put: (self rexR: destReg x: 0 b: srcReg);
  		at: 2 put: 16r0F;
  		at: 3 put: 16r2A;
  		at: 4 put: (self mod: ModReg RM: srcReg RO: destReg).
  	 ^machineCodeSize := 5!

Item was changed:
  ----- Method: CogX64Compiler>>concretizeIDIVR (in category 'generate machine code') -----
  concretizeIDIVR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| regDivisor |
+ 	regDivisor := operands at: 0.
- 	regDivisor := self concreteRegister: (operands at: 0).
  	machineCode
  		at: 0 put: (self rexR: 0 x: 0 b: regDivisor);
  		at: 1 put: 16rF7;
  		at: 2 put: (self mod: ModReg RM: regDivisor RO: 7).
  	^machineCodeSize := 3!

Item was changed:
  ----- Method: CogX64Compiler>>concretizeJumpR (in category 'generate machine code') -----
  concretizeJumpR
  	<inline: true>
  	| reg |
+ 	reg := operands at: 0.
- 	reg := self concreteRegister: (operands at: 0).
  	machineCode
  		at: 0 put: 16rFF;
  		at: 1 put: (self mod: ModReg RM: reg RO: 4).
  	^machineCodeSize := 2!

Item was changed:
  ----- Method: CogX64Compiler>>concretizeLoadEffectiveAddressMwrR (in category 'generate machine code') -----
  concretizeLoadEffectiveAddressMwrR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| srcReg offset destReg |
  	offset := operands at: 0.
+ 	srcReg := operands at: 1.
+ 	destReg := operands at: 2.
- 	srcReg := self concreteRegister: (operands at: 1).
- 	destReg := self concreteRegister: (operands at: 2).
  	machineCode
  		at: 0 put: (self rexR: destReg x: 0 b: srcReg);
  		at: 1 put: 16r8D.
  	(srcReg ~= RSP and: [srcReg ~= R12]) ifTrue:
  		[(self isQuick: offset) ifTrue:
  			[machineCode
  				at: 2 put: (self mod: ModRegRegDisp8 RM: srcReg RO: destReg);
  				at: 3 put: (offset bitAnd: 16rFF).
  			 ^machineCodeSize := 4].
  		machineCode
  			at: 2 put: (self mod: ModRegRegDisp32 RM: srcReg RO: destReg);
  			at: 3 put: (offset bitAnd: 16rFF);
  			at: 4 put: (offset >> 8 bitAnd: 16rFF);
  			at: 5 put: (offset >> 16 bitAnd: 16rFF);
  			at: 6 put: (offset >> 24 bitAnd: 16rFF).
  		^machineCodeSize := 7].
  	"ESP/R12:"
  	(self isQuick: offset) ifTrue:
  		[machineCode
  			at: 2 put: (self mod: ModRegRegDisp8 RM: srcReg RO: destReg);
  			at: 3 put: (self s: SIB1 i: 4 b: srcReg);
  			at: 4 put: (offset bitAnd: 16rFF).
  		 ^machineCodeSize := 5].
  	machineCode
  		at: 2 put: (self mod: ModRegRegDisp32 RM: srcReg RO: destReg);
  		at: 3 put: (self s: SIB1 i: 4 b: srcReg);
  		at: 4 put: (offset bitAnd: 16rFF);
  		at: 5 put: (offset >> 8 bitAnd: 16rFF);
  		at: 6 put: (offset >> 16 bitAnd: 16rFF);
  		at: 7 put: (offset >> 24 bitAnd: 16rFF).
  	^machineCodeSize := 8!

Item was changed:
  ----- Method: CogX64Compiler>>concretizeMoveAbR (in category 'generate machine code') -----
  concretizeMoveAbR
  	"N.B. The Cogit makes no assumption about the upper bits being set to zero because we
  	 deny byteReadsZeroExtend.  The cogit will clear the register before hand if necessary."
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| addressOperand reg offset save0 save1 |
  	addressOperand := operands at: 0.
  	(self isAnInstruction: (cogit cCoerceSimple: addressOperand to: #'AbstractInstruction *')) ifTrue:
  		[addressOperand := (cogit cCoerceSimple: addressOperand to: #'AbstractInstruction *') address].
  	(self isAddressRelativeToVarBase: addressOperand) ifTrue:
  		[save0 := operands at: 0.
  		 save1 := operands at: 1.
  		 operands
  			at: 0 put: addressOperand - cogit varBaseAddress;
  			at: 1 put: RBX;
  			at: 2 put: save1.
  		 self concretizeMoveMbrR.
  		 operands
  			at: 0 put: save0;
  			at: 1 put: save1;
  			at: 2 put: 0.
  		^machineCodeSize].
+ 	reg := operands at: 1.
- 	reg := self concreteRegister: (operands at: 1).
  	reg = RAX
  		ifTrue: [offset := 0]
  		ifFalse:
  			[machineCode
  				at: 0 put: (self rexR: 0 x: 0 b: reg);
  				at: 1 put: 16r90 + (reg \\ 8).
  			 offset := 2].
  	machineCode
  		at: 0 + offset put: 16r48;
  		at: 1 + offset put: 16rA0;
  		at: 2 + offset put: (addressOperand bitAnd: 16rFF);
  		at: 3 + offset put: (addressOperand >> 8 bitAnd: 16rFF);
  		at: 4 + offset put: (addressOperand >> 16 bitAnd: 16rFF);
  		at: 5 + offset put: (addressOperand >> 24 bitAnd: 16rFF);
  		at: 6 + offset put: (addressOperand >> 32 bitAnd: 16rFF);
  		at: 7 + offset put: (addressOperand >> 40 bitAnd: 16rFF);
  		at: 8 + offset put: (addressOperand >> 48 bitAnd: 16rFF);
  		at: 9 + offset put: (addressOperand >> 56 bitAnd: 16rFF).
  	reg = RAX ifTrue:
  		[^machineCodeSize := 10].
  	machineCode
  		at: 12 put: (machineCode at: 0);
  		at: 13 put: (machineCode at: 1).
  	^machineCodeSize := 14!

Item was changed:
  ----- Method: CogX64Compiler>>concretizeMoveAwR (in category 'generate machine code') -----
  concretizeMoveAwR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| addressOperand reg offset save0 save1 |
  	addressOperand := operands at: 0.
  	(self isAnInstruction: (cogit cCoerceSimple: addressOperand to: #'AbstractInstruction *')) ifTrue:
  		[addressOperand := (cogit cCoerceSimple: addressOperand to: #'AbstractInstruction *') address].
  	(self isAddressRelativeToVarBase: addressOperand) ifTrue:
  		[save0 := operands at: 0.
  		 save1 := operands at: 1.
  		 operands
  			at: 0 put: addressOperand - cogit varBaseAddress;
  			at: 1 put: RBX;
  			at: 2 put: save1.
  		 self concretizeMoveMwrR.
  		 operands
  			at: 0 put: save0;
  			at: 1 put: save1;
  			at: 2 put: 0.
  		^machineCodeSize].
+ 	reg := operands at: 1.
- 	reg := self concreteRegister: (operands at: 1).
  	reg = RAX
  		ifTrue: [offset := 0]
  		ifFalse:
  			[machineCode
  				at: 0 put: (self rexR: 0 x: 0 b: reg);
  				at: 1 put: 16r90 + (reg \\ 8).
  			 offset := 2].
  	machineCode
  		at: 0 + offset put: 16r48;
  		at: 1 + offset put: 16rA1;
  		at: 2 + offset put: (addressOperand bitAnd: 16rFF);
  		at: 3 + offset put: (addressOperand >> 8 bitAnd: 16rFF);
  		at: 4 + offset put: (addressOperand >> 16 bitAnd: 16rFF);
  		at: 5 + offset put: (addressOperand >> 24 bitAnd: 16rFF);
  		at: 6 + offset put: (addressOperand >> 32 bitAnd: 16rFF);
  		at: 7 + offset put: (addressOperand >> 40 bitAnd: 16rFF);
  		at: 8 + offset put: (addressOperand >> 48 bitAnd: 16rFF);
  		at: 9 + offset put: (addressOperand >> 56 bitAnd: 16rFF).
  	reg = RAX ifTrue:
  		[^machineCodeSize := 10].
  	machineCode
  		at: 12 put: (machineCode at: 0);
  		at: 13 put: (machineCode at: 1).
  	^machineCodeSize := 14!

Item was changed:
  ----- Method: CogX64Compiler>>concretizeMoveC32R (in category 'generate machine code') -----
  concretizeMoveC32R
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| value reg |
  	value := operands at: 0.
+ 	reg := operands at: 1.
- 	reg := self concreteRegister: (operands at: 1).
  	machineCode
  		at: 0 put: (self rexR: 0 x: 0 b: reg);
  		at: 1 put: 16rC7;
  		at: 2 put: (self mod: ModReg RM: reg RO: 0);
  		at: 3 put: (value bitAnd: 16rFF);
  		at: 4 put: (value >> 8 bitAnd: 16rFF);
  		at: 5 put: (value >> 16 bitAnd: 16rFF);
  		at: 6 put: (value >> 24 bitAnd: 16rFF).
  	^machineCodeSize := 7!

Item was changed:
  ----- Method: CogX64Compiler>>concretizeMoveCqR (in category 'generate machine code') -----
  concretizeMoveCqR
  	"Will get inlined into concretizeAt: switch.
  	 On x64 we can short-cut mov 0, reg using xor, and use 32-bit displacement, signed or unsigned, if possible."
  	<inline: true>
  	| value reg |
  	value := operands at: 0.
  	(self is32BitSignedImmediate: value) ifFalse:
  		[^self concretizeMoveCwR].
+ 	reg := operands at: 1.
- 	reg := self concreteRegister: (operands at: 1).
  	value = 0 ifTrue:
  		[machineCode
  			at: 0 put: (self rexR: reg x: 0 b: reg);
  			at: 1 put: 16r31;
  			at: 2 put: (self mod: ModReg RM: reg RO: reg).
  		^machineCodeSize := 3].
  	machineCode
  		at: 0 put: (self rexR: 0 x: 0 b: reg);
  		at: 1 put: 16rC7;
  		at: 2 put: (self mod: ModReg RM: reg RO: 0);
  		at: 3 put: (value bitAnd: 16rFF);
  		at: 4 put: (value >> 8 bitAnd: 16rFF);
  		at: 5 put: (value >> 16 bitAnd: 16rFF);
  		at: 6 put: (value >> 24 bitAnd: 16rFF).
  	^machineCodeSize := 7!

Item was changed:
  ----- Method: CogX64Compiler>>concretizeMoveM16rR (in category 'generate machine code') -----
  concretizeMoveM16rR
  	"N.B. The Cogit compiler makes no assumption about the upper bits being set to zero.
  	 It will clear the register before hand if necessary."
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| srcReg offset destReg |
  	offset := operands at: 0.
+ 	srcReg := operands at: 1.
+ 	destReg := operands at: 2.
- 	srcReg := self concreteRegister: (operands at: 1).
- 	destReg := self concreteRegister: (operands at: 2).
  	machineCode
  		at: 0 put: (self rexR: destReg x: 0 b: srcReg);
  		at: 1 put: 16r0f;
  		at: 2 put: 16rb7.
  	(srcReg ~= RSP and: [srcReg ~= R12]) ifTrue:
  		[(offset = 0 and: [destReg ~= RBP and: [destReg ~= R13]]) ifTrue:
  			[machineCode
  				at: 3 put: (self mod: ModRegInd RM: srcReg RO: destReg).
  			 ^machineCodeSize := 4].
  		 (self isQuick: offset) ifTrue:
  			[machineCode
  				at: 3 put: (self mod: ModRegRegDisp8 RM: srcReg RO: destReg);
  				at: 4 put: (offset bitAnd: 16rFF).
  			 ^machineCodeSize := 5].
  		machineCode
  			at: 3 put: (self mod: ModRegRegDisp32 RM: srcReg RO: destReg);
  			at: 4 put: (offset bitAnd: 16rFF);
  			at: 5 put: (offset >> 8 bitAnd: 16rFF);
  			at: 6 put: (offset >> 16 bitAnd: 16rFF);
  			at: 7 put: (offset >> 24 bitAnd: 16rFF).
  		^machineCodeSize := 8].
  	"RSP & R12:"
  	(offset = 0 and: [destReg ~= RBP and: [destReg ~= R13]]) ifTrue:
  		[machineCode
  			at: 3 put: (self mod: ModRegInd RM: srcReg RO: destReg);
  			at: 4 put: (self s: SIB1 i: 4 b: srcReg).
  		 ^machineCodeSize := 5].
  	(self isQuick: offset) ifTrue:
  		[machineCode
  			at: 3 put: (self mod: ModRegRegDisp8 RM: srcReg RO: destReg);
  			at: 4 put: (self s: SIB1 i: 4 b: srcReg);
  			at: 5 put: (offset bitAnd: 16rFF).
  		 ^machineCodeSize := 6].
  	machineCode
  		at: 3 put: (self mod: ModRegRegDisp32 RM: srcReg RO: destReg);
  		at: 4 put: (self s: SIB1 i: 4 b: srcReg);
  		at: 5 put: (offset bitAnd: 16rFF);
  		at: 6 put: (offset >> 8 bitAnd: 16rFF);
  		at: 7 put: (offset >> 16 bitAnd: 16rFF);
  		at: 8 put: (offset >> 24 bitAnd: 16rFF).
  	^machineCodeSize := 9!

Item was changed:
  ----- Method: CogX64Compiler>>concretizeMoveM64rRd (in category 'generate machine code') -----
  concretizeMoveM64rRd
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| offset srcReg destReg skip |
  	offset := operands at: 0.
+ 	srcReg := operands at: 1.
+ 	destReg := operands at: 2.
- 	srcReg := self concreteRegister: (operands at: 1).
- 	destReg := self concreteDPFPRegister: (operands at: 2).
  	machineCode at: 0 put: 16rF3.
  	(srcReg <= 7 and: [destReg <= 7])
  		ifTrue: [skip := 0]
  		ifFalse: [machineCode at: (skip := 1) put: (self rexw: false r: destReg x: 0 b: srcReg)].
  	machineCode
  		at: skip + 1 put: 16r0f;
  		at: skip + 2 put: 16r7e.
  	offset = 0 ifTrue:
  		[(srcReg bitAnd: 6) ~= RSP ifTrue:
  			[machineCode at: skip + 3 put: (self mod: ModRegInd RM: srcReg RO: destReg).
  			 ^machineCodeSize := skip + 4].
  		 (srcReg bitAnd: 7) = RSP ifTrue: "RBP & R13 fall through"
  			[machineCode
  				at: skip + 3 put: (self mod: ModRegInd RM: srcReg RO: destReg);
  				at: skip + 4 put: (self s: SIB1 i: 4 b: srcReg).
  			 ^machineCodeSize := skip + 5]].
  	(self isQuick: offset) ifTrue:
  		[(srcReg bitAnd: 7) ~= RSP ifTrue:
  			[machineCode
  				at: skip + 3 put: (self mod: ModRegRegDisp8 RM: srcReg RO: destReg);
  				at: skip + 4 put: (offset bitAnd: 16rFF).
  			 ^machineCodeSize := skip + 5].
  		 machineCode
  			at: skip + 3 put: (self mod: ModRegRegDisp8 RM: srcReg RO: destReg);
  			at: skip + 4 put: (self s: SIB1 i: 4 b: srcReg);
  			at: skip + 5 put: (offset bitAnd: 16rFF).
  		 ^machineCodeSize := skip + 6].
  	machineCode at: skip + 3 put: (self mod: ModRegRegDisp32 RM: srcReg RO: destReg).
  	(srcReg bitAnd: 7) = RSP ifTrue:
  		[machineCode at: skip + 4 put: (self s: SIB1 i: 4 b: srcReg).
  		 skip := skip + 1].
  	machineCode
  		at: skip + 4 put: (offset bitAnd: 16rFF);
  		at: skip + 5 put: (offset >> 8 bitAnd: 16rFF);
  		at: skip + 6 put: (offset >> 16 bitAnd: 16rFF);
  		at: skip + 7 put: (offset >> 24 bitAnd: 16rFF).
  	^machineCodeSize := skip + 8!

Item was changed:
  ----- Method: CogX64Compiler>>concretizeMoveMbrR (in category 'generate machine code') -----
  concretizeMoveMbrR
  	"N.B. The Cogit makes no assumption about the upper bits being set to zero because we
  	 deny byteReadsZeroExtend.  The cogit will clear the register before hand if necessary."
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| srcReg offset destReg |
  	offset := operands at: 0.
+ 	srcReg := operands at: 1.
+ 	destReg := operands at: 2.
- 	srcReg := self concreteRegister: (operands at: 1).
- 	destReg := self concreteRegister: (operands at: 2).
  	machineCode
  		at: 0 put: (self rexR: destReg x: 0 b: srcReg);
  		at: 1 put: 16r8A.
  	(srcReg ~= RSP and: [srcReg ~= R12]) ifTrue:
  		[(offset = 0 and: [srcReg ~= RBP and: [srcReg ~= R13]]) ifTrue:
  			[machineCode
  				at: 2 put: (self mod: ModRegInd RM: srcReg RO: destReg).
  			 ^machineCodeSize := 3].
  		(self isQuick: offset) ifTrue:
  			[machineCode
  				at: 2 put: (self mod: ModRegRegDisp8 RM: srcReg RO: destReg);
  				at: 3 put: (offset bitAnd: 16rFF).
  			 ^machineCodeSize := 4].
  		machineCode
  			at: 2 put: (self mod: ModRegRegDisp32 RM: srcReg RO: destReg);
  			at: 3 put: (offset bitAnd: 16rFF);
  			at: 4 put: (offset >> 8 bitAnd: 16rFF);
  			at: 5 put: (offset >> 16 bitAnd: 16rFF);
  			at: 6 put: (offset >> 24 bitAnd: 16rFF).
  		^machineCodeSize := 7].
  	"RSP:"
  	offset = 0 ifTrue:
  		[machineCode
  			at: 2 put: (self mod: ModRegInd RM: srcReg RO: destReg);
  			at: 3 put: (self s: SIB1 i: 4 b: srcReg).
  		 ^machineCodeSize := 4].
  	(self isQuick: offset) ifTrue:
  		[machineCode
  			at: 2 put: (self mod: ModRegRegDisp8 RM: srcReg RO: destReg);
  			at: 3 put: (self s: SIB1 i: 4 b: srcReg);
  			at: 4 put: (offset bitAnd: 16rFF).
  		 ^machineCodeSize := 5].
  	machineCode
  		at: 2 put: (self mod: ModRegRegDisp32 RM: srcReg RO: destReg);
  		at: 3 put: (self s: SIB1 i: 4 b: srcReg);
  		at: 4 put: (offset bitAnd: 16rFF);
  		at: 5 put: (offset >> 8 bitAnd: 16rFF);
  		at: 6 put: (offset >> 16 bitAnd: 16rFF);
  		at: 7 put: (offset >> 24 bitAnd: 16rFF).
  	^machineCodeSize := 8!

Item was changed:
  ----- Method: CogX64Compiler>>concretizeMoveMwrR (in category 'generate machine code') -----
  concretizeMoveMwrR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| srcReg offset destReg |
  	offset := operands at: 0.
+ 	srcReg := operands at: 1.
+ 	destReg := operands at: 2.
- 	srcReg := self concreteRegister: (operands at: 1).
- 	destReg := self concreteRegister: (operands at: 2).
  	machineCode
  		at: 0 put: (self rexR: destReg x: 0 b: srcReg);
  		at: 1 put: 16r8B.
  	(srcReg ~= RSP and: [srcReg ~= R12]) ifTrue:
  		[(offset = 0 and: [srcReg ~= RBP and: [srcReg ~= R13]]) ifTrue:
  			[machineCode
  				at: 2 put: (self mod: ModRegInd RM: srcReg RO: destReg).
  			 ^machineCodeSize := 3].
  		(self isQuick: offset) ifTrue:
  			[machineCode
  				at: 2 put: (self mod: ModRegRegDisp8 RM: srcReg RO: destReg);
  				at: 3 put: (offset bitAnd: 16rFF).
  			 ^machineCodeSize := 4].
  		machineCode
  			at: 2 put: (self mod: ModRegRegDisp32 RM: srcReg RO: destReg);
  			at: 3 put: (offset bitAnd: 16rFF);
  			at: 4 put: (offset >> 8 bitAnd: 16rFF);
  			at: 5 put: (offset >> 16 bitAnd: 16rFF);
  			at: 6 put: (offset >> 24 bitAnd: 16rFF).
  		^machineCodeSize := 7].
  	"RSP:"
  	offset = 0 ifTrue:
  		[machineCode
  			at: 2 put: (self mod: ModRegInd RM: srcReg RO: destReg);
  			at: 3 put: (self s: SIB1 i: 4 b: srcReg).
  		 ^machineCodeSize := 4].
  	(self isQuick: offset) ifTrue:
  		[machineCode
  			at: 2 put: (self mod: ModRegRegDisp8 RM: srcReg RO: destReg);
  			at: 3 put: (self s: SIB1 i: 4 b: srcReg);
  			at: 4 put: (offset bitAnd: 16rFF).
  		 ^machineCodeSize := 5].
  	machineCode
  		at: 2 put: (self mod: ModRegRegDisp32 RM: srcReg RO: destReg);
  		at: 3 put: (self s: SIB1 i: 4 b: srcReg);
  		at: 4 put: (offset bitAnd: 16rFF);
  		at: 5 put: (offset >> 8 bitAnd: 16rFF);
  		at: 6 put: (offset >> 16 bitAnd: 16rFF);
  		at: 7 put: (offset >> 24 bitAnd: 16rFF).
  	^machineCodeSize := 8!

Item was changed:
  ----- Method: CogX64Compiler>>concretizeMoveRAb (in category 'generate machine code') -----
  concretizeMoveRAb
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| addressOperand reg offset save1 |
+ 	reg := operands at: 0.
- 	reg := self concreteRegister: (operands at: 0).
  	addressOperand := operands at: 1.
  	(self isAnInstruction: (cogit cCoerceSimple: addressOperand to: #'AbstractInstruction *')) ifTrue:
  		[addressOperand := (cogit cCoerceSimple: addressOperand to: #'AbstractInstruction *') address].
  	(self isAddressRelativeToVarBase: addressOperand) ifTrue:
  		[save1 := operands at: 1.
  		 operands
  			at: 1 put: addressOperand - cogit varBaseAddress;
  			at: 2 put: RBX.
  		 self concretizeMoveRMbr.
  		 operands
  			at: 1 put: save1;
  			at: 2 put: 0.
  		^machineCodeSize].
  	reg = RAX
  		ifTrue: [offset := 0]
  		ifFalse:
  			[machineCode
  				at: 0 put: (self rexR: 0 x: 0 b: reg);
  				at: 1 put: 16r90 + (reg \\ 8).
  			 offset := 2].
  	machineCode
  		at: 0 + offset put: 16r48;
  		at: 1 + offset put: 16rA2;
  		at: 2 + offset put: (addressOperand bitAnd: 16rFF);
  		at: 3 + offset put: (addressOperand >> 8 bitAnd: 16rFF);
  		at: 4 + offset put: (addressOperand >> 16 bitAnd: 16rFF);
  		at: 5 + offset put: (addressOperand >> 24 bitAnd: 16rFF);
  		at: 6 + offset put: (addressOperand >> 32 bitAnd: 16rFF);
  		at: 7 + offset put: (addressOperand >> 40 bitAnd: 16rFF);
  		at: 8 + offset put: (addressOperand >> 48 bitAnd: 16rFF);
  		at: 9 + offset put: (addressOperand >> 56 bitAnd: 16rFF).
  	reg = RAX ifTrue:
  		[^machineCodeSize := 10].
  	machineCode
  		at: 12 put: (machineCode at: 0);
  		at: 13 put: (machineCode at: 1).
  	^machineCodeSize := 14!

Item was changed:
  ----- Method: CogX64Compiler>>concretizeMoveRAw (in category 'generate machine code') -----
  concretizeMoveRAw
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| addressOperand reg offset save1 |
+ 	reg := operands at: 0.
- 	reg := self concreteRegister: (operands at: 0).
  	addressOperand := operands at: 1.
  	(self isAnInstruction: (cogit cCoerceSimple: addressOperand to: #'AbstractInstruction *')) ifTrue:
  		[addressOperand := (cogit cCoerceSimple: addressOperand to: #'AbstractInstruction *') address].
  	(self isAddressRelativeToVarBase: addressOperand) ifTrue:
  		[save1 := operands at: 1.
  		 operands
  			at: 1 put: addressOperand - cogit varBaseAddress;
  			at: 2 put: RBX.
  		 self concretizeMoveRMwr.
  		 operands
  			at: 1 put: save1;
  			at: 2 put: 0.
  		^machineCodeSize].
  	reg = RAX
  		ifTrue: [offset := 0]
  		ifFalse:
  			[machineCode
  				at: 0 put: (self rexR: 0 x: 0 b: reg);
  				at: 1 put: 16r90 + (reg \\ 8).
  			 offset := 2].
  	machineCode
  		at: 0 + offset put: 16r48;
  		at: 1 + offset put: 16rA3;
  		at: 2 + offset put: (addressOperand bitAnd: 16rFF);
  		at: 3 + offset put: (addressOperand >> 8 bitAnd: 16rFF);
  		at: 4 + offset put: (addressOperand >> 16 bitAnd: 16rFF);
  		at: 5 + offset put: (addressOperand >> 24 bitAnd: 16rFF);
  		at: 6 + offset put: (addressOperand >> 32 bitAnd: 16rFF);
  		at: 7 + offset put: (addressOperand >> 40 bitAnd: 16rFF);
  		at: 8 + offset put: (addressOperand >> 48 bitAnd: 16rFF);
  		at: 9 + offset put: (addressOperand >> 56 bitAnd: 16rFF).
  	reg = RAX ifTrue:
  		[^machineCodeSize := 10].
  	machineCode
  		at: 12 put: (machineCode at: 0);
  		at: 13 put: (machineCode at: 1).
  	^machineCodeSize := 14!

Item was changed:
  ----- Method: CogX64Compiler>>concretizeMoveRMbr (in category 'generate machine code') -----
  concretizeMoveRMbr
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| srcReg offset destReg |
+ 	srcReg := operands at: 0.
- 	srcReg := self concreteRegister: (operands at: 0).
  	offset := operands at: 1.
+ 	destReg := operands at: 2.
- 	destReg := self concreteRegister: (operands at: 2).
  	machineCode
  		at: 0 put: (self rexR: srcReg x: 0 b: destReg);
  		at: 1 put: 16r88.
  	(destReg ~= RSP and: [destReg ~= R12]) ifTrue:
  		[(offset = 0 and: [destReg ~= RBP and: [destReg ~= R13]]) ifTrue:
  			[machineCode
  				at: 2 put: (self mod: ModRegInd RM: destReg RO: srcReg).
  			 ^machineCodeSize := 3].
  		 (self isQuick: offset) ifTrue:
  			[machineCode
  				at: 2 put: (self mod: ModRegRegDisp8 RM: destReg RO: srcReg);
  				at: 3 put: (offset bitAnd: 16rFF).
  			 ^machineCodeSize := 4].
  		machineCode
  			at: 2 put: (self mod: ModRegRegDisp32 RM: destReg RO: srcReg);
  			at: 3 put: (offset bitAnd: 16rFF);
  			at: 4 put: (offset >> 8 bitAnd: 16rFF);
  			at: 5 put: (offset >> 16 bitAnd: 16rFF);
  			at: 6 put: (offset >> 24 bitAnd: 16rFF).
  		^machineCodeSize := 7].
  	"RSP:"
  	offset = 0 ifTrue:
  		[machineCode
  			at: 2 put: (self mod: ModRegInd RM: destReg RO: srcReg);
  			at: 3 put: (self s: SIB1 i: 4 b: destReg).
  		 ^machineCodeSize := 4].
  	(self isQuick: offset) ifTrue:
  		[machineCode
  			at: 2 put: (self mod: ModRegRegDisp8 RM: destReg RO: srcReg);
  			at: 3 put: (self s: SIB1 i: 4 b: destReg);
  			at: 4 put: (offset bitAnd: 16rFF).
  		 ^machineCodeSize := 5].
  	machineCode
  		at: 2 put: (self mod: ModRegRegDisp32 RM: destReg RO: srcReg);
  		at: 3 put: (self s: SIB1 i: 4 b: destReg);
  		at: 4 put: (offset bitAnd: 16rFF);
  		at: 5 put: (offset >> 8 bitAnd: 16rFF);
  		at: 6 put: (offset >> 16 bitAnd: 16rFF);
  		at: 7 put: (offset >> 24 bitAnd: 16rFF).
  	^machineCodeSize := 8!

Item was changed:
  ----- Method: CogX64Compiler>>concretizeMoveRMwr (in category 'generate machine code') -----
  concretizeMoveRMwr
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| srcReg offset destReg |
+ 	srcReg := operands at: 0.
- 	srcReg := self concreteRegister: (operands at: 0).
  	offset := operands at: 1.
+ 	destReg := operands at: 2.
- 	destReg := self concreteRegister: (operands at: 2).
  	machineCode
  		at: 0 put: (self rexR: srcReg x: 0 b: destReg);
  		at: 1 put: 16r89.
  	(destReg ~= RSP and: [destReg ~= R12]) ifTrue:
  		[(offset = 0 and: [destReg ~= RBP and: [destReg ~= R13]]) ifTrue:
  			[machineCode
  				at: 2 put: (self mod: ModRegInd RM: destReg RO: srcReg).
  			 ^machineCodeSize := 3].
  		 (self isQuick: offset) ifTrue:
  			[machineCode
  				at: 2 put: (self mod: ModRegRegDisp8 RM: destReg RO: srcReg);
  				at: 3 put: (offset bitAnd: 16rFF).
  			 ^machineCodeSize := 4].
  		machineCode
  			at: 2 put: (self mod: ModRegRegDisp32 RM: destReg RO: srcReg);
  			at: 3 put: (offset bitAnd: 16rFF);
  			at: 4 put: (offset >> 8 bitAnd: 16rFF);
  			at: 5 put: (offset >> 16 bitAnd: 16rFF);
  			at: 6 put: (offset >> 24 bitAnd: 16rFF).
  		^machineCodeSize := 7].
  	"RSP:"
  	offset = 0 ifTrue:
  		[machineCode
  			at: 2 put: (self mod: ModRegInd RM: destReg RO: srcReg);
  			at: 3 put: (self s: SIB1 i: 4 b: destReg).
  		 ^machineCodeSize := 4].
  	(self isQuick: offset) ifTrue:
  		[machineCode
  			at: 2 put: (self mod: ModRegRegDisp8 RM: destReg RO: srcReg);
  			at: 3 put: (self s: SIB1 i: 4 b: destReg);
  			at: 4 put: (offset bitAnd: 16rFF).
  		 ^machineCodeSize := 5].
  	machineCode
  		at: 2 put: (self mod: ModRegRegDisp32 RM: destReg RO: srcReg);
  		at: 3 put: (self s: SIB1 i: 4 b: destReg);
  		at: 4 put: (offset bitAnd: 16rFF);
  		at: 5 put: (offset >> 8 bitAnd: 16rFF);
  		at: 6 put: (offset >> 16 bitAnd: 16rFF);
  		at: 7 put: (offset >> 24 bitAnd: 16rFF).
  	^machineCodeSize := 8!

Item was changed:
  ----- Method: CogX64Compiler>>concretizeMoveRRd (in category 'generate machine code') -----
  concretizeMoveRRd
  	<inline: true>
  	| srcReg destReg |
+ 	srcReg := operands at: 0.
+ 	destReg := operands at: 1.
- 	srcReg := self concreteRegister: (operands at: 0).
- 	destReg := self concreteDPFPRegister: (operands at: 1).
  	machineCode
  		at: 0 put: 16r66;
  		at: 1 put: (self rexR: destReg x: 0 b: srcReg);
  		at: 2 put: 16r0f;
  		at: 3 put: 16r6e;
  		at: 4 put: (self mod: ModReg RM: srcReg RO: destReg).
  	^machineCodeSize := 5!

Item was changed:
  ----- Method: CogX64Compiler>>concretizeMoveRXbrR (in category 'generate machine code') -----
  concretizeMoveRXbrR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| index base dest offset |
+ 	index := operands at: 0.
+ 	base := operands at: 1.
+ 	dest := operands at: 2.
- 	index := self concreteRegister: (operands at: 0).
- 	base := self concreteRegister: (operands at: 1).
- 	dest := self concreteRegister: (operands at: 2).
  	offset := 0.
  	(dest >= 8 or: [base >= 8 or: [index >= 8]]) ifTrue:
  		[machineCode at: 0 put: (self rexR: dest x: index b: base).
  		 offset := 1].
  	machineCode
  		at: 0 + offset put: 16r88.
  	(base ~= RBP and: [base ~= R13]) ifTrue:
  		[machineCode
  			at: 1 + offset put: (self mod: ModRegInd RM: 4 RO: dest);
  			at: 2 + offset put: (self s: SIB1 i: index b: base).
  		 ^machineCodeSize := 3 + offset].
  	machineCode
  		at: 1 + offset put: (self mod: ModRegRegDisp8 RM: 4 RO: dest);
  		at: 2 + offset put: (self s: SIB1 i: index b: base);
  		at: 3 + offset put: 0.
  	 ^machineCodeSize := 4 + offset!

Item was changed:
  ----- Method: CogX64Compiler>>concretizeMoveRXwrR (in category 'generate machine code') -----
  concretizeMoveRXwrR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| index base src |
+ 	src := operands at: 0.
+ 	index := operands at: 1.
+ 	base := operands at: 2.
- 	src := self concreteRegister: (operands at: 0).
- 	index := self concreteRegister: (operands at: 1).
- 	base := self concreteRegister: (operands at: 2).
  	machineCode
  		at: 0 put: (self rexR: src x: index b: base).
  	(base ~= RBP and: [base ~= R13]) ifTrue:
  		[machineCode
  			at: 1 put: 16r89;
  			at: 2 put: (self mod: ModRegInd RM: 4 RO: src);
  			at: 3 put: (self s: SIB8 i: index b: base).
  		 ^machineCodeSize := 4].
  	machineCode
  		at: 1 put: 16r89;
  		at: 2 put: (self mod: ModRegRegDisp8 RM: 4 RO: src);
  		at: 3 put: (self s: SIB8 i: index b: base);
  		at: 4 put: 0.
  	 ^machineCodeSize := 5!

Item was changed:
  ----- Method: CogX64Compiler>>concretizeMoveRdM64r (in category 'generate machine code') -----
  concretizeMoveRdM64r
  	<inline: true>
  	| offset srcReg destReg skip |
+ 	srcReg := operands at: 0.
- 	srcReg := self concreteDPFPRegister: (operands at: 0).
  	offset := operands at: 1.
+ 	destReg := operands at: 2.
- 	destReg := self concreteRegister: (operands at: 2).
  	machineCode at: 0 put: 16r66.
  	(srcReg <= 7 and: [destReg <= 7])
  		ifTrue: [skip := 0]
  		ifFalse: [machineCode at: (skip := 1) put: (self rexw: false r: srcReg x: 0 b: destReg)].
  	machineCode
  		at: skip + 1 put: 16r0f;
  		at: skip + 2 put: 16rd6.
  	offset = 0 ifTrue:
  		[(destReg bitAnd: 6) ~= RSP ifTrue:
  			[machineCode at: skip + 3 put: (self mod: ModRegInd RM: destReg RO: srcReg).
  			 ^machineCodeSize := skip + 4].
  		 (destReg bitAnd: 7) = RSP ifTrue: "RBP & R13 fall through"
  			[machineCode
  				at: skip + 3 put: (self mod: ModRegInd RM: destReg RO: srcReg);
  				at: skip + 4 put: (self s: SIB1 i: 4 b: destReg).
  			 ^machineCodeSize := skip + 5]].
  	(self isQuick: offset) ifTrue:
  		[(destReg bitAnd: 7) ~= RSP ifTrue:
  			[machineCode
  				at: skip + 3 put: (self mod: ModRegRegDisp8 RM: destReg RO: srcReg);
  				at: skip + 4 put: (offset bitAnd: 16rFF).
  			 ^machineCodeSize := skip + 5].
  		 machineCode
  			at: skip + 3 put: (self mod: ModRegRegDisp8 RM: destReg RO: srcReg);
  			at: skip + 4 put: (self s: SIB1 i: 4 b: destReg);
  			at: skip + 5 put: (offset bitAnd: 16rFF).
  		 ^machineCodeSize := skip + 6].
  	machineCode at: skip + 3 put: (self mod: ModRegRegDisp32 RM: destReg RO: srcReg).
  	(destReg bitAnd: 7) = RSP ifTrue:
  		[machineCode at: skip + 4 put: (self s: SIB1 i: 4 b: destReg).
  		 skip := skip + 1].
  	machineCode
  		at: skip + 4 put: (offset bitAnd: 16rFF);
  		at: skip + 5 put: (offset >> 8 bitAnd: 16rFF);
  		at: skip + 6 put: (offset >> 16 bitAnd: 16rFF);
  		at: skip + 7 put: (offset >> 24 bitAnd: 16rFF).
  	^machineCodeSize := skip + 8!

Item was changed:
  ----- Method: CogX64Compiler>>concretizeMoveRdR (in category 'generate machine code') -----
  concretizeMoveRdR
  	<inline: true>
  	| srcReg destReg |
+ 	srcReg := operands at: 0.
+ 	destReg := operands at: 1.
- 	srcReg := self concreteDPFPRegister: (operands at: 0).
- 	destReg := self concreteRegister: (operands at: 1).
  	machineCode
  		at: 0 put: 16r66;
  		at: 1 put: (self rexR: srcReg x: 0 b: destReg);
  		at: 2 put: 16r0f;
  		at: 3 put: 16r7e;
  		at: 4 put: (self mod: ModReg RM: destReg RO: srcReg).
  	^machineCodeSize := 5!

Item was changed:
  ----- Method: CogX64Compiler>>concretizeMoveX32rRR (in category 'generate machine code') -----
  concretizeMoveX32rRR
  	"MoveX32rRR is expected to zero-extend, so explicitly zero the destination."
  	| index base dest offset |
+ 	index := operands at: 0.
+ 	base := operands at: 1.
+ 	dest := operands at: 2.
- 	index := self concreteRegister: (operands at: 0).
- 	base := self concreteRegister: (operands at: 1).
- 	dest := self concreteRegister: (operands at: 2).
  	machineCode
  		at: 0 put: (self rexR: dest x: 0 b: dest);
  		at: 1 put: 16r31;
  		at: 2 put: (self mod: ModReg RM: dest RO: dest).
  	(index > 7 or: [base > 7 or: [dest > 7]])
  		ifTrue:
  			[machineCode at: 3 put: (self rexw: false r: dest x: index b: base).
  			 offset := 1]
  		ifFalse:
  			[offset := 0].
  	(base bitAnd: 7) ~= RBP ifTrue:
  		[machineCode
  			at: offset + 3 put: 16r8B;
  			at: offset + 4 put: (self mod: ModRegInd RM: 4 RO: dest);
  			at: offset + 5 put: (self s: SIB4 i: index b: base).
  		 ^machineCodeSize := offset + 6].
  	machineCode
  		at: offset + 3 put: 16r8B;
  		at: offset + 4 put: (self mod: ModRegRegDisp8 RM: 4 RO: dest);
  		at: offset + 5 put: (self s: SIB4 i: index b: base);
  		at: offset + 6 put: 0.
  	 ^machineCodeSize := offset + 7!

Item was changed:
  ----- Method: CogX64Compiler>>concretizeMoveXbrRR (in category 'generate machine code') -----
  concretizeMoveXbrRR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| index base dest |
+ 	index := operands at: 0.
+ 	base := operands at: 1.
+ 	dest := operands at: 2.
- 	index := self concreteRegister: (operands at: 0).
- 	base := self concreteRegister: (operands at: 1).
- 	dest := self concreteRegister: (operands at: 2).
  	machineCode
  		at: 0 put: (self rexR: dest x: index b: base);
  		at: 1 put: 16r8A.
  	(base ~= RBP and: [base ~= R13]) ifTrue:
  		[machineCode
  			at: 2 put: (self mod: ModRegInd RM: 4 RO: dest);
  			at: 3 put: (self s: SIB1 i: index b: base).
  		 ^machineCodeSize := 4].
  	machineCode
  		at: 2 put: (self mod: ModRegRegDisp8 RM: 4 RO: dest);
  		at: 3 put: (self s: SIB1 i: index b: base);
  		at: 4 put: 0.
  	 ^machineCodeSize := 5!

Item was changed:
  ----- Method: CogX64Compiler>>concretizeMoveXwrRR (in category 'generate machine code') -----
  concretizeMoveXwrRR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| index base dest |
+ 	index := operands at: 0.
+ 	base := operands at: 1.
+ 	dest := operands at: 2.
- 	index := self concreteRegister: (operands at: 0).
- 	base := self concreteRegister: (operands at: 1).
- 	dest := self concreteRegister: (operands at: 2).
  	machineCode
  		at: 0 put: (self rexR: dest x: index b: base).
  	(base ~= RBP and: [base ~= R13]) ifTrue:
  		[machineCode
  			at: 1 put: 16r8B;
  			at: 2 put: (self mod: ModRegInd RM: 4 RO: dest);
  			at: 3 put: (self s: SIB8 i: index b: base).
  		 ^machineCodeSize := 4].
  	machineCode
  		at: 1 put: 16r8B;
  		at: 2 put: (self mod: ModRegRegDisp8 RM: 4 RO: dest);
  		at: 3 put: (self s: SIB8 i: index b: base);
  		at: 4 put: 0.
  	 ^machineCodeSize := 5!

Item was changed:
  ----- Method: CogX64Compiler>>concretizeMulRR (in category 'generate machine code') -----
  concretizeMulRR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| reg1 reg2 |
+ 	reg1 := operands at: 0.
+ 	reg2 := operands at: 1.
- 	reg1 := self concreteRegister: (operands at: 0).
- 	reg2 := self concreteRegister: (operands at: 1).
  	machineCode
  		at: 0 put: (self rexR: reg2 x: 0 b: reg1);
  		at: 1 put: 16r0F;
  		at: 2 put: 16rAF;
  		at: 3 put: (self mod: ModReg RM: reg1 RO: reg2).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogX64Compiler>>concretizeNegateR (in category 'generate machine code') -----
  concretizeNegateR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| reg |
+ 	reg := operands at: 0.
- 	reg := self concreteRegister: (operands at: 0).
  	machineCode
  		at: 0 put: (self rexR: 0 x: 0 b: reg);
  		at: 1 put: 16rF7;
  		at: 2 put: (self mod: ModReg RM: reg RO: 3).
  	^machineCodeSize := 3!

Item was changed:
  ----- Method: CogX64Compiler>>concretizeOpRR: (in category 'generate machine code') -----
  concretizeOpRR: x64opcode
  	| regLHS regRHS |
+ 	regLHS := operands at: 0.
+ 	regRHS := operands at: 1.
- 	regLHS := self concreteRegister: (operands at: 0).
- 	regRHS := self concreteRegister: (operands at: 1).
  	machineCode
  		at: 0 put: (self rexR: regRHS x: 0 b: regLHS);
  		at: 1 put: x64opcode;
  		at: 2 put: (self mod: ModReg RM: regLHS RO: regRHS).
  	^machineCodeSize := 3!

Item was changed:
  ----- Method: CogX64Compiler>>concretizePopR (in category 'generate machine code') -----
  concretizePopR
  	<inline: true>
  	| reg |
+ 	reg := operands at: 0.
- 	reg := self concreteRegister: (operands at: 0).
  	reg < 8 ifTrue:
  		[machineCode at: 0 put: 16r58 + reg.
  		^machineCodeSize := 1].
  	machineCode
  		at: 0 put: 16r41;
  		at: 1 put: 16r58 + (reg - 8).
  	^machineCodeSize := 2!

Item was changed:
  ----- Method: CogX64Compiler>>concretizePushR (in category 'generate machine code') -----
  concretizePushR
  	<inline: true>
  	| reg |
+ 	reg := operands at: 0.
- 	reg := self concreteRegister: (operands at: 0).
  	reg < 8 ifTrue:
  		[machineCode at: 0 put: 16r50 + reg.
  		^machineCodeSize := 1].
  	machineCode
  		at: 0 put: 16r41;
  		at: 1 put: 16r50 + (reg - 8).
  	^machineCodeSize := 2!

Item was changed:
  ----- Method: CogX64Compiler>>concretizeReverseOpRR: (in category 'generate machine code') -----
  concretizeReverseOpRR: x64opcode
  	| regLHS regRHS |
  	"CmpRR/MoveRR RHS LHS computes LHS - RHS, i.e. apparently reversed.  You have to think subtract."
+ 	regRHS := operands at: 0.
+ 	regLHS := operands at: 1.
- 	regRHS := self concreteRegister: (operands at: 0).
- 	regLHS := self concreteRegister: (operands at: 1).
  	machineCode
  		at: 0 put: (self rexR: regRHS x: 0 b: regLHS);
  		at: 1 put: x64opcode;
  		at: 2 put: (self mod: ModReg RM: regLHS RO: regRHS).
  	^machineCodeSize := 3!

Item was changed:
  ----- Method: CogX64Compiler>>concretizeSEE2OpRdRd: (in category 'generate machine code') -----
  concretizeSEE2OpRdRd: x64opcode
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| regLHS regRHS |
+ 	regRHS := operands at: 0.
+ 	regLHS := operands at: 1.
- 	regRHS := self concreteDPFPRegister: (operands at: 0).
- 	regLHS := self concreteDPFPRegister: (operands at: 1).
  	machineCode
  		at: 0 put: 16rF2;
  		at: 1 put: 16r0F;
  		at: 2 put: x64opcode;
  		at: 3 put: (self mod: ModReg RM: regRHS RO: regLHS).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogX64Compiler>>concretizeShiftCqRegOpcode: (in category 'generate machine code') -----
  concretizeShiftCqRegOpcode: regOpcode
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| distance reg |
  	distance := operands at: 0.
  	self assert: (distance between: 1 and: 63).
+ 	reg := operands at: 1.
- 	reg := self concreteRegister: (operands at: 1).
  	machineCode at: 0 put: (self rexR: 0 x: 0 b: reg).
  	distance = 1 ifTrue:
  		[machineCode
  			at: 1 put: 16rD1;
  			at: 2 put: (self mod: ModReg RM: reg RO: regOpcode).
  		 ^machineCodeSize := 3].
  	machineCode
  		at: 1 put: 16rC1;
  		at: 2 put: (self mod: ModReg RM: reg RO: regOpcode);
  		at: 3 put: distance.
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogX64Compiler>>concretizeShiftRegRegOpcode: (in category 'generate machine code') -----
  concretizeShiftRegRegOpcode: regOpcode
  	"On the x64 the only instructions that shift by the value of a
  	 register require the shift count to be  in %ecx.  So we may
  	 have to use swap instructions to get the count into %ecx."
  	<inline: true>
  	| shiftCountReg destReg regToShift |
+ 	shiftCountReg := operands at: 0.
+ 	destReg := operands at: 1.
- 	shiftCountReg := self concreteRegister: (operands at: 0).
- 	destReg := self concreteRegister: (operands at: 1).
  	shiftCountReg = RCX ifTrue:
  		[machineCode
  			at: 0 put: (self rexR: 0 x: 0 b: destReg);
  			at: 1 put: 16rD3;
  			at: 2 put: (self mod: ModReg RM: destReg RO: regOpcode).
  		 ^machineCodeSize := 3].
  	regToShift := destReg = shiftCountReg
  					ifTrue: [RCX]
  					ifFalse: [destReg = RCX
  								ifTrue: [shiftCountReg]
  								ifFalse: [destReg]].
  	shiftCountReg = RAX ifTrue:
  		[machineCode
  			at: 0 put: 16r48;
  			at: 1 put: 16r90 + RCX; "XCHG RAX,RCX"
  			at: 2 put: (self rexR: 0 x: 0 b: regToShift);
  			at: 3 put: 16rD3;			"SAR RCX,RAX"
  			at: 4 put: (self mod: ModReg RM: regToShift RO: regOpcode);
  			at: 5 put: 16r48;
  			at: 6 put: 16r90 + RCX. "XCHG RAX,RCX"
  		 ^machineCodeSize := 7].
  	machineCode
  		at: 0 put: (self rexR: shiftCountReg x: 0 b: RCX);		"XCHG R?X,RCX"
  		at: 1 put: 16r87;
  		at: 2 put: (self mod: ModReg RM: RCX RO: shiftCountReg);
  		at: 3 put: (self rexR: 0 x: 0 b: regToShift);			"SAR RCX,R!!X"
  		at: 4 put: 16rD3;
  		at: 5 put: (self mod: ModReg RM: regToShift RO: regOpcode);
  		at: 6 put: (self rexR: shiftCountReg x: 0 b: RCX);		"XCHG R?X,RCX"
  		at: 7 put: 16r87;
  		at: 8 put: (self mod: ModReg RM: RCX RO: shiftCountReg).
  	^machineCodeSize := 9!

Item was changed:
  ----- Method: CogX64Compiler>>concretizeSqrtRd (in category 'generate machine code') -----
  concretizeSqrtRd
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| reg |
+ 	reg := operands at: 0.
- 	reg := self concreteDPFPRegister: (operands at: 0).
  	machineCode
  		at: 0 put: 16rF2;
  		at: 1 put: 16r0F;
  		at: 2 put: 16r51;
  		at: 3 put: (self mod: ModReg RM: reg RO: reg).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogX64Compiler>>concretizeTstCqR (in category 'generate machine code') -----
  concretizeTstCqR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| value reg |
  	value := operands at: 0.
+ 	reg := operands at: 1.
- 	reg := self concreteRegister: (operands at: 1).
  	machineCode
  		at: 0 put: (self rexR: 0 x: 0 b: reg).
  	(self isQuick: value) ifTrue:
  		[machineCode
  			at: 1 put: 16rF6;
  			at: 2 put: (self mod: ModReg RM: reg RO: 0);
  			at: 3 put: (value bitAnd: 16rFF).
  		 ^machineCodeSize := 4].
  	
  	(self isSignExtendedFourByteValue: value) ifTrue:
  		[reg = RAX ifTrue:
  			[machineCode
  				at: 1 put: 16rA9;
  				at: 2 put: (value bitAnd: 16rFF);
  				at: 3 put: (value >> 8 bitAnd: 16rFF);
  				at: 4 put: (value >> 16 bitAnd: 16rFF);
  				at: 5 put: (value >> 24 bitAnd: 16rFF).
  			 ^machineCodeSize := 6].
  		machineCode
  			at: 1 put: 16rF7;
  			at: 2 put: (self mod: ModReg RM: reg RO: 0);
  			at: 3 put: (value bitAnd: 16rFF);
  			at: 4 put: (value >> 8 bitAnd: 16rFF);
  			at: 5 put: (value >> 16 bitAnd: 16rFF);
  			at: 6 put: (value >> 24 bitAnd: 16rFF).
  		 ^machineCodeSize := 7].
  	^self concretizeArithCwR: 16r85!

Item was changed:
  ----- Method: CogX64Compiler>>concretizeXCHGRR (in category 'generate machine code') -----
  concretizeXCHGRR
  	| r1 r2 |
+ 	r1 := operands at: 0.
+ 	r2 := operands at: 1.
- 	r1 := self concreteRegister: (operands at: 0).
- 	r2 := self concreteRegister: (operands at: 1).
  	r2 = RAX ifTrue:
  		[r2 := r1. r1 := RAX].
  	r1 = RAX ifTrue:
  		[machineCode
  			at: 0 put: (self rexR: 0 x: 0 b: r2);
  			at: 1 put: 16r90 + (r2 \\ 8).
  		 ^machineCodeSize := 2].
  	machineCode
  		at: 0 put: (self rexR: r1 x: 0 b: r2);
  		at: 1 put: 87;
  		at: 2 put: (self mod: r2 RM: 0 RO: r1).
  	^machineCodeSize := 3!

Item was changed:
  ----- Method: CogX64Compiler>>genDivR:R:Quo:Rem: (in category 'abstract instructions') -----
  genDivR: abstractRegDivisor R: abstractRegDividend Quo: abstractRegQuotient Rem: abstractRegRemainder
  	| rDividend rDivisor rQuotient rRemainder saveRestoreEAX saveRestoreEDX saveRestoreExchanged |
  	self assert: abstractRegDividend ~= abstractRegDivisor.
  	self assert: abstractRegQuotient ~= abstractRegRemainder.
+ 	rDividend := abstractRegDividend.
+ 	rDivisor := abstractRegDivisor.
+ 	rQuotient := abstractRegQuotient.
+ 	rRemainder := abstractRegRemainder.
- 	rDividend := self concreteRegister: abstractRegDividend.
- 	rDivisor := self concreteRegister: abstractRegDivisor.
- 	rQuotient := self concreteRegister: abstractRegQuotient.
- 	rRemainder := self concreteRegister: abstractRegRemainder.
  	"IDIV r does a signed divide of RDX:RAX by r, RAX := Quotient, RDX := Remainder.
  	 Since we must sign extend the dividend into RDX we must substitute another register if RDX is an input."
  	(rDividend = RDX or: [rDivisor = RDX]) ifTrue:
  		[| rUnused |
  		"Slang, sigh..."
  		rUnused := RAX.
  		[rUnused <= RDI] whileTrue:
  			[(rUnused ~= RSP and: [rUnused ~= RBP and: [rUnused ~= RDX
  			  and: [rUnused ~= rDividend and: [rUnused ~= rDivisor
  			  and: [rUnused ~= rQuotient and: [rUnused ~= rRemainder]]]]]]) ifTrue:
  				[cogit PushR: rUnused.
  				cogit MoveR: RDX R: rUnused.
  				rDividend = RDX
  					ifTrue: [self genDivR: rDivisor R: rUnused Quo: rQuotient Rem: rRemainder]
  					ifFalse: [self genDivR: rUnused R: rDividend Quo: rQuotient Rem: rRemainder].
  				cogit PopR: rUnused.
  				^self].
  			  rUnused := rUnused + 1].
  		self error: 'couldn''t find unused register in genDivR:R:Quo:Rem:'].
  	"If either output does not include RAX or RDX we must save and restore RAX and/or RDX."
  	(saveRestoreEAX := rQuotient ~= RAX and: [rRemainder ~= RAX]) ifTrue:
  		[cogit PushR: RAX].
  	(saveRestoreEDX := rQuotient ~= RDX and: [rRemainder ~= RDX]) ifTrue:
  		[cogit PushR: RDX].
  	saveRestoreExchanged := -1.
  	rDividend ~= RAX ifTrue:
  		[rDivisor = RAX
  			ifTrue: [((rDividend ~= rQuotient and: [rDividend ~= rRemainder])
  					and: [rDividend ~= RDX or: [saveRestoreEDX not]]) ifTrue:
  						[cogit PushR: (saveRestoreExchanged := rDividend)].
  					cogit gen: XCHGRR operand: rDivisor operand: rDividend]
  			ifFalse: [cogit MoveR: rDividend R: RAX]].
  	"CDQ sign-extends RAX into RDX as required for IDIV"
  	cogit gen: CDQ.
  	cogit gen: IDIVR operand: (rDivisor = RAX ifTrue: [rDividend] ifFalse: [rDivisor]).
  	"Must not overwrite result while juggling"
  	(rQuotient = RDX and: [rRemainder = RAX])
  		ifTrue: [cogit gen: XCHGRR operand: rQuotient operand: rRemainder]
  		ifFalse:
  			[rQuotient = RDX
  				ifTrue:
  					[rRemainder ~= RDX ifTrue:
  						[cogit MoveR: RDX R: rRemainder].
  					rQuotient ~= RAX ifTrue:
  						[cogit MoveR: RAX R: rQuotient]]
  				ifFalse:
  					[rQuotient ~= RAX ifTrue:
  						[cogit MoveR: RAX R: rQuotient].
  					rRemainder ~= RDX ifTrue:
  						[cogit MoveR: RDX R: rRemainder]]].
  	saveRestoreExchanged >= 0 ifTrue:
  		[cogit PopR: saveRestoreExchanged].
  	saveRestoreEDX ifTrue:
  		[cogit PopR: RDX].
  	saveRestoreEAX ifTrue:
  		[cogit PopR: RAX]!

Item was changed:
  ----- Method: CogX64Compiler>>genRestoreRegsExcept: (in category 'abi') -----
+ genRestoreRegsExcept: preservedReg
- genRestoreRegsExcept: abstractReg
- 	| realReg |
- 	realReg := self concreteRegister: abstractReg.
  	self assert: (R15 > RAX and: [R15 - RAX + 1 = 16]).
  	RAX to: R15 do:
  		[:reg|
  		(reg between: RSP and: RBP) ifFalse:
+ 			[preservedReg = reg
- 			[realReg = reg
  				ifTrue: [cogit AddCq: 8 R: RSP]
  				ifFalse: [cogit PopR: reg]]].
  	^0!

Item was changed:
  ----- Method: Cogit>>printRegisterMapOn: (in category 'disassembly') -----
  printRegisterMapOn: aStream
  	<doNotGenerate>
  	| map n |
  	map := backEnd generalPurposeRegisterMap.
  	n := 0.
  	map keys sort
  		do:	[:regName| | abstractName |
+ 			abstractName := CogRTLOpcodes nameForRegister: (map at: regName).
- 			abstractName := CogRTLOpcodes nameForRegister: (backEnd abstractRegisterForConcreteRegister: (map at: regName)).
  			aStream nextPutAll: abstractName; nextPutAll: ' => '; nextPutAll: regName]
  		separatedBy: [(n := n + 1) \\ 4 = 0 ifTrue: [aStream cr] ifFalse: [aStream tab]].
  	aStream cr; flush!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>ceShortCutTraceLinkedSend: (in category 'simulation only') -----
  ceShortCutTraceLinkedSend: aProcessorSimulationTrap
  	self shortcutTrampoline: aProcessorSimulationTrap
+ 		to: [coInterpreter ceTraceLinkedSend: (processor registerAt: ReceiverResultReg)]!
- 		to: [coInterpreter ceTraceLinkedSend: (processor registerAt: (backEnd concreteRegister: ReceiverResultReg))]!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>ceShortCutTraceStore: (in category 'simulation only') -----
  ceShortCutTraceStore: aProcessorSimulationTrap
  	<doNotGenerate>
  	self shortcutTrampoline: aProcessorSimulationTrap
  		to: [coInterpreter
+ 				ceTraceStoreOf: (processor registerAt: ClassReg)
+ 				into: (processor registerAt: ReceiverResultReg)]!
- 				ceTraceStoreOf: (processor registerAt: (backEnd concreteRegister: ClassReg))
- 				into: (processor registerAt: (backEnd concreteRegister: ReceiverResultReg))]!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>ceShortCutTraceStore: (in category 'simulation only') -----
  ceShortCutTraceStore: aProcessorSimulationTrap
  	<doNotGenerate>
  	self shortcutTrampoline: aProcessorSimulationTrap
  		to: [coInterpreter
+ 				ceTraceStoreOf: (processor registerAt: TempReg)
+ 				into: (processor registerAt: ReceiverResultReg)]!
- 				ceTraceStoreOf: (processor registerAt: (backEnd concreteRegister: TempReg))
- 				into: (processor registerAt: (backEnd concreteRegister: ReceiverResultReg))]!

Item was changed:
  ----- Method: VMClass class>>shouldIncludeMethodForSelector: (in category 'translation') -----
  shouldIncludeMethodForSelector: selector
  	"Answer whether a primitive method shoud be translated.  Emit a warning to the transcript if the method doesn't exist."
  	^(self whichClassIncludesSelector: selector)
  		ifNotNil:
  			[:c|
  			 (c >> selector pragmaAt: #option:)
  				ifNotNil:
  					[:pragma|
+ 					 initializationOptions at: (pragma arguments first) ifAbsent: [false]]
- 					 initializationOptions at: (pragma arguments first) ifAbsent: [true]]
  				ifNil: [true]]
  		ifNil:
  			[Transcript nextPutAll: 'Cannot find implementation of '; nextPutAll: selector; nextPutAll: ' in hierarchy of '; print: self; cr; flush.
  			 false]!



More information about the Vm-dev mailing list