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

commits at source.squeak.org commits at source.squeak.org
Wed Jun 1 19:04:05 UTC 2016


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

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

Name: VMMaker.oscog-eem.1876
Author: eem
Time: 1 June 2016, 12:02:13.056404 pm
UUID: 28e91d90-4197-436d-9702-7c7dae02e85e
Ancestors: VMMaker.oscog-cb.1875

Eliminate the callerSavedRegMask variable and replace it with a CallerSavedRegisterMask variable computed at register initialization time.

On ARM:
- define the caller-saved registers as the subset of the caller-saved registers that excludes R0/CArg0Reg/TempReg & R1/CArg1Reg (R0 is the C result register), and use R2 & R3 for abstract registers (ClassReg and Arg0Reg).
- save and restore elements of the caller-saved registers as appropriate around run-time calls.
- use LDM & STM to do the saving.
- hence provide two extra registers, now provinding Extra[012]Reg

Fix the various nameForRegister: to get a useful printRegisterMap on RISCs that have register arguments in the C calling convention (x64 & ARM).

In the simulator, provide the same breakpoiting facilities for "click step" in ABI calls as for run-time calls, and have prntCogMethodFor: print something useful for trampoline addresses..

=============== Diff against VMMaker.oscog-cb.1875 ===============

Item was changed:
  CogAbstractInstruction subclass: #CogARMCompiler
  	instanceVariableNames: 'conditionOrNil'
+ 	classVariableNames: 'AL AddOpcode AndOpcode BicOpcode CArg0Reg CArg1Reg CArg2Reg CArg3Reg CC CMPSMULL CPSRReg CS CmpNotOpcode CmpOpcode ConcreteIPReg ConcretePCReg ConcreteVarBaseReg D0 D1 D2 D3 D4 D5 D6 D7 EQ GE GT HI LDMFD LE LR LS LT MI MRS MSR MoveNotOpcode MoveOpcode NE OrOpcode OverflowFlag PC PL PopLDM PushSTM R0 R1 R10 R11 R12 R2 R3 R4 R5 R6 R7 R8 R9 RsbOpcode SMLALOpcode SMULL SP STMFD SubOpcode TstOpcode VC VS XorOpcode'
- 	classVariableNames: 'AL AddOpcode AndOpcode BicOpcode CArg0Reg CArg1Reg CArg2Reg CArg3Reg CC CMPSMULL CPSRReg CS CmpNotOpcode CmpOpcode ConcreteIPReg ConcretePCReg ConcreteVarBaseReg D0 D1 D2 D3 D4 D5 D6 D7 EQ GE GT HI LDMFD LE LR LS LT MI MRS MSR MoveNotOpcode MoveOpcode NE OrOpcode OverflowFlag PC PL R0 R1 R10 R11 R12 R2 R3 R4 R5 R6 R7 R8 R9 RsbOpcode SMLALOpcode SMULL SP STMFD SubOpcode TstOpcode VC VS XorOpcode'
  	poolDictionaries: ''
  	category: 'VMMaker-JIT'!
  
  !CogARMCompiler commentStamp: 'lw 8/23/2012 19:38' prior: 0!
  I generate ARM instructions from CogAbstractInstructions.  For reference see
  http://infocenter.arm.com/help/index.jsp?topic=/com.arm.doc.set.architecture/index.html
  
  The Architecture Reference Manual used is that of version 5, which includes some version 6 instructions. Of those, only pld is used(for PrefetchAw).
  
  This class does not take any special action to flush the instruction cache on instruction-modification.!

Item was changed:
  ----- Method: CogARMCompiler class>>initialize (in category 'class initialization') -----
  initialize
  
  	"Initialize various ARM instruction-related constants."
  	"CogARMCompiler initialize"
  
  	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 PopLDM PushSTM LDMFD STMFD CMPSMULL)
- 		initializeSpecificOpcodes: #(SMULL MSR MRS LDMFD STMFD CMPSMULL)
  		in: thisContext method!

Item was changed:
  ----- Method: CogARMCompiler class>>initializeAbstractRegisters (in category 'class initialization') -----
  initializeAbstractRegisters
  	"Assign the abstract registers with the identities/indices of the relevant concrete registers."
  
- 	"N.B. According to BSABI, R0-R3 are caller-save, R4-R12 are callee save.
- 	 Note that R9 might be a special register for the implementation. In some slides
- 	 it is refered to as sb. R10 can contain the stack limit (sl), R11 the fp. R12 is an
- 	 intra-procedure scratch instruction pointer for link purposes. It can also be used.
- 	 R10 is used as temporary inside a single abstract opcode implementation"
- 	"R0-R3 are used when calling back to the interpreter. Using them would require
- 	 saving and restoring their values, so they are omitted so far. R12 is the only
- 	 scratch register at the moment.."
- 
  	super initializeAbstractRegisters.
  
+ 	"According to IHI0042E ARM Architecture Procedure Calling Standard, in section 5.1.1:
+ 		A subroutine must preserve the contents of the registers r4-r8, r10, r11 and SP (and r9 in PCS variants that designate r9 as v6).
+ 	 SP = r13, so the callee-saved regs are r4-r8 & r10-r12.
+ 	 The caller-saved registers are those that are not callee-saved and not reserved for hardware/abi uses,
+ 	 i..e r0-r3, r9 & r12.
+ 	 We exclude registers 0 & 1 (TempReg/CArg0Reg & CArg1Reg) from the CallerSavedRegisterMask because we only
+ 	 use them for argument passing and so never want to save and restore them.  In fact restoring TempReg/CArg0Reg
+ 	 would overwrite function results, so it shouldn't be included under any circumstances."
+ 
+ 	CallerSavedRegisterMask := self registerMaskFor: "0 and: 1 and:" 2 and: 3 and: 9 and: 12.
+ 
  	TempReg			:= R0.
+ 	ClassReg			:= R2.
+ 	ReceiverResultReg	:= R5.
- 	ClassReg			:= R8.
- 	ReceiverResultReg	:= R7.
  	SendNumArgsReg	:= R6.
  	SPReg				:= SP. "a.k.a. R13" self assert: SP = 13.
  	FPReg				:= R11.
+ 	Arg0Reg			:= R3. "overlaps with last C arg reg"
+ 	Arg1Reg			:= R4.
+ 	Extra0Reg			:= R7.
+ 	Extra1Reg			:= R8.
+ 	Extra2Reg			:= R9.
- 	Arg0Reg			:= R4.
- 	Arg1Reg			:= R5.
- 	Extra0Reg			:= R9.
  	VarBaseReg		:= R10.	"Must be callee saved" self assert: ConcreteVarBaseReg = R10.
  	RISCTempReg		:= R12.	"a.k.a. IP" self assert: ConcreteIPReg = R12.
  	LinkReg				:= LR. "R14"
  	PCReg				:= PC. "R15"	
  
  	DPFPReg0			:= D0.
  	DPFPReg1			:= D1.
  	DPFPReg2			:= D2.
  	DPFPReg3			:= D3.
  	DPFPReg4			:= D4.
  	DPFPReg5			:= D5.
  	DPFPReg6			:= D6.
+ 	DPFPReg7			:= D7!
- 	DPFPReg7			:= D7
- !

Item was changed:
  ----- Method: CogARMCompiler>>availableRegisterOrNoneFor: (in category 'register allocation') -----
  availableRegisterOrNoneFor: liveRegsMask
  	"Answer an unused abstract register in the liveRegMask.
  	 Subclasses with more registers can override to answer them.
  	 N.B. Do /not/ allocate TempReg."
  	<returnTypeC: #sqInt>
  	(cogit register: Extra0Reg isInMask: liveRegsMask) ifFalse:
  		[^Extra0Reg].
+ 	(cogit register: Extra1Reg isInMask: liveRegsMask) ifFalse:
+ 		[^Extra1Reg].
+ 	(cogit register: Extra2Reg isInMask: liveRegsMask) ifFalse:
+ 		[^Extra2Reg].
  	^super availableRegisterOrNoneFor: liveRegsMask!

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

Item was added:
+ ----- Method: CogARMCompiler>>canPushPopMultipleRegisters (in category 'testing') -----
+ canPushPopMultipleRegisters
+ 	<inline: true>
+ 	^true!

