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

commits at source.squeak.org commits at source.squeak.org
Wed Nov 18 20:42:45 UTC 2015


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

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

Name: VMMaker.oscog-eem.1526
Author: eem
Time: 18 November 2015, 12:40:54.121 pm
UUID: 65bfe6e2-d2a0-48a4-bdbb-67a9d71f32ee
Ancestors: VMMaker.oscog-eem.1525

Cogit:
Revise Ryan's scheme for overflow checks in arithmetic operations, using a scheme which shoudl generalise to the collapse of Cmp[Cq|R]R; JumpCond: sequences onto the unitary compare-and-branch instructions the MIPS provides.

So revert all uses of AddCheckOverflowRR et al and add these as specific opcodes of MIPSEL.  Make all JumpCond: methods follow the pattern of invoking previousInstruction noteFollowingConditionalBranch:, to allow the two instructions to be modified as required, either to check for overflow or to collapse onto a unitary instruction.

Tidy up the declaration of processor-specific abstract opcodes by extracting the code into a method, initializeSpecificOpcodes:in:.

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

Item was changed:
  ----- Method: CogARMCompiler class>>initialize (in category 'class initialization') -----
  initialize
+ 
- 	
  	"Initialize various ARM instruction-related constants."
  	"CogARMCompiler initialize"
+ 
- 	
- 	| specificOpcodes refs |
  	super initialize.
  	self ~~ CogARMCompiler ifTrue: [^self].
+ 
- 	
  	"ARM general registers"
  	R0 := 0.
  	R1 := 1.
  	R2 := 2.
  	R3 := 3.
  	R4 := 4.
  	R5 := 5.
  	R6 := 6.
  	R7 := 7.
  	R8 := 8.
  	R9 := 9.
  	R10 := 10.
  	R11 := 11.
  	R12 := 12.
  	SP := 13.
  	LR := 14.
  	PC := 15.
  	"ARM VFP Double precision floating point registers"
  	D0 := 0.
  	D1 := 1.
  	D2 := 2.
  	D3 := 3.
  	D4 := 4.
  	D5 := 5.
  	D6 := 6.
  	D7 := 7.
+ 
- 	
- 	
  	CArg0Reg := 0.
  	CArg1Reg := 1.
  	CArg2Reg := 2.
  	CArg3Reg := 3.
  
  	ConcreteVarBaseReg := 10.
  	ConcreteIPReg := 12. "IP, The Intra-Procedure-call scratch register."
  	ConcretePCReg := 15.
+ 
- 	
  	"Condition Codes. Note that cc=16rF is NOT ALLOWED as a condition; it specifies an extension instruction. See e.g.ARM_ARM v5 DDI01001.pdf A3.2.1"
  	EQ := 0.
  	NE := 1.
  	CS := 2.
  	CC := 3.
  	MI := 4.
  	PL := 5.
  	VS := 6.
  	VC := 7.
  	HI := 8.
  	LS := 9.
  	GE := 10.
  	LT := 11.
  	GT := 12.
  	LE := 13.
  	AL := 14.
  
  	"Table A3-2 in sec A3.4 Data-processing instructions of the AARM."
  	AddOpcode := 	4.
  	AndOpcode := 0.
  	BicOpcode := 14.
  	CmpOpcode := 10.
  	CmpNotOpcode := 11.
  	MoveOpcode := 13.
  	MoveNotOpcode := 15.
  	OrOpcode := 12.
  	RsbOpcode := 3.
  	SMLALOpcode := 7.
  	SubOpcode := 2.
  	TstOpcode := 8.
  	XorOpcode := 1.
  
  	CPSRReg := 16.
  	OverflowFlag := 1 << 28.
  
  	"Specific instructions"
+ 	self
+ 		initializeSpecificOpcodes: #(SMULL MSR MRS LDMFD STMFD CMPSMULL)
+ 		in: thisContext method!
- 	LastRTLCode isNil ifTrue:
- 		[CogRTLOpcodes initialize].
- 	specificOpcodes := #(SMULL MSR MRS LDMFD STMFD CMPSMULL).
- 	refs := (thisContext method literals select: [:l| l isVariableBinding and: [classPool includesKey: l key]]) collect:
- 				[:ea| ea key].
- 	(classPool keys reject: [:k| (specificOpcodes includes: k) or: [refs includes: k]]) do:
- 		[:k|
- 		Undeclared declare: k from: classPool].
- 	specificOpcodes withIndexDo:
- 		[:classVarName :value|
- 		self classPool
- 			declare: classVarName from: Undeclared;
- 			at: classVarName put: value + LastRTLCode - 1]!

Item was added:
+ ----- Method: CogAbstractInstruction class>>initializeSpecificOpcodes:in: (in category 'class initialization') -----
+ initializeSpecificOpcodes: opcodeSymbolSequence in: initializeMethod
+ 	"Declare as class variables, the opcodes in opcodeSymbolSequence.
+ 	 Assign values to them from LastRTLOpcode on.  Undeclare any obsolete
+ 	 class vars.  The assumption is that initializeMethod defines all class vars
+ 	 in the class. This method should be used by subclasses wiching to declare
+ 	 their own specific opcodes."
+ 	| classVariablesDefinedInMethod |
+ 	self assert: self ~~ CogAbstractInstruction.
+ 	LastRTLCode ifNil:
+ 		[CogRTLOpcodes initialize].
+ 	classVariablesDefinedInMethod := (initializeMethod literals select: [:l| l isVariableBinding and: [classPool includesKey: l key]]) collect:
+ 											[:ea| ea key].
+ 	"Undeclare any class var not defined in opcodeSymbolSequence or by the method."
+ 	(classPool keys reject: [:k| (opcodeSymbolSequence includes: k) or: [classVariablesDefinedInMethod includes: k]]) do:
+ 		[:k|
+ 		Undeclared declare: k from: classPool].
+ 	"Declare opcodeSymbolSequence's elements from LastRTLCode on up."
+ 	opcodeSymbolSequence withIndexDo:
+ 		[:classVarName :value|
+ 		self classPool
+ 			declare: classVarName from: Undeclared;
+ 			at: classVarName put: value + LastRTLCode - 1]!

Item was added:
+ ----- Method: CogAbstractInstruction>>noteFollowingConditionalBranch: (in category 'abstract instructions') -----
+ noteFollowingConditionalBranch: branch
+ 	"Support for processors without condition codes, such as the MIPS.
+ 	 Answer the branch opcode.  If there are no condition codes, modify
+ 	 the receiver and the branch to implement a suitable conditional
+ 	 branch that doesn't depend on condition codes being set by the
+ 	 receiver.  By default a noop. Overridden in subclasses as required."
+ 	<var: #branch type: #'AbstractInstruction *'>
+ 	<inline: true>
+ 	^branch!

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

Item was changed:
  CogAbstractInstruction subclass: #CogMIPSELCompiler
  	instanceVariableNames: ''
