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

commits at source.squeak.org commits at source.squeak.org
Fri Dec 13 22:57:59 UTC 2019


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

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

Name: VMMaker.oscog-eem.2609
Author: eem
Time: 13 December 2019, 2:57:47.119474 pm
UUID: 449abda0-bc8f-412b-88f0-dc4cca8ecbdf
Ancestors: VMMaker.oscog-eem.2608

Make categorization of mchine cod egeneration routines consistent (recategorizations only).

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

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeAddCqR (in category 'generate machine code - concretize') -----
- ----- 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.
  	(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).
  		 ^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).
  		 ^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).
  	 ^6!

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeAddCwR (in category 'generate machine code - concretize') -----
- ----- 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 = 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).
  		 ^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).
  	 ^6!

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

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeAddcRR (in category 'generate machine code - concretize') -----
- ----- Method: CogIA32Compiler>>concretizeAddcRR (in category 'generate machine code') -----
  concretizeAddcRR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	"Assemble the ADC instruction"
  	| regLHS regRHS |
  	regLHS := operands at: 0.
  	regRHS := operands at: 1.
  	machineCode
  		at: 0 put: 16r13;
  		at: 1 put: (self mod: ModReg RM: regLHS RO: regRHS).
  	^2!

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeAlignmentNops (in category 'generate machine code - concretize') -----
- ----- Method: CogIA32Compiler>>concretizeAlignmentNops (in category 'generate machine code') -----
  concretizeAlignmentNops
  	<inline: true>
  	self flag: 'if performance is an issue generate longer nops'.
  	0 to: machineCodeSize - 1 do:
  		[:i|
  		machineCode at: i put: 16r90].
  	^machineCodeSize!

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeAndCqR (in category 'generate machine code - concretize') -----
- ----- 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.
  	(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).
  		 ^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).
  		 ^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).
  	 ^6!

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeAndCwR (in category 'generate machine code - concretize') -----
- ----- 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 = 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).
  		 ^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).
  	 ^6!

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

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeArithmeticShiftRightRR (in category 'generate machine code - concretize') -----
- ----- 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 = ECX ifTrue:
  		[machineCode
  			at: 0 put: 16rD3;
  			at: 1 put: (self mod: ModReg RM: destReg RO: 7).
  		 ^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"
  		 ^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).
  	^6!

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeBSR (in category 'generate machine code - concretize') -----
- ----- Method: CogIA32Compiler>>concretizeBSR (in category 'generate machine code') -----
  concretizeBSR
  	"Bit Scan Reverse
  	First operand is output register (dest)
  	Second operand is input register (mask)"
  	"BSR"
  	<inline: true>
  	| dest mask |
  	dest := operands at: 0.
  	mask := operands at: 1.
  	machineCode
  		at: 0 put: 16r0F;
  		at: 1 put: 16rBD;
  		at: 2 put: (self mod: ModReg RM: dest RO: mask).
  	 ^3!

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeCDQ (in category 'generate machine code - concretize') -----
- ----- Method: CogIA32Compiler>>concretizeCDQ (in category 'generate machine code') -----
  concretizeCDQ
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	machineCode at: 0 put: 16r99.
  	^1!

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeCLD (in category 'generate machine code - concretize') -----
- ----- Method: CogIA32Compiler>>concretizeCLD (in category 'generate machine code') -----
  concretizeCLD
  	<inline: true>
  	machineCode at: 0 put: 16rFC.
  	^1!

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeCMPXCHGAwR (in category 'generate machine code - concretize') -----
- ----- Method: CogIA32Compiler>>concretizeCMPXCHGAwR (in category 'generate machine code') -----
  concretizeCMPXCHGAwR
  	<inline: true>
  	| addressOperand reg |
  	addressOperand := operands at: 0.
  	reg := 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).
  	^7!

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeCMPXCHGMwrR (in category 'generate machine code - concretize') -----
- ----- 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 ~= 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).
  			 ^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).
  		^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).
  		 ^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).
  	^8!

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeCPUID (in category 'generate machine code - concretize') -----
- ----- Method: CogIA32Compiler>>concretizeCPUID (in category 'generate machine code') -----
  concretizeCPUID
  	<inline: true>
  	machineCode
  		at: 0 put: 16r0F;
  		at: 1 put: 16rA2.
  	^2!

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeCall (in category 'generate machine code - concretize') -----
- ----- Method: CogIA32Compiler>>concretizeCall (in category 'generate machine code') -----
  concretizeCall
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| offset |
  	self assert: (operands at: 0) ~= 0.
  	offset := (operands at: 0) signedIntFromLong - (address + 5) signedIntFromLong.
  	machineCode
  		at: 0 put: 16rE8;
  		at: 1 put: (offset bitAnd: 16rFF);
  		at: 2 put: (offset >> 8 bitAnd: 16rFF);
  		at: 3 put: (offset >> 16 bitAnd: 16rFF);
  		at: 4 put: (offset >> 24 bitAnd: 16rFF).
  	^5!

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeCallR (in category 'generate machine code - concretize') -----
- ----- Method: CogIA32Compiler>>concretizeCallR (in category 'generate machine code') -----
  concretizeCallR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| reg |
  	"CmpRR RHS LHS computes LHS - RHS, i.e. apparently reversed.  You have to think subtract."
  	reg := operands at: 0.
  	machineCode
  		at: 0 put: 16rFF;
  		at: 1 put: (self mod: ModReg RM: reg RO: 2).
  	^2!

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeClzRR (in category 'generate machine code - concretize') -----
- ----- Method: CogIA32Compiler>>concretizeClzRR (in category 'generate machine code') -----
  concretizeClzRR
  	"Count leading zeros
  	First operand is output (dest)
  	Second operand is input (mask)"
  	"LZCNT"
  	<inline: true>
  	| dest mask |
  	dest := operands at: 0.
  	mask := operands at: 1.
  	machineCode
  		at: 0 put: 16rF3;
  		at: 1 put: 16r0F;
  		at: 2 put: 16rBD;
  		at: 3 put: (self mod: ModReg RM: dest RO: mask).
  	 ^4!

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeCmpCqR (in category 'generate machine code - concretize') -----
- ----- 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.
  	(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).
  		 ^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).
  		 ^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).
  	 ^6!

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeCmpCwR (in category 'generate machine code - concretize') -----
- ----- 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 = 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).
  		 ^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).
  	 ^6!

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeCmpRdRd (in category 'generate machine code - concretize') -----
- ----- 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.
  	machineCode
  		at: 0 put: 16r66;
  		at: 1 put: 16r0F;
  		at: 2 put: 16r2E;
  		at: 3 put: (self mod: ModReg RM: regRHS RO: regLHS).
  	^4!

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeCmpRsRs (in category 'generate machine code - concretize') -----
- ----- Method: CogIA32Compiler>>concretizeCmpRsRs (in category 'generate machine code') -----
  concretizeCmpRsRs
  	"Will get inlined into concretizeAt: switch.
  	 We use UCOMISS (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.
  	machineCode
  		at: 0 put: 16r0F;
  		at: 1 put: 16r2E;
  		at: 2 put: (self mod: ModReg RM: regRHS RO: regLHS).
  	^3!

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeConditionalJump: (in category 'generate machine code - concretize') -----
- ----- Method: CogIA32Compiler>>concretizeConditionalJump: (in category 'generate machine code') -----
  concretizeConditionalJump: conditionCode
  	"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>
  	| offset |
  	offset := self computeJumpTargetOffsetPlus: 2.
  	(machineCodeSize = 0 "size not determined because no sizeJump pass; generating initial trampolines"
  		ifTrue: [self isQuick: offset]
  		ifFalse: [machineCodeSize = 2]) ifTrue:
  		[machineCode
  			at: 0 put: 16r70 + conditionCode;
  			at: 1 put: (offset bitAnd: 16rFF).
  		 ^2].
  	^self concretizeConditionalJumpLong: conditionCode!

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeConditionalJumpLong: (in category 'generate machine code - concretize') -----
- ----- Method: CogIA32Compiler>>concretizeConditionalJumpLong: (in category 'generate machine code') -----
  concretizeConditionalJumpLong: conditionCode
  	"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>
  	| offset |
  	offset := self computeJumpTargetOffsetPlus: 6.
  	machineCode
  		at: 0 put: 16r0F;
  		at: 1 put: 16r80 + conditionCode;
  		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).
  	^6!

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeConvertRRd (in category 'generate machine code - concretize') -----
- ----- Method: CogIA32Compiler>>concretizeConvertRRd (in category 'generate machine code') -----
  concretizeConvertRRd
  	"Will get inlined into concretizeAt: switch."
  	"CVTSI2D"
  	<inline: true>
  	| srcReg destReg |
  	srcReg := operands at: 0.
  	destReg := 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).
  	 ^4!

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

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

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

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

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

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeFENCE: (in category 'generate machine code - concretize') -----
- ----- Method: CogIA32Compiler>>concretizeFENCE: (in category 'generate machine code') -----
  concretizeFENCE: regOpcode
  	<inline: true>
  	machineCode
  		at: 0 put: 16r0F;
  		at: 1 put: 16rAE;
  		at: 2 put: (self mod: ModReg RM: 0 RO: regOpcode).
  	^3!

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeFSTPD (in category 'generate machine code - concretize') -----
- ----- Method: CogIA32Compiler>>concretizeFSTPD (in category 'generate machine code') -----
  concretizeFSTPD
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| srcReg offset destReg |
  	srcReg := 3.
  	offset := operands at: 0.
  	destReg := operands at: 1.
  	destReg ~= ESP ifTrue:
  		[(self isQuick: offset) ifTrue:
  			"FSTP dest"
  			[machineCode
  				at: 0 put: 16rDD;
  				at: 1 put: (self mod: ModRegRegDisp8 RM: destReg RO: srcReg);
  				at: 2 put: (offset bitAnd: 16rFF).
  			 ^3].
  		"FSTP dest"
  		machineCode
  			at: 0 put: 16rDD;
  			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).
  		^6].
  	"ESP:"
  	(self isQuick: offset) ifTrue:
  		[machineCode
  			at: 0 put: 16rDD;
  			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).
  		 ^4].
  	machineCode
  		at: 0 put: 16rDD;
  		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).
  	^7!

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeFSTPS (in category 'generate machine code - concretize') -----
- ----- Method: CogIA32Compiler>>concretizeFSTPS (in category 'generate machine code') -----
  concretizeFSTPS
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| srcReg offset destReg |
  	srcReg := 3.
  	offset := operands at: 0.
  	destReg := operands at: 1.
  	destReg ~= ESP ifTrue:
  		[(self isQuick: offset) ifTrue:
  			"FSTP dest"
  			[machineCode
  				at: 0 put: 16rD9;
  				at: 1 put: (self mod: ModRegRegDisp8 RM: destReg RO: srcReg);
  				at: 2 put: (offset bitAnd: 16rFF).
  			 ^3].
  		"FSTP dest"
  		machineCode
  			at: 0 put: 16rD9;
  			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).
  		^6].
  	"ESP:"
  	(self isQuick: offset) ifTrue:
  		[machineCode
  			at: 0 put: 16rD9;
  			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).
  		 ^4].
  	machineCode
  		at: 0 put: 16rD9;
  		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).
  	^7!

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeFill32 (in category 'generate machine code - concretize') -----
- ----- Method: CogIA32Compiler>>concretizeFill32 (in category 'generate machine code') -----
  concretizeFill32
  	<inline: true>
  	| word |
  	<var: #word type: #'usqIntptr_t'>
  	word := operands at: 0.
  	machineCode at: 0 put: (word bitAnd: 16rFF).
  	machineCode at: 1 put: (word >> 8 bitAnd: 16rFF).
  	machineCode at: 2 put: (word >> 16 bitAnd: 16rFF).
  	machineCode at: 3 put: (word >> 24 bitAnd: 16rFF).
  	^4!

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

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeJump (in category 'generate machine code - concretize') -----
- ----- Method: CogIA32Compiler>>concretizeJump (in category 'generate machine code') -----
  concretizeJump
  	"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>
  	| jumpTarget offset |
  	<var: #jumpTarget type: #'AbstractInstruction *'>
  	jumpTarget := cogit cCoerceSimple: (operands at: 0) to: #'AbstractInstruction *'.
  	cogit assertSaneJumpTarget: jumpTarget.
  	(self isAnInstruction: jumpTarget) ifTrue:
  		[jumpTarget := cogit cCoerceSimple: jumpTarget address to: #'AbstractInstruction *'].
  	self assert: jumpTarget ~= 0.
  	offset := jumpTarget signedIntFromLong - (address + 2) signedIntFromLong.
  	(machineCodeSize = 0 "size not determined because no sizeJump pass; generating initial trampolines"
  		ifTrue: [self isQuick: offset]
  		ifFalse: [machineCodeSize = 2]) ifTrue:
  		[machineCode
  			at: 0 put: 16rEB;
  			at: 1 put: (offset bitAnd: 16rFF).
  		 ^2].
  	offset := jumpTarget signedIntFromLong - (address + 5) signedIntFromLong.
  	machineCode
  		at: 0 put: 16rE9;
  		at: 1 put: (offset bitAnd: 16rFF);
  		at: 2 put: (offset >> 8 bitAnd: 16rFF);
  		at: 3 put: (offset >> 16 bitAnd: 16rFF);
  		at: 4 put: (offset >> 24 bitAnd: 16rFF).
  	^5!

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeJumpLong (in category 'generate machine code - concretize') -----
- ----- Method: CogIA32Compiler>>concretizeJumpLong (in category 'generate machine code') -----
  concretizeJumpLong
  	"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>
  	| jumpTarget offset |
  	<var: #jumpTarget type: #'AbstractInstruction *'>
  	jumpTarget := cogit cCoerceSimple: (operands at: 0) to: #'AbstractInstruction *'.
  	(self isAnInstruction: jumpTarget) ifTrue:
  		[jumpTarget := cogit cCoerceSimple: jumpTarget address to: #'AbstractInstruction *'].
  	self assert: jumpTarget ~= 0.
  	offset := jumpTarget signedIntFromLong - (address + 5) signedIntFromLong.
  	machineCode
  		at: 0 put: 16rE9;
  		at: 1 put: (offset bitAnd: 16rFF);
  		at: 2 put: (offset >> 8 bitAnd: 16rFF);
  		at: 3 put: (offset >> 16 bitAnd: 16rFF);
  		at: 4 put: (offset >> 24 bitAnd: 16rFF).
  	^5!

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

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeLOCK (in category 'generate machine code - concretize') -----
- ----- Method: CogIA32Compiler>>concretizeLOCK (in category 'generate machine code') -----
  concretizeLOCK
  	<inline: true>
  	machineCode at: 0 put: 16rF0.
  	^1!

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeLoadEffectiveAddressMwrR (in category 'generate machine code - concretize') -----
- ----- 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 ~= 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).
  			 ^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).
  		^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).
  		 ^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).
  	^7!

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeLogicalShiftLeftCqR (in category 'generate machine code - concretize') -----
- ----- 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.
  	distance = 1 ifTrue:
  		[machineCode
  			at: 0 put: 16rD1;
  			at: 1 put: (self mod: ModReg RM: reg RO: 4).
  		 ^2].
  	machineCode
  		at: 0 put: 16rC1;
  		at: 1 put: (self mod: ModReg RM: reg RO: 4);
  		at: 2 put: distance.
  	^3!

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeLogicalShiftLeftRR (in category 'generate machine code - concretize') -----
- ----- 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 = ECX ifTrue:
  		[machineCode
  			at: 0 put: 16rD3;
  			at: 1 put: (self mod: ModReg RM: destReg RO: 4).
  		 ^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"
  		 ^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).
  	^6!

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeLogicalShiftRightCqR (in category 'generate machine code - concretize') -----
- ----- 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.
  	distance = 1 ifTrue:
  		[machineCode
  			at: 0 put: 16rD1;
  			at: 1 put: (self mod: ModReg RM: reg RO: 5).
  		 ^2].
  	machineCode
  		at: 0 put: 16rC1;
  		at: 1 put: (self mod: ModReg RM: reg RO: 5);
  		at: 2 put: distance.
  	^3!

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeMOVSB (in category 'generate machine code - concretize') -----
- ----- Method: CogIA32Compiler>>concretizeMOVSB (in category 'generate machine code') -----
  concretizeMOVSB
  	<inline: true>
  	machineCode at: 0 put: 16rA4.
  	^1!

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeMOVSD (in category 'generate machine code - concretize') -----
- ----- Method: CogIA32Compiler>>concretizeMOVSD (in category 'generate machine code') -----
  concretizeMOVSD
  	<inline: true>
  	machineCode at: 0 put: 16rA5.
  	^1!

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeMoveAbR (in category 'generate machine code - concretize') -----
- ----- 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.
  	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).
  	^7!

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeMoveAwR (in category 'generate machine code - concretize') -----
- ----- 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 = 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).
  			^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).
  	^6!

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeMoveCqR (in category 'generate machine code - concretize') -----
- ----- 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.
  	machineCode
  		at: 0 put: 16r31;
  		at: 1 put: (self mod: ModReg RM: reg RO: reg).
  	^2!

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeMoveCwR (in category 'generate machine code - concretize') -----
- ----- 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: 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).
  	^5!

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeMoveM16rR (in category 'generate machine code - concretize') -----
- ----- 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 ~= 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).
  			 ^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).
  		^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).
  		 ^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).
  	^8!

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeMoveM32rRs (in category 'generate machine code - concretize') -----
- ----- Method: CogIA32Compiler>>concretizeMoveM32rRs (in category 'generate machine code') -----
  concretizeMoveM32rRs
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| srcReg offset destReg |
  	offset := operands at: 0.
  	srcReg := operands at: 1.
  	destReg := operands at: 2.
  	srcReg ~= ESP ifTrue:
  		[(self isQuick: offset) ifTrue:
  			[machineCode
  				at: 0 put: 16rF3;
  				at: 1 put: 16r0F;
  				at: 2 put: 16r10;
  				at: 3 put: (self mod: ModRegRegDisp8 RM: srcReg RO: destReg);
  				at: 4 put: (offset bitAnd: 16rFF).
  			 ^5].
  		machineCode
  			at: 0 put: 16rF3;
  			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).
  		^8].
  	"ESP:"
  	(self isQuick: offset) ifTrue:
  		[machineCode
  			at: 0 put: 16rF3;
  			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).
  		 ^6].
  	machineCode
  		at: 0 put: 16rF3;
  		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).
  	^9!

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeMoveM64rRd (in category 'generate machine code - concretize') -----
- ----- 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 ~= 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).
  			 ^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).
  		^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).
  		 ^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).
  	^9!

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeMoveM8rR (in category 'generate machine code - concretize') -----
- ----- Method: CogIA32Compiler>>concretizeMoveM8rR (in category 'generate machine code') -----
  concretizeMoveM8rR
  	"Will get inlined into concretizeAt: switch."
  	"movzwl"
  	<inline: true>
  	| srcReg offset destReg |
  	offset := operands at: 0.
  	srcReg := operands at: 1.
  	destReg := 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).
  			 ^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).
  		^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).
  		 ^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).
  	^8!

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeMoveMbrR (in category 'generate machine code - concretize') -----
- ----- 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 ~= 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).
  			 ^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).
  		^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).
  		 ^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).
  	^8!

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeMoveMwrR (in category 'generate machine code - concretize') -----
- ----- 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 ~= ESP ifTrue:
  		[(offset = 0 and: [srcReg ~= EBP]) ifTrue:
  			[machineCode
  				at: 0 put: 16r8B;
  				at: 1 put: (self mod: ModRegInd RM: srcReg RO: destReg).
  			 ^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).
  			 ^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).
  		^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).
  		 ^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).
  		 ^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).
  	^7!

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeMoveRAb (in category 'generate machine code - concretize') -----
- ----- Method: CogIA32Compiler>>concretizeMoveRAb (in category 'generate machine code') -----
  concretizeMoveRAb
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| addressOperand reg |
  	reg := 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).
  			^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).
  	^6!

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeMoveRAw (in category 'generate machine code - concretize') -----
- ----- Method: CogIA32Compiler>>concretizeMoveRAw (in category 'generate machine code') -----
  concretizeMoveRAw
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| addressOperand reg |
  	reg := 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).
  			^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).
  	^6!

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeMoveRM16r (in category 'generate machine code - concretize') -----
- ----- Method: CogIA32Compiler>>concretizeMoveRM16r (in category 'generate machine code') -----
  concretizeMoveRM16r
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| srcReg offset destReg |
  	offset := operands at: 1.
  	srcReg := operands at: 0.
  	destReg := operands at: 2.
  	destReg ~= ESP ifTrue:
  		[(self isQuick: offset) ifTrue:
  			[machineCode
  				at: 0 put: 16r66;
  				at: 1 put: 16r89;
  				at: 2 put: (self mod: ModRegRegDisp8 RM: destReg RO: srcReg);
  				at: 3 put: (offset bitAnd: 16rFF).
  			 ^4].
  		machineCode
  			at: 0 put: 16r66;
  			at: 1 put: 16r89;
  			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).
  		^7].
  	machineCode
  		at: 0 put: 16r66;
  		at: 1 put: 16r89;
  		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).
  	^8!

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeMoveRMbr (in category 'generate machine code - concretize') -----
- ----- 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 >= 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).
  			 ^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).
  		^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).
  	^7!

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeMoveRMwr (in category 'generate machine code - concretize') -----
- ----- Method: CogIA32Compiler>>concretizeMoveRMwr (in category 'generate machine code') -----
  concretizeMoveRMwr
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| srcReg offset destReg |
  	srcReg := operands at: 0.
  	offset := operands at: 1.
  	destReg := 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).
  			 ^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).
  			 ^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).
  		^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).
  		 ^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).
  		 ^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).
  	^7!

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeMoveRXbrR (in category 'generate machine code - concretize') -----
- ----- 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.
  	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].
  		 ^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].
  	 ^4 + (2 * mcIdx)!

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeMoveRXwrR (in category 'generate machine code - concretize') -----
- ----- 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.
  	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).
  		 ^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.
  	 ^4!

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeMoveRdM64r (in category 'generate machine code - concretize') -----
- ----- Method: CogIA32Compiler>>concretizeMoveRdM64r (in category 'generate machine code') -----
  concretizeMoveRdM64r
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| srcReg offset destReg |
  	srcReg := operands at: 0.
  	offset := operands at: 1.
  	destReg := 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).
  			 ^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).
  		^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).
  		 ^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).
  	^9!

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

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeMoveRsM32r (in category 'generate machine code - concretize') -----
- ----- Method: CogIA32Compiler>>concretizeMoveRsM32r (in category 'generate machine code') -----
  concretizeMoveRsM32r
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| srcReg offset destReg |
  	srcReg := operands at: 0.
  	offset := operands at: 1.
  	destReg := operands at: 2.
  	destReg ~= ESP ifTrue:
  		[(self isQuick: offset) ifTrue:
  			"MOVSD destReg, srcReg"
  			[machineCode
  				at: 0 put: 16rF3;
  				at: 1 put: 16r0F;
  				at: 2 put: 16r11;
  				at: 3 put: (self mod: ModRegRegDisp8 RM: destReg RO: srcReg);
  				at: 4 put: (offset bitAnd: 16rFF).
  			 ^5].
  		"MOVSD destReg, srcReg"
  		machineCode
  			at: 0 put: 16rF3;
  			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).
  		^8].
  	"ESP:"
  	(self isQuick: offset) ifTrue:
  		[machineCode
  			at: 0 put: 16rF3;
  			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).
  		 ^6].
  	machineCode
  		at: 0 put: 16rF3;
  		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).
  	^9!

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

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeMoveXbrRR (in category 'generate machine code - concretize') -----
- ----- 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.
  	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).
  		 ^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.
  	 ^5!

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeMoveXwrRR (in category 'generate machine code - concretize') -----
- ----- 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.
  	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).
  		 ^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.
  	 ^4!

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeMulRR (in category 'generate machine code - concretize') -----
- ----- 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.
  	machineCode
  		at: 0 put: 16r0F;
  		at: 1 put: 16rAF;
  		at: 2 put: (self mod: ModReg RM: reg1 RO: reg2).
  	^3!

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

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeNop (in category 'generate machine code - concretize') -----
- ----- Method: CogIA32Compiler>>concretizeNop (in category 'generate machine code') -----
  concretizeNop
  	<inline: true>
  	machineCode at: 0 put: 16r90.
  	^1!

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

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

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeOrCqR (in category 'generate machine code - concretize') -----
- ----- 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.
  	(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).
  		 ^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).
  		 ^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).
  	 ^6!

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeOrCwR (in category 'generate machine code - concretize') -----
- ----- 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 = 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).
  		 ^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).
  	 ^6!

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

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizePrefetchAw (in category 'generate machine code - concretize') -----
- ----- Method: CogIA32Compiler>>concretizePrefetchAw (in category 'generate machine code') -----
  concretizePrefetchAw
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| addressOperand |
  	"Note that maxSize has been set to 7 or 0 in computeMaximumSize whether hasSSEInstructions or not"
  	maxSize > 0 ifTrue:
  		[addressOperand := operands at: 0.
  		 machineCode
  			at: 0 put: 16r0f;
  			at: 1 put: 16r18;
  			at: 2 put: (self mod: 0 RM: 5 RO: 1); "prefetch0, prefetch using the T0 temporal data hint"
  			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)].
  	^maxSize!

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizePushCq (in category 'generate machine code - concretize') -----
- ----- Method: CogIA32Compiler>>concretizePushCq (in category 'generate machine code') -----
  concretizePushCq
  	<inline: true>
  	| value |
  	value := operands at: 0.
  	(self isQuick: value) ifTrue:
  		[machineCode
  			at: 0 put: 16r6A;
  			at: 1 put: (value bitAnd: 16rFF).
  		^2].
  	machineCode
  		at: 0 put: 16r68;
  		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).
  	^5!

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizePushCw (in category 'generate machine code - concretize') -----
- ----- Method: CogIA32Compiler>>concretizePushCw (in category 'generate machine code') -----
  concretizePushCw
  	<inline: true>
  	| value |
  	value := operands at: 0.
  	machineCode
  		at: 0 put: 16r68;
  		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).
  	^5!

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

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeREP (in category 'generate machine code - concretize') -----
- ----- Method: CogIA32Compiler>>concretizeREP (in category 'generate machine code') -----
  concretizeREP
  	<inline: true>
  	machineCode at: 0 put: 16rF3.
  	^1!

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeRetN (in category 'generate machine code - concretize') -----
- ----- Method: CogIA32Compiler>>concretizeRetN (in category 'generate machine code') -----
  concretizeRetN
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| offset |
  	offset := operands at: 0.
  	offset = 0 ifTrue:
  		[machineCode at: 0 put: 16rC3.
  		^1].
  	machineCode
  		at: 0 put: 16rC2;
  		at: 1 put: (offset bitAnd: 16rFF);
  		at: 2 put: (offset >> 8).
  	^3!

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

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeSEE2OpRdRd: (in category 'generate machine code - concretize') -----
- ----- 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.
  	machineCode
  		at: 0 put: 16rF2;
  		at: 1 put: 16r0F;
  		at: 2 put: opCode;
  		at: 3 put: (self mod: ModReg RM: regRHS RO: regLHS).
  	^4!

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

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

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

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeSqrtRd (in category 'generate machine code - concretize') -----
- ----- Method: CogIA32Compiler>>concretizeSqrtRd (in category 'generate machine code') -----
  concretizeSqrtRd
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| reg |
  	reg := 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).
  	^4!

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

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeStop (in category 'generate machine code - concretize') -----
- ----- Method: CogIA32Compiler>>concretizeStop (in category 'generate machine code') -----
  concretizeStop
  	<inline: true>
  	machineCode at: 0 put: 16rCC.
  	^1!

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeSubCqR (in category 'generate machine code - concretize') -----
- ----- 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.
  	(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).
  		 ^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).
  		 ^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).
  	 ^6!

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeSubCwR (in category 'generate machine code - concretize') -----
- ----- 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 = 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).
  		 ^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).
  	 ^6!

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeSubbRR (in category 'generate machine code - concretize') -----
- ----- Method: CogIA32Compiler>>concretizeSubbRR (in category 'generate machine code') -----
  concretizeSubbRR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	"Assemble the SBB instruction"
  	| regLHS regRHS |
  	regLHS := operands at: 0.
  	regRHS := operands at: 1.
  	machineCode
  		at: 0 put: 16r1B;
  		at: 1 put: (self mod: ModReg RM: regLHS RO: regRHS).
  	^2!

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeTstCqR (in category 'generate machine code - concretize') -----
- ----- 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.
  	((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).
  		 ^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).
  		 ^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).
  	 ^6!

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeXCHGAwR (in category 'generate machine code - concretize') -----
- ----- Method: CogIA32Compiler>>concretizeXCHGAwR (in category 'generate machine code') -----
  concretizeXCHGAwR
  	<inline: true>
  	| addressOperand reg |
  	addressOperand := operands at: 0.
  	reg := 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).
  	^6!

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeXCHGMwrR (in category 'generate machine code - concretize') -----
- ----- 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 ~= 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).
  			 ^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).
  		^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).
  		 ^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).
  	^7!

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

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeXorCwR (in category 'generate machine code - concretize') -----
- ----- 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 = 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).
  		 ^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).
  	 ^6!

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

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