Item was changed:
  ----- Method: CogARMCompiler>>computeMaximumSize (in category 'generate machine code') -----
  computeMaximumSize
  	"Because we don't use Thumb, each ARM instruction has 4 bytes. Many
  	 abstract opcodes need more than one instruction. Instructions that refer
  	 to constants and/or literals depend on literals being stored in-line or out-of-line.
  
  	 N.B.  The ^N forms are to get around the bytecode compiler's long branch
  	 limits which are exceeded when each case jumps around the otherwise."
  
  	opcode
  		caseOf: {
  		"Noops & Pseudo Ops"
  		[Label]					-> [^0].
  		[Literal]					-> [^4].
  		[AlignmentNops]		-> [^(operands at: 0) - 4].
  		[Fill32]					-> [^4].
  		[Nop]					-> [^4].
  		"Control"
  		[Call]					-> [^4].
  		[CallFull]				-> [^self literalLoadInstructionBytes + 4].
  		[JumpR]					-> [^4].
  		[Jump]					-> [^4].
  		[JumpFull]				-> [^self literalLoadInstructionBytes + 4].
  		[JumpLong]				-> [^4].
  		[JumpZero]				-> [^4].
  		[JumpNonZero]			-> [^4].
  		[JumpNegative]			-> [^4].
  		[JumpNonNegative]		-> [^4].
  		[JumpOverflow]			-> [^4].
  		[JumpNoOverflow]		-> [^4].
  		[JumpCarry]			-> [^4].
  		[JumpNoCarry]			-> [^4].
  		[JumpLess]				-> [^4].
  		[JumpGreaterOrEqual]	-> [^4].
  		[JumpGreater]			-> [^4].
  		[JumpLessOrEqual]		-> [^4].
  		[JumpBelow]			-> [^4].
  		[JumpAboveOrEqual]	-> [^4].
  		[JumpAbove]			-> [^4].
  		[JumpBelowOrEqual]	-> [^4].
  		[JumpLongZero]		-> [^4].
  		[JumpLongNonZero]	-> [^4].
  		[JumpFPEqual]			-> [^8].
  		[JumpFPNotEqual]		-> [^8].
  		[JumpFPLess]			-> [^8].
  		[JumpFPGreaterOrEqual]-> [^8].
  		[JumpFPGreater]		-> [^8].
  		[JumpFPLessOrEqual]	-> [^8].
  		[JumpFPOrdered]		-> [^8].
  		[JumpFPUnordered]		-> [^8].
  		[RetN]					-> [^(operands at: 0) = 0 ifTrue: [4] ifFalse: [8]].
  		[Stop]					-> [^4].
  
  		"Arithmetic"
  		[AddCqR]				-> [^self rotateable8bitSignedImmediate: (operands at: 0)
  										ifTrue: [:r :i :n| 4]
  										ifFalse: [self literalLoadInstructionBytes + 4]].
  		[AndCqR]				-> [^self rotateable8bitBitwiseImmediate: (operands at: 0)
  										ifTrue: [:r :i :n| 4]
  										ifFalse:
  											[self literalLoadInstructionBytes = 4
  												ifTrue: [8]
  												ifFalse:
  													[1 << (operands at: 0) highBit = ((operands at: 0) + 1)
  														ifTrue: [8]
  														ifFalse: [self literalLoadInstructionBytes + 4]]]].
  		[AndCqRR]				-> [^self rotateable8bitBitwiseImmediate: (operands at: 0)
  										ifTrue: [:r :i :n| 4]
  										ifFalse:
  											[self literalLoadInstructionBytes = 4
  												ifTrue: [8]
  												ifFalse:
  													[1 << (operands at: 0) highBit = ((operands at: 0) + 1)
  														ifTrue: [8]
  														ifFalse: [self literalLoadInstructionBytes + 4]]]].
  		[CmpCqR]				-> [^self rotateable8bitSignedImmediate: (operands at: 0)
  											ifTrue: [:r :i :n| 4]
  											ifFalse: [self literalLoadInstructionBytes + 4]].
  		[OrCqR]					-> [^self rotateable8bitImmediate: (operands at: 0)
  											ifTrue: [:r :i| 4]
  											ifFalse: [self literalLoadInstructionBytes + 4]].
  		[SubCqR]				-> [^self rotateable8bitSignedImmediate: (operands at: 0)
  											ifTrue: [:r :i :n| 4]
  											ifFalse: [self literalLoadInstructionBytes + 4]].
  		[TstCqR]				-> [^self rotateable8bitImmediate: (operands at: 0)
  											ifTrue: [:r :i| 4]
  											ifFalse: [self literalLoadInstructionBytes + 4]].
  		[XorCqR]				-> [^self rotateable8bitBitwiseImmediate: (operands at: 0)
  										ifTrue: [:r :i :n| 4]
  										ifFalse:
  											[self literalLoadInstructionBytes = 4
  												ifTrue: [8]
  												ifFalse:
  													[1 << (operands at: 0) highBit = ((operands at: 0) + 1)
  														ifTrue: [8]
  														ifFalse: [self literalLoadInstructionBytes + 4]]]].
  		[AddCwR]				-> [^self literalLoadInstructionBytes + 4].
  		[AndCwR]				-> [^self literalLoadInstructionBytes + 4].
  		[CmpCwR]				-> [^self literalLoadInstructionBytes + 4].
  		[OrCwR]				-> [^self literalLoadInstructionBytes + 4].
  		[SubCwR]				-> [^self literalLoadInstructionBytes + 4].
  		[XorCwR]				-> [^self literalLoadInstructionBytes + 4].
  		[AddRR]					-> [^4].
  		[AndRR]					-> [^4].
  		[CmpRR]				-> [^4].
  		[OrRR]					-> [^4].
  		[XorRR]					-> [^4].
  		[SubRR]					-> [^4].
  		[NegateR]				-> [^4].
  		[LoadEffectiveAddressMwrR]
  									-> [^self rotateable8bitImmediate: (operands at: 0)
  											ifTrue: [:r :i| 4]
  											ifFalse: [self literalLoadInstructionBytes + 4]].
  
  		[LogicalShiftLeftCqR]		-> [^4].
  		[LogicalShiftRightCqR]		-> [^4].
  		[ArithmeticShiftRightCqR]	-> [^4].
  		[LogicalShiftLeftRR]			-> [^4].
  		[LogicalShiftRightRR]		-> [^4].
  		[ArithmeticShiftRightRR]		-> [^4].
  		[AddRdRd]					-> [^4].
  		[CmpRdRd]					-> [^4].
  		[SubRdRd]					-> [^4].
  		[MulRdRd]					-> [^4].
  		[DivRdRd]					-> [^4].
  		[SqrtRd]					-> [^4].
  		"ARM Specific Arithmetic"
  		[SMULL]				-> [^4].
  		[MSR]					-> [^4].
  		[CMPSMULL]			-> [^4]. "special compare for genMulR:R: usage"
+ 		"ARM Specific Data Movement"
+ 		[PopLDM]				-> [^4].
+ 		[PushSTM]				-> [^4].
  		"Data Movement"						
  		[MoveCqR]				-> [^self literalLoadInstructionBytes = 4
  										ifTrue: [self literalLoadInstructionBytes]
  										ifFalse:
  											[self rotateable8bitBitwiseImmediate: (operands at: 0)
  												ifTrue: [:r :i :n| 4]
  												ifFalse: [self literalLoadInstructionBytes]]].
  		[MoveCwR]				-> [^self literalLoadInstructionBytes = 4
  										ifTrue: [self literalLoadInstructionBytes]
  										ifFalse:
  											[(self inCurrentCompilation: (operands at: 0))
  												ifTrue: [4]
  												ifFalse: [self literalLoadInstructionBytes]]].
  		[MoveRR]				-> [^4].
  		[MoveRdRd]				-> [^4].
  		[MoveAwR]				-> [^(self isAddressRelativeToVarBase: (operands at: 0))
  													ifTrue: [4]
  													ifFalse: [self literalLoadInstructionBytes + 4]].
  		[MoveRAw]				-> [^(self isAddressRelativeToVarBase: (operands at: 1))
  													ifTrue: [4]
  													ifFalse: [self literalLoadInstructionBytes + 4]].
  		[MoveAbR]				-> [^(self isAddressRelativeToVarBase: (operands at: 0))
  													ifTrue: [4]
  													ifFalse: [self literalLoadInstructionBytes + 4]].
  		[MoveRAb]				-> [^(self isAddressRelativeToVarBase: (operands at: 1))
  													ifTrue: [4]
  													ifFalse: [self literalLoadInstructionBytes + 4]].
  		[MoveRMwr]			-> [^self is12BitValue: (operands at: 1)
  										ifTrue: [:u :i| 4]
  										ifFalse: [self literalLoadInstructionBytes + 4]].
  		[MoveRdM64r]			-> [^self literalLoadInstructionBytes + 4]. 
  		[MoveMbrR]				-> [^self is12BitValue: (operands at: 0)
  										ifTrue: [:u :i| 4]
  										ifFalse: [self literalLoadInstructionBytes + 4]].
  		[MoveRMbr]				-> [^self is12BitValue: (operands at: 1)
  										ifTrue: [:u :i| 4]
  										ifFalse: [self literalLoadInstructionBytes + 4]].
  		[MoveRM16r]				-> [^self is12BitValue: (operands at: 1)
  										ifTrue: [:u :i| 4]
  										ifFalse: [self literalLoadInstructionBytes + 4]].
  		[MoveM16rR]			-> [^self rotateable8bitImmediate: (operands at: 0)
  											ifTrue: [:r :i| 4]
  											ifFalse: [self literalLoadInstructionBytes + 4]].
  		[MoveM64rRd]			-> [^self literalLoadInstructionBytes + 4].
  		[MoveMwrR]			-> [^self is12BitValue: (operands at: 0)
  										ifTrue: [:u :i| 4]
  										ifFalse: [self literalLoadInstructionBytes + 4]].
  		[MoveXbrRR]			-> [^4].
  		[MoveRXbrR]			-> [^4].
  		[MoveXwrRR]			-> [^4].
  		[MoveRXwrR]			-> [^4].
  		[PopR]					-> [^4].
  		[PushR]					-> [^4].
  		[PushCw]				-> [^self literalLoadInstructionBytes = 4
  										ifTrue: [self literalLoadInstructionBytes + 4]
  										ifFalse:
  											[(self inCurrentCompilation: (operands at: 0))
  												ifTrue: [8]
  												ifFalse:
  													[self rotateable8bitBitwiseImmediate: (operands at: 0)
  														ifTrue: [:r :i :n| 8]
  														ifFalse: [self literalLoadInstructionBytes + 4]]]].
  		[PushCq]				-> [^self literalLoadInstructionBytes = 4
  										ifTrue: [self literalLoadInstructionBytes + 4]
  										ifFalse:
  											[self rotateable8bitBitwiseImmediate: (operands at: 0)
  												ifTrue: [:r :i :n| 8]
  												ifFalse: [self literalLoadInstructionBytes + 4]]].
  		[PrefetchAw] 			-> [^(self isAddressRelativeToVarBase: (operands at: 0))
  										ifTrue: [4]
  										ifFalse: [self literalLoadInstructionBytes + 4]].
  		"Conversion"
  		[ConvertRRd]			-> [^8].
  		}.
  	^0 "to keep C compiler quiet"
  !