+ 	classVariableNames: 'AddCheckOverflowCqR AddCheckOverflowRR BrEqRR BrGtzRR BrLezRR BrNeRR Cmp CmpSGT CmpSLT CmpUGT CmpULT ConcreteVarBaseReg MulCheckOverflowRR MulRR Overflow OverflowTemp1 OverflowTemp2 SubCheckOverflowCqR SubCheckOverflowRR TargetReg'
- 	classVariableNames: 'Cmp CmpSGT CmpSLT CmpUGT CmpULT ConcreteVarBaseReg Overflow OverflowTemp1 OverflowTemp2 TargetReg'
  	poolDictionaries: 'MIPSConstants'
  	category: 'VMMaker-JIT'!

Item was changed:
+ ----- Method: CogMIPSELCompiler class>>ISA (in category 'class initialization') -----
- ----- Method: CogMIPSELCompiler class>>ISA (in category 'as yet unclassified') -----
  ISA
  	^#MIPSEL!

Item was changed:
+ ----- Method: CogMIPSELCompiler class>>initialize (in category 'class initialization') -----
- ----- Method: CogMIPSELCompiler class>>initialize (in category 'as yet unclassified') -----
  initialize
  	"CogMIPSELCompiler initialize"
  
  	super initialize.
  	
  	ConcreteVarBaseReg := S6.
  
  	"Simulating a condition register."
  	Cmp := T0.
  	CmpSLT := T1.
  	CmpSGT := T2.
  	CmpULT := T3.
  	CmpUGT := T4.
  	Overflow := T0.
  	OverflowTemp1 := T1.
  	OverflowTemp2 := T2.
  
  	"OABI position independent code expects T9 to have its entry point on entry?"
  	self flag: #OABI.
+ 	TargetReg := T9.
+ 
+ 	"Specific instructions"
+ 	self
+ 		initializeSpecificOpcodes: #(MulRR
+ 									AddCheckOverflowCqR AddCheckOverflowRR MulCheckOverflowRR SubCheckOverflowCqR SubCheckOverflowRR
+ 									"Ryan, here are proposed opcodes for conditional branches."
+ 									BrEqRR BrNeRR BrLezRR BrGtzRR)
+ 		in: thisContext method
+ 		
+ 	!
- 	TargetReg := T9. !

Item was added:
+ ----- Method: CogMIPSELCompiler>>noteFollowingConditionalBranch: (in category 'abstract instructions') -----
+ noteFollowingConditionalBranch: branch
+ 	"Support for processors without condition codes, such as the MIPS.
+ 	 Answer the branch opcode.  Modify the receiver and the branch to
+ 	 implement a suitable conditional branch that doesn't depend on
+ 	 condition codes being set by the receiver."
+ 	<var: #branch type: #'AbstractInstruction *'>
+ 	branch opcode caseOf: {
+ 		[JumpOverflow]		-> [opcode := opcode caseOf: {
+ 										[AddCqR]	-> [AddCheckOverflowCqR].
+ 										[AddRR]		-> [AddCheckOverflowRR].
+ 										[MulRR]		-> [MulCheckOverflowRR].
+ 										[SubCqR]	-> [SubCheckOverflowCqR].
+ 										[SubRR]		-> [SubCheckOverflowRR].
+ 										}].
+ 		[JumpNoOverflow]	-> [opcode := opcode caseOf: {
+ 										[AddCqR]	-> [AddCheckOverflowCqR].
+ 										[AddRR]		-> [AddCheckOverflowRR].
+ 										[MulRR]		-> [MulCheckOverflowRR].
+ 										[SubCqR]	-> [SubCheckOverflowCqR].
+ 										[SubRR]		-> [SubCheckOverflowRR].
+ 										}].
+ 		"Ryan, I'm imagining that all the other cases go in here, such as collapsing CmpRR; JumpZero to Label; BrEqRR.
+ 		 This is obviously not nearly complete."
+ 		[JumpZero]			-> [opcode caseOf: {
+ 									[CmpRR]	-> [branch setOpcode: BrEqRR andOperandsFrom: self.
+ 													opcode := Label].
+ 								}].
+ 		[JumpNonZero]		-> [opcode caseOf: {
+ 									[CmpRR]	-> [branch setOpcode: BrNeRR andOperandsFrom: self.
+ 													opcode := Label].
+ 								}].
+ 		}
+ 		"No otherwise for now to catch all cases"
+ 		"otherwise: []".
+ 	^branch!

Item was added:
+ ----- Method: CogMIPSELCompiler>>setOpcode:andOperandsFrom: (in category 'accessing') -----
+ setOpcode: anOpcode andOperandsFrom: cmpInstruction
+ 	<var: #cmpInstruction type: #'AbstractInstruction *'>
+ 	<inline: true>
+ 	opcode := anOpcode.
+ 	operands
+ 		at: 0 put: (cmpInstruction opcodes at: 0);
+ 		at: 1 put: (cmpInstruction opcodes at: 1)!

Item was changed:
  SharedPool subclass: #CogRTLOpcodes
  	instanceVariableNames: ''