Item was changed:
+ ----- Method: CogIA32Compiler>>concretizeZeroExtend16RR (in category 'generate machine code - concretize') -----
- ----- Method: CogIA32Compiler>>concretizeZeroExtend16RR (in category 'generate machine code') -----
  concretizeZeroExtend16RR
  	"Will get inlined into concretizeAt: switch."
  	"movzwl"
  	| srcReg destReg |
  	srcReg := operands at: 0.
  	destReg := operands at: 1.
  	machineCode
  		at: 0 put: 16r0F;
  		at: 1 put: 16rB7;
  		at: 2 put: (self mod: ModReg RM: srcReg RO: destReg).
  	^ 3!

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

Item was changed:
+ ----- Method: CogIA32Compiler>>stopsFrom:to: (in category 'generate machine code - support') -----
- ----- Method: CogIA32Compiler>>stopsFrom:to: (in category 'generate machine code') -----
  stopsFrom: startAddr to: endAddr
  	self
  		cCode: [self memset: startAddr _: self stop _: endAddr - startAddr + 1]
  		inSmalltalk:
  			[| alignedEnd alignedStart stops |
  			stops := self stop << 8 + self stop.
  			stops := stops << 16 + stops.
  			alignedStart := startAddr + 3 // 4 * 4.
  			alignedEnd := endAddr - 1 // 4 * 4.
  			alignedEnd <= startAddr
  				ifTrue:
  					[startAddr to: endAddr do:
  						[:addr | objectMemory byteAt: addr put: self stop]]
  				ifFalse:
  					[startAddr to: alignedStart - 1 do:
  						[:addr | objectMemory byteAt: addr put: self stop].
  					 alignedStart to: alignedEnd by: 4 do:
  						[:addr | objectMemory long32At: addr put: stops].
  					 alignedEnd + 4 to: endAddr do:
  						[:addr | objectMemory byteAt: addr put: self stop]]]!