Item was added:
+ ----- Method: CogARMCompiler>>concretizePushOrPopMultipleRegisters: (in category 'generate machine code - concretize') -----
+ concretizePushOrPopMultipleRegisters: doPush
+ 	self assert: (operands at: 0) ~= 0.
+ 	machineCode at: 0 put: AL << 28
+ 						  + (doPush     "2r100PUSWL"
+ 								ifTrue: [2r10010010 << 20]
+ 								ifFalse: [2r10001011 << 20])
+ 						  + (SP << 16)
+ 						  + (operands at: 0).
+ 	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogARMCompiler>>dispatchConcretize (in category 'generate machine code') -----
  dispatchConcretize
  	"Attempt to generate concrete machine code for the instruction at address.
  	 This is the inner dispatch of concretizeAt: actualAddress which exists only
  	 to get around the branch size limits in the SqueakV3 (blue book derived)
  	 bytecode set."
  	<returnTypeC: #void>
  	conditionOrNil ifNotNil:
  		[self concretizeConditionalInstruction.
  		 ^self].
  		 
  	opcode caseOf: {
  		"Noops & Pseudo Ops"
  		[Label]					-> [^self concretizeLabel].
  		[Literal]					-> [^self concretizeLiteral].
  		[AlignmentNops]		-> [^self concretizeAlignmentNops].
  		[Fill32]					-> [^self concretizeFill32].
  		[Nop]					-> [^self concretizeNop].
  		"Control"
  		[Call]						-> [^self concretizeCall]. "call code within code space"
  		[CallFull]					-> [^self concretizeCallFull]. "call code anywhere in address space"
  		[JumpR]						-> [^self concretizeJumpR].
  		[JumpFull]					-> [^self concretizeJumpFull]."jump within address space"
  		[JumpLong]					-> [^self concretizeConditionalJump: AL]."jumps witihn code space"
  		[JumpLongZero]			-> [^self concretizeConditionalJump: EQ].
  		[JumpLongNonZero]		-> [^self concretizeConditionalJump: NE].
  		[Jump]						-> [^self concretizeConditionalJump: AL].
  		[JumpZero]					-> [^self concretizeConditionalJump: EQ].
  		[JumpNonZero]				-> [^self concretizeConditionalJump: NE].
  		[JumpNegative]				-> [^self concretizeConditionalJump: MI].
  		[JumpNonNegative]			-> [^self concretizeConditionalJump: PL].
  		[JumpOverflow]				-> [^self concretizeConditionalJump: VS].
  		[JumpNoOverflow]			-> [^self concretizeConditionalJump: VC].
  		[JumpCarry]				-> [^self concretizeConditionalJump: CS].
  		[JumpNoCarry]				-> [^self concretizeConditionalJump: CC].
  		[JumpLess]					-> [^self concretizeConditionalJump: LT].
  		[JumpGreaterOrEqual]		-> [^self concretizeConditionalJump: GE].
  		[JumpGreater]				-> [^self concretizeConditionalJump: GT].
  		[JumpLessOrEqual]			-> [^self concretizeConditionalJump: LE].
  		[JumpBelow]				-> [^self concretizeConditionalJump: CC]. "unsigned lower"
  		[JumpAboveOrEqual]		-> [^self concretizeConditionalJump: CS]. "unsigned greater or equal"
  		[JumpAbove]				-> [^self concretizeConditionalJump: HI].
  		[JumpBelowOrEqual]		-> [^self concretizeConditionalJump: LS].
  		[JumpFPEqual]				-> [^self concretizeFPConditionalJump: EQ].
  		[JumpFPNotEqual]			-> [^self concretizeFPConditionalJump: NE].
  		[JumpFPLess]				-> [^self concretizeFPConditionalJump: LT].
  		[JumpFPGreaterOrEqual]	-> [^self concretizeFPConditionalJump: GE].
  		[JumpFPGreater]			-> [^self concretizeFPConditionalJump: GT].
  		[JumpFPLessOrEqual]		-> [^self concretizeFPConditionalJump: LE].
  		[JumpFPOrdered]			-> [^self concretizeFPConditionalJump: VC].
  		[JumpFPUnordered]			-> [^self concretizeFPConditionalJump: VS].
  		[RetN]						-> [^self concretizeRetN].
  		[Stop]						-> [^self concretizeStop].
  		"Arithmetic"
  		[AddCqR]					-> [^self concretizeNegateableDataOperationCqR: AddOpcode].
  		[AndCqR]					-> [^self concretizeInvertibleDataOperationCqR: AndOpcode].
  		[AndCqRR]					-> [^self concretizeAndCqRR].
  		[CmpCqR]					-> [^self concretizeNegateableDataOperationCqR: CmpOpcode].
  		[OrCqR]						-> [^self concretizeDataOperationCqR: OrOpcode].
  		[SubCqR]					-> [^self concretizeSubCqR].
  		[TstCqR]					-> [^self concretizeTstCqR].
  		[XorCqR]					-> [^self concretizeInvertibleDataOperationCqR: XorOpcode].
  		[AddCwR]					-> [^self concretizeDataOperationCwR: AddOpcode].
  		[AndCwR]					-> [^self concretizeDataOperationCwR: AndOpcode].
  		[CmpCwR]					-> [^self concretizeDataOperationCwR: CmpOpcode].
  		[OrCwR]					-> [^self concretizeDataOperationCwR: OrOpcode].
  		[SubCwR]					-> [^self concretizeDataOperationCwR: SubOpcode].
  		[XorCwR]					-> [^self concretizeDataOperationCwR: XorOpcode].
  		[AddRR]						-> [^self concretizeDataOperationRR: AddOpcode].
  		[AndRR]						-> [^self concretizeDataOperationRR: AndOpcode].
  		[CmpRR]					-> [^self concretizeDataOperationRR: CmpOpcode].
  		[OrRR]						-> [^self concretizeDataOperationRR: OrOpcode].
  		[SubRR]						-> [^self concretizeDataOperationRR: SubOpcode].
  		[XorRR]						-> [^self concretizeDataOperationRR: XorOpcode].
  		[AddRdRd]					-> [^self concretizeAddRdRd].
  		[CmpRdRd]					-> [^self concretizeCmpRdRd].
  		[DivRdRd]					-> [^self concretizeDivRdRd].
  		[MulRdRd]					-> [^self concretizeMulRdRd].
  		[SubRdRd]					-> [^self concretizeSubRdRd].
  		[SqrtRd]					-> [^self concretizeSqrtRd].
  		[NegateR]						-> [^self concretizeNegateR].
  		[LoadEffectiveAddressMwrR]	-> [^self concretizeLoadEffectiveAddressMwrR].
  		[ArithmeticShiftRightCqR]		-> [^self concretizeArithmeticShiftRightCqR].
  		[LogicalShiftRightCqR]			-> [^self concretizeLogicalShiftRightCqR].
  		[LogicalShiftLeftCqR]			-> [^self concretizeLogicalShiftLeftCqR].
  		[ArithmeticShiftRightRR]			-> [^self concretizeArithmeticShiftRightRR].
  		[LogicalShiftLeftRR]				-> [^self concretizeLogicalShiftLeftRR].
  		[LogicalShiftRightRR]			-> [^self concretizeLogicalShiftRightRR].
  		"ARM Specific Arithmetic" 
  		[SMULL]			-> [^self concretizeSMULL]	.
  		[CMPSMULL]		-> [^self concretizeCMPSMULL].
  		[MSR]				-> [^self concretizeMSR].
+ 		"ARM Specific Data Movement"
+ 		[PopLDM]			-> [^self concretizePushOrPopMultipleRegisters: false].
+ 		[PushSTM]			-> [^self concretizePushOrPopMultipleRegisters: true].
  		"Data Movement"
  		[MoveCqR]			-> [^self concretizeMoveCqR].
  		[MoveCwR]			-> [^self concretizeMoveCwR].
  		[MoveRR]			-> [^self concretizeMoveRR].
  		[MoveAwR]			-> [^self concretizeMoveAwR].
  		[MoveRAw]			-> [^self concretizeMoveRAw].
  		[MoveAbR] 			 -> [^self concretizeMoveAbR].
   		[MoveRAb]			-> [^self concretizeMoveRAb].
  		[MoveMbrR]			-> [^self concretizeMoveMbrR].
  		[MoveRMbr]			-> [^self concretizeMoveRMbr].
  		[MoveRM16r]		-> [^self concretizeMoveRM16r].
  		[MoveM16rR]		-> [^self concretizeMoveM16rR].
  		[MoveM64rRd]		-> [^self concretizeMoveM64rRd].
  		[MoveMwrR]		-> [^self concretizeMoveMwrR].
  		[MoveXbrRR]		-> [^self concretizeMoveXbrRR].
  		[MoveRXbrR]		-> [^self concretizeMoveRXbrR].
  		[MoveXwrRR]		-> [^self concretizeMoveXwrRR].
  		[MoveRXwrR]		-> [^self concretizeMoveRXwrR].
  		[MoveRMwr]		-> [^self concretizeMoveRMwr].
  		[MoveRdM64r]		-> [^self concretizeMoveRdM64r].
  		[PopR]				-> [^self concretizePopR].
  		[PushR]				-> [^self concretizePushR].
  		[PushCq]			-> [^self concretizePushCq].
  		[PushCw]			-> [^self concretizePushCw].
  		[PrefetchAw]		-> [^self concretizePrefetchAw].
  		"Conversion"
  		[ConvertRRd]		-> [^self concretizeConvertRRd]}!

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

Item was added:
+ ----- Method: CogARMCompiler>>genPopRegisterMask: (in category 'generate machine code') -----
+ genPopRegisterMask: registersToBeSavedMask
+ 	<inline: true>
+ 	^registersToBeSavedMask = 0
+ 		ifTrue: [cogit Label]
+ 		ifFalse: [cogit gen: PopLDM operand: registersToBeSavedMask]!

Item was added:
+ ----- Method: CogARMCompiler>>genPushRegisterMask: (in category 'generate machine code') -----
+ genPushRegisterMask: registersToBeSavedMask
+ 	<inline: true>
+ 	^registersToBeSavedMask = 0
+ 		ifTrue: [cogit Label]
+ 		ifFalse: [cogit gen: PushSTM operand: registersToBeSavedMask]!

Item was changed:
  ----- Method: CogARMCompiler>>genRestoreRegs: (in category 'abi') -----
  genRestoreRegs: regMask
+ 	"Restore the registers in regMask as saved by genSaveRegs:."
+ 	<inline: true>
+ 	^self genPopRegisterMask: regMask!
- 	"Restore the registers in regMask as saved by genSaveRegs:.
- 	 Restore none, because the ARM ABI only defines callee saved registers, no caller-saved regs."
- 	^0!

Item was changed:
  ----- Method: CogARMCompiler>>genSaveRegs: (in category 'abi') -----
  genSaveRegs: regMask
+ 	"Save the registers in regMask for a call into the C run-time from a trampoline"
+ 	<inline: true>
+ 	^self genPushRegisterMask: regMask!
- 	"Save the registers in regMask for a call into the C run-time from a trampoline.
- 	 Save none, because the ARM ABI only defines callee saved registers, no caller-saved regs."
- 	^0!

Item was changed:
  ----- Method: CogARMCompiler>>generalPurposeRegisterMap (in category 'disassembly') -----
  generalPurposeRegisterMap
  	<doNotGenerate>
  	"Answer a Dictionary from register getter to register index."
  	^Dictionary newFromPairs:
  		{	#r0. R0.
+ 			#r1. R1.
+ 			#r2. R2.
+ 			#r3. R3.
  			#r4. R4.
  			#r5. R5.
  			#r6. R6.
  			#r7. R7.
  			#r8. R8.
+ 			#r9. R9.
  			#r10. R10.
  			#r11. R11.
  			#r12. R12	}!

Item was changed:
  ----- Method: CogARMCompiler>>nameForRegister: (in category 'printing') -----
  nameForRegister: reg "<Integer>"
  	<doNotGenerate>
+ 	| default |
+ 	default := super nameForRegister: reg.
+ 	^default last = $?
+ 		ifTrue:
+ 			[#(LR SP PC CArg0Reg CArg0Reg CArg1Reg CArg2Reg CArg3Reg)
+ 				detect: [:sym| (thisContext method methodClass classPool at: sym) = reg] 
+ 				ifNone: [default]]
+ 		ifFalse:
+ 			[default]!
- 	reg < 0 ifTrue:
- 		[^super nameForRegister: reg].
- 	^#(LR SP PC CArg0Reg CArg0Reg CArg1Reg CArg2Reg CArg3Reg)
- 		detect: [:sym| (thisContext method methodClass classPool at: sym) = reg] 
- 		ifNone: [super nameForRegister: reg]!

Item was changed:
  ----- Method: CogAbstractInstruction class>>initializeAbstractRegisters (in category 'class initialization') -----
  initializeAbstractRegisters
+ 	"Assign the abstract registers with the identities/indices of the relevant concrete registers,
+ 	 and assign CallerSavedRegisterMask appropriately.
- 	"Assign the abstract registers with the identities/indices of the relevant concrete registers.
  	 First set all abstract registers to #undefined via CogAbstractRegisters initialize, and then,
  	 each subclasses assigns the subset they choose with values of specific concrete registers."
+ 	CallerSavedRegisterMask := #undefined.
  	CogAbstractRegisters initialize!

Item was added:
+ ----- Method: CogAbstractInstruction class>>registerMaskFor: (in category 'register management') -----
+ registerMaskFor: reg
+ 	^Cogit basicNew registerMaskFor: reg!

Item was added:
+ ----- Method: CogAbstractInstruction class>>registerMaskFor:and: (in category 'register management') -----
+ registerMaskFor: reg1 and: reg2
+ 	^Cogit basicNew registerMaskFor: reg1 and: reg2!

Item was added:
+ ----- Method: CogAbstractInstruction class>>registerMaskFor:and:and: (in category 'register management') -----
+ registerMaskFor: reg1 and: reg2 and: reg3
+ 	^Cogit basicNew registerMaskFor: reg1 and: reg2 and: reg3!

Item was added:
+ ----- Method: CogAbstractInstruction class>>registerMaskFor:and:and:and: (in category 'register management') -----
+ registerMaskFor: reg1 and: reg2 and: reg3 and: reg4
+ 	^Cogit basicNew registerMaskFor: reg1 and: reg2 and: reg3 and: reg4!

Item was added:
+ ----- Method: CogAbstractInstruction class>>registerMaskFor:and:and:and:and: (in category 'register management') -----
+ registerMaskFor: reg1 and: reg2 and: reg3 and: reg4 and: reg5
+ 	^Cogit basicNew registerMaskFor: reg1 and: reg2 and: reg3 and: reg4 and: reg5!

Item was added:
+ ----- Method: CogAbstractInstruction class>>registerMaskFor:and:and:and:and:and: (in category 'register management') -----
+ registerMaskFor: reg1 and: reg2 and: reg3 and: reg4 and: reg5 and: reg6
+ 	^Cogit basicNew registerMaskFor: reg1 and: reg2 and: reg3 and: reg4 and: reg5 and: reg6!

Item was added:
+ ----- Method: CogAbstractInstruction class>>registerMaskFor:and:and:and:and:and:and: (in category 'register management') -----
+ registerMaskFor: reg1 and: reg2 and: reg3 and: reg4 and: reg5 and: reg6 and: reg7
+ 	^Cogit basicNew registerMaskFor: reg1 and: reg2 and: reg3 and: reg4 and: reg5 and: reg6 and: reg7!

Item was added:
+ ----- Method: CogAbstractInstruction class>>registerMaskFor:and:and:and:and:and:and:and: (in category 'register management') -----
+ registerMaskFor: reg1 and: reg2 and: reg3 and: reg4 and: reg5 and: reg6 and: reg7 and: reg8
+ 	^Cogit basicNew registerMaskFor: reg1 and: reg2 and: reg3 and: reg4 and: reg5 and: reg6 and: reg7 and: reg8!

Item was added:
+ ----- Method: CogAbstractInstruction class>>registerMaskFor:and:and:and:and:and:and:and:and: (in category 'register management') -----
+ registerMaskFor: reg1 and: reg2 and: reg3 and: reg4 and: reg5 and: reg6 and: reg7 and: reg8 and: reg9
+ 	^Cogit basicNew registerMaskFor: reg1 and: reg2 and: reg3 and: reg4 and: reg5 and: reg6 and: reg7 and: reg8 and: reg9!

Item was added:
+ ----- Method: CogAbstractInstruction class>>registerMaskFor:and:and:and:and:and:and:and:and:and: (in category 'register management') -----
+ registerMaskFor: reg1 and: reg2 and: reg3 and: reg4 and: reg5 and: reg6 and: reg7 and: reg8 and: reg9 and: reg10
+ 	^Cogit basicNew registerMaskFor: reg1 and: reg2 and: reg3 and: reg4 and: reg5 and: reg6 and: reg7 and: reg8 and: reg9 and: reg10!

Item was removed:
- ----- Method: CogAbstractInstruction>>callerSavedRegisterMask (in category 'accessing') -----
- callerSavedRegisterMask
- 	"Answer an abstract register mask as computed by StackToRegisterMappingCogit registerMaskFor:"
- 	self subclassResponsibility!

Item was added:
+ ----- Method: CogAbstractInstruction>>canPushPopMultipleRegisters (in category 'testing') -----
+ canPushPopMultipleRegisters
+ 	<inline: true>
+ 	^false!

Item was changed:
  SharedPool subclass: #CogAbstractRegisters
  	instanceVariableNames: ''
+ 	classVariableNames: 'Arg0Reg Arg1Reg CallerSavedRegisterMask ClassReg DPFPReg0 DPFPReg1 DPFPReg10 DPFPReg11 DPFPReg12 DPFPReg13 DPFPReg14 DPFPReg15 DPFPReg2 DPFPReg3 DPFPReg4 DPFPReg5 DPFPReg6 DPFPReg7 DPFPReg8 DPFPReg9 Extra0Reg Extra1Reg Extra2Reg Extra3Reg Extra4Reg Extra5Reg Extra6Reg Extra7Reg FPReg LinkReg NoReg PCReg RISCTempReg ReceiverResultReg SPReg SendNumArgsReg TempReg VarBaseReg'
- 	classVariableNames: 'Arg0Reg Arg1Reg ClassReg DPFPReg0 DPFPReg1 DPFPReg10 DPFPReg11 DPFPReg12 DPFPReg13 DPFPReg14 DPFPReg15 DPFPReg2 DPFPReg3 DPFPReg4 DPFPReg5 DPFPReg6 DPFPReg7 DPFPReg8 DPFPReg9 Extra0Reg Extra1Reg Extra2Reg Extra3Reg Extra4Reg Extra5Reg Extra6Reg Extra7Reg FPReg LinkReg NoReg PCReg RISCTempReg ReceiverResultReg SPReg SendNumArgsReg TempReg VarBaseReg'
  	poolDictionaries: ''
  	category: 'VMMaker-JIT'!
  
  !CogAbstractRegisters commentStamp: 'eem 12/26/2015 14:06' prior: 0!
  I am a pool for the abstract register set that the Cogit uses to define its model of Smalltalk compiled to machine code.!

Item was changed:
  ----- Method: CogAbstractRegisters class>>nameForRegister: (in category 'debug printing') -----
  nameForRegister: reg "<Integer>"
  	^#(Arg0Reg Arg1Reg ClassReg FPReg ReceiverResultReg SPReg SendNumArgsReg TempReg
  		LinkReg RISCTempReg VarBaseReg PCReg
+ 		Extra0Reg Extra1Reg Extra2Reg Extra3Reg Extra4Reg Extra5Reg)
- 		Scratch0Reg Scratch1Reg Scratch2Reg Scratch3Reg Scratch4Reg Scratch5Reg)
  			detect: [:sym| (classPool at: sym) = reg]
  			ifNone: ['REG', reg printString, '?']!