+ 	classVariableNames: 'AddCqR AddCwR AddRR AddRdRd AlignmentNops AndCqR AndCqRR AndCwR AndRR Arg0Reg Arg1Reg ArithmeticShiftRightCqR ArithmeticShiftRightRR Call CallFull ClassReg CmpC32R CmpCqR CmpCwR CmpRR CmpRdRd ConvertRRd DPFPReg0 DPFPReg1 DPFPReg2 DPFPReg3 DPFPReg4 DPFPReg5 DPFPReg6 DPFPReg7 DivRdRd FPReg Fill16 Fill32 Fill8 FillBytesFrom FillFromWord FirstJump FirstShortJump Jump JumpAbove JumpAboveOrEqual JumpBelow JumpBelowOrEqual JumpCarry JumpFPEqual JumpFPGreater JumpFPGreaterOrEqual JumpFPLess JumpFPLessOrEqual JumpFPNotEqual JumpFPOrdered JumpFPUnordered JumpFull JumpGreater JumpGreaterOrEqual JumpLess JumpLessOrEqual JumpLong JumpLongNonZero JumpLongZero JumpNegative JumpNoCarry JumpNoOverflow JumpNonNegative JumpNonZero JumpOverflow JumpR JumpZero Label LastJump LastRTLCode LinkReg Literal LoadEffectiveAddressMwrR LoadEffectiveAddressXowrR LogicalShiftLeftCqR LogicalShiftLeftRR LogicalShiftRightCqR LogicalShiftRightRR MoveAbR MoveAwR MoveC32R MoveC64R MoveCqR MoveCwR MoveM16rR MoveM32rR MoveM64rRd MoveMbrR MoveMwrR MoveRAb MoveRAw MoveRM16r MoveRM32r MoveRMbr MoveRMwr MoveRR MoveRX16rR MoveRX32rR MoveRXbrR MoveRXowr MoveRXwrR MoveRdM64r MoveRdRd MoveX16rRR MoveX32rRR MoveXbrRR MoveXowrR MoveXwrRR MulRdRd NegateR Nop OrCqR OrCwR OrRR PCReg PopR PrefetchAw PushCq PushCw PushR RISCTempReg ReceiverResultReg RetN SPReg Scratch0Reg Scratch1Reg Scratch2Reg Scratch3Reg Scratch4Reg Scratch5Reg Scratch6Reg Scratch7Reg SendNumArgsReg SqrtRd Stop SubCqR SubCwR SubRR SubRdRd TempReg TstCqR VarBaseReg XorCqR XorCwR XorRR'
- 	classVariableNames: 'AddCheckOverflowCqR AddCheckOverflowRR AddCqR AddCwR AddRR AddRdRd AlignmentNops AndCqR AndCqRR AndCwR AndRR Arg0Reg Arg1Reg ArithmeticShiftRightCqR ArithmeticShiftRightRR Call CallFull ClassReg CmpC32R CmpCqR CmpCwR CmpRR CmpRdRd ConvertRRd DPFPReg0 DPFPReg1 DPFPReg2 DPFPReg3 DPFPReg4 DPFPReg5 DPFPReg6 DPFPReg7 DivRdRd FPReg Fill16 Fill32 Fill8 FillBytesFrom FillFromWord FirstJump FirstShortJump Jump JumpAbove JumpAboveOrEqual JumpBelow JumpBelowOrEqual JumpCarry JumpFPEqual JumpFPGreater JumpFPGreaterOrEqual JumpFPLess JumpFPLessOrEqual JumpFPNotEqual JumpFPOrdered JumpFPUnordered JumpFull JumpGreater JumpGreaterOrEqual JumpLess JumpLessOrEqual JumpLong JumpLongNonZero JumpLongZero JumpNegative JumpNoCarry JumpNoOverflow JumpNonNegative JumpNonZero JumpOverflow JumpR JumpZero Label LastJump LastRTLCode LinkReg Literal LoadEffectiveAddressMwrR LoadEffectiveAddressXowrR LogicalShiftLeftCqR LogicalShiftLeftRR LogicalShiftRightCqR LogicalShiftRightRR MoveAbR MoveAwR MoveC32R MoveC64R MoveCqR MoveCwR MoveM16rR MoveM32rR MoveM64rRd MoveMbrR MoveMwrR MoveRAb MoveRAw MoveRM16r MoveRM32r MoveRMbr MoveRMwr MoveRR MoveRX16rR MoveRX32rR MoveRXbrR MoveRXowr MoveRXwrR MoveRdM64r MoveRdRd MoveX16rRR MoveX32rRR MoveXbrRR MoveXowrR MoveXwrRR MulRdRd NegateR Nop OrCqR OrCwR OrRR PCReg PopR PrefetchAw PushCq PushCw PushR RISCTempReg ReceiverResultReg RetN SPReg Scratch0Reg Scratch1Reg Scratch2Reg Scratch3Reg Scratch4Reg Scratch5Reg Scratch6Reg Scratch7Reg SendNumArgsReg SqrtRd Stop SubCheckOverflowCqR SubCheckOverflowRR SubCqR SubCwR SubRR SubRdRd TempReg TstCqR VarBaseReg XorCqR XorCwR XorRR'
  	poolDictionaries: ''
  	category: 'VMMaker-JIT'!
  
  !CogRTLOpcodes commentStamp: '<historical>' prior: 0!
  I am a pool for the Register-Transfer-Language to which Cog compiles.  I define unique integer values for all RTL opcodes and abstract registers.  See CogAbstractInstruction for instances of instructions with the opcodes that I define.!