Item was changed:
+ ----- Method: CogInLineLiteralsX64Compiler>>concretizeArithCwR: (in category 'generate machine code - concretize') -----
- ----- Method: CogInLineLiteralsX64Compiler>>concretizeArithCwR: (in category 'generate machine code') -----
  concretizeArithCwR: x64opcode
  	| value reg reverse |
  	value := operands at: 0.
  	reg := 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:  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]);
  		at: 11 put: x64opcode;
  		at: 12 put: (reverse
  					ifTrue: [self mod: ModReg RM: reg RO: RISCTempReg]
  					ifFalse: [self mod: ModReg RM: RISCTempReg RO: reg]).
  	self assert: (machineCode at: 12) > 16r90. "See literalBeforeFollowingAddress:"
  	^13!

Item was changed:
+ ----- Method: CogInLineLiteralsX64Compiler>>concretizeMoveCwR (in category 'generate machine code - concretize') -----
- ----- 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.
  	(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).
  		^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).
  	"Add a nop to disambiguate between MoveCwR/PushCw and ArithCwR, which ends with a (self mod: ModReg RM: 0 RO: 0)"
  	machineCode at: 10 put: 16r90.
  	^11!

Item was changed:
+ ----- Method: CogInLineLiteralsX64Compiler>>concretizePushCw (in category 'generate machine code - concretize') -----
- ----- 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: 1 put: 16r8D; "LoadEffectiveAddress"
  			at: 2 put: (self mod: ModRegInd RM: 5 RO: RISCTempReg);
  			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.
  		^9].
  	machineCode
  		at:  0 put: (self rexR: RISCTempReg x: 0 b: RISCTempReg);
  		at:  1 put: 16rB8 + (RISCTempReg 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, PushCw and ArithCwR, which ends with a (self mod: ModReg RM: 0 RO: 0)"
  	self assert: (machineCode at: 11) < 16r90. "see literalBeforeFollowingAddress:"
  	^12!

Item was changed:
+ ----- Method: CogMIPSELCompiler>>stopsFrom:to: (in category 'generate machine code - support') -----
- ----- Method: CogMIPSELCompiler>>stopsFrom:to: (in category 'generate machine code') -----
  stopsFrom: startAddr to: endAddr
  	self assert: endAddr - startAddr + 1 \\ 4 = 0.
  	startAddr to: endAddr by: 4 do: 
  		[:addr | objectMemory longAt: addr put: self stop].!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeAlignmentNops (in category 'generate machine code - concretize') -----
- ----- Method: CogX64Compiler>>concretizeAlignmentNops (in category 'generate machine code') -----
  concretizeAlignmentNops
  	<inline: true>
  	self flag: 'if performance is an issue generate longer nops'.
  	0 to: machineCodeSize - 1 do:
  		[:i|
  		machineCode at: i put: 16r90].
  	^machineCodeSize!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeArithCqRWithRO:raxOpcode: (in category 'generate machine code - concretize') -----
- ----- 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.
  	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).
  		 ^4].
  	(self is32BitSignedImmediate: 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).
  			 ^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).
  		 ^7].
  	^self concretizeArithCwR: (raxOpcode = 16r3D "Cmp" ifTrue: [16r39] ifFalse: [raxOpcode - 2])!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeBSR (in category 'generate machine code - concretize') -----