Item was changed:
  ----- Method: CogIA32Compiler class>>initializeAbstractRegisters (in category 'class initialization') -----
  initializeAbstractRegisters
  	"Assign the abstract registers with the identities/indices of the relevant concrete registers."
  
+ 	super initializeAbstractRegisters.
+ 
  	"N.B. EAX ECX & EDX are caller-save (scratch) registers.  Hence we use ECX for class and EDX for
  		receiver/result since these are written in all normal sends.  EBX ESI & EDI are callee-save."
  
+ 	CallerSavedRegisterMask := self registerMaskFor: EAX and: ECX and: EDX.
- 	super initializeAbstractRegisters.
  
  	TempReg				:= EAX.
  	ClassReg				:= ECX.
  	ReceiverResultReg		:= EDX.
  	SendNumArgsReg		:= EBX.
  	SPReg					:= ESP.
  	FPReg					:= EBP.
  	Arg0Reg				:= ESI.
  	Arg1Reg				:= EDI.
  
  	DPFPReg0				:= XMM0L.
  	DPFPReg1				:= XMM1L.
  	DPFPReg2				:= XMM2L.
  	DPFPReg3				:= XMM3L.
  	DPFPReg4				:= XMM4L.
  	DPFPReg5				:= XMM5L.
  	DPFPReg6				:= XMM6L.
  	DPFPReg7				:= XMM7L!

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

Item was changed:
  ----- Method: CogMIPSELCompiler class>>initializeAbstractRegisters (in category 'class initialization') -----
  initializeAbstractRegisters
  	"Assign the abstract registers with the identities/indices of the relevant concrete registers."
  
  	"See MIPSConstants>>initializeRegisters for a description of the C ABI."
  
  	"Note we can fit all of the abstract registers in C preserved registers, and
  	 not need to save or restore them at runtime calls."
  	super initializeAbstractRegisters.
  
+ 	self flag: #OABI.
+ 	CallerSavedRegisterMask := self
+ 									registerMaskFor: T0 and: T1 and: T2 and: T3
+ 									and: T4 and: T5 and: T6 and: T7 and: T8 and: T9.
+ 
  	ReceiverResultReg		:= S0.
  	Arg0Reg				:= S1.
  	Arg1Reg				:= S2.
  	ClassReg				:= S3.
  	SendNumArgsReg		:= S4.
  	TempReg				:= S5.
  	VarBaseReg			:= S6. "Must be callee saved"
  	SPReg					:= SP.
  	FPReg					:= FP.
  	RISCTempReg			:= AT.
  	LinkReg					:= RA.
  
  	self flag: #todo.
  	"Extra0Reg			:= ??.
  	Extra1Reg			:= ??.
  	Extra2Reg			:= ??.
  	Extra3Reg			:= ??.
  	Extra4Reg			:= ??.
  	Extra5Reg			:= ??.
  	Extra6Reg			:= ??.
  	Extra7Reg			:= ??."
  
  	self flag: #todo.
  	"DPFPReg0				:= ??.
  	DPFPReg1				:= ??.
  	DPFPReg2				:= ??.
  	DPFPReg3				:= ??.
  	DPFPReg4				:= ??.
  	DPFPReg5				:= ??.
  	DPFPReg6				:= ??.
  	DPFPReg7				:= ??.
  	DPFPReg8				:= ??.
  	DPFPReg9				:= ??.
  	DPFPReg10				:= ??.
  	DPFPReg11				:= ??.
  	DPFPReg12				:= ??.
  	DPFPReg13				:= ??.
  	DPFPReg14				:= ??.
  	DPFPReg15				:= ??"!

Item was removed:
- ----- Method: CogMIPSELCompiler>>callerSavedRegisterMask (in category 'accessing') -----
- callerSavedRegisterMask
- 	"Volatile"
- 	"See MIPSConstants initializeRegisters."
- 	self flag: #OABI.
- 	^cogit
- 		registerMaskFor: T0
- 		and: T1
- 		and: T2
- 		and: T3
- 		and: T4
- 		and: T5
- 		and: T6
- 		and: T7
- 		and: T8
- 		and: T9!

Item was changed:
  ----- Method: CogMIPSELCompiler>>nameForRegister: (in category 'printing') -----
  nameForRegister: reg "<Integer>"
  	<doNotGenerate>
- 	reg < 0 ifTrue: [^super nameForRegister: reg].
  	^MIPSConstants nameForRegister: reg!