Item was changed:
  ----- Method: CogRTLOpcodes class>>initialize (in category 'class initialization') -----
  initialize
  	"Abstract opcodes are a compound of a one word operation specifier and zero or more operand type specifiers.
  	 e.g. MoveRR is the Move opcode with two register operand specifiers and defines a move register to
  	 register instruction from operand 0 to operand 1.  The word and register size is assumed to be either 32-bits on
  	 a 32-bit architecture or 64-bits on a 64-bit architecture.  The abstract machine is mostly a 2 address machine
  	 with the odd three address instruction added to better exploit RISCs.
  			(self initialize)
  	The operand specifiers are
  		R		- general purpose register
  		Rd		- double-precision floating-point register
  		Cq		- a `quick' constant that can be encoded in the minimum space possible.
  		Cw		- a constant with word size where word is the default operand size for the Smalltalk VM, 32-bits
  				  for a 32-bit VM, 64-bits for a 64-bit VM.  The generated constant must occupy the default number
  				  of bits.  This allows e.g. a garbage collector to update the value without invalidating the code.
  		C32	- a constant with 32 bit size.  The generated constant must occupy 32 bits.
  		C64	- a constant with 64 bit size.  The generated constant must occupy 64 bits.
  		Aw		- memory word at an absolute address
  		Ab		- memory byte at an absolute address
  		Mwr	- memory word whose address is at a constant offset from an address in a register
  		Mbr		- memory byte whose address is at a constant offset from an address in a register (zero-extended on read)
  		M16r	- memory 16-bit halfword whose address is at a constant offset from an address in a register
  		M32r	- memory 32-bit halfword whose address is at a constant offset from an address in a register
  		M64r	- memory 64-bit doubleword whose address is at a constant offset from an address in a register
  		XbrR	- memory word whose address is r * byte size away from an address in a register
  		X16rR	- memory word whose address is r * (2 bytes size) away from an address in a register
  		X32rR	- memory word whose address is r * (4 bytes size) away from an address in a register
  		XwrR	- memory word whose address is r * word size away from an address in a register
  		XowrR	- memory word whose address is (r * word size) + o away from an address in a register (scaled indexed)
  
  	An alternative would be to decouple opcodes from operands, e.g.
  		Move := 1. Add := 2. Sub := 3...
  		RegisterOperand := 1. ConstantQuickOperand := 2. ConstantWordOperand := 3...
  	But not all combinations make sense and even fewer are used so we stick with the simple compound approach.
  
  	The assumption is that comparison and arithmetic instructions set condition codes and that move instructions
  	leave the condition codes unaffected.  In particular LoadEffectiveAddressMwrR does not set condition codes
  	although it can be used to do arithmetic.
  
  	Not all of the definitions in opcodeDefinitions below are implemented.  In particular we do not implement the
  	XowrR scaled index addressing mode since it requires 4 operands.
  
  	Note that there are no generic division instructions defined, but a processor may define some.
  
  	Branch/Call ranges.  Jump[Cond] can be generated as short as possible.  Call/Jump[Cond]Long must be generated
  	in the same number of bytes irrespective of displacement since their targets may be updated, but they need only
  	span 16Mb, the maximum size of the code zone.  This allows e.g. ARM to use single-word call and jump instructions
  	for most calls and jumps.  CallFull/JumpFull must also be generated in the same number of bytes irrespective of
  	displacement for the same reason, but they must be able to span the full (32-bit or 64-bit) address space because
  	they are used to call code in the C runtime, which may be distant from the code zone.  CallFull/JumpFull are allowed
  	to use the cResultRegister as a scratch if required (e.g. on x64 where there is no direct 64-bit call or jump).
  
  	Byte reads.  If the concrete compiler class answers true to byteReadsZeroExtend then byte reads must zero-extend
  	the byte read into the destination register.  If not, the other bits of the register should be left undisturbed and the
  	Cogit will add an instruction to zero the register as required.  Under no circumstances should byte reads sign-extend.
  
  	16-bit (and on 64-bits, 32-bit) reads.  These /are/ expected to always zero-extend."
  
  	| opcodeNames refs |
  	"A small fixed set of abstract registers are defined and used in code generation
  	 for Smalltalk code, and executes on stack pages in the stack zone.
  	 These are mapped to processor-specific registers by concreteRegister:"
  	FPReg := -1.	"A frame pointer is used for Smalltalk frames."
  	SPReg := -2.
  	ReceiverResultReg := -3.		"The receiver at point of send, and return value of a send"
  	TempReg := -4.
  	ClassReg := -5.					"The inline send cache class tag is in this register, loaded at the send site"
  	SendNumArgsReg := -6.		"Sends > 2 args set the arg count in this reg"
  	Arg0Reg := -7.					"In the StackToRegisterMappingCogit 1 & 2 arg sends marshall into these registers."
  	Arg1Reg := -8.
  
  	"A small fixed set of abstract scratch registers for register-rich machines (ARM can use 1, x64 can use 6)."
  	Scratch0Reg := -9.
  	Scratch1Reg := -10.
  	Scratch2Reg := -11.
  	Scratch3Reg := -12.
  	Scratch4Reg := -13.
  	Scratch5Reg := -14.
  	Scratch6Reg := -15.
  	Scratch7Reg := -16.
  
  	"RISC-specific registers"
  	LinkReg := -17.
  	RISCTempReg := -18.	"Used to synthesize CISC instructions from multiple RISC instructions."
  	PCReg := -19.
  	VarBaseReg := -20.		"If useful, points to base of interpreter variables."
  
  	"Floating-point registers"
  	DPFPReg0 := -21.
  	DPFPReg1 := -22.
  	DPFPReg2 := -23.
  	DPFPReg3 := -24.
  	DPFPReg4 := -25.
  	DPFPReg5 := -26.
  	DPFPReg6 := -27.
  	DPFPReg7 := -28.
  
  	opcodeNames := #("Noops & Pseudo Ops"
  						Label
  						Literal			"a word-sized literal"
  						AlignmentNops
  						FillBytesFrom	"output operand 0's worth of bytes from the address in operand 1"
  						Fill8				"output a byte's worth of bytes with operand 0"
  						Fill16			"output two byte's worth of bytes with operand 0"
  						Fill32			"output four byte's worth of bytes with operand 0"
  						FillFromWord	"output BytesPerWord's worth of bytes with operand 0 + operand 1"
  						Nop
  
  						"Control"
  						Call					"call within the code zone"
  						CallFull				"call anywhere within the full address space"
  						RetN
  						JumpR				"Not a regular jump, i.e. not pc dependent."
  						Stop				"Halt the processor"
  
  						"N.B.  Jumps are contiguous.  Long and Full jumps are contigiuous within them.  See FirstJump et al below"
  						JumpFull			"Jump anywhere within the address space"
  						JumpLong			"Jump anywhere within the 16mb code zone."
  						JumpLongZero			"a.k.a. JumpLongEqual"
  						JumpLongNonZero		"a.k.a. JumpLongNotEqual"
  						Jump				"short jumps; can be encoded in as few bytes as possible; will not be disturbed by GC or relocation."
  						JumpZero				"a.k.a. JumpEqual"
  						JumpNonZero			"a.k.a. JumpNotEqual"
  						JumpNegative
  						JumpNonNegative
  						JumpOverflow
  						JumpNoOverflow
  						JumpCarry
  						JumpNoCarry
  						JumpLess			"signed"
  						JumpGreaterOrEqual
  						JumpGreater
  						JumpLessOrEqual
  						JumpBelow			"unsigned"
  						JumpAboveOrEqual
  						JumpAbove
  						JumpBelowOrEqual
  
  						JumpFPEqual
  						JumpFPNotEqual
  						JumpFPLess
  						JumpFPLessOrEqual
  						JumpFPGreater
  						JumpFPGreaterOrEqual
  						JumpFPOrdered
  						JumpFPUnordered
  
  						"Data Movement; destination is always last operand"
  						MoveRR
  						MoveAwR
  						MoveRAw
  						MoveAbR
  						MoveRAb
  						MoveMwrR MoveRMwr MoveXwrRR MoveRXwrR MoveXowrR MoveRXowr
  						MoveM16rR MoveRM16r MoveX16rRR MoveRX16rR
  						MoveM32rR MoveRM32r MoveX32rRR MoveRX32rR
  						MoveMbrR MoveRMbr MoveXbrRR MoveRXbrR
  						MoveCqR MoveCwR MoveC32R MoveC64R
  						MoveRdRd MoveM64rRd MoveRdM64r
  						PopR PushR PushCq PushCw
  						PrefetchAw
  
  						"Arithmetic; destination is always last operand except Cmp; CmpXR is SubRX with no update of result"
  						LoadEffectiveAddressMwrR LoadEffectiveAddressXowrR "Variants of add/multiply"
  						NegateR "2's complement negation"
  						ArithmeticShiftRightCqR ArithmeticShiftRightRR
  						LogicalShiftRightCqR LogicalShiftRightRR
  						LogicalShiftLeftCqR LogicalShiftLeftRR
  
  						CmpRR AddRR SubRR AndRR OrRR XorRR
  						CmpCqR AddCqR SubCqR AndCqR OrCqR TstCqR XorCqR
  						CmpCwR CmpC32R AddCwR SubCwR AndCwR OrCwR XorCwR
  
- 						AddCheckOverflowCqR AddCheckOverflowRR SubCheckOverflowCqR SubCheckOverflowRR MulCheckOverflowRR
- 
  						AndCqRR
  
  						CmpRdRd AddRdRd SubRdRd MulRdRd DivRdRd SqrtRd
  
  						"Conversion"
  						ConvertRRd
  
  						LastRTLCode).
  
  	"Magic auto declaration. Add to the classPool any new variables and nuke any obsolete ones, and assign values"
  	"Find the variables directly referenced by this method"
  	refs := (thisContext method literals select: [:l| l isVariableBinding and: [classPool includesKey: l key]]) collect:
  				[:ea| ea key].
  	"Move to Undeclared any opcodes in classPool not in opcodes or this method."
  	(classPool keys reject: [:k| (opcodeNames includes: k) or: [refs includes: k]]) do:
  		[:k|
  		Undeclared declare: k from: classPool].
  	"Declare as class variables and number elements of opcodeArray above"
  	opcodeNames withIndexDo:
  		[:classVarName :value|
  		self classPool
  			declare: classVarName from: Undeclared;
  			at: classVarName put: value].
  
  	"For CogAbstractInstruction>>isJump etc..."
  	FirstJump := JumpFull.
  	LastJump := JumpFPUnordered.
  	FirstShortJump := Jump.
  
  	"And now initialize the backends; they add their own opcodes and hence these must be reinitialized."
  	(Smalltalk classNamed: #CogAbstractInstruction) ifNotNil:
  		[:cogAbstractInstruction| cogAbstractInstruction allSubclasses do: [:sc| sc initialize]]!

Item was changed:
  ----- Method: CogX64Compiler class>>initialize (in category 'class initialization') -----
  initialize
  	"Initialize various x64 instruction-related constants.
  	 [1] IA-32 Intel® Architecture Software Developer's Manual Volume 2A: Instruction Set Reference, A-M"
  
  	"CogX64Compiler initialize"
  
- 	| specificOpcodes refs |
  	self ~~ CogX64Compiler ifTrue: [^self].
  
  	ABI ifNil:
  		[ABI := #SysV]. "Default ABI; other choice is #MSVC"
  
  	RAX := 0.
  	RCX := 1.  "Were they completely mad or simply sadistic?"
  	RDX := 2.
  	RBX := 3.
  	RSP := 4.
  	RBP := 5.
  	RSI := 6.
  	RDI := 7.
  	R8 := 8.
  	R9 := 9.
  	R10 := 10.
  	R11 := 11.
  	R12 := 12.
  	R13 := 13.
  	R14 := 14.
  	R15 := 15.
  
  	XMM0L := 0.
  	XMM1L := 2.
  	XMM2L := 4.
  	XMM3L := 6.
  	XMM4L := 8.
  	XMM5L := 10.
  	XMM6L := 12.
  	XMM7L := 14.
  
  	XMM0H := 1.
  	XMM1H := 3.
  	XMM2H := 5.
  	XMM3H := 7.
  	XMM4H := 9.
  	XMM5H := 11.
  	XMM6H := 13.
  	XMM7H := 15.
  
  	"Mod R/M Mod fields.  See [1] Sec 2.4, 2.5 & 2.6 & Table 2-2"
  	ModRegInd := 0.
  		ModRegIndSIB := 4.
  		ModRegIndDisp32 := 5.
  	ModRegRegDisp8 := 1.
  	ModRegRegDisp32 := 2.
  	ModReg := 3.
  
  	"SIB Scaled Index modes.  See [1] Sec 2.4, 2.5 & 2.6 & Table 2-3"
  	SIB1 := 0.
  	SIB2 := 1.
  	SIB4 := 2.
  	SIB8 := 3.
  
  	"Specific instructions"
+ 	self
+ 		initializeSpecificOpcodes: #(CDQ IDIVR IMULRR CPUID LFENCE MFENCE SFENCE LOCK CMPXCHGAwR CMPXCHGMwrR XCHGAwR XCHGMwrR XCHGRR)
+ 		in: thisContext method!
- 	LastRTLCode ifNil:
- 		[CogRTLOpcodes initialize].
- 	specificOpcodes := #(CDQ IDIVR IMULRR CPUID LFENCE MFENCE SFENCE LOCK CMPXCHGAwR CMPXCHGMwrR XCHGAwR XCHGMwrR XCHGRR).
- 	refs := (thisContext method literals select: [:l| l isVariableBinding and: [classPool includesKey: l key]]) collect:
- 				[:ea| ea key].
- 	(classPool keys reject: [:k| (specificOpcodes includes: k) or: [refs includes: k]]) do:
- 		[:k|
- 		Undeclared declare: k from: classPool].
- 	specificOpcodes withIndexDo:
- 		[:classVarName :value|
- 		self classPool
- 			declare: classVarName from: Undeclared;
- 			at: classVarName put: value + LastRTLCode - 1]!

Item was changed:
  ----- Method: Cogit>>JumpAbove: (in category 'abstract instructions') -----
  JumpAbove: jumpTarget
  	<inline: true>
  	<returnTypeC: #'AbstractInstruction *'>
  	<var: #jumpTarget type: #'void *'>
+ 	^self previousInstruction noteFollowingConditionalBranch:
+ 		(self gen: JumpAbove operand: jumpTarget asInteger)!
- 	^self gen: JumpAbove operand: jumpTarget asInteger!

Item was changed:
  ----- Method: Cogit>>JumpAboveOrEqual: (in category 'abstract instructions') -----
  JumpAboveOrEqual: jumpTarget
  	<inline: true>
  	<returnTypeC: #'AbstractInstruction *'>
  	<var: #jumpTarget type: #'void *'>
+ 	^self previousInstruction noteFollowingConditionalBranch:
+ 		(self gen: JumpAboveOrEqual operand: jumpTarget asInteger)!
- 	^self gen: JumpAboveOrEqual operand: jumpTarget asInteger!

Item was changed:
  ----- Method: Cogit>>JumpBelow: (in category 'abstract instructions') -----
  JumpBelow: jumpTarget
  	<inline: true>
  	<returnTypeC: #'AbstractInstruction *'>
  	<var: #jumpTarget type: #'void *'>
+ 	^self previousInstruction noteFollowingConditionalBranch:
+ 		(self gen: JumpBelow operand: jumpTarget asInteger)!
- 	^self gen: JumpBelow operand: jumpTarget asInteger!

Item was changed:
  ----- Method: Cogit>>JumpBelowOrEqual: (in category 'abstract instructions') -----
  JumpBelowOrEqual: jumpTarget
  	<inline: true>
  	<returnTypeC: #'AbstractInstruction *'>
  	<var: #jumpTarget type: #'void *'>
+ 	^self previousInstruction noteFollowingConditionalBranch:
+ 		(self gen: JumpBelowOrEqual operand: jumpTarget asInteger)!
- 	^self gen: JumpBelowOrEqual operand: jumpTarget asInteger!

Item was changed:
  ----- Method: Cogit>>JumpCarry: (in category 'abstract instructions') -----
  JumpCarry: jumpTarget
  	<inline: true>
  	<returnTypeC: #'AbstractInstruction *'>
  	<var: #jumpTarget type: #'void *'>
+ 	^self previousInstruction noteFollowingConditionalBranch:
+ 		(self gen: JumpCarry operand: jumpTarget asInteger)!
- 	^self gen: JumpCarry operand: jumpTarget asInteger!

Item was changed:
  ----- Method: Cogit>>JumpGreater: (in category 'abstract instructions') -----
  JumpGreater: jumpTarget
  	<inline: true>
  	<returnTypeC: #'AbstractInstruction *'>
  	<var: #jumpTarget type: #'void *'>
+ 	^self previousInstruction noteFollowingConditionalBranch:
+ 		(self gen: JumpGreater operand: jumpTarget asInteger)!
- 	^self gen: JumpGreater operand: jumpTarget asInteger!

Item was changed:
  ----- Method: Cogit>>JumpGreaterOrEqual: (in category 'abstract instructions') -----
  JumpGreaterOrEqual: jumpTarget
  	<inline: true>
  	<returnTypeC: #'AbstractInstruction *'>
  	<var: #jumpTarget type: #'void *'>
+ 	^self previousInstruction noteFollowingConditionalBranch:
+ 		(self gen: JumpGreaterOrEqual operand: jumpTarget asInteger)!
- 	^self gen: JumpGreaterOrEqual operand: jumpTarget asInteger!

Item was changed:
  ----- Method: Cogit>>JumpLess: (in category 'abstract instructions') -----
  JumpLess: jumpTarget
  	<inline: true>
  	<returnTypeC: #'AbstractInstruction *'>
  	<var: #jumpTarget type: #'void *'>
+ 	^self previousInstruction noteFollowingConditionalBranch:
+ 		(self gen: JumpLess operand: jumpTarget asInteger)!
- 	^self gen: JumpLess operand: jumpTarget asInteger!

Item was changed:
  ----- Method: Cogit>>JumpLessOrEqual: (in category 'abstract instructions') -----
  JumpLessOrEqual: jumpTarget
  	<inline: true>
  	<returnTypeC: #'AbstractInstruction *'>
  	<var: #jumpTarget type: #'void *'>
+ 	^self previousInstruction noteFollowingConditionalBranch:
+ 		(self gen: JumpLessOrEqual operand: jumpTarget asInteger)!
- 	^self gen: JumpLessOrEqual operand: jumpTarget asInteger!

Item was changed:
  ----- Method: Cogit>>JumpLongNonZero: (in category 'abstract instructions') -----
  JumpLongNonZero: jumpTarget
  	<inline: true>
  	<returnTypeC: #'AbstractInstruction *'>
+ 	^self previousInstruction noteFollowingConditionalBranch:
+ 		(self gen: JumpLongNonZero operand: jumpTarget asInteger)!
- 	^self gen: JumpLongNonZero operand: jumpTarget asInteger!

Item was changed:
  ----- Method: Cogit>>JumpLongZero: (in category 'abstract instructions') -----
  JumpLongZero: jumpTarget
  	<inline: true>
  	<returnTypeC: #'AbstractInstruction *'>
+ 	^self previousInstruction noteFollowingConditionalBranch:
+ 		(self gen: JumpLongZero operand: jumpTarget asInteger)!
- 	^self gen: JumpLongZero operand: jumpTarget asInteger!

Item was changed:
  ----- Method: Cogit>>JumpNegative: (in category 'abstract instructions') -----
  JumpNegative: jumpTarget
  	<inline: true>
  	<returnTypeC: #'AbstractInstruction *'>
  	<var: #jumpTarget type: #'void *'>
+ 	^self previousInstruction noteFollowingConditionalBranch:
+ 		(self gen: JumpNegative operand: jumpTarget asInteger)!
- 	^self gen: JumpNegative operand: jumpTarget asInteger!

Item was changed:
  ----- Method: Cogit>>JumpNoCarry: (in category 'abstract instructions') -----
  JumpNoCarry: jumpTarget
  	<inline: true>
  	<returnTypeC: #'AbstractInstruction *'>
  	<var: #jumpTarget type: #'void *'>
+ 	^self previousInstruction noteFollowingConditionalBranch:
+ 		(self gen: JumpNoCarry operand: jumpTarget asInteger)!
- 	^self gen: JumpNoCarry operand: jumpTarget asInteger!

Item was changed:
  ----- Method: Cogit>>JumpNoOverflow: (in category 'abstract instructions') -----
  JumpNoOverflow: jumpTarget
  	<inline: true>
  	<returnTypeC: #'AbstractInstruction *'>
  	<var: #jumpTarget type: #'void *'>
+ 	^self previousInstruction noteFollowingConditionalBranch:
+ 		(self gen: JumpNoOverflow operand: jumpTarget asInteger)!
- 	^self gen: JumpNoOverflow operand: jumpTarget asInteger!

Item was changed:
  ----- Method: Cogit>>JumpNonNegative: (in category 'abstract instructions') -----
  JumpNonNegative: jumpTarget
  	<inline: true>
  	<returnTypeC: #'AbstractInstruction *'>
  	<var: #jumpTarget type: #'void *'>
+ 	^self previousInstruction noteFollowingConditionalBranch:
+ 		(self gen: JumpNonNegative operand: jumpTarget asInteger)!
- 	^self gen: JumpNonNegative operand: jumpTarget asInteger!

Item was changed:
  ----- Method: Cogit>>JumpNonZero: (in category 'abstract instructions') -----
  JumpNonZero: jumpTarget
  	<inline: true>
  	<returnTypeC: #'AbstractInstruction *'>
  	<var: #jumpTarget type: #'void *'>
+ 	^self previousInstruction noteFollowingConditionalBranch:
+ 		(self gen: JumpNonZero operand: jumpTarget asInteger)!
- 	^self gen: JumpNonZero operand: jumpTarget asInteger!

Item was changed:
  ----- Method: Cogit>>JumpOverflow: (in category 'abstract instructions') -----
  JumpOverflow: jumpTarget
  	<inline: true>
  	<returnTypeC: #'AbstractInstruction *'>
  	<var: #jumpTarget type: #'void *'>
+ 	^self previousInstruction noteFollowingConditionalBranch:
+ 		(self gen: JumpOverflow operand: jumpTarget asInteger)!
- 	^self gen: JumpOverflow operand: jumpTarget asInteger!

Item was changed:
  ----- Method: Cogit>>JumpZero: (in category 'abstract instructions') -----
  JumpZero: jumpTarget
  	<inline: true>
  	<returnTypeC: #'AbstractInstruction *'>
  	<var: #jumpTarget type: #'void *'>
+ 	^self previousInstruction noteFollowingConditionalBranch:
+ 		(self gen: JumpZero operand: jumpTarget asInteger)!
- 	^self gen: JumpZero operand: jumpTarget asInteger!

Item was changed:
  ----- Method: Cogit>>MoveR:R: (in category 'abstract instructions') -----
  MoveR: reg1 R: reg2
  	<inline: true>
  	<returnTypeC: #'AbstractInstruction *'>
  	^self gen: MoveRR operand: reg1 operand: reg2!

Item was added:
+ ----- Method: Cogit>>previousInstruction (in category 'compile abstract instructions') -----
+ previousInstruction
+ 	<returnTypeC: #'AbstractInstruction *'>
+ 	self assert: opcodeIndex > 0.
+ 	^self abstractInstructionAt: opcodeIndex - 1!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genPrimitiveAdd (in category 'primitive generators') -----
  genPrimitiveAdd
  	"Stack looks like
  		receiver (also in ResultReceiverReg)
  		arg
  		return address"
  	| jumpNotSI jumpOvfl |
  	<var: #jumpNotSI type: #'AbstractInstruction *'>
  	<var: #jumpOvfl type: #'AbstractInstruction *'>
  	self genLoadArgAtDepth: 0 into: TempReg.
  	self MoveR: TempReg R: ClassReg.
  	jumpNotSI := objectRepresentation genJumpNotSmallIntegerInScratchReg: TempReg.
  	objectRepresentation genRemoveSmallIntegerTagsInScratchReg: ClassReg.
  	self MoveR: ReceiverResultReg R: TempReg.
+ 	self AddR: ClassReg R: TempReg.
- 	self AddCheckOverflowR: ClassReg R: TempReg.
  	jumpOvfl := self JumpOverflow: 0.
  	self MoveR: TempReg R: ReceiverResultReg.
  	self RetN: (self primRetNOffsetFor: 1).
  	jumpOvfl jmpTarget: (jumpNotSI jmpTarget: self Label).
  	^0!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genPrimitiveMultiply (in category 'primitive generators') -----
  genPrimitiveMultiply
  	| jumpNotSI jumpOvfl |
  	<var: #jumpNotSI type: #'AbstractInstruction *'>
  	<var: #jumpOvfl type: #'AbstractInstruction *'>
  	self genLoadArgAtDepth: 0 into: TempReg.
  	self MoveR: TempReg R: ClassReg.
  	jumpNotSI := objectRepresentation genJumpNotSmallIntegerInScratchReg: TempReg.
  	objectRepresentation genShiftAwaySmallIntegerTagsInScratchReg: ClassReg.
  	self MoveR: ReceiverResultReg R: TempReg.
  	objectRepresentation genRemoveSmallIntegerTagsInScratchReg: TempReg.
+ 	self MulR: TempReg R: ClassReg.
- 	self MulCheckOverflowR: TempReg R: ClassReg.
  	jumpOvfl := self JumpOverflow: 0.
  	objectRepresentation genSetSmallIntegerTagsIn: ClassReg.
  	self MoveR: ClassReg R: ReceiverResultReg.
  	self RetN: (self primRetNOffsetFor: 1).
  	jumpOvfl jmpTarget: (jumpNotSI jmpTarget: self Label).
  	^0!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genPrimitiveSubtract (in category 'primitive generators') -----
  genPrimitiveSubtract
  	"Stack looks like
  		receiver (also in ResultReceiverReg)
  		arg
  		return address"
  	| jumpNotSI jumpOvfl |
  	<var: #jumpNotSI type: #'AbstractInstruction *'>
  	<var: #jumpOvfl type: #'AbstractInstruction *'>
  	self genLoadArgAtDepth: 0 into: TempReg.
  	self MoveR: TempReg R: ClassReg.
  	jumpNotSI := objectRepresentation genJumpNotSmallIntegerInScratchReg: TempReg.
  	self MoveR: ReceiverResultReg R: TempReg.
+ 	self SubR: ClassReg R: TempReg.
- 	self SubCheckOverflowR: ClassReg R: TempReg.
  	jumpOvfl := self JumpOverflow: 0.
  	objectRepresentation genAddSmallIntegerTagsTo: TempReg.
  	self MoveR: TempReg R: ReceiverResultReg.
  	self RetN: (self primRetNOffsetFor: 1).
  	jumpOvfl jmpTarget: (jumpNotSI jmpTarget: self Label).
  	^0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genPrimitiveAdd (in category 'primitive generators') -----
  genPrimitiveAdd
  	| jumpNotSI jumpOvfl |
  	<var: #jumpNotSI type: #'AbstractInstruction *'>
  	<var: #jumpOvfl type: #'AbstractInstruction *'>
  	self MoveR: Arg0Reg R: ClassReg.
  	jumpNotSI := objectRepresentation genJumpNotSmallInteger: Arg0Reg scratchReg: TempReg.
  	objectRepresentation genRemoveSmallIntegerTagsInScratchReg: ClassReg.
+ 	self AddR: ReceiverResultReg R: ClassReg.
- 	self AddCheckOverflowR: ReceiverResultReg R: ClassReg.
  	jumpOvfl := self JumpOverflow: 0.
  	self MoveR: ClassReg R: ReceiverResultReg.
  	self RetN: 0.
  	jumpOvfl jmpTarget: (jumpNotSI jmpTarget: self Label).
  	^0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genPrimitiveMultiply (in category 'primitive generators') -----
  genPrimitiveMultiply
  	| jumpNotSI jumpOvfl |
  	<var: #jumpNotSI type: #'AbstractInstruction *'>
  	<var: #jumpOvfl type: #'AbstractInstruction *'>
  	self MoveR: Arg0Reg R: ClassReg.
  	self MoveR: ReceiverResultReg R: Arg1Reg.
  	jumpNotSI := objectRepresentation genJumpNotSmallInteger: Arg0Reg scratchReg: TempReg..
  	objectRepresentation genShiftAwaySmallIntegerTagsInScratchReg: ClassReg.
  	objectRepresentation genRemoveSmallIntegerTagsInScratchReg: Arg1Reg.
+ 	self MulR: Arg1Reg R: ClassReg.
- 	self MulCheckOverflowR: Arg1Reg R: ClassReg.
  	jumpOvfl := self JumpOverflow: 0.
  	objectRepresentation genSetSmallIntegerTagsIn: ClassReg.
  	self MoveR: ClassReg R: ReceiverResultReg.
  	self RetN: 0.
  	jumpOvfl jmpTarget: (jumpNotSI jmpTarget: self Label).
  	^0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genPrimitiveSubtract (in category 'primitive generators') -----
  genPrimitiveSubtract
  	| jumpNotSI jumpOvfl |
  	<var: #jumpNotSI type: #'AbstractInstruction *'>
  	<var: #jumpOvfl type: #'AbstractInstruction *'>
  	jumpNotSI := objectRepresentation genJumpNotSmallInteger: Arg0Reg scratchReg: TempReg.
  	self MoveR: ReceiverResultReg R: TempReg.
+ 	self SubR: Arg0Reg R: TempReg.
- 	self SubCheckOverflowR: Arg0Reg R: TempReg.
  	jumpOvfl := self JumpOverflow: 0.
  	objectRepresentation genAddSmallIntegerTagsTo: TempReg.
  	self MoveR: TempReg R: ReceiverResultReg.
  	self RetN: 0.
  	jumpOvfl jmpTarget: (jumpNotSI jmpTarget: self Label).
  	^0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genSpecialSelectorArithmetic (in category 'bytecode generators') -----
  genSpecialSelectorArithmetic
  	| primDescriptor rcvrIsConst argIsConst rcvrIsInt argIsInt rcvrInt argInt result
  	 jumpNotSmallInts jumpContinue annotateInst instToAnnotate index |
  	<var: #primDescriptor type: #'BytecodeDescriptor *'>
  	<var: #jumpNotSmallInts type: #'AbstractInstruction *'>
  	<var: #jumpContinue type: #'AbstractInstruction *'>
  	<var: #instToAnnotate type: #'AbstractInstruction *'>
  	primDescriptor := self generatorAt: byte0.
  	argIsInt := (argIsConst := self ssTop type = SSConstant)
  				 and: [objectMemory isIntegerObject: (argInt := self ssTop constant)].
  	rcvrIsInt := (rcvrIsConst := (self ssValue: 1) type = SSConstant)
  				 and: [objectMemory isIntegerObject: (rcvrInt := (self ssValue: 1) constant)].
  
  	(argIsInt and: [rcvrIsInt]) ifTrue:
  		[rcvrInt := objectMemory integerValueOf: rcvrInt.
  		 argInt := objectMemory integerValueOf: argInt.
  		 primDescriptor opcode caseOf: {
  			[AddRR]	-> [result := rcvrInt + argInt].
  			[SubRR]	-> [result := rcvrInt - argInt].
  			[AndRR]	-> [result := rcvrInt bitAnd: argInt].
  			[OrRR]	-> [result := rcvrInt bitOr: argInt] }.
  		(objectMemory isIntegerValue: result) ifTrue:
  			["Must enter any annotatedConstants into the map"
  			 self annotateBytecodeIfAnnotated: (self ssValue: 1).
  			 self annotateBytecodeIfAnnotated: self ssTop.
  			 "Must annotate the bytecode for correct pc mapping."
  			^self ssPop: 2; ssPushAnnotatedConstant: (objectMemory integerObjectOf: result)].
  		^self genSpecialSelectorSend].
  
  	"If there's any constant involved other than a SmallInteger don't attempt to inline."
  	((rcvrIsConst and: [rcvrIsInt not])
  	 or: [argIsConst and: [argIsInt not]]) ifTrue:
  		[^self genSpecialSelectorSend].
  
  	"If we know nothing about the types then better not to inline as the inline cache and
  	 primitive code is not terribly slow so wasting time on duplicating tag tests is pointless."
  	(argIsInt or: [rcvrIsInt]) ifFalse:
  		[^self genSpecialSelectorSend].
  
  	argIsInt
  		ifTrue:
  			[self ssFlushTo: simStackPtr - 2.
  			 (self ssValue: 1) popToReg: ReceiverResultReg.
  			 annotateInst := self ssTop annotateUse.
  			 self ssPop: 2.
  			 self MoveR: ReceiverResultReg R: TempReg]
  		ifFalse:
  			[self marshallSendArguments: 1.
  			 self MoveR: Arg0Reg R: TempReg.
  			 rcvrIsInt ifFalse:
  				[objectRepresentation isSmallIntegerTagNonZero
  					ifTrue: [self AndR: ReceiverResultReg R: TempReg]
  					ifFalse: [self OrR: ReceiverResultReg R: TempReg]]].
  	jumpNotSmallInts := objectRepresentation genJumpNotSmallIntegerInScratchReg: TempReg.
  	primDescriptor opcode caseOf: {
  		[AddRR] -> [argIsInt
  						ifTrue:
+ 							[instToAnnotate := self AddCq: argInt - ConstZero R: ReceiverResultReg.
- 							[instToAnnotate := self AddCheckOverflowCq: argInt - ConstZero R: ReceiverResultReg.
  							 jumpContinue := self JumpNoOverflow: 0.
  							 "overflow; must undo the damage before continuing"
  							 self SubCq: argInt - ConstZero R: ReceiverResultReg]
  						ifFalse:
  							[objectRepresentation genRemoveSmallIntegerTagsInScratchReg: ReceiverResultReg.
+ 							 self AddR: Arg0Reg R: ReceiverResultReg.
- 							 self AddCheckOverflowR: Arg0Reg R: ReceiverResultReg.
  							jumpContinue := self JumpNoOverflow: 0.
  							"overflow; must undo the damage before continuing"
  							 rcvrIsInt
  								ifTrue: [self MoveCq: rcvrInt R: ReceiverResultReg]
  								ifFalse:
  									[self SubR: Arg0Reg R: ReceiverResultReg.
  									 objectRepresentation genSetSmallIntegerTagsIn: ReceiverResultReg]]].
  		[SubRR] -> [argIsInt
  						ifTrue:
+ 							[instToAnnotate := self SubCq: argInt - ConstZero R: ReceiverResultReg.
- 							[instToAnnotate := self SubCheckOverflowCq: argInt - ConstZero R: ReceiverResultReg.
  							 jumpContinue := self JumpNoOverflow: 0.
  							 "overflow; must undo the damage before continuing"
  							 self AddCq: argInt - ConstZero R: ReceiverResultReg]
  						ifFalse:
  							[objectRepresentation genRemoveSmallIntegerTagsInScratchReg: Arg0Reg.
+ 							 self SubR: Arg0Reg R: ReceiverResultReg.
- 							 self SubCheckOverflowR: Arg0Reg R: ReceiverResultReg.
  							 jumpContinue := self JumpNoOverflow: 0.
  							 "overflow; must undo the damage before continuing"
  							 self AddR: Arg0Reg R: ReceiverResultReg.
  							 objectRepresentation genSetSmallIntegerTagsIn: Arg0Reg]].
  		[AndRR] -> [argIsInt
  						ifTrue: [instToAnnotate := self AndCq: argInt R: ReceiverResultReg]
  						ifFalse: [self AndR: Arg0Reg R: ReceiverResultReg].
  					jumpContinue := self Jump: 0].
  		[OrRR]	-> [argIsInt
  						ifTrue: [instToAnnotate := self OrCq: argInt R: ReceiverResultReg]
  						ifFalse: [self OrR: Arg0Reg R: ReceiverResultReg].
  					jumpContinue := self Jump: 0] }.
  	jumpNotSmallInts jmpTarget: self Label.
  	argIsInt ifTrue:
  		[annotateInst ifTrue: [self annotateBytecode: instToAnnotate].
  		 self MoveCq: argInt R: Arg0Reg].
  	index := byte0 - self firstSpecialSelectorBytecodeOffset.
  	self genMarshalledSend: index negated - 1 numArgs: 1 sendTable: ordinarySendTrampolines.
  	jumpContinue jmpTarget: self Label.
  	^0!



More information about the Vm-dev mailing list