- ----- Method: CogX64Compiler>>concretizeBSR (in category 'generate machine code') -----
  concretizeBSR
  	"Bit Scan Reverse
  	First operand is output register (dest)
  	Second operand is input register (mask)"
  	"BSR"
  	<inline: true>
  	| dest mask |
  	dest := operands at: 0.
  	mask := operands at: 1.
  	(dest <= 7 and: [mask <= 7])
  		ifTrue: [machineCode at: 0 put: (self rexw: true r: 0 x: 0 b: 0)]
  		ifFalse: ["Beware: operation is on 32bits for R8-15"machineCode at: 0 put: (self rexw: false r: 0 x: 0 b: 0)].
  
  	machineCode
  		at: 1 put: 16r0F;
  		at: 2 put: 16rBD;
  		at: 3 put: (self mod: ModReg RM: dest RO: mask).
  	 ^4!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeCDQ (in category 'generate machine code - concretize') -----
- ----- Method: CogX64Compiler>>concretizeCDQ (in category 'generate machine code') -----
  concretizeCDQ
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	machineCode
  		at: 0 put: 16r48;
  		at: 1 put: 16r99.
  	^2!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeCLD (in category 'generate machine code - concretize') -----
- ----- Method: CogX64Compiler>>concretizeCLD (in category 'generate machine code') -----
  concretizeCLD
  	<inline: true>
  	machineCode at: 0 put: 16rFC.
  	^1!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeCPUID (in category 'generate machine code - concretize') -----
- ----- Method: CogX64Compiler>>concretizeCPUID (in category 'generate machine code') -----
  concretizeCPUID
  	<inline: true>
  	machineCode
  		at: 0 put: 16r0F;
  		at: 1 put: 16rA2.
  	^2!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeCall (in category 'generate machine code - concretize') -----
- ----- Method: CogX64Compiler>>concretizeCall (in category 'generate machine code') -----
  concretizeCall
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| offset |
  	self assert: (operands at: 0) ~= 0.
  	offset := (operands at: 0) signedIntFromLong - (address + 5) signedIntFromLong.
  	machineCode
  		at: 0 put: 16rE8;
  		at: 1 put: (offset bitAnd: 16rFF);
  		at: 2 put: (offset >> 8 bitAnd: 16rFF);
  		at: 3 put: (offset >> 16 bitAnd: 16rFF);
  		at: 4 put: (offset >> 24 bitAnd: 16rFF).
  	^5!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeCallFull (in category 'generate machine code - concretize') -----
- ----- Method: CogX64Compiler>>concretizeCallFull (in category 'generate machine code') -----
  concretizeCallFull
  	"Since CallFull (and JumpFull) is used to invoke code in dynamically-loaded plugins it shouldn't
  	 assume that code will be loaded within 2Gb of the code zone.  Hence generate a full 64-bit call,
  	 movabsq $0x123456789abcdef0, %rax; callq *%rax."
  	<inline: true>
  	| operand |
  	operand := operands at: 0.
  	machineCode
  		at: 0 put: 16r48;
  		at: 1 put: 16rB8;
  		at: 2 put: (operand bitAnd: 16rFF);
  		at: 3 put: (operand >> 8 bitAnd: 16rFF);
  		at: 4 put: (operand >> 16 bitAnd: 16rFF);
  		at: 5 put: (operand >> 24 bitAnd: 16rFF);
  		at: 6 put: (operand >> 32 bitAnd: 16rFF);
  		at: 7 put: (operand >> 40 bitAnd: 16rFF);
  		at: 8 put: (operand >> 48 bitAnd: 16rFF);
  		at: 9 put: (operand >> 56 bitAnd: 16rFF);
  		at: 10 put: 16rFF;
  		at: 11 put: (self mod: ModReg RM: RAX RO: 2).
  	^12!

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

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeClzRR (in category 'generate machine code - concretize') -----
- ----- Method: CogX64Compiler>>concretizeClzRR (in category 'generate machine code') -----
  concretizeClzRR
  	"Count leading zeros
  	First operand is output (dest)
  	Second operand is input (mask)"
  	"LZCNT"
  	<inline: true>
  	| dest mask |
  	dest := operands at: 0.
  	mask := operands at: 1.
  	machineCode
  		at: 0 put: 16rF3.
  	(dest <= 7 and: [mask <= 7])
  		ifTrue: [machineCode at: 1 put: (self rexw: true r: 0 x: 0 b: 0)]
  		ifFalse: [machineCode at: 1 put: (self rexw: false r: 0 x: 0 b: 0)].
  
  	machineCode
  		at: 2 put: 16r0F;
  		at: 3 put: 16rBD;
  		at: 4 put: (self mod: ModReg RM: dest RO: mask).
  	 ^5!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeCmpC32R (in category 'generate machine code - concretize') -----
- ----- Method: CogX64Compiler>>concretizeCmpC32R (in category 'generate machine code') -----
  concretizeCmpC32R
  	"Will get inlined into concretizeAt: switch."
  	"N.B. This use of 32-bit comparisons allows us to squeak by and use a short jump
  	 in PIC case dispatch, where a jump to the abort is 126 bytes (!!!!)."
  	<inline: true>
  	| value reg skip |
  	value := operands at: 0.
  	reg := operands at: 1.
  	reg = RAX
  		ifTrue:
  			[machineCode at: 0 put: 16r3D.
  			 skip := 0]
  		ifFalse:
  			[reg > 7
  				ifTrue:
  					[machineCode at: 0 put: 16r41.
  					 skip := 2]
  				ifFalse:
  					[skip := 1].
  			 machineCode
  				at: skip - 1 put: 16r81;
  				at: skip put:  (self mod: ModReg RM: reg RO: 7)].
  	machineCode		
  		at: skip + 1 put: (value bitAnd: 16rFF);
  		at: skip + 2 put: (value >> 8 bitAnd: 16rFF);
  		at: skip + 3 put: (value >> 16 bitAnd: 16rFF);
  		at: skip + 4 put: (value >> 24 bitAnd: 16rFF).
  	 ^5 + skip!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeCmpRdRd (in category 'generate machine code - concretize') -----
- ----- 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 skip |
  	"CmpRR RHS LHS computes LHS - RHS, i.e. apparently reversed.  You have to think subtract."
  	regRHS := operands at: 0.
  	regLHS := operands at: 1.
  	
  	machineCode
  		at: 0 put: 16r66.
  	(regLHS <= 7 and: [regRHS <= 7])
  		ifTrue: [skip := 0]
  		ifFalse: [machineCode at: (skip := 1) put: (self rexw: false r: regLHS x: 0 b: regRHS)].	
  	
  	machineCode
  		at: skip + 1 put: 16r0F;
  		at: skip + 2 put: 16r2E;
  		at: skip + 3 put: (self mod: ModReg RM: regRHS RO: regLHS).
  	^skip + 4!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeCmpRsRs (in category 'generate machine code - concretize') -----
- ----- Method: CogX64Compiler>>concretizeCmpRsRs (in category 'generate machine code') -----
  concretizeCmpRsRs
  	"Will get inlined into concretizeAt: switch.
  	 We use UCOMISS"
  	<inline: true>
  	| regLHS regRHS skip |
  	"CmpRR RHS LHS computes LHS - RHS, i.e. apparently reversed.  You have to think subtract."
  	regRHS := operands at: 0.
  	regLHS := operands at: 1.
  	
  	(regLHS <= 7 and: [regRHS <= 7])
  		ifTrue: [skip := 0]
  		ifFalse: [machineCode at: (skip := 1) put: (self rexw: false r: regLHS x: 0 b: regRHS)].
  		
  	machineCode
  		at: skip + 0 put: 16r0F;
  		at: skip + 1 put: 16r2E;
  		at: skip + 2 put: (self mod: ModReg RM: regRHS RO: regLHS).
  	^skip + 3!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeConditionalJump: (in category 'generate machine code - concretize') -----