Item was changed:
  ----- Method: CogObjectRepresentationForSpur>>genGetActiveContextLarge:inBlock: (in category 'initialization') -----
  genGetActiveContextLarge: isLarge inBlock: isInBlock
  	"Create a trampoline to answer the active context that will
  	 answer it if a frame is already married, and create it otherwise.
  	 Assume numArgs is in SendNumArgsReg and ClassReg is free."
  	| header slotSize jumpSingle loopHead jumpNeedScavenge continuation exit |
  	<var: #jumpNeedScavenge type: #'AbstractInstruction *'>
  	<var: #continuation type: #'AbstractInstruction *'>
  	<var: #jumpSingle type: #'AbstractInstruction *'>
  	<var: #loopHead type: #'AbstractInstruction *'>
  	<var: #exit type: #'AbstractInstruction *'>
  	cogit "load the flag; stash it in both TempReg & ClassReg; do the compare (a prime candidated for use of AndCq:R:R:)"
  		MoveMw: FoxMethod r: FPReg R: ClassReg;
  		AndCq: MFMethodFlagHasContextFlag R: ClassReg R: TempReg.
  	jumpSingle := cogit JumpZero: 0. "jump if flag bit not set"
  	cogit "since the flag bit was set, get the context in the receiver reg and return"
  		MoveMw: FoxThisContext r: FPReg R: ReceiverResultReg;
  		RetN: 0.
  	jumpSingle jmpTarget: cogit Label.
  
  	"OK, it doesn't exist; instantiate and initialize it"
  	"set the hasContext flag; See CoInterpreter class>>initializeFrameIndices"
  	cogit
  		OrCq: MFMethodFlagHasContextFlag R: ClassReg;
  		MoveR: ClassReg Mw: FoxMethod r: FPReg.
  	"now get the home CogMethod into ClassReg and save for post-instantiation."
  	isInBlock
  		ifTrue:
  			[cogit
  				SubCq: 3 R: ClassReg; "-3 is -(hasContext+isBlock) flags"
  				MoveM16: 0 r: ClassReg R: TempReg;
  				SubR: TempReg R: ClassReg]
  		ifFalse:
  			[cogit SubCq: 1 R: ClassReg]. "-1 is hasContext flag"
  
  	"instantiate the context..."
  	slotSize := isLarge ifTrue: [LargeContextSlots] ifFalse: [SmallContextSlots].
  	header := objectMemory
  					headerForSlots: slotSize
  					format: objectMemory indexablePointersFormat
  					classIndex: ClassMethodContextCompactIndex.
  	self flag: #endianness.
  	cogit MoveAw: objectMemory freeStartAddress R: ReceiverResultReg.
  	self genStoreHeader: header intoNewInstance: ReceiverResultReg using: TempReg.
  	cogit
  		MoveR: ReceiverResultReg R: TempReg;
  		AddCq: (objectMemory smallObjectBytesForSlots: slotSize) R: TempReg;
  		MoveR: TempReg Aw: objectMemory freeStartAddress;
  		CmpCq: objectMemory getScavengeThreshold R: TempReg.
  	jumpNeedScavenge := cogit JumpAboveOrEqual: 0.
  
  	"Now initialize the fields of the context.  See CoInterpreter>>marryFrame:SP:copyTemps:"
  	"sender gets frame pointer as a SmallInteger"
  	continuation :=
  	cogit MoveR: FPReg R: TempReg.
  	self genSetSmallIntegerTagsIn: TempReg.
  	cogit MoveR: TempReg Mw: objectMemory baseHeaderSize + (SenderIndex * objectMemory bytesPerOop) r: ReceiverResultReg.
  
  	"pc gets frame caller as a SmallInteger"
  	cogit MoveMw: FoxSavedFP r: FPReg R: TempReg.
  	self genSetSmallIntegerTagsIn: TempReg.
  	cogit MoveR: TempReg Mw: objectMemory baseHeaderSize + (InstructionPointerIndex * objectMemory bytesPerOop) r: ReceiverResultReg.
  
  	"Set the method field, freeing up ClassReg again, and frame's context field,"
  	cogit
  		MoveMw: (cogit offset: CogMethod of: #methodObject) r: ClassReg R: TempReg;
  		MoveR: TempReg Mw: objectMemory baseHeaderSize + (MethodIndex * objectMemory wordSize) r: ReceiverResultReg;
  		MoveR: ReceiverResultReg Mw: FoxThisContext r: FPReg.
  
  	"Now compute stack pointer; this is stackPointer (- 1 for return pc if a CISC) - framePointer - wordSize (1 each for saved pc, method, context, receiver) + 1 (1-relative) + numArgs"
  	"TPR note - the code here is actually doing
  	context stackPointer := ((((fp - sp) / wordSize) - [3|4]) + num args) asSmallInteger"
  	cogit
  		MoveR: FPReg R: TempReg;
  		SubR: SPReg R: TempReg;
  		LogicalShiftRightCq: self log2BytesPerWord R: TempReg;
  		SubCq: (cogit backEnd hasLinkRegister ifTrue: [3] ifFalse: [4]) R: TempReg;
  		AddR: SendNumArgsReg R: TempReg.
  	self genConvertIntegerToSmallIntegerInReg: TempReg.
  	cogit MoveR: TempReg Mw: objectMemory baseHeaderSize + (StackPointerIndex * objectMemory bytesPerOop) r: ReceiverResultReg.
  
  	"Set closureOrNil to either the stacked receiver or nil"
  	isInBlock
  		ifTrue:
  			[cogit
  				MoveR: SendNumArgsReg R: TempReg;
  				AddCq: 2 R: TempReg; "+2 for saved fp and saved pc"
  				MoveXwr: TempReg R: FPReg R: TempReg]
  		ifFalse:
  			[cogit genMoveNilR: TempReg].
  	cogit MoveR: TempReg Mw: objectMemory baseHeaderSize + (ClosureIndex * objectMemory bytesPerOop) r: ReceiverResultReg.
  
  	"Set the receiver"
  	cogit
  		MoveMw: FoxMFReceiver r: FPReg R: TempReg;
  		MoveR: TempReg Mw: objectMemory baseHeaderSize + (ReceiverIndex * objectMemory bytesPerOop) r: ReceiverResultReg.
  
  	"Now copy the arguments.  This is tricky because of the shortage of registers,.  ClassReg ranges
  	 from 1 to numArgs (SendNumArgsReg), and from ReceiverIndex + 1 to ReceiverIndex + numArgs.
  	 1 to: numArgs do:
  		[:i|
  		temp := longAt(FPReg + ((SendNumArgs - i + 2) * wordSize)). +2 for saved pc and savedfp
  		longAtput(FPReg + FoxMFReceiver + (i * wordSize), temp)]"
  	"TPR note: this is a prime candidate for passing off to the backend to do at least faintly optimal code"
  	cogit MoveCq: 1 R: ClassReg.
  	loopHead := cogit CmpR: SendNumArgsReg R: ClassReg.
  	exit := cogit JumpGreater: 0.
  	cogit
  		MoveR: SendNumArgsReg R: TempReg;
  		SubR: ClassReg R: TempReg;
  		AddCq: 2 R: TempReg; "+2 for saved fp and saved pc"
  		MoveXwr: TempReg R: FPReg R: TempReg;
  		AddCq: ReceiverIndex + (objectMemory baseHeaderSize / objectMemory wordSize) R: ClassReg; "Now convert ClassReg from frame index to context index"
  		MoveR: TempReg Xwr: ClassReg R: ReceiverResultReg;
  		SubCq: ReceiverIndex + (objectMemory baseHeaderSize / objectMemory wordSize) - 1 R: ClassReg; "convert back adding 1 ;-)"
  		Jump: loopHead.
  	exit jmpTarget: cogit Label.
  
  	"Finally nil or copy the non-argument temps.
  	 ClassReg := FPReg + FoxMFReceiver.
  	 SendNumArgsReg := SendNumArgsReg+ReceiverIndex.
  	 [ClassReg := ClassReg - wordSize.
  	  backEnd hasLinkRegister
  			ifTrue: [ClassReg > SPReg]
  			ifFalse: [ClassReg >= SPReg]] whileTrue:
  		[receiver[SendNumArgsReg] := *ClassReg.
  		 SendNumArgsReg := SendNumArgsReg + 1]]"
  	coInterpreter marryFrameCopiesTemps ifFalse:
  		[cogit MoveCq: objectMemory nilObject R: TempReg].
  	cogit
  		MoveR: FPReg R: ClassReg;
  		AddCq: FoxMFReceiver R: ClassReg;
  		AddCq: ReceiverIndex + 1 + (objectMemory baseHeaderSize / objectMemory wordSize) R: SendNumArgsReg.
  	loopHead :=
  	cogit SubCq: objectMemory wordSize R: ClassReg.
  	cogit CmpR: SPReg R: ClassReg.
  	"If on a CISC there's a retpc for the trampoline call on top of stack; if on a RISC there isn't."
  	exit := cogit backEnd hasLinkRegister
  				ifTrue: [cogit JumpBelow: 0]
  				ifFalse: [cogit JumpBelowOrEqual: 0].
  	coInterpreter marryFrameCopiesTemps ifTrue:
  		[cogit MoveMw: 0 r: ClassReg R: TempReg].
  	cogit
  		MoveR: TempReg Xwr: SendNumArgsReg R: ReceiverResultReg;
  		AddCq: 1 R: SendNumArgsReg;
  		Jump: loopHead.
  	exit jmpTarget: cogit Label.
  
  	cogit RetN: 0.
  	
  	jumpNeedScavenge jmpTarget: cogit Label.
  	cogit backEnd saveAndRestoreLinkRegAround:
+ 		[cogit
+ 			CallRT: ceScheduleScavengeTrampoline
+ 			registersToBeSavedMask: (cogit registerMaskFor: ReceiverResultReg and: SendNumArgsReg and: ClassReg)].
- 		[cogit CallRT: ceScheduleScavengeTrampoline].
  	cogit Jump: continuation.
  	^0!

Item was changed:
  ----- Method: CogObjectRepresentationForSpur>>genStoreCheckTrampoline (in category 'initialization') -----
  genStoreCheckTrampoline
  	| jumpSC |
  	<var: #jumpSC type: #'AbstractInstruction *'>
  	<inline: true>
  	CheckRememberedInTrampoline ifTrue:
  		[cogit zeroOpcodeIndex.
  		 jumpSC := self genCheckRememberedBitOf: ReceiverResultReg scratch: cogit backEnd cResultRegister.
  		 self assert: jumpSC opcode = JumpNonZero.
  		 jumpSC opcode: JumpZero.
  		 cogit RetN: 0.
  		 jumpSC jmpTarget: cogit Label].
  	^cogit
  		genTrampolineFor: #remember:
  		called: 'ceStoreCheckTrampoline'
  		numArgs: 1
  		arg: ReceiverResultReg
  		arg: nil
  		arg: nil
  		arg: nil
+ 		regsToSave: (CallerSavedRegisterMask bitClear: (cogit registerMaskFor: ReceiverResultReg))
- 		regsToSave: (cogit callerSavedRegMask bitClear: (cogit registerMaskFor: ReceiverResultReg))
  		pushLinkReg: true
  		resultReg: cogit returnRegForStoreCheck
  		appendOpcodes: CheckRememberedInTrampoline!

Item was changed:
  ----- Method: CogObjectRepresentationForSpur>>generateObjectRepresentationTrampolines (in category 'initialization') -----
  generateObjectRepresentationTrampolines
  	"Do the store check.  Answer the argument for the benefit of the code generator;
  	 ReceiverResultReg may be caller-saved and hence smashed by this call.  Answering
  	 it allows the code generator to reload ReceiverResultReg cheaply.
  	 In Spur the only thing we leave to the run-time is adding the receiver to the
  	 remembered set and setting its isRemembered bit."
  	self 
  		cppIf: IMMUTABILITY
  		ifTrue: 
  			[self cCode: [] inSmalltalk:
  				[ceStoreTrampolines := CArrayAccessor on: (Array new: NumStoreTrampolines)].
  			 0 to: NumStoreTrampolines - 1 do:
  				[:instVarIndex |
  				 ceStoreTrampolines
  					at: instVarIndex
  					put: (self 
  							genStoreTrampolineCalled: (cogit 
  															trampolineName: 'ceStoreTrampoline' 
  															numArgs: instVarIndex 
  															limit: NumStoreTrampolines - 2) 
  							instVarIndex: instVarIndex)]].
  	ceStoreCheckTrampoline := self genStoreCheckTrampoline.
  	ceStoreCheckContextReceiverTrampoline := self genStoreCheckContextReceiverTrampoline.
  	ceScheduleScavengeTrampoline := cogit
  											genTrampolineFor: #ceScheduleScavenge
  											called: 'ceScheduleScavengeTrampoline'
+ 											regsToSave: CallerSavedRegisterMask.
- 											regsToSave: cogit callerSavedRegMask.
  	ceSmallActiveContextInMethodTrampoline := self genActiveContextTrampolineLarge: false inBlock: false called: 'ceSmallMethodContext'.
  	ceSmallActiveContextInBlockTrampoline := self genActiveContextTrampolineLarge: false inBlock: true called: 'ceSmallBlockContext'.
  	ceLargeActiveContextInMethodTrampoline := self genActiveContextTrampolineLarge: true inBlock: false called: 'ceLargeMethodContext'.
  	ceLargeActiveContextInBlockTrampoline := self genActiveContextTrampolineLarge: true inBlock: true called: 'ceLargeBlockContext'!

Item was changed:
  ----- Method: CogObjectRepresentationForSqueakV3>>generateObjectRepresentationTrampolines (in category 'initialization') -----
  generateObjectRepresentationTrampolines
  	"Do the store check.  Answer the argument for the benefit of the code generator;
  	 ReceiverResultReg may be caller-saved and hence smashed by this call.  Answering
  	 it allows the code generator to reload ReceiverResultReg cheaply."
  	ceStoreCheckTrampoline := cogit
  									genTrampolineFor: #ceStoreCheck:
  									called: 'ceStoreCheckTrampoline'
  									arg: ReceiverResultReg
+ 									regsToSave: (CallerSavedRegisterMask bitClear: (cogit registerMaskFor: ReceiverResultReg))
- 									regsToSave: (cogit callerSavedRegMask bitClear: (cogit registerMaskFor: ReceiverResultReg))
  									result: cogit returnRegForStoreCheck.
  	ceCreateNewArrayTrampoline := cogit genTrampolineFor: #ceNewArraySlotSize:
  											called: 'ceCreateNewArrayTrampoline'
  											arg: SendNumArgsReg
+ 											regsToSave: (CallerSavedRegisterMask bitClear: (cogit registerMaskFor: ReceiverResultReg))
- 											regsToSave: (cogit callerSavedRegMask bitClear: (cogit registerMaskFor: ReceiverResultReg))
  											result: ReceiverResultReg.
  	cePositive32BitIntegerTrampoline := cogit genTrampolineFor: #positive32BitIntegerFor:
  												called: 'cePositive32BitIntegerTrampoline'
  												arg: ReceiverResultReg
+ 												regsToSave: (CallerSavedRegisterMask bitClear: (cogit registerMaskFor: ReceiverResultReg))
- 												regsToSave: (cogit callerSavedRegMask bitClear: (cogit registerMaskFor: ReceiverResultReg))
  												result: TempReg.
  	ceActiveContextTrampoline := self genActiveContextTrampoline.
  	ceClosureCopyTrampoline := cogit genTrampolineFor: #ceClosureCopyDescriptor:
  										called: 'ceClosureCopyTrampoline'
  										arg: SendNumArgsReg
+ 										regsToSave: (CallerSavedRegisterMask bitClear: (cogit registerMaskFor: ReceiverResultReg))
- 										regsToSave: (cogit callerSavedRegMask bitClear: (cogit registerMaskFor: ReceiverResultReg))
  										result: ReceiverResultReg!

Item was changed:
  ----- Method: CogX64Compiler class>>initializeAbstractRegisters (in category 'class initialization') -----
  initializeAbstractRegisters
  	"Assign the abstract registers with the identities/indices of the relevant concrete registers."
  	"[1] Figure 3.4 Register Usage in
  		System V Application Binary Interface
+ 		AMD64 Architecture Processor Supplement"
- 		AMD64 Architecture Processor Supplement
  
+ 	super initializeAbstractRegisters.
+ 
+ 	"N.B. RAX RCX & RDX are caller-save (scratch) registers.  Hence we use RCX for class and RDX for
- 	N.B. RAX RCX & RDX are caller-save (scratch) registers.  Hence we use RCX for class and RDX for
  		receiver/result since these are written in all normal sends."
  
+ 	CallerSavedRegisterMask := self
+ 									registerMaskFor: RAX
+ 									and: RCX
+ 									and: RDX
+ 									and: RSI
+ 									and: RDI
+ 									and: R8
+ 									and: R9
+ 									and: R10
+ 									and: R11.
- 	super initializeAbstractRegisters.
  
  	TempReg				:= RAX.
  	ClassReg				:= RCX.
  	ReceiverResultReg		:= RDX.
  	SendNumArgsReg		:= R9.
  	SPReg					:= RSP.
  	FPReg					:= RBP.
  	Arg0Reg				:= RDI. "So as to agree with C ABI arg 0"
  	Arg1Reg				:= RSI. "So as to agree with C ABI arg 1"
  	VarBaseReg			:= RBX. "Must be callee saved"
  	"R8 is either RISCTempReg or Extra6Reg depending on subclass."
  	Extra0Reg				:= R10.
  	Extra1Reg				:= R11.
  	Extra2Reg				:= R12.
  	Extra3Reg				:= R13.
  	Extra4Reg				:= R14.
  	Extra5Reg				:= R15.
  
  	DPFPReg0				:= XMM0L.
  	DPFPReg1				:= XMM1L.
  	DPFPReg2				:= XMM2L.
  	DPFPReg3				:= XMM3L.
  	DPFPReg4				:= XMM4L.
  	DPFPReg5				:= XMM5L.
  	DPFPReg6				:= XMM6L.
  	DPFPReg7				:= XMM7L.
  	DPFPReg8				:= XMM8L.
  	DPFPReg9				:= XMM9L.
  	DPFPReg10				:= XMM10L.
  	DPFPReg11				:= XMM11L.
  	DPFPReg12				:= XMM12L.
  	DPFPReg13				:= XMM13L.
  	DPFPReg14				:= XMM14L.
  	DPFPReg15				:= XMM15L!

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

Item was changed:
  ----- Method: CogX64Compiler>>genMarshallNArgs:arg:arg:arg:arg: (in category 'abi') -----
  genMarshallNArgs: numArgs arg: regOrConst0 arg: regOrConst1 arg: regOrConst2 arg: regOrConst3
  	"Generate the code to pass up to four arguments in a C run-time call.  Hack: each argument is
  	 either a negative number, which encodes a constant, or a non-negative number, that of a register.
  
  	 Run-time calls have no more than four arguments, so chosen so that on ARM, where in its C ABI the
  	 first four integer arguments are passed in registers, all arguments can be passed in registers.  We
  	 defer to the back end to generate this code not so much that the back end knows whether it uses
  	 the stack or registers to pass arguments (it does, but...). In fact we defer for an extremely evil reason.
  	 Doing so allows the x64 (where up to 6 args are passed) to assign the register arguments in an order
  	 that allows some of the argument registers to be used for specific abstract  registers, specifically
  	 ReceiverResultReg and ClassReg.  This is evil, evil, evil, but also it's really nice to keep using the old
  	 register assignments the original author has grown accustomed to.
  
  	 How can this possibly work?  Look at Cogit class>>runtime for a list of the run-time calls and their
  	 arguments, including which arguments are passed in which registers.  Look at CogX64Compiler's
  	 subclass implementations of initializeAbstractRegisters.  There are no calls in which ReceiverResultReg
  	 (RDX) and/or ClassReg (RCX) are passed along with Arg0Reg and Arg1Reg, and none in which the use of
  	 either ReceiverResultReg or ClassReg conflict for args 3 & 4.  So if args are assigned in order, the
  	 registers do not get overwritten.  Yes, this is evil, but it's so nice to continue to use RCX & RDX.
  
  	 Argument registers for args 0 to 3 in SysV are RDI RSI RDX RCX, and in Win64 are RDI RSI R8 R9"
  	<inline: true>
  	numArgs = 0 ifTrue: [^self].
  	(cogit isTrampolineArgConstant: regOrConst0)
+ 		ifTrue: [cogit MoveCq: (cogit trampolineArgValue: regOrConst0) R: RDI] "a.k.a. Arg0Reg"
- 		ifTrue: [cogit MoveCq: (cogit trampolineArgValue: regOrConst0) R: RDI]
  		ifFalse:
  			[regOrConst0 ~= RDI ifTrue:
  				[cogit MoveR: regOrConst0 R: RDI]].
  	numArgs = 1 ifTrue: [^self].
  	(cogit isTrampolineArgConstant: regOrConst1)
+ 		ifTrue: [cogit MoveCq: (cogit trampolineArgValue: regOrConst1) R: RSI] "a.k.a. Arg1Reg"
- 		ifTrue: [cogit MoveCq: (cogit trampolineArgValue: regOrConst1) R: RSI]
  		ifFalse:
  			[regOrConst1 ~= RSI ifTrue:
  				[cogit MoveR: regOrConst1 R: RSI]].
  	numArgs = 2 ifTrue: [^self].
  	self cppIf: ABI == #SysV ifTrue:
  		[(cogit isTrampolineArgConstant: regOrConst2)
+ 			ifTrue: [cogit MoveCq: (cogit trampolineArgValue: regOrConst2) R: RDX] "a.k.a. ReceiverResultReg"
- 			ifTrue: [cogit MoveCq: (cogit trampolineArgValue: regOrConst2) R: RDX]
  			ifFalse:
  				[regOrConst2 ~= RDX ifTrue:
  					[cogit MoveR: regOrConst2 R: RDX]].
  		 numArgs = 3 ifTrue: [^self].
  		 (cogit isTrampolineArgConstant: regOrConst3)
+ 				ifTrue: [cogit MoveCq: (cogit trampolineArgValue: regOrConst3) R: RCX] "a.k.a. ClassReg"
- 				ifTrue: [cogit MoveCq: (cogit trampolineArgValue: regOrConst3) R: RCX]
  				ifFalse:
  					[regOrConst3 ~= RCX ifTrue:
  						[cogit MoveR: regOrConst3 R: RCX]]].
+ 	self cppIf: ABI == #MSVC ifTrue: "completely untested..."
- 	self cppIf: ABI == #MSVC ifTrue:
  		[(cogit isTrampolineArgConstant: regOrConst2)
+ 			ifTrue: [cogit MoveCq: (cogit trampolineArgValue: regOrConst2) R: R8] "a.k.a. RISCTempReg in CogInLineLiteralsX64Compiler and Extra6Reg in CogOutOfLineLiteralsX64Compiler"
- 			ifTrue: [cogit MoveCq: (cogit trampolineArgValue: regOrConst2) R: R8]
  			ifFalse:
  				[regOrConst2 ~= R8 ifTrue:
  					[cogit MoveR: regOrConst2 R: R8]].
  		 numArgs = 3 ifTrue: [^self].
  		 (cogit isTrampolineArgConstant: regOrConst3)
+ 				ifTrue: [cogit MoveCq: (cogit trampolineArgValue: regOrConst3) R: R9] "a.k.a. SendNumArgsReg"
- 				ifTrue: [cogit MoveCq: (cogit trampolineArgValue: regOrConst3) R: R9]
  				ifFalse:
  					[regOrConst3 ~= R9 ifTrue:
  						[cogit MoveR: regOrConst3 R: R9]]].
  	self assert: numArgs <= 4!

Item was changed:
  ----- Method: CogX64Compiler>>nameForRegister: (in category 'printing') -----
  nameForRegister: reg "<Integer>"
  	<doNotGenerate>