- ----- Method: CogX64Compiler>>concretizeConditionalJump: (in category 'generate machine code') -----
  concretizeConditionalJump: conditionCode
  	"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>
  	| offset |
  	offset := self computeJumpTargetOffsetPlus: 2.
  	(machineCodeSize = 0 "size not determined because no sizeJump pass; generating initial trampolines"
  		ifTrue: [self isQuick: offset]
  		ifFalse: [machineCodeSize = 2]) ifTrue:
  		[machineCode
  			at: 0 put: 16r70 + conditionCode;
  			at: 1 put: (offset bitAnd: 16rFF).
  		 ^2].
  	^self concretizeConditionalJumpLong: conditionCode!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeConditionalJumpLong: (in category 'generate machine code - concretize') -----
- ----- Method: CogX64Compiler>>concretizeConditionalJumpLong: (in category 'generate machine code') -----
  concretizeConditionalJumpLong: conditionCode
  	"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>
  	| offset |
  	offset := self computeJumpTargetOffsetPlus: 6.
  	machineCode
  		at: 0 put: 16r0F;
  		at: 1 put: 16r80 + conditionCode;
  		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).
  	^6!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeConvertRRd (in category 'generate machine code - concretize') -----
- ----- 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.
  	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).
  	 ^5!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeConvertRRs (in category 'generate machine code - concretize') -----
- ----- Method: CogX64Compiler>>concretizeConvertRRs (in category 'generate machine code') -----
  concretizeConvertRRs
  	"Will get inlined into concretizeAt: switch."
  	"CVTSI2SS"
  	<inline: true>
  	| srcReg destReg skip |
  	srcReg := operands at: 0.
  	destReg := operands at: 1.
  	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: 16r2A;
  		at: skip + 3 put: (self mod: ModReg RM: srcReg RO: destReg).
  	 ^skip + 4!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeConvertRdR (in category 'generate machine code - concretize') -----
- ----- Method: CogX64Compiler>>concretizeConvertRdR (in category 'generate machine code') -----
  concretizeConvertRdR
  	"Will get inlined into concretizeAt: switch."
  	"CVTSD2SI"
  	<inline: true>
  	| srcReg destReg |
  	srcReg := operands at:0.
  	destReg := 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: 16r2D;
  		at: 4 put: (self mod: ModReg RM: srcReg RO: destReg).
  	 ^5!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeConvertRdRs (in category 'generate machine code - concretize') -----
- ----- Method: CogX64Compiler>>concretizeConvertRdRs (in category 'generate machine code') -----
  concretizeConvertRdRs
  	"Will get inlined into concretizeAt: switch."
  	"CVTSD2SS"
  	<inline: true>
  	| srcReg destReg skip |
  	srcReg := operands at: 0.
  	destReg := operands at: 1.
  	machineCode
  		at: 0 put: 16rF2.
  	(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: 16r5A;
  		at: skip + 3 put: (self mod: ModReg RM: srcReg RO: destReg).
  	 ^skip + 4!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeConvertRsR (in category 'generate machine code - concretize') -----
- ----- Method: CogX64Compiler>>concretizeConvertRsR (in category 'generate machine code') -----
  concretizeConvertRsR
  	"Will get inlined into concretizeAt: switch."
  	"CVTSS2SI"
  	<inline: true>
  	| srcReg destReg skip |
  	srcReg := operands at: 0.
  	destReg := operands at: 1.
  	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: 16r2D;
  		at: skip + 3 put: (self mod: ModReg RM: srcReg RO: destReg).
  	 ^skip + 4!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeConvertRsRd (in category 'generate machine code - concretize') -----
- ----- Method: CogX64Compiler>>concretizeConvertRsRd (in category 'generate machine code') -----
  concretizeConvertRsRd
  	"Will get inlined into concretizeAt: switch."
  	"CVTSS2SD"
  	<inline: true>
  	| srcReg destReg skip |
  	srcReg := operands at: 0.
  	destReg := operands at: 1.
  	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: 16r5A;
  		at: skip + 3 put: (self mod: ModReg RM: srcReg RO: destReg).
  	 ^skip + 4!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeFill32 (in category 'generate machine code - concretize') -----
- ----- Method: CogX64Compiler>>concretizeFill32 (in category 'generate machine code') -----
  concretizeFill32
  	<inline: true>
  	| word |
  	<var: #word type: #'usqIntptr_t'>
  	word := operands at: 0.
  	machineCode at: 0 put: (word bitAnd: 16rFF).
  	machineCode at: 1 put: (word >> 8 bitAnd: 16rFF).
  	machineCode at: 2 put: (word >> 16 bitAnd: 16rFF).
  	machineCode at: 3 put: (word >> 24 bitAnd: 16rFF).
  	^4!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeIDIVR (in category 'generate machine code - concretize') -----
- ----- Method: CogX64Compiler>>concretizeIDIVR (in category 'generate machine code') -----
  concretizeIDIVR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| regDivisor |
  	regDivisor := 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).
  	^3!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeJump (in category 'generate machine code - concretize') -----
- ----- Method: CogX64Compiler>>concretizeJump (in category 'generate machine code') -----
  concretizeJump
  	"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>
  	| jumpTarget offset |
  	<var: #jumpTarget type: #'AbstractInstruction *'>
  	jumpTarget := cogit cCoerceSimple: (operands at: 0) to: #'AbstractInstruction *'.
  	cogit assertSaneJumpTarget: jumpTarget.
  	(self isAnInstruction: jumpTarget) ifTrue:
  		[jumpTarget := cogit cCoerceSimple: jumpTarget address to: #'AbstractInstruction *'].
  	self assert: jumpTarget ~= 0.
  	offset := jumpTarget signedIntFromLong - (address + 2) signedIntFromLong.
  	(machineCodeSize = 0 "size not determined because no sizeJump pass; generating initial trampolines"
  		ifTrue: [self isQuick: offset]
  		ifFalse: [machineCodeSize = 2]) ifTrue:
  		[machineCode
  			at: 0 put: 16rEB;
  			at: 1 put: (offset bitAnd: 16rFF).
  		 ^2].
  	offset := jumpTarget signedIntFromLong - (address + 5) signedIntFromLong.
  	machineCode
  		at: 0 put: 16rE9;
  		at: 1 put: (offset bitAnd: 16rFF);
  		at: 2 put: (offset >> 8 bitAnd: 16rFF);
  		at: 3 put: (offset >> 16 bitAnd: 16rFF);
  		at: 4 put: (offset >> 24 bitAnd: 16rFF).
  	^5!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeJumpFull (in category 'generate machine code - concretize') -----
- ----- Method: CogX64Compiler>>concretizeJumpFull (in category 'generate machine code') -----
  concretizeJumpFull
  	"Since JumpFull (and CallFull) is used to invoke code in dynamically-loaded plugins it shouldn't
  	 assume that code will be loaded within 2Gb of the code zone.  Hence generate a full 64-bit call,
  	 movabsq 0x123456789abcdef0, %rax; jmpq *%rax."
  	<inline: true>
  	| operand |
  	operand := operands at: 0.
  	machineCode
  		at: 0 put: 16r48;
  		at: 1 put: 16rB8;
  		at: 2 put: (operand bitAnd: 16rFF);
  		at: 3 put: (operand >> 8 bitAnd: 16rFF);
  		at: 4 put: (operand >> 16 bitAnd: 16rFF);
  		at: 5 put: (operand >> 24 bitAnd: 16rFF);
  		at: 6 put: (operand >> 32 bitAnd: 16rFF);
  		at: 7 put: (operand >> 40 bitAnd: 16rFF);
  		at: 8 put: (operand >> 48 bitAnd: 16rFF);
  		at: 9 put: (operand >> 56 bitAnd: 16rFF);
  		at: 10 put: 16rFF;
  		at: 11 put: (self mod: ModReg RM: RAX RO: 4).
  	^12!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeJumpLong (in category 'generate machine code - concretize') -----
- ----- Method: CogX64Compiler>>concretizeJumpLong (in category 'generate machine code') -----
  concretizeJumpLong
  	"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>
  	| jumpTarget offset |
  	<var: #jumpTarget type: #'AbstractInstruction *'>
  	jumpTarget := cogit cCoerceSimple: (operands at: 0) to: #'AbstractInstruction *'.
  	(self isAnInstruction: jumpTarget) ifTrue:
  		[jumpTarget := cogit cCoerceSimple: jumpTarget address to: #'AbstractInstruction *'].
  	self assert: jumpTarget ~= 0.
  	offset := jumpTarget signedIntFromLong - (address + 5) signedIntFromLong.
  	machineCode
  		at: 0 put: 16rE9;
  		at: 1 put: (offset bitAnd: 16rFF);
  		at: 2 put: (offset >> 8 bitAnd: 16rFF);
  		at: 3 put: (offset >> 16 bitAnd: 16rFF);
  		at: 4 put: (offset >> 24 bitAnd: 16rFF).
  	^5!

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

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeLoadEffectiveAddressMwrR (in category 'generate machine code - concretize') -----
- ----- 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.
  	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).
  			 ^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).
  		^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).
  		 ^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).
  	^8!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeMOVSB (in category 'generate machine code - concretize') -----
- ----- Method: CogX64Compiler>>concretizeMOVSB (in category 'generate machine code') -----
  concretizeMOVSB
  	<inline: true>
  	machineCode at: 0 put: 16rA4.
  	^1!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeMOVSQ (in category 'generate machine code - concretize') -----
- ----- Method: CogX64Compiler>>concretizeMOVSQ (in category 'generate machine code') -----
  concretizeMOVSQ
  	<inline: true>
  	machineCode
  		at: 0 put: (self rexw: true r: 0 x: 0 b: 0);
  		at: 1 put: 16rA5.
  	^2!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeMoveA32R (in category 'generate machine code - concretize') -----
- ----- Method: CogX64Compiler>>concretizeMoveA32R (in category 'generate machine code') -----
  concretizeMoveA32R
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| addressOperand reg offset |
  	addressOperand := operands at: 0.
  	(self isAnInstruction: (cogit cCoerceSimple: addressOperand to: #'AbstractInstruction *')) ifTrue:
  		[addressOperand := (cogit cCoerceSimple: addressOperand to: #'AbstractInstruction *') address].
  	reg := 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: 16rA1;
  		at: 1 + offset put: (addressOperand bitAnd: 16rFF);
  		at: 2 + offset put: (addressOperand >> 8 bitAnd: 16rFF);
  		at: 3 + offset put: (addressOperand >> 16 bitAnd: 16rFF);
  		at: 4 + offset put: (addressOperand >> 24 bitAnd: 16rFF);
  		at: 5 + offset put: (addressOperand >> 32 bitAnd: 16rFF);
  		at: 6 + offset put: (addressOperand >> 40 bitAnd: 16rFF);
  		at: 7 + offset put: (addressOperand >> 48 bitAnd: 16rFF);
  		at: 8 + offset put: (addressOperand >> 56 bitAnd: 16rFF).
  	reg = RAX ifTrue:
  		[^9].
  	machineCode
  		at: 11 put: (machineCode at: 0);
  		at: 12 put: (machineCode at: 1).
  	^13!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeMoveAbR (in category 'generate machine code - concretize') -----
- ----- 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 savedSize |
  	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.
  		 savedSize := self concretizeMoveMbrR.
  		 operands
  			at: 0 put: save0;
  			at: 1 put: save1;
  			at: 2 put: 0.
  		^savedSize].
  	reg := 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:
  		[^10].
  	machineCode
  		at: 12 put: (machineCode at: 0);
  		at: 13 put: (machineCode at: 1).
  	^14!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeMoveAwR (in category 'generate machine code - concretize') -----
- ----- Method: CogX64Compiler>>concretizeMoveAwR (in category 'generate machine code') -----
  concretizeMoveAwR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| addressOperand reg offset save0 save1 savedSize |
  	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.
  		 savedSize := self concretizeMoveMwrR.
  		 operands
  			at: 0 put: save0;
  			at: 1 put: save1;
  			at: 2 put: 0.
  		^savedSize].
  	reg := operands at: 1.
  	"If fetching RAX, fetch directly, otherwise, because of instruction encoding limitations, the register
  	 _must_ be fetched through RAX.  If reg = RBP or RSP simply fetch directly, otherwise swap RAX with
  	 the register before and after the fetch through RAX.  We avoid swapping before hand with RBP
  	 and RSP because setting RSP to whatever the contents of RAX is can cause disastrous results if
  	 an interrupt is delivered immediately after that point.  See mail threads beginning with
  		http://lists.squeakfoundation.org/pipermail/vm-dev/2019-September/031428.html
  		http://lists.squeakfoundation.org/pipermail/vm-dev/2019-October/031499.html"
  	(reg = RAX or: [reg = RBP or: [reg = RSP]])
  		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:
  		[^10].
  	"Now effect the assignment via xchg, which saves a byte over a move"
  	(reg = RBP or: [reg = RSP]) ifTrue:
  		[machineCode
  			at: 10 put: (self rexR: RAX x: 0 b: reg);
  			at: 11 put: 16r90 + (reg \\ 8).
  		^12].
  	machineCode
  		at: 12 put: (machineCode at: 0);
  		at: 13 put: (machineCode at: 1).
  	^14!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeMoveC32R (in category 'generate machine code - concretize') -----
- ----- 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.
  	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).
  	^7!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeMoveCqR (in category 'generate machine code - concretize') -----
- ----- 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 signed 32-bit displacement, if possible."
  	<inline: true>
  	| value reg |
  	value := operands at: 0.
  	reg := operands at: 1.
  	(self is32BitSignedImmediate: value) ifTrue:
  		[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).
  			 ^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).
  		 ^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).
  	^10!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeMoveCwR (in category 'generate machine code - concretize') -----
- ----- Method: CogX64Compiler>>concretizeMoveCwR (in category 'generate machine code') -----
  concretizeMoveCwR
  	self subclassResponsibility!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeMoveM16rR (in category 'generate machine code - concretize') -----
- ----- 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.
  	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: [srcReg ~= RBP and: [srcReg ~= R13]]) ifTrue:
  			[machineCode
  				at: 3 put: (self mod: ModRegInd RM: srcReg RO: destReg).
  			 ^4].
  		 (self isQuick: offset) ifTrue:
  			[machineCode
  				at: 3 put: (self mod: ModRegRegDisp8 RM: srcReg RO: destReg);
  				at: 4 put: (offset bitAnd: 16rFF).
  			 ^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).
  		^8].
  	"RSP & R12:"
  	(offset = 0 and: [srcReg ~= RBP and: [srcReg ~= R13]]) ifTrue:
  		[machineCode
  			at: 3 put: (self mod: ModRegInd RM: srcReg RO: destReg);
  			at: 4 put: (self s: SIB1 i: 4 b: srcReg).
  		 ^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).
  		 ^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).
  	^9!

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

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeMoveM32rRs (in category 'generate machine code - concretize') -----
- ----- Method: CogX64Compiler>>concretizeMoveM32rRs (in category 'generate machine code') -----
  concretizeMoveM32rRs
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| offset srcReg destReg skip |
  	offset := operands at: 0.
  	srcReg := operands at: 1.
  	destReg := 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: destReg x: 0 b: srcReg)].
  	machineCode
  		at: skip + 1 put: 16r0f;
  		at: skip + 2 put: 16r6e.
  	offset = 0 ifTrue:
  		[(srcReg bitAnd: 6) ~= RSP ifTrue:
  			[machineCode at: skip + 3 put: (self mod: ModRegInd RM: srcReg RO: destReg).
  			 ^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).
  			 ^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).
  			 ^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).
  		 ^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).
  	^skip + 8!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeMoveM64rRd (in category 'generate machine code - concretize') -----
- ----- 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.
  	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).
  			 ^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).
  			 ^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).
  			 ^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).
  		 ^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).
  	^skip + 8!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeMoveMbrR (in category 'generate machine code - concretize') -----
- ----- 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.
  	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).
  			 ^3].
  		(self isQuick: offset) ifTrue:
  			[machineCode
  				at: 2 put: (self mod: ModRegRegDisp8 RM: srcReg RO: destReg);
  				at: 3 put: (offset bitAnd: 16rFF).
  			 ^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).
  		^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).
  		 ^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).
  		 ^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).
  	^8!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeMoveMwrR (in category 'generate machine code - concretize') -----
- ----- 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.
  	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).
  			 ^3].
  		(self isQuick: offset) ifTrue:
  			[machineCode
  				at: 2 put: (self mod: ModRegRegDisp8 RM: srcReg RO: destReg);
  				at: 3 put: (offset bitAnd: 16rFF).
  			 ^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).
  		^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).
  		 ^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).
  		 ^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).
  	^8!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeMoveRA32 (in category 'generate machine code - concretize') -----
- ----- Method: CogX64Compiler>>concretizeMoveRA32 (in category 'generate machine code') -----
  concretizeMoveRA32
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| addressOperand reg offset |
  	reg := operands at: 0.
  	addressOperand := operands at: 1.
  	(self isAnInstruction: (cogit cCoerceSimple: addressOperand to: #'AbstractInstruction *')) ifTrue:
  		[addressOperand := (cogit cCoerceSimple: addressOperand to: #'AbstractInstruction *') address].
  	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: 16rA3;
  		at: 1 + offset put: (addressOperand bitAnd: 16rFF);
  		at: 2 + offset put: (addressOperand >>   8 bitAnd: 16rFF);
  		at: 3 + offset put: (addressOperand >> 16 bitAnd: 16rFF);
  		at: 4 + offset put: (addressOperand >> 24 bitAnd: 16rFF);
  		at: 5 + offset put: (addressOperand >> 32 bitAnd: 16rFF);
  		at: 6 + offset put: (addressOperand >> 40 bitAnd: 16rFF);
  		at: 7 + offset put: (addressOperand >> 48 bitAnd: 16rFF);
  		at: 8 + offset put: (addressOperand >> 56 bitAnd: 16rFF).
  	reg = RAX ifTrue:
  		[^9].
  	machineCode
  		at: 11 put: (machineCode at: 0);
  		at: 12 put: (machineCode at: 1).
  	^13!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeMoveRAb (in category 'generate machine code - concretize') -----
- ----- Method: CogX64Compiler>>concretizeMoveRAb (in category 'generate machine code') -----
  concretizeMoveRAb
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| addressOperand reg offset save1 savedSize |
  	reg := 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.
  		 savedSize := self concretizeMoveRMbr.
  		 operands
  			at: 1 put: save1;
  			at: 2 put: 0.
  		^savedSize].
  	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:
  		[^10].
  	machineCode
  		at: 12 put: (machineCode at: 0);
  		at: 13 put: (machineCode at: 1).
  	^14!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeMoveRAw (in category 'generate machine code - concretize') -----
- ----- Method: CogX64Compiler>>concretizeMoveRAw (in category 'generate machine code') -----
  concretizeMoveRAw
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| addressOperand reg offset save1 savedSize |
  	reg := 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.
  		 savedSize := self concretizeMoveRMwr.
  		 operands
  			at: 1 put: save1;
  			at: 2 put: 0.
  		^savedSize].
  	"If storing RAX, store directly, otherwise, because of instruction encoding limitations, the register
  	 _must_ be stored through RAX.  If reg = RBP or RSP simply store directly, otherwise swap RAX with
  	 the register before and after the store through RAX.  We avoid sweapping before hand with RBP
  	 and RSP because setting RSP to whatever the contents of RAX is can cause disastrous results if
  	 an interrupt is delivered immediately after that point.  See mail threads beginning with
  		http://lists.squeakfoundation.org/pipermail/vm-dev/2019-September/031428.html
  		http://lists.squeakfoundation.org/pipermail/vm-dev/2019-October/031499.html"
  	(reg = RAX or: [reg = RBP or: [reg = RSP]])
  		ifTrue: [offset := 0]
  		ifFalse:
  			[(reg = RBP or: [reg = RSP])
  				ifTrue:
  					[machineCode
  						at: 0 put: (self rexR: reg x: 0 b: RAX);
  						at: 1 put: 16r89;
  						at: 2 put: (self mod: ModReg RM: RAX RO: reg).
  					 offset := 3]
  				ifFalse:
  					[machineCode
  						at: 0 put: (self rexR: RAX 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:
  		[^10].
  	(reg = RBP or: [reg = RSP]) ifTrue:
  		[^13].
  	"Now effect the assignment via xchg, which restores RAX"
  	machineCode
  		at: 12 put: (machineCode at: 0);
  		at: 13 put: (machineCode at: 1).
  	^14!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeMoveRM16r (in category 'generate machine code - concretize') -----
- ----- Method: CogX64Compiler>>concretizeMoveRM16r (in category 'generate machine code') -----
  concretizeMoveRM16r
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| srcReg offset destReg skip |
  	srcReg := operands at: 0.
  	offset := operands at: 1.
  	destReg := operands at: 2.
  	machineCode at: 0 put: 16r66.
  	(srcReg > 7 or: [destReg > 7])
  		ifTrue:
  			[machineCode at: 1 put: (self rexw: false r: srcReg x: 0 b: destReg).
  			 skip := 1]
  		ifFalse:
  			[skip := 0].
  	(destReg bitAnd: 7) ~= RSP ifTrue:
  		[(self isQuick: offset) ifTrue:
  			[machineCode
  				at: skip + 1 put: 16r89;
  				at: skip + 2 put: (self mod: ModRegRegDisp8 RM: destReg RO: srcReg);
  				at: skip + 3 put: (offset bitAnd: 16rFF).
  			 ^skip + 4].
  		machineCode
  			at: skip + 1 put: 16r89;
  			at: skip + 2 put: (self mod: ModRegRegDisp32 RM: destReg RO: srcReg);
  			at: skip + 3 put: (offset bitAnd: 16rFF);
  			at: skip + 4 put: (offset >> 8 bitAnd: 16rFF);
  			at: skip + 5 put: (offset >> 16 bitAnd: 16rFF);
  			at: skip + 6 put: (offset >> 24 bitAnd: 16rFF).
  		^skip + 7].
  	"RSP:"
  	(self isQuick: offset) ifTrue:
  		[machineCode
  			at: skip + 1 put: 16r89;
  			at: skip + 2 put: (self mod: ModRegRegDisp8 RM: destReg RO: srcReg);
  			at: skip + 3 put: (self s: SIB1 i: 4 b: destReg);
  			at: skip + 4 put: (offset bitAnd: 16rFF).
  		 ^skip + 5].
  	machineCode
  		at: skip + 1 put: 16r89;
  		at: skip + 2 put: (self mod: ModRegRegDisp32 RM: destReg RO: srcReg);
  		at: skip + 3 put: (self s: SIB1 i: 4 b: destReg);
  		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).
  	^skip + 8!

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

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

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeMoveRMwr (in category 'generate machine code - concretize') -----
- ----- Method: CogX64Compiler>>concretizeMoveRMwr (in category 'generate machine code') -----
  concretizeMoveRMwr
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| srcReg offset destReg |
  	srcReg := operands at: 0.
  	offset := operands at: 1.
  	destReg := 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).
  			 ^3].
  		 (self isQuick: offset) ifTrue:
  			[machineCode
  				at: 2 put: (self mod: ModRegRegDisp8 RM: destReg RO: srcReg);
  				at: 3 put: (offset bitAnd: 16rFF).
  			 ^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).
  		^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).
  		 ^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).
  		 ^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).
  	^8!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeMoveRRd (in category 'generate machine code - concretize') -----