+ 	| default |
+ 	default := super nameForRegister: reg.
+ 	^(default last = $?
+ 	  and: [reg between: 0 and: 15])
+ 		ifTrue: [#(RAX RCX RDX RBX RSP RBP RSI RDI R8 R9 R10 R11 R12 R13 R14 R15) at: reg + 1]
+ 		ifFalse: [default]!
- 	(reg between: 0 and: 15) ifTrue:
- 		[^#(RAX RCX RDX RBX RSP RBP RSI RDI R8 R9 R10 R11 R12 R13 R14 R15) at: reg + 1].
- 	^super nameForRegister: reg!

Item was changed:
  CogClass subclass: #Cogit
+ 	instanceVariableNames: 'coInterpreter objectMemory objectRepresentation processor threadManager methodZone methodZoneBase codeBase minValidCallAddress lastNInstructions simulatedAddresses simulatedTrampolines simulatedVariableGetters simulatedVariableSetters printRegisters printInstructions compilationTrace clickConfirm breakPC breakBlock singleStep guardPageSize traceFlags traceStores breakMethod methodObj enumeratingCogMethod methodHeader initialPC endPC methodOrBlockNumArgs inBlock needsFrame hasYoungReferent primitiveIndex backEnd literalsManager postCompileHook methodLabel stackCheckLabel blockEntryLabel blockEntryNoContextSwitch blockNoContextSwitchOffset stackOverflowCall sendMiss missOffset entryPointMask checkedEntryAlignment uncheckedEntryAlignment cmEntryOffset entry cmNoCheckEntryOffset noCheckEntry fullBlockEntry cbEntryOffset fullBlockNoContextSwitchEntry cbNoSwitchEntryOffset picMNUAbort picInterpretAbort endCPICCase0 endCPICCase1 firstCPICCaseOffset cPICCaseSize cPICEndSize closedPICSize openPICSize fixups abstractOpcodes generatorTable byte0 byte1 byte2 byte3 bytecodePC bytecodeSetOffset opcodeIndex numAbstractOpcodes blockStarts blockCount labelCounter cStackAlignment expectedSPAlignment expectedFPAlignment codeModified maxLitIndex ceMethodAbortTrampoline cePICAbortTrampoline ceCheckForInterruptTrampoline ceCPICMissTrampoline ceReturnToInterpreterTrampoline ceBaseFrameReturnTrampoline ceSendMustBeBooleanAddTrueTrampoline ceSendMustBeBooleanAddFalseTrampoline ceCannotResumeTrampoline ceEnterCogCodePopReceiverReg ceCallCogCodePopReceiverReg ceCallCogCodePopReceiverAndClassRegs cePrimReturnEnterCogCode cePrimReturnEnterCogCodeProfiling ceNonLocalReturnTrampoline ceFetchContextInstVarTrampoline ceStoreContextInstVarTrampoline ceEnclosingObjectTrampoline ceFlushICache ceCheckFeaturesFunction ceTraceLinkedSendTrampoline ceTraceBlockActivationTrampoline ceTraceStoreTrampoline ceGetFP ceGetSP ceCaptureCStackPointers ordinarySendTrampolines superSendTrampolines directedSuperSendTrampolines dynamicSuperSendTrampolines outerSendTrampolines selfSendTrampolines firstSend lastSend realCEEnterCogCodePopReceiverReg realCECallCogCodePopReceiverReg realCECallCogCodePopReceiverAndClassRegs trampolineTableIndex trampolineAddresses objectReferencesInRuntime runtimeObjectRefIndex cFramePointerInUse debugPrimCallStackOffset ceTryLockVMOwner ceUnlockVMOwner extA extB tempOop numIRCs indexOfIRC theIRCs implicitReceiverSendTrampolines cogMethodSurrogateClass cogBlockMethodSurrogateClass nsSendCacheSurrogateClass CStackPointer CFramePointer cPICPrototype cPICEndOfCodeOffset cPICEndOfCodeLabel maxCPICCases debugBytecodePointers debugOpcodeIndices disassemblingMethod'
- 	instanceVariableNames: 'coInterpreter objectMemory objectRepresentation processor threadManager methodZone methodZoneBase codeBase minValidCallAddress lastNInstructions simulatedAddresses simulatedTrampolines simulatedVariableGetters simulatedVariableSetters printRegisters printInstructions compilationTrace clickConfirm breakPC breakBlock singleStep guardPageSize traceFlags traceStores breakMethod methodObj enumeratingCogMethod methodHeader initialPC endPC methodOrBlockNumArgs inBlock needsFrame hasYoungReferent primitiveIndex backEnd literalsManager callerSavedRegMask postCompileHook methodLabel stackCheckLabel blockEntryLabel blockEntryNoContextSwitch blockNoContextSwitchOffset stackOverflowCall sendMiss missOffset entryPointMask checkedEntryAlignment uncheckedEntryAlignment cmEntryOffset entry cmNoCheckEntryOffset noCheckEntry fullBlockEntry cbEntryOffset fullBlockNoContextSwitchEntry cbNoSwitchEntryOffset picMNUAbort picInterpretAbort endCPICCase0 endCPICCase1 firstCPICCaseOffset cPICCaseSize cPICEndSize closedPICSize openPICSize fixups abstractOpcodes generatorTable byte0 byte1 byte2 byte3 bytecodePC bytecodeSetOffset opcodeIndex numAbstractOpcodes blockStarts blockCount labelCounter cStackAlignment expectedSPAlignment expectedFPAlignment codeModified maxLitIndex ceMethodAbortTrampoline cePICAbortTrampoline ceCheckForInterruptTrampoline ceCPICMissTrampoline ceReturnToInterpreterTrampoline ceBaseFrameReturnTrampoline ceSendMustBeBooleanAddTrueTrampoline ceSendMustBeBooleanAddFalseTrampoline ceCannotResumeTrampoline ceEnterCogCodePopReceiverReg ceCallCogCodePopReceiverReg ceCallCogCodePopReceiverAndClassRegs cePrimReturnEnterCogCode cePrimReturnEnterCogCodeProfiling ceNonLocalReturnTrampoline ceFetchContextInstVarTrampoline ceStoreContextInstVarTrampoline ceEnclosingObjectTrampoline ceFlushICache ceCheckFeaturesFunction ceTraceLinkedSendTrampoline ceTraceBlockActivationTrampoline ceTraceStoreTrampoline ceGetFP ceGetSP ceCaptureCStackPointers ordinarySendTrampolines superSendTrampolines directedSuperSendTrampolines dynamicSuperSendTrampolines outerSendTrampolines selfSendTrampolines firstSend lastSend realCEEnterCogCodePopReceiverReg realCECallCogCodePopReceiverReg realCECallCogCodePopReceiverAndClassRegs trampolineTableIndex trampolineAddresses objectReferencesInRuntime runtimeObjectRefIndex cFramePointerInUse debugPrimCallStackOffset ceTryLockVMOwner ceUnlockVMOwner extA extB tempOop numIRCs indexOfIRC theIRCs implicitReceiverSendTrampolines cogMethodSurrogateClass cogBlockMethodSurrogateClass nsSendCacheSurrogateClass CStackPointer CFramePointer cPICPrototype cPICEndOfCodeOffset cPICEndOfCodeLabel maxCPICCases debugBytecodePointers debugOpcodeIndices disassemblingMethod'
  	classVariableNames: 'AltBlockCreationBytecodeSize AltFirstSpecialSelector AltNSSendIsPCAnnotated AltNumSpecialSelectors AnnotationConstantNames AnnotationShift AnnotationsWithBytecodePCs BlockCreationBytecodeSize Debug DisplacementMask DisplacementX2N EagerInstructionDecoration FirstAnnotation FirstSpecialSelector HasBytecodePC IsAbsPCReference IsAnnotationExtension IsDirectedSuperSend IsDisplacementX2N IsNSDynamicSuperSend IsNSImplicitReceiverSend IsNSSelfSend IsNSSendCall IsObjectReference IsRelativeCall IsSendCall IsSuperSend MapEnd MaxCompiledPrimitiveIndex MaxStackAllocSize MaxX2NDisplacement NSCClassTagIndex NSCEnclosingObjectIndex NSCNumArgsIndex NSCSelectorIndex NSCTargetIndex NSSendIsPCAnnotated NeedsFixupFlag NumObjRefsInRuntime NumOopsPerNSC NumSpecialSelectors NumTrampolines ProcessorClass'
  	poolDictionaries: 'CogAbstractRegisters CogCompilationConstants CogMethodConstants CogRTLOpcodes VMBasicConstants VMBytecodeConstants VMObjectIndices VMStackFrameOffsets'
  	category: 'VMMaker-JIT'!
  Cogit class
  	instanceVariableNames: 'generatorTable primitiveTable'!
  
  !Cogit commentStamp: 'eem 4/6/2015 15:56' prior: 0!
  I am the code generator for the Cog VM.  My job is to produce machine code versions of methods for faster execution and to manage inline caches for faster send performance.  I can be tested in the current image using my class-side in-image compilation facilities.  e.g. try
  
  	StackToRegisterMappingCogit genAndDis: (Integer >> #benchFib)
  
  I have concrete subclasses that implement different levels of optimization:
  	SimpleStackBasedCogit is the simplest code generator.
  
  	StackToRegisterMappingCogit is the current production code generator  It defers pushing operands
  	to the stack until necessary and implements a register-based calling convention for low-arity sends.
  
  	StackToRegisterMappingCogit is an experimental code generator with support for counting
  	conditional branches, intended to support adaptive optimization.
  
  coInterpreter <CoInterpreterSimulator>
  	the VM's interpreter with which I cooperate
  methodZoneManager <CogMethodZoneManager>
  	the manager of the machine code zone
  objectRepresentation <CogObjectRepresentation>
  	the object used to generate object accesses
  processor <BochsIA32Alien|?>
  	the simulator that executes the IA32/x86 machine code I generate when simulating execution in Smalltalk
  simulatedTrampolines <Dictionary of Integer -> MessageSend>
  	the dictionary mapping trap jump addresses to run-time routines used to warp from simulated machine code in to the Smalltalk run-time.
  simulatedVariableGetters <Dictionary of Integer -> MessageSend>
  	the dictionary mapping trap read addresses to variables in run-time objects used to allow simulated machine code to read variables in the Smalltalk run-time.
  simulatedVariableSetters <Dictionary of Integer -> MessageSend>
  	the dictionary mapping trap write addresses to variables in run-time objects used to allow simulated machine code to write variables in the Smalltalk run-time.
  printRegisters printInstructions clickConfirm <Boolean>
  	flags controlling debug printing and code simulation
  breakPC <Integer>
  	machine code pc breakpoint
  cFramePointer cStackPointer <Integer>
  	the variables representing the C stack & frame pointers, which must change on FFI callback and return
  selectorOop <sqInt>
  	the oop of the methodObj being compiled
  methodObj <sqInt>
  	the bytecode method being compiled
  initialPC endPC <Integer>
  	the start and end pcs of the methodObj being compiled
  methodOrBlockNumArgs <Integer>
  	argument count of current method or block being compiled
  needsFrame <Boolean>
  	whether methodObj or block needs a frame to execute
  primitiveIndex <Integer>
  	primitive index of current method being compiled
  methodLabel <CogAbstractOpcode>
  	label for the method header
  blockEntryLabel <CogAbstractOpcode>
  	label for the start of the block dispatch code
  stackOverflowCall <CogAbstractOpcode>
  	label for the call of ceStackOverflow in the method prolog
  sendMissCall <CogAbstractOpcode>
  	label for the call of ceSICMiss in the method prolog
  entryOffset <Integer>
  	offset of method entry code from start (header) of method
  entry <CogAbstractOpcode>
  	label for the first instruction of the method entry code
  noCheckEntryOffset <Integer>
  	offset of the start of a method proper (after the method entry code) from start (header) of method
  noCheckEntry <CogAbstractOpcode>
  	label for the first instruction of start of a method proper
  fixups <Array of <AbstractOpcode Label | nil>>
  	the labels for forward jumps that will be fixed up when reaching the relevant bytecode.  fixup shas one element per byte in methodObj's bytecode
  abstractOpcodes <Array of <AbstractOpcode>>
  	the code generated when compiling methodObj
  byte0 byte1 byte2 byte3 <Integer>
  	individual bytes of current bytecode being compiled in methodObj
  bytecodePointer <Integer>
  	bytecode pc (same as Smalltalk) of the current bytecode being compiled
  opcodeIndex <Integer>
  	the index of the next free entry in abstractOpcodes (this code is translated into C where OrderedCollection et al do not exist)
  numAbstractOpcodes <Integer>
  	the number of elements in abstractOpcocdes
  blockStarts <Array of <BlockStart>>
  	the starts of blocks in the current method
  blockCount
  	the index into blockStarts as they are being noted, and hence eventually the total number of blocks in the current method
  labelCounter <Integer>
  	a nicety for numbering labels not needed in the production system but probably not expensive enough to worry about
  ceStackOverflowTrampoline <Integer>
  ceSend0ArgsTrampoline <Integer>
  ceSend1ArgsTrampoline <Integer>
  ceSend2ArgsTrampoline <Integer>
  ceSendNArgsTrampoline <Integer>
  ceSendSuper0ArgsTrampoline <Integer>
  ceSendSuper1ArgsTrampoline <Integer>
  ceSendSuper2ArgsTrampoline <Integer>
  ceSendSuperNArgsTrampoline <Integer>
  ceSICMissTrampoline <Integer>
  ceCPICMissTrampoline <Integer>
  ceStoreCheckTrampoline <Integer>
  ceReturnToInterpreterTrampoline <Integer>
  ceBaseFrameReturnTrampoline <Integer>
  ceSendMustBeBooleanTrampoline <Integer>
  ceClosureCopyTrampoline <Integer>
  	the various trampolines (system-call-like jumps from machine code to the run-time).
  	See Cogit>>generateTrampolines for the mapping from trampoline to run-time
  	routine and then read the run-time routine for a funcitonal description.
  ceEnterCogCodePopReceiverReg <Integer>
  	the enilopmart (jump from run-time to machine-code)
  methodZoneBase <Integer>
  !
  Cogit class
  	instanceVariableNames: 'generatorTable primitiveTable'!

Item was added:
+ ----- Method: Cogit>>CallFullRT:registersToBeSavedMask: (in category 'compile abstract instructions') -----
+ CallFullRT: callTarget registersToBeSavedMask: registersToBeSaved
+ 	<returnTypeC: #'AbstractInstruction *'>
+ 	| callerSavedRegsToBeSaved lastInst reg registersToBePushed |
+ 	<var: 'lastInst' type: #'AbstractInstruction *'>
+ 	callerSavedRegsToBeSaved := CallerSavedRegisterMask bitAnd: registersToBeSaved.
+ 
+ 	backEnd canPushPopMultipleRegisters
+ 		ifTrue: [backEnd genPushRegisterMask: callerSavedRegsToBeSaved]
+ 		ifFalse:
+ 			[registersToBePushed := callerSavedRegsToBeSaved.
+ 			 reg := 0.
+ 			 [registersToBePushed ~= 0] whileTrue:
+ 				[(registersToBePushed anyMask: 1) ifTrue:
+ 					[self PushR: reg].
+ 				 reg := reg + 1.
+ 				 registersToBePushed := registersToBePushed >>> 1]].
+ 
+ 	lastInst := self CallFullRT: callTarget.
+ 
+ 	backEnd canPushPopMultipleRegisters
+ 		ifTrue: [^backEnd genPopRegisterMask: callerSavedRegsToBeSaved]
+ 		ifFalse:
+ 			[[reg >= 0] whileTrue:
+ 				[(callerSavedRegsToBeSaved anyMask: 1 << reg) ifTrue:
+ 					[lastInst := self PopR: reg].
+ 				 reg := reg - 1].
+ 
+ 			 ^lastInst]!

Item was added:
+ ----- Method: Cogit>>CallRT:registersToBeSavedMask: (in category 'compile abstract instructions') -----
+ CallRT: callTarget registersToBeSavedMask: registersToBeSaved
+ 	<returnTypeC: #'AbstractInstruction *'>
+ 	| callerSavedRegsToBeSaved lastInst reg registersToBePushed |
+ 	<var: 'lastInst' type: #'AbstractInstruction *'>
+ 	callerSavedRegsToBeSaved := CallerSavedRegisterMask bitAnd: registersToBeSaved.
+ 
+ 	backEnd canPushPopMultipleRegisters
+ 		ifTrue: [backEnd genPushRegisterMask: callerSavedRegsToBeSaved]
+ 		ifFalse:
+ 			[registersToBePushed := callerSavedRegsToBeSaved.
+ 			 reg := 0.
+ 			 [registersToBePushed ~= 0] whileTrue:
+ 				[(registersToBePushed anyMask: 1) ifTrue:
+ 					[self PushR: reg].
+ 				 reg := reg + 1.
+ 				 registersToBePushed := registersToBePushed >>> 1]].
+ 
+ 	lastInst := self CallRT: callTarget.
+ 
+ 	backEnd canPushPopMultipleRegisters
+ 		ifTrue: [^backEnd genPopRegisterMask: callerSavedRegsToBeSaved]
+ 		ifFalse:
+ 			[[reg >= 0] whileTrue:
+ 				[(callerSavedRegsToBeSaved anyMask: 1 << reg) ifTrue:
+ 					[lastInst := self PopR: reg].
+ 				 reg := reg - 1].
+ 
+ 			 ^lastInst]!

Item was removed:
- ----- Method: Cogit>>callerSavedRegMask (in category 'accessing') -----
- callerSavedRegMask
- 	<cmacro: '() callerSavedRegMask'>
- 	^callerSavedRegMask!

Item was changed:
  ----- Method: Cogit>>handleABICallOrJumpSimulationTrap:evaluable: (in category 'simulation only') -----
  handleABICallOrJumpSimulationTrap: aProcessorSimulationTrap evaluable: evaluable
  	<doNotGenerate>
  
  	self assert: aProcessorSimulationTrap type = #call.
  	processor
  		simulateLeafCallOf: aProcessorSimulationTrap address
  		nextpc: aProcessorSimulationTrap nextpc
  		memory: coInterpreter memory.
  	self recordInstruction: {'(simulated call of '. aProcessorSimulationTrap address. '/'. evaluable selector. ')'}.
+ 	((printRegisters or: [printInstructions]) and: [clickConfirm]) ifTrue:
+  		[(self confirm: 'skip run-time call?') ifFalse:
+ 			[clickConfirm := false. self halt]].
  	evaluable valueWithArguments: (processor
  										postCallArgumentsNumArgs: evaluable numArgs
  										in: coInterpreter memory).
  	self recordInstruction: {'(simulated return to '. processor retpcIn: coInterpreter memory. ')'}.
  	processor
  		smashABICallerSavedRegistersWithValuesFrom: 16r80000000 by: objectMemory wordSize;
  		simulateLeafReturnIn: coInterpreter memory!

Item was changed:
  ----- Method: Cogit>>initializeBackend (in category 'initialization') -----
  initializeBackend
  	methodLabel machineCodeSize: 0.
  	methodLabel opcode: Label.
  	methodLabel operands at: 0 put: 0.
  	methodLabel operands at: 1 put: 0. "label offset"
- 	callerSavedRegMask := backEnd callerSavedRegisterMask.
  	backEnd hasVarBaseRegister ifTrue:
+ 		[self assert: ((self registerMaskFor: VarBaseReg) noMask: CallerSavedRegisterMask)].
- 		[self assert: ((self registerMaskFor: VarBaseReg) noMask: callerSavedRegMask)].
  	literalsManager allocateLiterals: 4; resetLiterals!

Item was changed:
  ----- Method: Cogit>>printCogMethodFor: (in category 'printing') -----
  printCogMethodFor: address
  	<api>
  	<var: #address type: #'void *'>
  	| cogMethod |
  	<var: #cogMethod type: #'CogMethod *'>
  	cogMethod := methodZone methodFor: address.
  	cogMethod = 0
+ 		ifTrue: [(self codeEntryFor: address)
+ 					ifNil: [coInterpreter print: 'not a method'; cr]
+ 					ifNotNil: [coInterpreter print: 'trampoline '; print: (self codeEntryNameFor: address); cr]]
- 		ifTrue: [coInterpreter print: 'not a method'; cr]
  		ifFalse: [coInterpreter printCogMethod: cogMethod]!

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

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genTraceStoreTrampoline (in category 'initialization') -----
  genTraceStoreTrampoline
  	ceTraceStoreTrampoline := self genTrampolineFor: #ceTraceStoreOf:into:
  										called: 'ceTraceStoreTrampoline'
  										arg: ClassReg
  										arg: ReceiverResultReg
+ 										regsToSave: CallerSavedRegisterMask!
- 										regsToSave: callerSavedRegMask!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>generateTracingTrampolines (in category 'initialization') -----
  generateTracingTrampolines
  	"Generate trampolines for tracing.  In the simulator we can save a lot of time
  	 and avoid noise instructions in the lastNInstructions log by short-cutting these
  	 trampolines, but we need them in the real vm."
  	ceTraceLinkedSendTrampoline :=
  		self genTrampolineFor: #ceTraceLinkedSend:
  			called: 'ceTraceLinkedSendTrampoline'
  			arg: ReceiverResultReg
+ 			regsToSave: CallerSavedRegisterMask.
- 			regsToSave: callerSavedRegMask.
  	ceTraceBlockActivationTrampoline :=
  		self genTrampolineFor: #ceTraceBlockActivation
  			called: 'ceTraceBlockActivationTrampoline'
+ 			regsToSave: CallerSavedRegisterMask..
- 			regsToSave: callerSavedRegMask..
  	ceTraceStoreTrampoline :=
  		self genTrampolineFor: #ceTraceStoreOf:into:
  			called: 'ceTraceStoreTrampoline'
  			arg: ClassReg
  			arg: ReceiverResultReg
+ 			regsToSave: CallerSavedRegisterMask..
- 			regsToSave: callerSavedRegMask..
  	self cCode: [] inSmalltalk:
  		[ceTraceLinkedSendTrampoline := self simulatedTrampolineFor: #ceShortCutTraceLinkedSend:.
  		 ceTraceBlockActivationTrampoline := self simulatedTrampolineFor: #ceShortCutTraceBlockActivation:.
  		 ceTraceStoreTrampoline := self simulatedTrampolineFor: #ceShortCutTraceStore:]!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>isCallerSavedReg: (in category 'register management') -----
  isCallerSavedReg: reg
  	<inline: true>
+ 	^self register: reg isInMask: CallerSavedRegisterMask!
- 	^self register: reg isInMask: callerSavedRegMask!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>generateTracingTrampolines (in category 'initialization') -----
  generateTracingTrampolines
  	"Generate trampolines for tracing.  In the simulator we can save a lot of time
  	 and avoid noise instructions in the lastNInstructions log by short-cutting these
  	 trampolines, but we need them in the real vm."
  	ceTraceLinkedSendTrampoline :=
  		self genTrampolineFor: #ceTraceLinkedSend:
  			called: 'ceTraceLinkedSendTrampoline'
  			arg: ReceiverResultReg
+ 			regsToSave: CallerSavedRegisterMask..
- 			regsToSave: callerSavedRegMask..
  	ceTraceBlockActivationTrampoline :=
  		self genTrampolineFor: #ceTraceBlockActivation
  			called: 'ceTraceBlockActivationTrampoline'
+ 			regsToSave: CallerSavedRegisterMask..
- 			regsToSave: callerSavedRegMask..
  	ceTraceStoreTrampoline :=
  		self genTrampolineFor: #ceTraceStoreOf:into:
  			called: 'ceTraceStoreTrampoline'
  			arg: TempReg
  			arg: ReceiverResultReg
+ 			regsToSave: CallerSavedRegisterMask..
- 			regsToSave: callerSavedRegMask..
  	self cCode: [] inSmalltalk:
  		[ceTraceLinkedSendTrampoline := self simulatedTrampolineFor: #ceShortCutTraceLinkedSend:.
  		 ceTraceBlockActivationTrampoline := self simulatedTrampolineFor: #ceShortCutTraceBlockActivation:.
  		 ceTraceStoreTrampoline := self simulatedTrampolineFor: #ceShortCutTraceStore:]!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>ssAllocateCallReg: (in category 'simulation stack') -----
  ssAllocateCallReg: requiredReg
  	"Allocate a register needed in a run-time call (i.e. flush uses of the
  	 register to the real stack).  Since the run-time can smash any and
  	 all caller-saved registers also flush all caller-saved registers."
+ 	self ssAllocateRequiredRegMask: (CallerSavedRegisterMask
- 	self ssAllocateRequiredRegMask: (callerSavedRegMask
  										bitOr: (self registerMaskFor: requiredReg))
  		upThrough: simStackPtr!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>ssAllocateCallReg:and: (in category 'simulation stack') -----
  ssAllocateCallReg: requiredReg1 and: requiredReg2
  	"Allocate registers needed in a run-time call (i.e. flush uses of the
  	 registers to the real stack).  Since the run-time can smash any and
  	 all caller-saved registers also flush all caller-saved registers."
+ 	self ssAllocateRequiredRegMask: (CallerSavedRegisterMask
- 	self ssAllocateRequiredRegMask: (callerSavedRegMask
  										bitOr: ((self registerMaskFor: requiredReg1)
  										bitOr: (self registerMaskFor: requiredReg2)))
  		upThrough: simStackPtr!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>ssAllocateCallReg:and:and: (in category 'simulation stack') -----
  ssAllocateCallReg: requiredReg1 and: requiredReg2 and: requiredReg3
  	"Allocate registers needed in a run-time call (i.e. flush uses of the
  	 registers to the real stack).  Since the run-time can smash any and
  	 all caller-saved registers also flush all caller-saved registers."
+ 	self ssAllocateRequiredRegMask: (CallerSavedRegisterMask
- 	self ssAllocateRequiredRegMask: (callerSavedRegMask
  										bitOr: ((self registerMaskFor: requiredReg1)
  										bitOr: ((self registerMaskFor: requiredReg2)
  										bitOr: (self registerMaskFor: requiredReg3))))
  		upThrough: simStackPtr!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>ssAllocateCallReg:and:and:and: (in category 'simulation stack') -----
  ssAllocateCallReg: requiredReg1 and: requiredReg2 and: requiredReg3 and: requiredReg4
  	"Allocate registers needed in a run-time call (i.e. flush uses of the
  	 registers to the real stack).  Since the run-time can smash any and
  	 all caller-saved registers also flush all caller-saved registers."
+ 	self ssAllocateRequiredRegMask: (CallerSavedRegisterMask
- 	self ssAllocateRequiredRegMask: (callerSavedRegMask
  										bitOr: ((self registerMaskFor: requiredReg1)
  										bitOr: ((self registerMaskFor: requiredReg2)
  										bitOr: ((self registerMaskFor: requiredReg3)
  										bitOr: (self registerMaskFor: requiredReg4)))))
  		upThrough: simStackPtr!



More information about the Vm-dev mailing list