- ----- Method: CogX64Compiler>>concretizeMoveRRd (in category 'generate machine code') -----
  concretizeMoveRRd
  	<inline: true>
  	| srcReg destReg |
  	srcReg := operands at: 0.
  	destReg := 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).
  	^5!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeMoveRX32rR (in category 'generate machine code - concretize') -----
- ----- Method: CogX64Compiler>>concretizeMoveRX32rR (in category 'generate machine code') -----
  concretizeMoveRX32rR
  	| index base src offset |
  	src := operands at: 0.
  	index := operands at: 1.
  	base := operands at: 2.
  	(index > 7 or: [base > 7 or: [src > 7]])
  		ifTrue:
  			[machineCode at: 0 put: (self rexw: false r: src x: index b: base).
  			 offset := 1]
  		ifFalse:
  			[offset := 0].
  	(base bitAnd: 7) ~= RBP ifTrue:
  		[machineCode
  			at: offset + 0 put: 16r89;
  			at: offset + 1 put: (self mod: ModRegInd RM: 4 RO: src);
  			at: offset + 2 put: (self s: SIB4 i: index b: base).
  		 ^offset + 3].
  	machineCode
  		at: offset + 0 put: 16r89;
  		at: offset + 1 put: (self mod: ModRegRegDisp8 RM: 4 RO: src);
  		at: offset + 2 put: (self s: SIB4 i: index b: base);
  		at: offset + 3 put: 0.
  	 ^offset + 4!

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

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeMoveRXwrR (in category 'generate machine code - concretize') -----
- ----- 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.
  	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).
  		 ^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.
  	 ^5!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeMoveRdM64r (in category 'generate machine code - concretize') -----
- ----- Method: CogX64Compiler>>concretizeMoveRdM64r (in category 'generate machine code') -----
  concretizeMoveRdM64r
  	<inline: true>
  	| offset srcReg destReg skip |
  	srcReg := operands at: 0.
  	offset := operands at: 1.
  	destReg := 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).
  			 ^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).
  			 ^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).
  			 ^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).
  		 ^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).
  	^skip + 8!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeMoveRdR (in category 'generate machine code - concretize') -----
- ----- Method: CogX64Compiler>>concretizeMoveRdR (in category 'generate machine code') -----
  concretizeMoveRdR
  	<inline: true>
  	| srcReg destReg |
  	srcReg := operands at: 0.
  	destReg := 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).
  	^5!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeMoveRdRd (in category 'generate machine code - concretize') -----
- ----- Method: CogX64Compiler>>concretizeMoveRdRd (in category 'generate machine code') -----
  concretizeMoveRdRd
  	"Will get inlined into concretizeAt: switch."
  	"MOVSD"
  	<inline: true>
  	| srcReg destReg skip |
  	srcReg := operands at: 0.
  	destReg := operands at: 1.
  	machineCode
  		at: 0 put: 16rF2.
  	(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: 16r11;
  		at: skip + 3 put: (self mod: ModReg RM: destReg RO: srcReg).
  	^skip + 4!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeMoveRsM32r (in category 'generate machine code - concretize') -----
- ----- Method: CogX64Compiler>>concretizeMoveRsM32r (in category 'generate machine code') -----
  concretizeMoveRsM32r
  	<inline: true>
  	| offset srcReg destReg skip |
  	srcReg := operands at: 0.
  	offset := operands at: 1.
  	destReg := 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: 16r7e.
  	offset = 0 ifTrue:
  		[(destReg bitAnd: 6) ~= RSP ifTrue:
  			[machineCode at: skip + 3 put: (self mod: ModRegInd RM: destReg RO: srcReg).
  			 ^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).
  			 ^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).
  			 ^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).
  		 ^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).
  	^skip + 8!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeMoveRsRs (in category 'generate machine code - concretize') -----
- ----- Method: CogX64Compiler>>concretizeMoveRsRs (in category 'generate machine code') -----
  concretizeMoveRsRs
  	"Will get inlined into concretizeAt: switch."
  	"MOVSS"
  	<inline: true>
  	| srcReg destReg skip |
  	srcReg := operands at: 0.
  	destReg := operands at: 1.
  	machineCode
  		at: 0 put: 16rF3.
  	(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: 16r11;
  		at: skip + 3 put: (self mod: ModReg RM: destReg RO: srcReg).
  	^skip + 4!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeMoveX32rRR (in category 'generate machine code - concretize') -----
- ----- 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.
  	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).
  		 ^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.
  	 ^offset + 7!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeMoveXbrRR (in category 'generate machine code - concretize') -----
- ----- 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.
  	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).
  		 ^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.
  	 ^5!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeMoveXwrRR (in category 'generate machine code - concretize') -----
- ----- 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.
  	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).
  		 ^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.
  	 ^5!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeMulRR (in category 'generate machine code - concretize') -----
- ----- 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.
  	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).
  	^4!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeNegateR (in category 'generate machine code - concretize') -----
- ----- Method: CogX64Compiler>>concretizeNegateR (in category 'generate machine code') -----
  concretizeNegateR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| reg |
  	reg := 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).
  	^3!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeNop (in category 'generate machine code - concretize') -----
- ----- Method: CogX64Compiler>>concretizeNop (in category 'generate machine code') -----
  concretizeNop
  	<inline: true>
  	machineCode at: 0 put: 16r90.
  	^1!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeOpRR: (in category 'generate machine code - concretize') -----
- ----- Method: CogX64Compiler>>concretizeOpRR: (in category 'generate machine code') -----
  concretizeOpRR: x64opcode
  	| regLHS regRHS |
  	regLHS := operands at: 0.
  	regRHS := 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).
  	^3!

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

Item was changed:
+ ----- Method: CogX64Compiler>>concretizePrefetchAw (in category 'generate machine code - concretize') -----
- ----- Method: CogX64Compiler>>concretizePrefetchAw (in category 'generate machine code') -----
  concretizePrefetchAw
  	"We support only prefetches for addresses that are variables relative to VarBase"
  	| operand offset |
  	operand := operands at: 0.
  	(self isAddressRelativeToVarBase: operand) ifFalse:
  		[^0].
  	offset := operand - cogit varBaseAddress.
  	machineCode
  		at: 0 put: 16r0f;
  		at: 1 put: 16r18;
  		at: 2 put: 16r93;
  		at: 3 put: (offset bitAnd: 16rFF);
  		at: 4 put: (offset >> 16 bitAnd: 16rFF);
  		at: 5 put: (offset >> 8 bitAnd: 16rFF);
  		at: 6 put: offset >> 24.
  	^7!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizePushCq (in category 'generate machine code - concretize') -----
- ----- Method: CogX64Compiler>>concretizePushCq (in category 'generate machine code') -----
  concretizePushCq
  	<inline: true>
  	| value |
  	value := operands at: 0.
  	(self isQuick: value) ifTrue:
  		[machineCode
  			at: 0 put: 16r6A;
  			at: 1 put: (value bitAnd: 16rFF).
  		^2].
  	(self is32BitSignedImmediate: value) ifTrue:
  		[machineCode
  			at: 0 put: 16r68;
  			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).
  		^5].
  	^self concretizePushCw!

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

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeREP (in category 'generate machine code - concretize') -----
- ----- Method: CogX64Compiler>>concretizeREP (in category 'generate machine code') -----
  concretizeREP
  	<inline: true>
  	machineCode at: 0 put: 16rF3.
  	^1!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeRetN (in category 'generate machine code - concretize') -----
- ----- Method: CogX64Compiler>>concretizeRetN (in category 'generate machine code') -----
  concretizeRetN
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| offset |
  	offset := operands at: 0.
  	offset = 0 ifTrue:
  		[machineCode at: 0 put: 16rC3.
  		^1].
  	machineCode
  		at: 0 put: 16rC2;
  		at: 1 put: (offset bitAnd: 16rFF);
  		at: 2 put: (offset >> 8).
  	^3!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeReverseOpRR: (in category 'generate machine code - concretize') -----
- ----- 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.
  	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).
  	^3!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeSEE2OpRdRd: (in category 'generate machine code - concretize') -----
- ----- Method: CogX64Compiler>>concretizeSEE2OpRdRd: (in category 'generate machine code') -----
  concretizeSEE2OpRdRd: x64opcode
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| regLHS regRHS skip |
  	regRHS := operands at: 0.
  	regLHS := operands at: 1.
  	machineCode
  		at: 0 put: 16rF2.
  	(regLHS <= 7 and: [regRHS <= 7])
  		ifTrue: [skip := 0]
  		ifFalse: [machineCode at: (skip := 1) put: (self rexw: false r: regLHS x: 0 b: regRHS)].
  	machineCode 
  		at: skip + 1 put: 16r0F;
  		at: skip + 2 put: x64opcode;
  		at: skip + 3 put: (self mod: ModReg RM: regRHS RO: regLHS).
  	^skip + 4!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeSEEOpRsRs: (in category 'generate machine code - concretize') -----
- ----- Method: CogX64Compiler>>concretizeSEEOpRsRs: (in category 'generate machine code') -----
  concretizeSEEOpRsRs: x64opcode
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| regLHS regRHS skip |
  	regRHS := operands at: 0.
  	regLHS := operands at: 1.
  	machineCode
  		at: 0 put: 16rF3.
  	(regLHS <= 7 and: [regRHS <= 7])
  		ifTrue: [skip := 0]
  		ifFalse: [machineCode at: (skip := 1) put: (self rexw: false r: regLHS x: 0 b: regRHS)].
  	machineCode 
  		at: skip + 1 put: 16r0F;
  		at: skip + 2 put: x64opcode;
  		at: skip + 3 put: (self mod: ModReg RM: regRHS RO: regLHS).
  	^skip + 4!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeShiftCqRegOpcode: (in category 'generate machine code - concretize') -----
- ----- 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.
  	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).
  		 ^3].
  	machineCode
  		at: 1 put: 16rC1;
  		at: 2 put: (self mod: ModReg RM: reg RO: regOpcode);
  		at: 3 put: distance.
  	^4!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeShiftRegRegOpcode: (in category 'generate machine code - concretize') -----
- ----- 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 = 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).
  		 ^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"
  		 ^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).
  	^9!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeSignExtend16RR (in category 'generate machine code - concretize') -----
- ----- Method: CogX64Compiler>>concretizeSignExtend16RR (in category 'generate machine code') -----
  concretizeSignExtend16RR
  	"Will get inlined into concretizeAt: switch."
  	"movsxwq"
  	<inline: true>
  	| srcReg destReg |
  	srcReg := operands at: 0.
  	destReg := operands at: 1.
  	machineCode
  		at: 0 put: (self rexw: true r: destReg x: 0 b: srcReg);
  		at: 1 put: 16r0F;
  		at: 2 put: 16rBF;
  		at: 3 put: (self mod: ModReg RM: srcReg RO: destReg).
  	^ 4!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeSignExtend32RR (in category 'generate machine code - concretize') -----
- ----- Method: CogX64Compiler>>concretizeSignExtend32RR (in category 'generate machine code') -----
  concretizeSignExtend32RR
  	"Will get inlined into concretizeAt: switch."
  	"movsxdq"
  	<inline: true>
  	| srcReg destReg |
  	srcReg := operands at: 0.
  	destReg := operands at: 1.
  	machineCode
  		at: 0 put: (self rexw: true r: destReg x: 0 b: srcReg);
  		at: 1 put: 16r63;
  		at: 2 put: (self mod: ModReg RM: srcReg RO: destReg).
  	^ 3!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeSignExtend8RR (in category 'generate machine code - concretize') -----
- ----- Method: CogX64Compiler>>concretizeSignExtend8RR (in category 'generate machine code') -----
  concretizeSignExtend8RR
  	"Will get inlined into concretizeAt: switch."
  	"movsxbq"
  	<inline: true>
  	| srcReg destReg |
  	srcReg := operands at: 0.
  	destReg := operands at: 1.
  	machineCode
  		at: 0 put: (self rexw: true r: destReg x: 0 b: srcReg);
  		at: 1 put: 16r0F;
  		at: 2 put: 16rBE;
  		at: 3 put: (self mod: ModReg RM: srcReg RO: destReg).
  	^ 4!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeSqrtRd (in category 'generate machine code - concretize') -----
- ----- Method: CogX64Compiler>>concretizeSqrtRd (in category 'generate machine code') -----
  concretizeSqrtRd
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| reg skip |
  	reg := operands at: 0.
  	machineCode
  		at: 0 put: 16rF2.
  	(reg <= 7)
  		ifTrue: [skip := 0]
  		ifFalse: [machineCode at: (skip := 1) put: (self rexw: false r: reg x: 0 b: reg)].
  	machineCode
  		at: skip + 1 put: 16r0F;
  		at: skip + 2 put: 16r51;
  		at: skip + 3 put: (self mod: ModReg RM: reg RO: reg).
  	^skip + 4!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeSqrtRs (in category 'generate machine code - concretize') -----
- ----- Method: CogX64Compiler>>concretizeSqrtRs (in category 'generate machine code') -----
  concretizeSqrtRs
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| reg skip |
  	reg := operands at: 0.
  	machineCode
  		at: 0 put: 16rF3.
  	(reg <= 7)
  		ifTrue: [skip := 0]
  		ifFalse: [machineCode at: (skip := 1) put: (self rexw: false r: reg x: 0 b: reg)].
  	machineCode
  		at: skip + 1 put: 16r0F;
  		at: skip + 2 put: 16r51;
  		at: skip + 3 put: (self mod: ModReg RM: reg RO: reg).
  	^skip + 4!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeStop (in category 'generate machine code - concretize') -----
- ----- Method: CogX64Compiler>>concretizeStop (in category 'generate machine code') -----
  concretizeStop
  	<inline: true>
  	machineCode at: 0 put: 16rCC.
  	^1!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeTstCqR (in category 'generate machine code - concretize') -----
- ----- 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.
  	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).
  		 ^4].
  	
  	(self is32BitSignedImmediate: 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).
  			 ^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).
  		 ^7].
  	^self concretizeArithCwR: 16r85!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeXCHGRR (in category 'generate machine code - concretize') -----
- ----- Method: CogX64Compiler>>concretizeXCHGRR (in category 'generate machine code') -----
  concretizeXCHGRR
  	| r1 r2 |
  	r1 := operands at: 0.
  	r2 := 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).
  		 ^2].
  	machineCode
  		at: 0 put: (self rexR: r1 x: 0 b: r2);
  		at: 1 put: 16r87;
  		at: 2 put: (self mod: ModReg RM: r2 RO: r1).
  	^3!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeXorRdRd (in category 'generate machine code - concretize') -----
- ----- Method: CogX64Compiler>>concretizeXorRdRd (in category 'generate machine code') -----
  concretizeXorRdRd
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| regLHS regRHS skip |
  	regRHS := self operands at: 0.
  	regLHS := self operands at: 1.
  	machineCode
  		at: 0 put: 16r66.
  	(regLHS <= 7 and: [regRHS <= 7])
  		ifTrue: [skip := 0]
  		ifFalse: [machineCode at: (skip := 1) put: (self rexw: false r: regLHS x: 0 b: regRHS)].
  	machineCode
  		at: skip + 1 put: 16r0f;
  		at: skip + 2 put: 16r57;
  		at: skip + 3 put: (self mod: ModReg RM: regRHS RO: regLHS).
  	^skip + 4!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeXorRsRs (in category 'generate machine code - concretize') -----
- ----- Method: CogX64Compiler>>concretizeXorRsRs (in category 'generate machine code') -----
  concretizeXorRsRs
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| regLHS regRHS skip |
  	regRHS := self operands at: 0.
  	regLHS := self operands at: 1.
  	machineCode
  		at: 0 put: 16r0F.
  	(regLHS <= 7 and: [regRHS <= 7])
  		ifTrue: [skip := 0]
  		ifFalse: [machineCode at: (skip := 1) put: (self rexw: false r: regLHS x: 0 b: regRHS)].
  	
  	machineCode	
  		at: skip + 1 put: 16r57;
  		at: skip + 2 put: (self mod: ModReg RM: regRHS RO: regLHS).
  	^skip + 3!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeZeroExtend16RR (in category 'generate machine code - concretize') -----
- ----- Method: CogX64Compiler>>concretizeZeroExtend16RR (in category 'generate machine code') -----
  concretizeZeroExtend16RR
  	"Will get inlined into concretizeAt: switch."
  	"movzxwq"
  	<inline: true>
  	| srcReg destReg |
  	srcReg := operands at: 0.
  	destReg := operands at: 1.
  	machineCode
  		at: 0 put: (self rexw: true r: destReg x: 0 b: srcReg);
  		at: 1 put: 16r0F;
  		at: 2 put: 16rB7;
  		at: 3 put: (self mod: ModReg RM: srcReg RO: destReg).
  	^ 4!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeZeroExtend32RR (in category 'generate machine code - concretize') -----
- ----- Method: CogX64Compiler>>concretizeZeroExtend32RR (in category 'generate machine code') -----
  concretizeZeroExtend32RR
  	"Will get inlined into concretizeAt: switch."
  	"movzxbq"
  	<inline: true>
  	| srcReg destReg skip |
  	srcReg := operands at: 0.
  	destReg := operands at: 1.
  	(srcReg <= 7 and: [destReg <= 7])
  		ifTrue: [skip := 0]
  		ifFalse: [skip := 1. machineCode at: 0 put: (self rexw: false r: destReg x: 0 b: srcReg)].
  		
  	machineCode
  		at: skip + 0 put: 16r8b;
  		at: skip + 1 put: (self mod: ModReg RM: srcReg RO: destReg).
  	^ skip + 2!

Item was changed:
+ ----- Method: CogX64Compiler>>concretizeZeroExtend8RR (in category 'generate machine code - concretize') -----
- ----- Method: CogX64Compiler>>concretizeZeroExtend8RR (in category 'generate machine code') -----
  concretizeZeroExtend8RR
  	"Will get inlined into concretizeAt: switch."
  	"movzxbq"
  	<inline: true>
  	| srcReg destReg |
  	srcReg := operands at: 0.
  	destReg := operands at: 1.
  	machineCode
  		at: 0 put: (self rexw: true r: destReg x: 0 b: srcReg);
  		at: 1 put: 16r0F;
  		at: 2 put: 16rB6;
  		at: 3 put: (self mod: ModReg RM: srcReg RO: destReg).
  	^ 4!

Item was changed:
+ ----- Method: CogX64Compiler>>stopsFrom:to: (in category 'generate machine code - support') -----
- ----- Method: CogX64Compiler>>stopsFrom:to: (in category 'generate machine code') -----
  stopsFrom: startAddr to: endAddr
  	self
  		cCode: [self memset: startAddr _: self stop _: endAddr - startAddr + 1]
  		inSmalltalk:
  			[| alignedEnd alignedStart stops |
  			stops := self stop << 8 + self stop.
  			stops := stops << 16 + stops.
  			stops := stops << 32 + stops.
  			alignedStart := startAddr + 7 // 8 * 8.
  			alignedEnd := endAddr - 1 // 8 * 8.
  			alignedEnd <= startAddr
  				ifTrue:
  					[startAddr to: endAddr do:
  						[:addr | objectMemory byteAt: addr put: self stop]]
  				ifFalse:
  					[startAddr to: alignedStart - 1 do:
  						[:addr | objectMemory byteAt: addr put: self stop].
  					 alignedStart to: alignedEnd by: 8 do:
  						[:addr | objectMemory long64At: addr put: stops].
  					 alignedEnd + 8 to: endAddr do:
  						[:addr | objectMemory byteAt: addr put: self stop]]]!



More information about the Vm-dev mailing list