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

commits at source.squeak.org commits at source.squeak.org
Tue Jun 9 22:20:22 UTC 2015


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

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

Name: VMMaker.oscog-eem.1342
Author: eem
Time: 9 June 2015, 3:18:21.796 pm
UUID: 15bbc313-57fa-44b9-b2aa-ba0bc38aa00f
Ancestors: VMMaker.oscog-eem.1341

ARM Cogit:
First cut of out-of-line literal support.  Add
OutOfLineLiteralsManager and InLineLiteralsManager
to insulate the Cogit from the difference.  Add
calls in generation to generate literals, dump literals
etc.  InLineLiteralsManager implements these as
empty, so the existing backends are unchanged.
Allow the literals manager to mediate creation of
instructions that refer to literals.

N.B.  Only the existing in-line literal back end should be
fully functional.  The out-of-line back end needs work:
- very likely the computation of the offset to fetch
  the out-of-line literal is wrong; see
  CogOutOfLineLiteralsARMCompiler>>#moveCw:intoR:
- annotations on instructions that refer to literals
  are not changed to refer to the literals.
- disassembly is not fixed to print literals as literals
- none of the relocation/relinking code affected by
  out-of-line literals has been written yet.
- the literals management code hasn't been added
  to the PIC prototype generators yet.

Refactor CogARMCompiler into CogARMCompiler &
Cog[In/OutOf]LineLiteralsARMCompiler.  Make about
14 methods subclass responsibilities, moving the
originals down into CogInLineLiteralsARMCompiler.

Fix bugs in computeMaximumSize with AddCqR and
SubCqR, and a bad slip in concretizePushCq.

Nuke the unused BICCqR opcode.  Add class vars to
name all the opcodes passed to concretizeDataOperationCwR:.

Add a class var to hold the current compiler class
instead of using CogProcessorAlien class>>
abstractInstructionCompilerClass.

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

Item was changed:
  CogAbstractInstruction subclass: #CogARMCompiler
  	instanceVariableNames: 'conditionOrNil'
+ 	classVariableNames: 'AL AddOpcode AndOpcode BICCqR BicOpcode CArg0Reg CArg1Reg CArg2Reg CArg3Reg CC CMPSMULL CPSRReg CS CmpOpcode ConcreteIPReg ConcreteVarBaseReg 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'
- 	classVariableNames: 'AL AddOpcode AndOpcode BICCqR BicOpcode CArg0Reg CArg1Reg CArg2Reg CArg3Reg CC CMPSMULL CPSRReg CS CmpOpcode ConcreteIPReg ConcreteVarBaseReg 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 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"
  	
  	| specificOpcodes refs |
  	super initialize.
  	self ~~ CogARMCompiler ifTrue: [^self].
  	
  	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.
  	
  	CArg0Reg := 0.
  	CArg1Reg := 1.
  	CArg2Reg := 2.
  	CArg3Reg := 3.
  
  	ConcreteVarBaseReg := 10.
  	ConcreteIPReg := 12. "IP, The Intra-Procedure-call scratch register."
  	
  	"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.
  
  	AddOpcode := 	4.
  	AndOpcode := 0.
  	BicOpcode := 14.
  	CmpOpcode := 10.
  	MoveOpcode := 13.
  	MoveNotOpcode := 15.
  	OrOpcode := 12.
  	RsbOpcode := 3.
+ 	SMLALOpcode := 7.
  	SubOpcode := 2.
+ 	TstOpcode := 8.
  	XorOpcode := 1.
- 	SMLALOpcode := 7.
  
  	CPSRReg := 16.
  	OverflowFlag := 1 << 28.
  
  	"Specific instructions"
  	LastRTLCode isNil ifTrue:
  		[CogRTLOpcodes initialize].
+ 	specificOpcodes := #(SMULL MSR MRS LDMFD STMFD CMPSMULL).
- 	specificOpcodes := #(SMULL MSR MRS LDMFD STMFD BICCqR 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 removed:
- ----- Method: CogARMCompiler>>at:moveCw:intoR: (in category 'generate machine code - support') -----
- at: offset moveCw: constant intoR: destReg
- 	"This loads aWord into the inter-opcode temporary register. Because most ARM instruction enable using a (8-12bit) offset relative to a register, the LS Byte can be included in that instruction, saving one instruction. This is done in a decorator, e.g. CmpCqR"
- 	"Generates:along the lines of
- 	MOV destReg, #<constantByte3>, 12
- 	ORR destReg, destReg, #<constantByte2>, 8
- 	ORR destReg, destReg, #<constantByte1>, 4
- 	ORR destReg, destReg, #<constantByte0>, 0
- 	with minimal choice of the rotation (last digit)"
- 	"The same area can be modified multiple times, because the opperation is (inclusive) or."
- 	 <var: 'constant' type: #usqInt>
- 	<inline: true>
- 	"self assert: destReg < 12."
- 
- 	self machineCodeAt: offset put: (self mov: destReg imm: (constant >>24 bitAnd: 16rFF) ror: 8).
- 	self machineCodeAt: offset +4 put: (self orr: destReg imm: (constant >> 16 bitAnd: 16rFF) ror: 16).
- 	self machineCodeAt: offset +8 put: (self orr: destReg imm: (constant >> 8 bitAnd: 16rFF) ror: 24).
- 	self machineCodeAt: offset +12 put: (self orr: destReg imm: (constant bitAnd: 16rFF) ror: 0).
- 	^16!

Item was changed:
  ----- Method: CogARMCompiler>>callFullTargetFromReturnAddress: (in category 'inline cacheing') -----
  callFullTargetFromReturnAddress: callSiteReturnAddress
  	"Answer the address that the call immediately preceeding callSiteReturnAddress will jump to."
  	"this is also used by #jumpLongTargetBeforeFollowingAddress: and so we check for both call and jump related instructions; later on we can use simpler tests once it feels safe to assume we get here always with a call/jump in the proper place"
+ 	^self subclassResponsibility!
- 	| call |
- 	call := self instructionBeforeAddress: callSiteReturnAddress.
- 	self assert: ((self instructionIsBX: call) or: [self instructionIsBLX: call]).
- 	"A Long Call/Jump. Extract the value saved to RISCTempReg from all the instructions before."
- 	^self extract32BitOperandFrom4InstructionsPreceeding: callSiteReturnAddress - 4!

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."
+ 
- 	"Because we don't use Thumb, each ARM instruction has 4 bytes. Some abstract opcodes need more than one instruction. We only handle those in this caseOf: and let the default return 4"
- 	
- 	
  	opcode
  		caseOf: {
  		"Noops & Pseudo Ops"
  		[Label]					-> [^maxSize := 0].
+ 		[Literal]					-> [^maxSize := 4].
  		[AlignmentNops]		-> [^maxSize := (operands at: 0) - 4].
  		[Fill16]					-> [^maxSize := 4].
  		[Fill32]					-> [^maxSize := 4].
  		[FillFromWord]			-> [^maxSize := 4].
  		[Nop]					-> [^maxSize := 4].
- 		"ARM Specific Control/Data Movement"
- 		[BICCqR]				-> [^self rotateable8bitImmediate: (operands at: 0)
- 											ifTrue: [:r :i| maxSize := 4]
- 											ifFalse: [maxSize := 20]].
- 		[TstCqR]				-> [^self rotateable8bitImmediate: (operands at: 0)
- 											ifTrue: [:r :i| maxSize := 4]
- 											ifFalse: [maxSize := 20]].
- 		[SMULL]				-> [^maxSize := 4].
- 		[MSR]					-> [^maxSize := 4].
- 		[CMPSMULL]			-> [^maxSize := 4]. "special compare for genMulR:R: usage"
  		"Control"
  		[Call]					-> [^maxSize := 4].
+ 		[CallFull]				-> [^maxSize := self literalLoadInstructionBytes + 4].
- 		[CallFull]				-> [^maxSize := 20].
  		[JumpR]					-> [^maxSize := 4].
  		[Jump]					-> [^maxSize := 4].
+ 		[JumpFull]				-> [^maxSize := self literalLoadInstructionBytes + 4].
- 		[JumpFull]				-> [^maxSize := 20].
  		[JumpLong]				-> [^maxSize := 4].
  		[JumpZero]				-> [^maxSize := 4].
  		[JumpNonZero]			-> [^maxSize := 4].
  		[JumpNegative]			-> [^maxSize := 4].
  		[JumpNonNegative]		-> [^maxSize := 4].
  		[JumpOverflow]			-> [^maxSize := 4].
  		[JumpNoOverflow]		-> [^maxSize := 4].
  		[JumpCarry]			-> [^maxSize := 4].
  		[JumpNoCarry]			-> [^maxSize := 4].
  		[JumpLess]				-> [^maxSize := 4].
  		[JumpGreaterOrEqual]	-> [^maxSize := 4].
  		[JumpGreater]			-> [^maxSize := 4].
  		[JumpLessOrEqual]		-> [^maxSize := 4].
  		[JumpBelow]			-> [^maxSize := 4].
  		[JumpAboveOrEqual]	-> [^maxSize := 4].
  		[JumpAbove]			-> [^maxSize := 4].
  		[JumpBelowOrEqual]	-> [^maxSize := 4].
  		[JumpLongZero]		-> [^maxSize := 4].
  		[JumpLongNonZero]	-> [^maxSize := 4].
  		[JumpFPEqual]			-> [^maxSize := 8].
  		[JumpFPNotEqual]		-> [^maxSize := 8].
  		[JumpFPLess]			-> [^maxSize := 8].
  		[JumpFPGreaterOrEqual]-> [^maxSize := 8].
  		[JumpFPGreater]		-> [^maxSize := 8].
  		[JumpFPLessOrEqual]	-> [^maxSize := 8].
  		[JumpFPOrdered]		-> [^maxSize := 8].
  		[JumpFPUnordered]		-> [^maxSize := 8].
+ 		[RetN]					-> [^maxSize := (operands at: 0) = 0 ifTrue: [4] ifFalse: [8]].
- 		[RetN]					-> [^(operands at: 0) = 0 
- 										ifTrue: [maxSize := 4]
- 										ifFalse: [maxSize := 8]].
  		[Stop]					-> [^maxSize := 4].
  
  		"Arithmetic"
  		[AddCqR]				-> [^self rotateable8bitImmediate: (operands at: 0)
  											ifTrue: [:r :i| maxSize := 4]
+ 											ifFalse:
+ 												[self rotateable8bitImmediate: (operands at: 0) negated
+ 													ifTrue: [:r :i| maxSize := 4]
+ 													ifFalse: [maxSize := self literalLoadInstructionBytes + 4]]].
- 											ifFalse: [maxSize := 20]].
  		[AndCqR]				-> [^self rotateable8bitImmediate: (operands at: 0)
  											ifTrue: [:r :i| maxSize := 4]
+ 											ifFalse: [maxSize := self literalLoadInstructionBytes + 4]].
- 											ifFalse: [maxSize := 20]].
  		[AndCqRR]				-> [^self rotateable8bitImmediate: (operands at: 0)
  											ifTrue: [:r :i| maxSize := 4]
+ 											ifFalse:
+ 												[| val invVal |
+ 												invVal := (val := operands at: 0) < 0 ifTrue: [-1 - val] ifFalse: [val bitInvert32].
+ 												self rotateable8bitImmediate: invVal
+ 													ifTrue: [:r :i| maxSize := 4]
+ 													ifFalse: [maxSize := self literalLoadInstructionBytes + 4]]].
- 											ifFalse: [maxSize := 20]].
  		[CmpCqR]				-> [^self rotateable8bitImmediate: (operands at: 0)
  											ifTrue: [:r :i| maxSize := 4]
+ 											ifFalse: [maxSize := self literalLoadInstructionBytes + 4]].
- 											ifFalse: [maxSize := 20]].
  		[OrCqR]					-> [^self rotateable8bitImmediate: (operands at: 0)
  											ifTrue: [:r :i| maxSize := 4]
+ 											ifFalse: [maxSize := self literalLoadInstructionBytes + 4]].
- 											ifFalse: [maxSize := 20]].
  		[SubCqR]				-> [^self rotateable8bitImmediate: (operands at: 0)
  											ifTrue: [:r :i| maxSize := 4]
+ 											ifFalse:
+ 												[self rotateable8bitImmediate: (operands at: 0) negated
+ 													ifTrue: [:r :i| maxSize := 4]
+ 													ifFalse: [maxSize := self literalLoadInstructionBytes + 4]]].
+ 		[TstCqR]				-> [^self rotateable8bitImmediate: (operands at: 0)
+ 											ifTrue: [:r :i| maxSize := 4]
+ 											ifFalse: [maxSize := self literalLoadInstructionBytes + 4]].
- 											ifFalse: [maxSize := 20]].
  		[XorCqR]				-> [^self rotateable8bitImmediate: (operands at: 0)
  											ifTrue: [:r :i| maxSize := 4]
+ 											ifFalse: [maxSize := self literalLoadInstructionBytes + 4]].
+ 		[AddCwR]				-> [^maxSize := self literalLoadInstructionBytes + 4].
+ 		[AndCwR]				-> [^maxSize := self literalLoadInstructionBytes + 4].
+ 		[CmpCwR]				-> [^maxSize := self literalLoadInstructionBytes + 4].
+ 		[OrCwR]				-> [^maxSize := self literalLoadInstructionBytes + 4].
+ 		[SubCwR]				-> [^maxSize := self literalLoadInstructionBytes + 4].
+ 		[XorCwR]				-> [^maxSize := self literalLoadInstructionBytes + 4].
- 											ifFalse: [maxSize := 20]].
- 		[AddCwR]				-> [^maxSize := 20].
- 		[AndCwR]				-> [^maxSize := 20].
- 		[CmpCwR]				-> [^maxSize := 20].
- 		[OrCwR]				-> [^maxSize := 20].
- 		[SubCwR]				-> [^maxSize := 20].
- 		[XorCwR]				-> [^maxSize := 20].
  		[AddRR]					-> [^maxSize := 4].
  		[AndRR]					-> [^maxSize := 4].
  		[CmpRR]				-> [^maxSize := 4].
  		[OrRR]					-> [^maxSize := 4].
  		[XorRR]					-> [^maxSize := 4].
  		[SubRR]					-> [^maxSize := 4].
  		[NegateR]				-> [^maxSize := 4].
  		[LoadEffectiveAddressMwrR]
  									-> [^self rotateable8bitImmediate: (operands at: 0)
  											ifTrue: [:r :i| maxSize := 4]
+ 											ifFalse: [maxSize := self literalLoadInstructionBytes + 4]].
- 											ifFalse: [maxSize := 20]].
  
  		[LogicalShiftLeftCqR]		-> [^maxSize := 4].
+ 		[LogicalShiftRightCqR]		-> [^maxSize := 4].
- 		[LogicalShiftRightCqR]		->  [^maxSize := 4].
  		[ArithmeticShiftRightCqR]	-> [^maxSize := 4].
+ 		[LogicalShiftLeftRR]			-> [^maxSize := 4].
+ 		[LogicalShiftRightRR]		-> [^maxSize := 4].
- 		[LogicalShiftLeftRR]			->  [^maxSize := 4].
- 		[LogicalShiftRightRR]		->  [^maxSize := 4].
  		[ArithmeticShiftRightRR]		-> [^maxSize := 4].
+ 		[AddRdRd]					-> [^maxSize := 4].
+ 		[CmpRdRd]					-> [^maxSize := 4].
+ 		[SubRdRd]					-> [^maxSize := 4].
+ 		[MulRdRd]					-> [^maxSize := 4].
+ 		[DivRdRd]					-> [^maxSize := 4].
+ 		[SqrtRd]					-> [^maxSize := 4].
+ 		"ARM Specific Arithmetic"
+ 		[SMULL]				-> [^maxSize := 4].
+ 		[MSR]					-> [^maxSize := 4].
+ 		[CMPSMULL]			-> [^maxSize := 4]. "special compare for genMulR:R: usage"
- 		[AddRdRd]			-> [^maxSize := 4].
- 		[CmpRdRd]			-> [^maxSize := 4].
- 		[SubRdRd]			-> [^maxSize := 4].
- 		[MulRdRd]			-> [^maxSize := 4].
- 		[DivRdRd]			-> [^maxSize := 4].
- 		[SqrtRd]			-> [^maxSize := 4].		
  		"Data Movement"						
+ 		[MoveCqR]				-> [^self literalLoadInstructionBytes = 4
+ 										ifTrue: [maxSize := self literalLoadInstructionBytes]
+ 										ifFalse:
+ 											[self rotateable8bitImmediate: (operands at: 0)
+ 												ifTrue: [:r :i| maxSize := 4]
+ 												ifFalse:
+ 													[| val invVal |
+ 													invVal := (val := operands at: 0) < 0 ifTrue: [-1 - val] ifFalse: [val bitInvert32].
+ 													self rotateable8bitImmediate: invVal
+ 														ifTrue: [:r :i| maxSize := 4]
+ 														ifFalse: [maxSize := self literalLoadInstructionBytes]]]].
+ 		[MoveCwR]				-> [^maxSize := self literalLoadInstructionBytes].
- 		[MoveCqR]				-> [^self rotateable8bitImmediate: (operands at: 0)
- 										ifTrue: [:r :i| maxSize := 4]
- 										ifFalse: [maxSize := 16]].
- 		[MoveCwR]				-> [^maxSize := 16].
  		[MoveRR]				-> [^maxSize := 4].
+ 		[MoveRdRd]				-> [^maxSize := 4].
- 		[MoveRdRd]		-> [^maxSize := 4].
  		[MoveAwR]				-> [^maxSize := (self isAddressRelativeToVarBase: (operands at: 0))
  													ifTrue: [4]
+ 													ifFalse: [self literalLoadInstructionBytes + 4]].
- 													ifFalse: [20]].
  		[MoveRAw]				-> [^maxSize := (self isAddressRelativeToVarBase: (operands at: 1))
  													ifTrue: [4]
+ 													ifFalse: [self literalLoadInstructionBytes + 4]].
+ 		[MoveRMwr]			-> [^self is12BitValue: (operands at: 1)
+ 										ifTrue: [:u :i| maxSize := 4]
+ 										ifFalse: [maxSize := self literalLoadInstructionBytes + 4]].
+ 		[MoveRdM64r]			-> [^maxSize := self literalLoadInstructionBytes + 4]. 
+ 		[MoveMbrR]				-> [^self is12BitValue: (operands at: 0)
+ 										ifTrue: [:u :i| maxSize := 4]
+ 										ifFalse: [maxSize := self literalLoadInstructionBytes + 4]].
+ 		[MoveRMbr]				-> [^self is12BitValue: (operands at: 1)
+ 										ifTrue: [:u :i| maxSize := 4]
+ 										ifFalse: [maxSize := self literalLoadInstructionBytes + 4]].
- 													ifFalse: [20]].
- 		[MoveRMwr]			-> [self is12BitValue: (operands at: 1)
- 										ifTrue: [ :u :i | ^maxSize := 4]
- 										ifFalse: [ ^maxSize := 20 ]].
- 		[MoveRdM64r]	-> [^maxSize := 20]. 
- 		[MoveMbrR]				-> [self is12BitValue: (operands at: 0)
- 										ifTrue: [ :u :i | ^maxSize := 4]
- 										ifFalse: [ ^maxSize := 20 ]].
- 		[MoveRMbr]				-> [self is12BitValue: (operands at: 1)
- 										ifTrue: [ :u :i | ^maxSize := 4]
- 										ifFalse: [ ^maxSize := 20 ]].
  		[MoveM16rR]			-> [^self rotateable8bitImmediate: (operands at: 0)
  											ifTrue: [:r :i| maxSize := 4]
+ 											ifFalse: [maxSize := self literalLoadInstructionBytes + 4]].
+ 		[MoveM64rRd]			-> [^maxSize := self literalLoadInstructionBytes + 4].
+ 		[MoveMwrR]			-> [^self is12BitValue: (operands at: 0)
+ 										ifTrue: [:u :i| maxSize := 4]
+ 										ifFalse: [maxSize := self literalLoadInstructionBytes + 4]].
- 											ifFalse: [maxSize := 20]].
- 		[MoveM64rRd]	-> [^maxSize := 20].
- 		[MoveMwrR]			-> [self is12BitValue: (operands at: 0)
- 										ifTrue: [ :u :i | ^maxSize := 4]
- 										ifFalse: [ ^maxSize := 20 ]].
  		[MoveXbrRR]			-> [^maxSize := 4].
  		[MoveRXbrR]			-> [^maxSize := 4].
  		[MoveXwrRR]			-> [^maxSize := 4].
  		[MoveRXwrR]			-> [^maxSize := 4].
  		[PopR]					-> [^maxSize := 4].
  		[PushR]					-> [^maxSize := 4].
+ 		[PushCw]				-> [^maxSize := self literalLoadInstructionBytes + 4].
+ 		[PushCq]				-> [^self literalLoadInstructionBytes = 4
+ 										ifTrue: [maxSize := self literalLoadInstructionBytes + 4]
+ 										ifFalse:
+ 											[self rotateable8bitImmediate: (operands at: 0)
+ 												ifTrue: [:r :i| maxSize := 8]
+ 												ifFalse:
+ 													[| val invVal |
+ 													invVal := (val := operands at: 0) < 0 ifTrue: [-1 - val] ifFalse: [val bitInvert32].
+ 													self rotateable8bitImmediate: invVal
+ 														ifTrue: [:r :i| maxSize := 8]
+ 														ifFalse: [maxSize := self literalLoadInstructionBytes + 4]]]].
- 		[PushCw]				-> [^maxSize := 20].
- 		[PushCq]				-> [^self rotateable8bitImmediate: (operands at: 0)
- 											ifTrue: [:r :i| maxSize := 8]
- 											ifFalse: [maxSize := 20]].
  		[PrefetchAw] 			-> [^maxSize := (self isAddressRelativeToVarBase: (operands at: 1))
  													ifTrue: [4]
+ 													ifFalse: [self literalLoadInstructionBytes + 4]].
- 													ifFalse: [20]].
  		"Conversion"
+ 		[ConvertRRd]			-> [^maxSize := 4].
- 		[ConvertRRd]	-> [^maxSize := 4].
- 
- 
  		}.
  	^0 "to keep C compiler quiet"
  !

Item was changed:
  ----- Method: CogARMCompiler>>concretizeAddCqR (in category 'generate machine code - concretize') -----
  concretizeAddCqR
  	"Will get inlined into concretizeAt: switch."
  	"Try whether the quick constant is a small negative number. If it is, optimize."
  	<inline: true>
  	self rotateable8bitImmediate: (operands at: 0)
  		ifTrue: [ :rot :immediate | | reg |
  			reg := self concreteRegister: (operands at: 1).
  			self machineCodeAt: 0 put: (self adds: reg rn: reg imm: immediate ror: rot).
  			^machineCodeSize := 4]
  		ifFalse: [
  			self rotateable8bitImmediate: (operands at: 0) negated
  				ifTrue: [ :rot :immediate | |reg|
  					reg := self concreteRegister: (operands at: 1).
  					self machineCodeAt: 0 put: (self subs: reg rn: reg imm: immediate ror: rot).
  					^machineCodeSize := 4]
+ 				ifFalse: [^self concretizeDataOperationCwR: AddOpcode]].
- 				ifFalse: [^self concretizeDataOperationCwR: 4]].
  	^0 "to keep Slang happy"!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeCallFull (in category 'generate machine code - concretize') -----
  concretizeCallFull
  	"Will get inlined into concretizeAt: switch."
  	"Sizing/generating calls.
  		Jump targets can be to absolute addresses or other abstract instructions.
  		Generating initial trampolines instructions may have no maxSize and be to absolute addresses.
  		Otherwise instructions must have a machineCodeSize which must be kept to."
  	<inline: true>
  	| jumpTarget instrOffset|
  	<var: #jumpTarget type: #'AbstractInstruction *'>
  	jumpTarget := self longJumpTargetAddress.
+ 	instrOffset := self moveCw: jumpTarget intoR: ConcreteIPReg.
- 	instrOffset := self at: 0 moveCw: jumpTarget intoR: ConcreteIPReg.
  	"blx ConcreteIPReg"
  	self machineCodeAt: instrOffset put: (self blx: ConcreteIPReg).
+ 	self assert: instrOffset = self literalLoadInstructionBytes.
- 	self assert: instrOffset = 16.
  	^machineCodeSize := instrOffset + 4!

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

Item was changed:
  ----- Method: CogARMCompiler>>concretizeJumpFull (in category 'generate machine code - concretize') -----
  concretizeJumpFull
  	"Will get inlined into concretizeAt: switch."
  	"A JumpFull is used when we need to jump to anywhere in 32bit address space rather than somewhere known to be in code-space. It also must be relocatable and non-varying with the jump range. On ARM this means using the build-long-const + BX sequence."
  	<inline: true>
  	| jumpTarget instrOffset|
  	<var: #jumpTarget type: #'AbstractInstruction *'>
  	jumpTarget := self longJumpTargetAddress.
+ 	instrOffset := self moveCw: jumpTarget intoR: ConcreteIPReg.
- 	instrOffset := self at: 0 moveCw: jumpTarget intoR: ConcreteIPReg.
  	"bx ConcreteIPReg"
  	self machineCodeAt: instrOffset put: (self bx: ConcreteIPReg).
  	^machineCodeSize := instrOffset + 4!

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

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

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

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

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

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

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

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

Item was changed:
  ----- Method: CogARMCompiler>>concretizePrefetchAw (in category 'generate machine code - concretize') -----
  concretizePrefetchAw
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| addressOperand instrOffset|
  	addressOperand := operands at: 0.
  	(self isAddressRelativeToVarBase: addressOperand) ifTrue:
  		[self machineCodeAt: 0 put: (self pld: ConcreteVarBaseReg plus: 1 offset: addressOperand - cogit varBaseAddress).
  		 ^machineCodeSize := 4].
+ 	instrOffset := self moveCw: addressOperand intoR: ConcreteIPReg.
- 	instrOffset := self at: 0 moveCw: addressOperand intoR: ConcreteIPReg.
  	"pld	[ConcreteIPReg]"
  	self machineCodeAt: instrOffset put: (self pld: ConcreteIPReg plus: 1offset: 0).
  	^machineCodeSize := instrOffset + 4!

Item was changed:
  ----- Method: CogARMCompiler>>concretizePushCq (in category 'generate machine code - concretize') -----
  concretizePushCq
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| word instrOffset|
  	word := operands at: 0.
  	self 
  		rotateable8bitImmediate: word 
  		ifTrue: [:rot :immediate |
  			self machineCodeAt: 0 put: (self mov: ConcreteIPReg imm: immediate ror: rot).
  			instrOffset := 4]
  		ifFalse:[|invVal|
  			word <0
  				ifTrue:[invVal := -1 - word]
  				ifFalse:[invVal := word bitInvert32].
  			self rotateable8bitImmediate: invVal
  				ifTrue: [ :rot :immediate |
  					self machineCodeAt: 0 put: (self mvn: ConcreteIPReg imm: immediate ror: rot).
+ 					instrOffset := 4]
+ 				ifFalse: [instrOffset := self moveCw: word intoR: ConcreteIPReg]].
- 					^machineCodeSize := 4]
- 				ifFalse: [instrOffset := self at: 0 moveCw: word intoR: ConcreteIPReg]].
  	self machineCodeAt: instrOffset put: (self pushR: ConcreteIPReg).
  	^machineCodeSize := instrOffset + 4!

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

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

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].
  		[Fill16]					-> [^self concretizeFill16].
  		[Fill32]					-> [^self concretizeFill32].
  		[FillFromWord]			-> [^self concretizeFillFromWord].
  		[Nop]					-> [^self concretizeNop].
- 		"ARM Specific Control/Data Movement" 
- 		[SMULL]				-> [^self concretizeSMULL]	.
- 		[CMPSMULL]				-> [^self concretizeCMPSMULL].
- 		[MSR]						-> [^self concretizeMSR].
- 		[BICCqR]					-> [^self concretizeDataOperationCqR: BicOpcode].
  		"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 concretizeAddCqR].
  		[AddCwR]					-> [^self concretizeDataOperationCwR: AddOpcode].
  		[AddRR]						-> [^self concretizeDataOperationRR: AddOpcode].
  		[AddRdRd]					-> [^self concretizeAddRdRd].
  		[AndCqR]					-> [^self concretizeAndCqR].
  		[AndCqRR]					-> [^self concretizeAndCqRR].
  		[AndCwR]					-> [^self concretizeDataOperationCwR: AndOpcode].
  		[AndRR]						-> [^self concretizeDataOperationRR: AndOpcode].
  		[CmpCqR]					-> [^self concretizeDataOperationCqR: CmpOpcode].
  		[CmpCwR]					-> [^self concretizeDataOperationCwR: CmpOpcode].
  		[CmpRR]					-> [^self concretizeDataOperationRR: CmpOpcode].
  		[CmpRdRd]					-> [^self concretizeCmpRdRd].
  		[DivRdRd]					-> [^self concretizeDivRdRd].
  		[MulRdRd]					-> [^self concretizeMulRdRd].
  		[OrCqR]						-> [^self concretizeDataOperationCqR: OrOpcode].
  		[OrCwR]					-> [^self concretizeDataOperationCwR: OrOpcode].
  		[OrRR]						-> [^self concretizeDataOperationRR: OrOpcode].
  		[SubCqR]					-> [^self concretizeSubCqR].
  		[SubCwR]					-> [^self concretizeDataOperationCwR: SubOpcode].
  		[SubRR]						-> [^self concretizeDataOperationRR: SubOpcode].
  		[SubRdRd]					-> [^self concretizeSubRdRd].
  		[SqrtRd]					-> [^self concretizeSqrtRd].
  		[TstCqR]					-> [^self concretizeTstCqR].
  		[XorCqR]						-> [^self concretizeDataOperationCqR: XorOpcode].
  		[XorCwR]						-> [^self concretizeDataOperationCwR: XorOpcode].
  		[XorRR]							-> [^self concretizeDataOperationRR: XorOpcode].
  		[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].
  		"Data Movement"
  		[MoveCqR]			-> [^self concretizeMoveCqR].
  		[MoveCwR]			-> [^self concretizeMoveCwR].
  		[MoveRR]			-> [^self concretizeMoveRR].
  		[MoveAwR]			-> [^self concretizeMoveAwR].
  		[MoveRAw]			-> [^self concretizeMoveRAw].
  		[MoveMbrR]			-> [^self concretizeMoveMbrR].
  		[MoveRMbr]			-> [^self concretizeMoveRMbr].
  		[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 removed:
- ----- Method: CogARMCompiler>>extract32BitOperandFrom4InstructionsPreceeding: (in category 'testing') -----
- extract32BitOperandFrom4InstructionsPreceeding: addr
- 	<inline: true>
- 	^(objectMemory byteAt: addr -4) 
- 	 + ((objectMemory byteAt: addr - 8) << 8) 
- 	 + ((objectMemory byteAt: addr - 12) << 16) 
- 	 + ((objectMemory byteAt: addr - 16) << 24)!

Item was changed:
  ----- Method: CogARMCompiler>>inlineCacheTagAt: (in category 'inline cacheing') -----
  inlineCacheTagAt: callSiteReturnAddress
  	"Answer the inline cache tag for the return address of a send."
+ 	^self subclassResponsibility!
- 	self assert: (self instructionIsBL: (self instructionBeforeAddress: callSiteReturnAddress)).
- 	^self extract32BitOperandFrom4InstructionsPreceeding: callSiteReturnAddress - 4!

Item was removed:
- ----- Method: CogARMCompiler>>insert32BitOperand:into4InstructionsPreceeding: (in category 'testing') -----
- insert32BitOperand: operand into4InstructionsPreceeding: addr
- 	<inline: true>
- 	objectMemory
- 		byteAt: addr -   4 put: (operand			bitAnd: 16rFF);
- 		byteAt: addr -   8 put: (operand >>   8	bitAnd: 16rFF);
- 		byteAt: addr - 12 put: (operand >> 16	bitAnd: 16rFF);
- 		byteAt: addr - 16 put: (operand >> 24	bitAnd: 16rFF)!

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

Item was removed:
- ----- Method: CogARMCompiler>>isPCDependent (in category 'testing') -----
- isPCDependent
- 	"Answer if the receiver is a pc-dependent instruction."
- 	^self isJump or: [opcode = AlignmentNops or: [opcode = Call]]!

Item was changed:
  ----- Method: CogARMCompiler>>literalBeforeFollowingAddress: (in category 'inline cacheing') -----
  literalBeforeFollowingAddress: followingAddress
+ 	"Answer the constant loaded by the instruction sequence just before this address:"
+ 	^self subclassResponsibility!
- 	"Answer the long constant loaded by a MOV/ORR/ORR/ORR
- 	 or MOV/ORR/ORR/ORR/PUSH, or MOV/ORR/ORR/ORR/CMP sequence, just before this address:"
- 	^(self instructionIsOR: (self instructionBeforeAddress: followingAddress))
- 		ifTrue: [self extract32BitOperandFrom4InstructionsPreceeding: followingAddress]
- 		ifFalse: [self extract32BitOperandFrom4InstructionsPreceeding: followingAddress - 4]!

Item was added:
+ ----- Method: CogARMCompiler>>literalLoadInstructionBytes (in category 'accessing') -----
+ literalLoadInstructionBytes
+ 	"Answer the size of a literal load instruction (which may or may not include the size of the literal).
+ 	 This differs between in-line and out-of-line literal generation."
+ 	<inline: true>
+ 	^self subclassResponsibility!

Item was changed:
  ----- Method: CogARMCompiler>>loadCwInto: (in category 'generate machine code - support') -----
  loadCwInto: destReg
  	"Load the operand into the destination register, answering
  	 the size of the instructions generated to do so."
  	| operand distance |
  	operand := operands at: 0.
  	"First try and encode as a pc-relative reference..."
  	(cogit addressIsInCurrentCompilation: operand) ifTrue:
  		[distance := operand - (address + 8).
  		 self rotateable8bitImmediate: distance
  		 	ifTrue: [ :rot :immediate |
  		 		self machineCodeAt: 0 put: (self add: destReg rn: PC imm: immediate ror: rot).
  		 		^4]
  		 	ifFalse:
  		 		[self rotateable8bitImmediate: distance negated
  		 			ifTrue: [ :rot :immediate |
  		 				self machineCodeAt: 0 put: (self sub: destReg rn: PC imm: immediate ror: rot).
  		 				^4]
  					ifFalse: []]].
  	"If this fails, use the conventional and painfully long 4 instruction sequence."
+ 	^self moveCw: operand intoR: destReg!
- 	^self at: 0 moveCw: operand intoR: destReg!

Item was added:
+ ----- Method: CogARMCompiler>>moveCw:intoR: (in category 'generate machine code - support') -----
+ moveCw: constant intoR: destReg
+ 	"Emit a load of aWord into destReg.  Answer the number of bytes of machine code generated."
+ 	 <var: 'constant' type: #usqInt>
+ 	<inline: true>
+ 	^self subclassResponsibility!

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

Item was changed:
  ----- Method: CogARMCompiler>>relocateMethodReferenceBeforeAddress:by: (in category 'inline cacheing') -----
  relocateMethodReferenceBeforeAddress: pc by: delta
  	"If possible we generate the method address using pc-relative addressing.
  	 If so we don't need to relocate it in code.  So check if pc-relative code was
  	 generated, and if not, adjust a long sequence.  There are two cases, a push
  	 or a register load.  If a push, then there is a register load, but in the instruction
  	 before."
+ 	^self subclassResponsibility!
- 	| pcPreceedingLoad reference |
- 	pcPreceedingLoad := (self instructionIsPush: (self instructionBeforeAddress: pc))
- 							ifTrue: [pc - 4]
- 							ifFalse: [pc].
- 	"If the load is not done via pc-relative addressing we have to relocate."
- 	(self isPCRelativeValueLoad: (self instructionBeforeAddress: pcPreceedingLoad)) ifFalse:
- 		[reference := self extract32BitOperandFrom4InstructionsPreceeding: pcPreceedingLoad.
- 		 reference := reference + delta.
- 		 self insert32BitOperand: reference into4InstructionsPreceeding: pcPreceedingLoad]!

Item was changed:
  ----- Method: CogARMCompiler>>rewriteFullTransferAt:target:expectedInstruction: (in category 'inline cacheing') -----
  rewriteFullTransferAt: callSiteReturnAddress target: callTargetAddress expectedInstruction: expectedInstruction
  	"Rewrite a CallFull or JumpFull instruction to transfer to a different target.
  	 This variant is used to rewrite cached primitive calls.   Answer the extent
  	 of the code change which is used to compute the range of the icache to flush."
+ 	^self subclassResponsibility!
- 	<var: #callSiteReturnAddress type: #usqInt>
- 	<var: #callTargetAddress type: #usqInt>
- 	"cogit disassembleFrom: callSiteReturnAddress - 20 to: callSiteReturnAddress - 1"
- 	self assert: (self instructionBeforeAddress: callSiteReturnAddress) = expectedInstruction.
- 	self insert32BitOperand: callTargetAddress into4InstructionsPreceeding: callSiteReturnAddress - 4.
- 	self assert: (self callFullTargetFromReturnAddress: callSiteReturnAddress) signedIntToLong = callTargetAddress.
- 	^20!

Item was changed:
  ----- Method: CogARMCompiler>>rewriteInlineCacheAt:tag:target: (in category 'inline cacheing') -----
  rewriteInlineCacheAt: callSiteReturnAddress tag: cacheTag target: callTargetAddress
  	"Rewrite an inline cache to call a different target for a new tag.  This variant is used
  	 to link unlinked sends in ceSend:to:numArgs: et al.  Answer the extent of the code
  	 change which is used to compute the range of the icache to flush."
  	
+ 	^self subclassResponsibility!
- 	"chacheTag contains an oop to the selector which need be loaded before jumping"
- 	<var: #callSiteReturnAddress type: #usqInt>
- 	<var: #callTargetAddress type: #usqInt>
- 	| call callDistance |
- 	false
- 		ifTrue: [self assert: callTargetAddress >= cogit minCallAddress]
- 		ifFalse: [callTargetAddress >= cogit minCallAddress ifFalse:
- 					[self error: 'linking callsite to invalid address']].
- 	callDistance := (callTargetAddress - (callSiteReturnAddress + 8 "pc offset"- 4 "return offset")) signedIntToLong.
- 	self assert: (self isInImmediateJumpRange: callDistance). "we don't support long call updates here"
- 	call := self bl: callDistance.
- 	objectMemory longAt: callSiteReturnAddress - 4 put: call.
- 	self insert32BitOperand: cacheTag into4InstructionsPreceeding: callSiteReturnAddress - 4.
- 	self assert: (self callTargetFromReturnAddress: callSiteReturnAddress) signedIntToLong = callTargetAddress.
- 	self assert: (self extract32BitOperandFrom4InstructionsPreceeding: callSiteReturnAddress - 4) = cacheTag.
- 	"self cCode: ''
- 		inSmalltalk: [cogit disassembleFrom: callSiteReturnAddress - 20 to: callSiteReturnAddress - 1]."
- 	^20!

Item was changed:
  ----- Method: CogARMCompiler>>rewriteInlineCacheTag:at: (in category 'inline cacheing') -----
  rewriteInlineCacheTag: cacheTag at: callSiteReturnAddress
  	"Rewrite an inline cache with a new tag.  This variant is used
  	 by the garbage collector."
+ 	^self subclassResponsibility!
- 	self insert32BitOperand: cacheTag into4InstructionsPreceeding: callSiteReturnAddress -4!

Item was removed:
- ----- Method: CogARMCompiler>>sizePCDependentInstructionAt: (in category 'generate machine code') -----
- sizePCDependentInstructionAt: eventualAbsoluteAddress
- 	"Size a jump and set its address.  The target may be another instruction
- 	 or an absolute address.  On entry the address inst var holds our virtual
- 	 address. On exit address is set to eventualAbsoluteAddress, which is
- 	 where this instruction will be output.  The span of a jump to a following
- 	 instruction is therefore between that instruction's address and this
- 	 instruction's address ((which are both still their virtual addresses), but the
- 	 span of a jump to a preceeding instruction or to an absolute address is
- 	 between that instruction's address (which by now is its eventual absolute
- 	 address) or absolute address and eventualAbsoluteAddress.
- 
- 	 ARM is simple; the 26-bit call/jump range means no short jumps.  This routine
- 	 only has to determine the targets of jumps, not determine sizes."
- 
- 	opcode = AlignmentNops ifTrue:
- 		[| alignment |
- 		 address := eventualAbsoluteAddress.
- 		 alignment := operands at: 0.
- 		 ^machineCodeSize := (eventualAbsoluteAddress + (alignment - 1) bitAnd: alignment negated)
- 							   - eventualAbsoluteAddress].
- 	self assert: (self isJump or: [opcode = Call or: [opcode = CallFull]]).
- 	self isJump ifTrue: [self resolveJumpTarget].
- 	address := eventualAbsoluteAddress.
- 	^machineCodeSize := maxSize!

Item was changed:
  ----- Method: CogARMCompiler>>storeLiteral:beforeFollowingAddress: (in category 'inline cacheing') -----
  storeLiteral: literal beforeFollowingAddress: followingAddress
+ 	"Rewrite the long constant loaded by the instruction sequence just before this address:"
+ 	^self subclassResponsibility!
- 	"Rewrite the long constant loaded by a MOV/ORR/ORR/ORR
- 	 or MOV/ORR/ORR/ORR/PUSH  sequence, just before this address:"
- 	^(self instructionIsOR: (self instructionBeforeAddress: followingAddress))
- 		ifTrue: [self insert32BitOperand: literal into4InstructionsPreceeding: followingAddress]
- 		ifFalse: [self insert32BitOperand: literal into4InstructionsPreceeding: followingAddress - 4]!

Item was changed:
  ----- Method: CogAbstractInstruction class>>byteSizeForSimulator: (in category 'simulation only') -----
  byteSizeForSimulator: aVMClass
  	"Answer an approximation of the byte size of an AbstractInstruction struct.
  	 This is for estimating the alloca in allocateOpcodes:bytecodes:ifFail:"
+ 	| ptrsize |
- 	| concreteClass ptrsize |
- 	concreteClass := aVMClass processor abstractInstructionCompilerClass.
  	ptrsize := aVMClass sizeof: #'void *'.
+ 	^CogCompilerClass instSize - 4 "cogit, objectMemory et al" * ptrsize
+ 	+ CogCompilerClass basicNew machineCodeBytes
- 	^concreteClass instSize - 4 "cogit, objectMemory et al" * ptrsize
- 	+ concreteClass basicNew machineCodeBytes
  		roundTo: ptrsize!

Item was added:
+ ----- Method: CogAbstractInstruction class>>literalsManagerClass (in category 'accessing class hierarchy') -----
+ literalsManagerClass
+ 	"Answer the manager that generates in-line literals;
+ 	 subclasses that use out-of-line literals override."
+ 	^InLineLiteralsManager!

Item was changed:
  ----- Method: CogAbstractInstruction>>labelOffset (in category 'generate machine code') -----
  labelOffset
+ 	"Hack:  To arrange that the block method field pushed in a block entry has
+ 	 its MFMethodFlagIsBlockFlag bit set we provide labels with an offset.  The
+ 	 offset for the fakeHeader reference is MFMethodFlagIsBlockFlag.  See
+ 	 compileBlockFrameBuild:"
- 	"To arrange that the block method field pushed in a block entry has
- 	 its MFMethodFlagIsBlockFlag bit set we provide labels with an offset.
- 	 The offset for the fakeHeader reference is MFMethodFlagIsBlockFlag.
- 	 See compileBlockFrameBuild:"
  	^operands at: 1!

Item was added:
+ ----- Method: CogAbstractInstruction>>operand0: (in category 'accessing') -----
+ operand0: operand
+ 	<inline: true>
+ 	operands at: 0 put: operand!

Item was added:
+ ----- Method: CogAbstractInstruction>>operand1: (in category 'accessing') -----
+ operand1: operand
+ 	<inline: true>
+ 	operands at: 1 put: operand!

Item was added:
+ ----- Method: CogAbstractInstruction>>operand2: (in category 'accessing') -----
+ operand2: operand
+ 	<inline: true>
+ 	operands at: 2 put: operand!

Item was changed:
  ----- Method: CogAbstractInstruction>>printStateOn: (in category 'printing') -----
  printStateOn: aStream
  	| opcodeName orneryOperands format |
  	<doNotGenerate> "Smalltalk-side only"
  	opcode isNil ifTrue:
  		[^self].
  	aStream space; nextPut: $(; nextPutAll: (opcodeName := self class nameForOpcode: opcode).
  	orneryOperands := operands isCObjectAccessor
  							ifTrue: [operands object]
  							ifFalse: [operands].
  	(cogit isKindOf: Cogit) ifTrue:
  		[format := CogRTLOpcodes printFormatForOpcodeName: opcodeName].
  	orneryOperands withIndexDo:
  		[:operand :index|
  		operand notNil ifTrue:
  			[aStream space.
  			 index >= (orneryOperands identityIndexOf: nil ifAbsent: [orneryOperands size + 1]) ifTrue:
  				[aStream print: index - 1; nextPut: $:].
  			 (format notNil and: [(format at: index ifAbsent: nil) = $r])
  				ifTrue: [aStream nextPutAll: (self nameForRegister: operand)]
  				ifFalse:
  					[aStream print: operand.
  					 (operand isInteger and: [operand > 16 and: [opcode ~= Label]]) ifTrue:
  						[(operand allMask: 16r80000000) ifTrue:
  							[aStream nextPut: $/; print: operand signedIntFromLong].
  						 aStream nextPut: $/.
  						 operand printOn: aStream base: 16]]]].
  	machineCodeSize ifNotNil:
  		[(machineCodeSize between: 1 and: machineCode size) ifTrue:
  			[0 to: machineCodeSize - 1 by: self codeGranularity do:
  				[:i|
  				 aStream space.
+ 				 (self machineCodeAt: i)
+ 					ifNil: [aStream nextPut: $.]
+ 					ifNotNil: [:mc| mc printOn: aStream base: 16]]]].
- 				 (self machineCodeAt: i) printOn: aStream base: 16]]].
  	address ifNotNil:
  		[aStream nextPut: $@.
  		 address printOn: aStream base: 16].
  	aStream nextPut: $)!

Item was added:
+ ----- Method: CogAbstractInstruction>>sizePCDependentInstructionAt: (in category 'generate machine code') -----
+ sizePCDependentInstructionAt: eventualAbsoluteAddress
+ 	"Size a jump and set its address.  The target may be another instruction
+ 	 or an absolute address.  On entry the address inst var holds our virtual
+ 	 address. On exit address is set to eventualAbsoluteAddress, which is
+ 	 where this instruction will be output.  The span of a jump to a following
+ 	 instruction is therefore between that instruction's address and this
+ 	 instruction's address ((which are both still their virtual addresses), but the
+ 	 span of a jump to a preceeding instruction or to an absolute address is
+ 	 between that instruction's address (which by now is its eventual absolute
+ 	 address) or absolute address and eventualAbsoluteAddress."
+ 
+ 	self subclassResponsibility!

Item was changed:
  SharedPool subclass: #CogCompilationConstants
  	instanceVariableNames: ''
+ 	classVariableNames: 'BadRegisterSet CogCompilerClass NumSendTrampolines SSBaseOffset SSConstant SSIllegal SSRegister SSSpill UnimplementedOperation'
- 	classVariableNames: 'BadRegisterSet NumSendTrampolines SSBaseOffset SSConstant SSIllegal SSRegister SSSpill UnimplementedOperation'
  	poolDictionaries: ''
  	category: 'VMMaker-JIT'!

Item was changed:
  ----- Method: CogIA32Compiler>>jmpTarget: (in category 'accessing') -----
  jmpTarget: anAbstractInstruction
  	"Set the target of a jump instruction.  These all have the target in the first operand.
+ 	 Override to cope with JumpFPNotEqual where because of IEEE NaN conformance and
- 	 Override to cope with JumpFPNotEqual where because if IEEE NaN conformance and
  	 the behaviour of COMISD/UCOMISD we generate two jumps to the same target."
  	| aDependent |
  	<var: #aDependent type: #'AbstractInstruction *'>
  	aDependent := dependent.
  	[aDependent notNil] whileTrue:
  		[aDependent jmpTarget: anAbstractInstruction.
  		 aDependent := aDependent dependent].
  	^super jmpTarget: anAbstractInstruction!

Item was added:
+ CogARMCompiler subclass: #CogInLineLiteralsARMCompiler
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'VMMaker-JIT'!

Item was added:
+ ----- Method: CogInLineLiteralsARMCompiler>>callFullTargetFromReturnAddress: (in category 'inline cacheing') -----
+ callFullTargetFromReturnAddress: callSiteReturnAddress
+ 	"Answer the address that the call immediately preceeding callSiteReturnAddress will jump to."
+ 	"this is also used by #jumpLongTargetBeforeFollowingAddress: and so we check for both call and jump related instructions; later on we can use simpler tests once it feels safe to assume we get here always with a call/jump in the proper place"
+ 	| call |
+ 	call := self instructionBeforeAddress: callSiteReturnAddress.
+ 	self assert: ((self instructionIsBX: call) or: [self instructionIsBLX: call]).
+ 	"A Long Call/Jump. Extract the value saved to RISCTempReg from all the instructions before."
+ 	^self extract32BitOperandFrom4InstructionsPreceeding: callSiteReturnAddress - 4!

Item was added:
+ ----- Method: CogInLineLiteralsARMCompiler>>extract32BitOperandFrom4InstructionsPreceeding: (in category 'testing') -----
+ extract32BitOperandFrom4InstructionsPreceeding: addr
+ 	<inline: true>
+ 	^(objectMemory byteAt: addr -4) 
+ 	 + ((objectMemory byteAt: addr - 8) << 8) 
+ 	 + ((objectMemory byteAt: addr - 12) << 16) 
+ 	 + ((objectMemory byteAt: addr - 16) << 24)!

Item was added:
+ ----- Method: CogInLineLiteralsARMCompiler>>inlineCacheTagAt: (in category 'inline cacheing') -----
+ inlineCacheTagAt: callSiteReturnAddress
+ 	"Answer the inline cache tag for the return address of a send."
+ 	self assert: (self instructionIsBL: (self instructionBeforeAddress: callSiteReturnAddress)).
+ 	^self extract32BitOperandFrom4InstructionsPreceeding: callSiteReturnAddress - 4!

Item was added:
+ ----- Method: CogInLineLiteralsARMCompiler>>insert32BitOperand:into4InstructionsPreceeding: (in category 'testing') -----
+ insert32BitOperand: operand into4InstructionsPreceeding: addr
+ 	<inline: true>
+ 	objectMemory
+ 		byteAt: addr -   4 put: (operand			bitAnd: 16rFF);
+ 		byteAt: addr -   8 put: (operand >>   8	bitAnd: 16rFF);
+ 		byteAt: addr - 12 put: (operand >> 16	bitAnd: 16rFF);
+ 		byteAt: addr - 16 put: (operand >> 24	bitAnd: 16rFF)!

Item was added:
+ ----- Method: CogInLineLiteralsARMCompiler>>isPCDependent (in category 'testing') -----
+ isPCDependent
+ 	"Answer if the receiver is a pc-dependent instruction."
+ 	^self isJump or: [opcode = AlignmentNops or: [opcode = Call]]!

Item was added:
+ ----- Method: CogInLineLiteralsARMCompiler>>literalBeforeFollowingAddress: (in category 'inline cacheing') -----
+ literalBeforeFollowingAddress: followingAddress
+ 	"Answer the long constant loaded by a MOV/ORR/ORR/ORR
+ 	 or MOV/ORR/ORR/ORR/PUSH, or MOV/ORR/ORR/ORR/CMP sequence, just before this address:"
+ 	^(self instructionIsOR: (self instructionBeforeAddress: followingAddress))
+ 		ifTrue: [self extract32BitOperandFrom4InstructionsPreceeding: followingAddress]
+ 		ifFalse: [self extract32BitOperandFrom4InstructionsPreceeding: followingAddress - 4]!

Item was added:
+ ----- Method: CogInLineLiteralsARMCompiler>>literalLoadInstructionBytes (in category 'accessing') -----
+ literalLoadInstructionBytes
+ 	"Answer the size of a literal load instruction.  With in-line literals this is 4 instructions."
+ 	<inline: true>
+ 	^16!

Item was added:
+ ----- Method: CogInLineLiteralsARMCompiler>>moveCw:intoR: (in category 'generate machine code - support') -----
+ moveCw: constant intoR: destReg
+ 	"Emit a load of aWord into destReg.  Because most ARM instruction enable using a (8-12bit) offset relative to a
+ 	 register, the LS Byte can be included in that instruction, saving one instruction. This is done in a decorator,
+ 	 e.g. concretizeDataOperationCwR:  Generates along the lines of
+ 		MOV destReg, #<constantByte3>, 12
+ 		ORR destReg, destReg, #<constantByte2>, 8
+ 		ORR destReg, destReg, #<constantByte1>, 4
+ 		ORR destReg, destReg, #<constantByte0>, 0
+ 	 with minimal choice of the rotation (last digit).
+ 	 The same register can be modified multiple times, because the operation is (inclusive) or."
+ 	 <var: 'constant' type: #usqInt>
+ 	<inline: true>
+ 	"self assert: destReg < 12."
+ 
+ 	self machineCodeAt: 0 put: (self mov: destReg imm: (constant >>24 bitAnd: 16rFF) ror: 8).
+ 	self machineCodeAt: 4 put: (self orr: destReg imm: (constant >> 16 bitAnd: 16rFF) ror: 16).
+ 	self machineCodeAt: 8 put: (self orr: destReg imm: (constant >> 8 bitAnd: 16rFF) ror: 24).
+ 	self machineCodeAt: 12 put: (self orr: destReg imm: (constant bitAnd: 16rFF) ror: 0).
+ 	^16!

Item was added:
+ ----- Method: CogInLineLiteralsARMCompiler>>relocateMethodReferenceBeforeAddress:by: (in category 'inline cacheing') -----
+ relocateMethodReferenceBeforeAddress: pc by: delta
+ 	"If possible we generate the method address using pc-relative addressing.
+ 	 If so we don't need to relocate it in code.  So check if pc-relative code was
+ 	 generated, and if not, adjust a long sequence.  There are two cases, a push
+ 	 or a register load.  If a push, then there is a register load, but in the instruction
+ 	 before."
+ 	| pcPreceedingLoad reference |
+ 	pcPreceedingLoad := (self instructionIsPush: (self instructionBeforeAddress: pc))
+ 							ifTrue: [pc - 4]
+ 							ifFalse: [pc].
+ 	"If the load is not done via pc-relative addressing we have to relocate."
+ 	(self isPCRelativeValueLoad: (self instructionBeforeAddress: pcPreceedingLoad)) ifFalse:
+ 		[reference := self extract32BitOperandFrom4InstructionsPreceeding: pcPreceedingLoad.
+ 		 reference := reference + delta.
+ 		 self insert32BitOperand: reference into4InstructionsPreceeding: pcPreceedingLoad]!

Item was added:
+ ----- Method: CogInLineLiteralsARMCompiler>>rewriteFullTransferAt:target:expectedInstruction: (in category 'inline cacheing') -----
+ rewriteFullTransferAt: callSiteReturnAddress target: callTargetAddress expectedInstruction: expectedInstruction
+ 	"Rewrite a CallFull or JumpFull instruction to transfer to a different target.
+ 	 This variant is used to rewrite cached primitive calls.   Answer the extent
+ 	 of the code change which is used to compute the range of the icache to flush."
+ 	<var: #callSiteReturnAddress type: #usqInt>
+ 	<var: #callTargetAddress type: #usqInt>
+ 	"cogit disassembleFrom: callSiteReturnAddress - 20 to: callSiteReturnAddress - 1"
+ 	self assert: (self instructionBeforeAddress: callSiteReturnAddress) = expectedInstruction.
+ 	self insert32BitOperand: callTargetAddress into4InstructionsPreceeding: callSiteReturnAddress - 4.
+ 	self assert: (self callFullTargetFromReturnAddress: callSiteReturnAddress) signedIntToLong = callTargetAddress.
+ 	^20!

Item was added:
+ ----- Method: CogInLineLiteralsARMCompiler>>rewriteInlineCacheAt:tag:target: (in category 'inline cacheing') -----
+ rewriteInlineCacheAt: callSiteReturnAddress tag: cacheTag target: callTargetAddress
+ 	"Rewrite an inline cache to call a different target for a new tag.  This variant is used
+ 	 to link unlinked sends in ceSend:to:numArgs: et al.  Answer the extent of the code
+ 	 change which is used to compute the range of the icache to flush."
+ 	
+ 	"chacheTag contains an oop to the selector which need be loaded before jumping"
+ 	<var: #callSiteReturnAddress type: #usqInt>
+ 	<var: #callTargetAddress type: #usqInt>
+ 	| call callDistance |
+ 	false
+ 		ifTrue: [self assert: callTargetAddress >= cogit minCallAddress]
+ 		ifFalse: [callTargetAddress >= cogit minCallAddress ifFalse:
+ 					[self error: 'linking callsite to invalid address']].
+ 	callDistance := (callTargetAddress - (callSiteReturnAddress + 8 "pc offset"- 4 "return offset")) signedIntToLong.
+ 	self assert: (self isInImmediateJumpRange: callDistance). "we don't support long call updates here"
+ 	call := self bl: callDistance.
+ 	objectMemory longAt: callSiteReturnAddress - 4 put: call.
+ 	self insert32BitOperand: cacheTag into4InstructionsPreceeding: callSiteReturnAddress - 4.
+ 	self assert: (self callTargetFromReturnAddress: callSiteReturnAddress) signedIntToLong = callTargetAddress.
+ 	self assert: (self extract32BitOperandFrom4InstructionsPreceeding: callSiteReturnAddress - 4) = cacheTag.
+ 	"self cCode: ''
+ 		inSmalltalk: [cogit disassembleFrom: callSiteReturnAddress - 20 to: callSiteReturnAddress - 1]."
+ 	^20!

Item was added:
+ ----- Method: CogInLineLiteralsARMCompiler>>rewriteInlineCacheTag:at: (in category 'inline cacheing') -----
+ rewriteInlineCacheTag: cacheTag at: callSiteReturnAddress
+ 	"Rewrite an inline cache with a new tag.  This variant is used
+ 	 by the garbage collector."
+ 	self insert32BitOperand: cacheTag into4InstructionsPreceeding: callSiteReturnAddress -4!

Item was added:
+ ----- Method: CogInLineLiteralsARMCompiler>>sizePCDependentInstructionAt: (in category 'generate machine code') -----
+ sizePCDependentInstructionAt: eventualAbsoluteAddress
+ 	"Size a jump and set its address.  The target may be another instruction
+ 	 or an absolute address.  On entry the address inst var holds our virtual
+ 	 address. On exit address is set to eventualAbsoluteAddress, which is
+ 	 where this instruction will be output.  The span of a jump to a following
+ 	 instruction is therefore between that instruction's address and this
+ 	 instruction's address ((which are both still their virtual addresses), but the
+ 	 span of a jump to a preceeding instruction or to an absolute address is
+ 	 between that instruction's address (which by now is its eventual absolute
+ 	 address) or absolute address and eventualAbsoluteAddress.
+ 
+ 	 ARM is simple; the 26-bit call/jump range means no short jumps.  This routine
+ 	 only has to determine the targets of jumps, not determine sizes."
+ 
+ 	opcode = AlignmentNops ifTrue:
+ 		[| alignment |
+ 		 address := eventualAbsoluteAddress.
+ 		 alignment := operands at: 0.
+ 		 ^machineCodeSize := (eventualAbsoluteAddress + (alignment - 1) bitAnd: alignment negated)
+ 							   - eventualAbsoluteAddress].
+ 	self assert: (self isJump or: [opcode = Call or: [opcode = CallFull]]).
+ 	self isJump ifTrue: [self resolveJumpTarget].
+ 	address := eventualAbsoluteAddress.
+ 	^machineCodeSize := maxSize!

Item was added:
+ ----- Method: CogInLineLiteralsARMCompiler>>storeLiteral:beforeFollowingAddress: (in category 'inline cacheing') -----
+ storeLiteral: literal beforeFollowingAddress: followingAddress
+ 	"Rewrite the long constant loaded by a MOV/ORR/ORR/ORR
+ 	 or MOV/ORR/ORR/ORR/PUSH  sequence, just before this address:"
+ 	^(self instructionIsOR: (self instructionBeforeAddress: followingAddress))
+ 		ifTrue: [self insert32BitOperand: literal into4InstructionsPreceeding: followingAddress]
+ 		ifFalse: [self insert32BitOperand: literal into4InstructionsPreceeding: followingAddress - 4]!

Item was changed:
  ----- Method: CogMethodZone>>limitZony (in category 'accessing') -----
+ limitZony "Let us salute Andrei Tarkovsky and his movie Stalker"
- limitZony "Let us salute Andrei Tarkovski and his movie Stalker"
  	<cmacro: '() ((CogMethod *)mzFreeStart)'>
  	^mzFreeStart!

Item was changed:
  ----- Method: CogMethodZone>>relocateMethodsPreCompaction (in category 'compaction') -----
  relocateMethodsPreCompaction
  	"All surviving methods have had the amount they are going to relocate by
  	 stored in their objectHeader fields.  Relocate all relative calls so that after
  	 the compaction of both the method containing each call and the call target
  	 the calls invoke the same target."
  	| cogMethod |
  	<var: #cogMethod type: #'CogMethod *'>
  	cogMethod := cogit cCoerceSimple: baseAddress to: #'CogMethod *'.
+ 	[cogMethod asUnsignedInteger] whileTrue:
- 	[cogMethod < (cogit cCoerceSimple: mzFreeStart to: #'CogMethod *')] whileTrue:
  		[cogMethod cmType ~= CMFree ifTrue:
  			[cogMethod cmType = CMClosedPIC
  				ifTrue: [cogit relocateCallsInClosedPIC: cogMethod]
  				ifFalse: [cogit relocateCallsAndSelfReferencesInMethod: cogMethod]].
  		 cogMethod := self methodAfter: cogMethod].
  	self relocateAndPruneYoungReferrers.
  	^true!

Item was added:
+ CogARMCompiler subclass: #CogOutOfLineLiteralsARMCompiler
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'VMMaker-JIT'!

Item was added:
+ ----- Method: CogOutOfLineLiteralsARMCompiler class>>literalsManagerClass (in category 'accessing class hierarchy') -----
+ literalsManagerClass
+ 	^OutOfLineLiteralsManager!

Item was added:
+ ----- Method: CogOutOfLineLiteralsARMCompiler>>concretizeLiteral (in category 'generate machine code') -----
+ concretizeLiteral
+ 	self assert: (dependent notNil and: [dependent opcode = Literal and: [dependent address = address]]).
+ 	self machineCodeAt: 0 put: (operands at: 0)!

Item was added:
+ ----- Method: CogOutOfLineLiteralsARMCompiler>>isPCDependent (in category 'testing') -----
+ isPCDependent
+ 	"Answer if the receiver is a pc-dependent instruction.  With out-of-line literals any instruction
+ 	 that refers to a literal depends on the address of the literal, so add them in addition to the jumps."
+ 	^self isJump or: [opcode = AlignmentNops or: [opcode = Call or: [dependent notNil and: [dependent opcode = Literal]]]]!

Item was added:
+ ----- Method: CogOutOfLineLiteralsARMCompiler>>literalLoadInstructionBytes (in category 'accessing') -----
+ literalLoadInstructionBytes
+ 	"Answer the size of a literal load instruction (which does not include the size of the literal).
+ 	 With out-of-line literals this is always a single LDR instruction that refers to the literal."
+ 	<inline: true>
+ 	^4!

Item was added:
+ ----- Method: CogOutOfLineLiteralsARMCompiler>>literalOpcodeIndex (in category 'generate machine code') -----
+ literalOpcodeIndex
+ 	"Hack:  To know how far away a literal is from its referencing instruction we store
+ 	 its opcodeIndex, or -1, if as yet unassigned, in the second operand of the literal."
+ 	<inline: true>
+ 	^operands at: 2!

Item was added:
+ ----- Method: CogOutOfLineLiteralsARMCompiler>>moveCw:intoR: (in category 'generate machine code - support') -----
+ moveCw: constant intoR: destReg
+ 	"Emit a load of aWord into destReg.  Answer the number of bytes of machine code generated.
+ 	 Literals are stored out-of-line; emit a LDR with the relevant offset."
+ 	 <var: 'constant' type: #usqInt>
+ 	<inline: true>
+ 	self machineCodeAt: 0 put: (self ldr: destReg rn: PC plusImm: address - dependent address).
+ 	^machineCodeSize := 4!

Item was added:
+ ----- Method: CogOutOfLineLiteralsARMCompiler>>setLiteralOpcodeIndex: (in category 'generate machine code') -----
+ setLiteralOpcodeIndex: index
+ 	"Hack:  To know how far away a literal is from its referencing instruction we store
+ 	 its opcodeIndex, or -1, if as yet unassigned, in the second operand of the literal."
+ 	<inline: true>
+ 	^operands at: 2 put: index!

Item was added:
+ ----- Method: CogOutOfLineLiteralsARMCompiler>>sizePCDependentInstructionAt: (in category 'generate machine code') -----
+ sizePCDependentInstructionAt: eventualAbsoluteAddress
+ 	"Size a jump and set its address.  The target may be another instruction
+ 	 or an absolute address.  On entry the address inst var holds our virtual
+ 	 address. On exit address is set to eventualAbsoluteAddress, which is
+ 	 where this instruction will be output.  The span of a jump to a following
+ 	 instruction is therefore between that instruction's address and this
+ 	 instruction's address ((which are both still their virtual addresses), but the
+ 	 span of a jump to a preceeding instruction or to an absolute address is
+ 	 between that instruction's address (which by now is its eventual absolute
+ 	 address) or absolute address and eventualAbsoluteAddress.
+ 
+ 	 ARM is simple; the 26-bit call/jump range means no short jumps.  This routine
+ 	 only has to determine the targets of jumps, not determine sizes."
+ 
+ 	opcode = AlignmentNops ifTrue:
+ 		[| alignment |
+ 		 address := eventualAbsoluteAddress.
+ 		 alignment := operands at: 0.
+ 		 ^machineCodeSize := (eventualAbsoluteAddress + (alignment - 1) bitAnd: alignment negated)
+ 							   - eventualAbsoluteAddress].
+ 	self assert: (self isJump or: [opcode = Call or: [opcode = CallFull
+ 				or: [dependent notNil and: [dependent opcode = Literal]]]]).
+ 	self isJump ifTrue: [self resolveJumpTarget].
+ 	address := eventualAbsoluteAddress.
+ 	(opcode = Literal and: [dependent notNil and: [dependent opcode = Literal]]) ifTrue:
+ 		[dependent address: address].
+ 	^machineCodeSize := maxSize!

Item was added:
+ ----- Method: CogOutOfLineLiteralsARMCompiler>>updateLabel: (in category 'generate machine code') -----
+ updateLabel: labelInstruction
+ 	opcode ~= Literal ifTrue:
+ 		[super updateLabel: labelInstruction]!

Item was added:
+ ----- Method: CogOutOfLineLiteralsARMCompiler>>usesOutOfLineLiteral (in category 'testing') -----
+ usesOutOfLineLiteral
+ 	"Answer if the receiver uses an out-of-line literal.  Needs only
+ 	 to work for the opcodes created with gen:literal:operand: et al."
+ 
+ 	opcode
+ 		caseOf: {
+ 		[CallFull]		-> [^true].
+ 		[JumpFull]		-> [^true].
+ 		"Arithmetic"
+ 		[AddCqR]		-> [^self rotateable8bitImmediate: (operands at: 0) ifTrue: [:r :i| false] ifFalse: [true]].
+ 		[AndCqR]		-> [^self rotateable8bitImmediate: (operands at: 0) ifTrue: [:r :i| false] ifFalse: [true]].
+ 		[AndCqRR]		-> [^self rotateable8bitImmediate: (operands at: 0) ifTrue: [:r :i| false] ifFalse: [true]].
+ 		[CmpCqR]		-> [^self rotateable8bitImmediate: (operands at: 0) ifTrue: [:r :i| false] ifFalse: [true]].
+ 		[OrCqR]			-> [^self rotateable8bitImmediate: (operands at: 0) ifTrue: [:r :i| false] ifFalse: [true]].
+ 		[SubCqR]		-> [^self rotateable8bitImmediate: (operands at: 0) ifTrue: [:r :i| false] ifFalse: [true]].
+ 		[TstCqR]		-> [^self rotateable8bitImmediate: (operands at: 0) ifTrue: [:r :i| false] ifFalse: [true]].
+ 		[XorCqR]		-> [^self rotateable8bitImmediate: (operands at: 0) ifTrue: [:r :i| false] ifFalse: [true]].
+ 		[AddCwR]		-> [^true].
+ 		[AndCwR]		-> [^true].
+ 		[CmpCwR]		-> [^true].
+ 		[OrCwR]		-> [^true].
+ 		[SubCwR]		-> [^true].
+ 		[XorCwR]		-> [^true].
+ 		[LoadEffectiveAddressMwrR]
+ 						-> [^self rotateable8bitImmediate: (operands at: 0) ifTrue: [:r :i| false] ifFalse: [true]].
+ 		"Data Movement"						
+ 		[MoveCqR]		-> [^self rotateable8bitImmediate: (operands at: 0) ifTrue: [:r :i| false] ifFalse: [true]].
+ 		[MoveCwR]		-> [^true].
+ 		[MoveAwR]		-> [^(self isAddressRelativeToVarBase: (operands at: 0)) ifTrue: [false] ifFalse: [true]].
+ 		[MoveRAw]		-> [^(self isAddressRelativeToVarBase: (operands at: 1)) ifTrue: [false] ifFalse: [true]].
+ 		[MoveRMwr]	-> [^self is12BitValue: (operands at: 1) ifTrue: [:u :i| false] ifFalse: [true]].
+ 		[MoveRdM64r]	-> [^true]. 
+ 		[MoveMbrR]		-> [^self is12BitValue: (operands at: 0) ifTrue: [:u :i| false] ifFalse: [true]].
+ 		[MoveRMbr]		-> [^self is12BitValue: (operands at: 1) ifTrue: [:u :i| false] ifFalse: [true]].
+ 		[MoveM16rR]	-> [^self rotateable8bitImmediate: (operands at: 0) ifTrue: [:r :i| false] ifFalse: [true]].
+ 		[MoveM64rRd]	-> [^true].
+ 		[MoveMwrR]	-> [^self is12BitValue: (operands at: 0) ifTrue: [:u :i| false] ifFalse: [true]].
+ 		[PushCw]		-> [^true].
+ 		[PushCq]		-> [^self rotateable8bitImmediate: (operands at: 0) ifTrue: [:r :i| false] ifFalse: [true]].
+ 		[PrefetchAw] 	-> [^(self isAddressRelativeToVarBase: (operands at: 0)) ifTrue: [false] ifFalse: [true]].
+ 		}
+ 		otherwise: [self assert: false].
+ 	^false "to keep C compiler quiet"
+ !

Item was changed:
  SharedPool subclass: #CogRTLOpcodes
  	instanceVariableNames: ''
+ 	classVariableNames: 'AddCqR AddCwR AddRR AddRdRd AlignmentNops AndCqR AndCqRR AndCwR AndRR Arg0Reg Arg1Reg ArithmeticShiftRightCqR ArithmeticShiftRightRR Call CallFull ClassReg CmpCqR CmpCwR CmpRR CmpRdRd ConvertRRd DPFPReg0 DPFPReg1 DPFPReg2 DPFPReg3 DPFPReg4 DPFPReg5 DPFPReg6 DPFPReg7 DivRdRd FPReg Fill16 Fill32 Fill8 FillBytesFrom FillFromWord FirstJump FirstShortJump GPRegMax GPRegMin 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 MulCqR MulCwR MulRR MulRdRd NegateR Nop OrCqR OrCwR OrRR PCReg PopR PrefetchAw PushCq PushCw PushR RISCTempReg ReceiverResultReg RetN SPReg SendNumArgsReg SqrtRd Stop SubCqR SubCwR SubRR SubRdRd TempReg TstCqR VarBaseReg XorCqR XorCwR XorRR'
- 	classVariableNames: 'AddCqR AddCwR AddRR AddRdRd AlignmentNops AndCqR AndCqRR AndCwR AndRR Arg0Reg Arg1Reg ArithmeticShiftRightCqR ArithmeticShiftRightRR Call CallFull ClassReg CmpCqR CmpCwR CmpRR CmpRdRd ConvertRRd DPFPReg0 DPFPReg1 DPFPReg2 DPFPReg3 DPFPReg4 DPFPReg5 DPFPReg6 DPFPReg7 DivRdRd FPReg Fill16 Fill32 Fill8 FillBytesFrom FillFromWord FirstJump FirstShortJump GPRegMax GPRegMin 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 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 MulCqR MulCwR MulRR MulRdRd NegateR Nop OrCqR OrCwR OrRR PCReg PopR PrefetchAw PushCq PushCw PushR RISCTempReg ReceiverResultReg RetN SPReg SendNumArgsReg SqrtRd Stop 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
  		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."
  
  	| opcodeNames refs |
  	self flag: 'GPRegMin and GPRegMax are poorly thought-out and should instead defer to the backEnd for allocateable registers.'.
  	"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 := GPRegMax := -3. "The receiver at point of send, and return value from 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 := GPRegMin := -8.
  
  	"Floating-point registers"
  	DPFPReg0 := -9.
  	DPFPReg1 := -10.
  	DPFPReg2 := -11.
  	DPFPReg3 := -12.
  	DPFPReg4 := -13.
  	DPFPReg5 := -14.
  	DPFPReg6 := -15.
  	DPFPReg7 := -16.
  
  	"RISC-specific"
  	LinkReg := -17.
  	RISCTempReg := -18.
  	PCReg := -19.
  	VarBaseReg := -20. "If useful, points to base of interpreter variables."
  
  	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 MulRR
  						CmpCqR AddCqR SubCqR AndCqR OrCqR TstCqR XorCqR MulCqR
  						CmpCwR AddCwR SubCwR AndCwR OrCwR XorCwR MulCwR
  
  						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:
  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 initialPC endPC methodOrBlockNumArgs inBlock needsFrame hasYoungReferent primitiveIndex backEnd literalsManager callerSavedRegMask postCompileHook primInvokeLabel methodLabel stackCheckLabel blockEntryLabel blockEntryNoContextSwitch blockNoContextSwitchOffset stackOverflowCall sendMiss missOffset entryPointMask checkedEntryAlignment uncheckedEntryAlignment cmEntryOffset entry cmNoCheckEntryOffset noCheckEntry picMNUAbort picInterpretAbort endCPICCase0 endCPICCase1 numPICCases firstCPICCaseOffset cPICCaseSize cPICEndSize closedPICSize openPICSize fixups abstractOpcodes annotations generatorTable primitiveGeneratorTable byte0 byte1 byte2 byte3 bytecodePC bytecodeSetOffset opcodeIndex numAbstractOpcodes annotationIndex 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 ceCaptureCStackPointers ceFlushICache ceCheckFeaturesFunction ceTraceLinkedSendTrampoline ceTraceBlockActivationTrampoline ceTraceStoreTrampoline ceGetSP ordinarySendTrampolines superSendTrampolines directedSuperSendTrampolines dynamicSuperSendTrampolines outerSendTrampolines selfSendTrampolines firstSend lastSend realCEEnterCogCodePopReceiverReg realCECallCogCodePopReceiverReg realCECallCogCodePopReceiverAndClassRegs trampolineTableIndex trampolineAddresses objectReferencesInRuntime runtimeObjectRefIndex cFramePointerInUse debugPrimCallStackOffset ceTryLockVMOwner ceUnlockVMOwner cogMethodSurrogateClass cogBlockMethodSurrogateClass extA extB numIRCs indexOfIRC theIRCs implicitReceiverSendTrampolines nsSendCacheSurrogateClass tempOop'
- 	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 initialPC endPC methodOrBlockNumArgs inBlock needsFrame hasYoungReferent primitiveIndex backEnd callerSavedRegMask postCompileHook primInvokeLabel methodLabel stackCheckLabel blockEntryLabel blockEntryNoContextSwitch blockNoContextSwitchOffset stackOverflowCall sendMiss missOffset entryPointMask checkedEntryAlignment uncheckedEntryAlignment cmEntryOffset entry cmNoCheckEntryOffset noCheckEntry picMNUAbort picInterpretAbort endCPICCase0 endCPICCase1 numPICCases firstCPICCaseOffset cPICCaseSize cPICEndSize closedPICSize openPICSize fixups abstractOpcodes annotations generatorTable primitiveGeneratorTable byte0 byte1 byte2 byte3 bytecodePC bytecodeSetOffset opcodeIndex numAbstractOpcodes annotationIndex 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 ceCaptureCStackPointers ceFlushICache ceCheckFeaturesFunction ceTraceLinkedSendTrampoline ceTraceBlockActivationTrampoline ceTraceStoreTrampoline ceGetSP ordinarySendTrampolines superSendTrampolines directedSuperSendTrampolines dynamicSuperSendTrampolines outerSendTrampolines selfSendTrampolines firstSend lastSend realCEEnterCogCodePopReceiverReg realCECallCogCodePopReceiverReg realCECallCogCodePopReceiverAndClassRegs trampolineTableIndex trampolineAddresses objectReferencesInRuntime runtimeObjectRefIndex cFramePointerInUse debugPrimCallStackOffset ceTryLockVMOwner ceUnlockVMOwner cogMethodSurrogateClass cogBlockMethodSurrogateClass extA extB numIRCs indexOfIRC theIRCs implicitReceiverSendTrampolines nsSendCacheSurrogateClass tempOop'
  	classVariableNames: 'AltBlockCreationBytecodeSize AltFirstSpecialSelector AltNSSendIsPCAnnotated 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 NumObjRefsInRuntime NumOopsPerNSC NumTrampolines ProcessorClass'
  	poolDictionaries: '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 changed:
  ----- Method: Cogit class>>activeCompilerClass (in category 'translation') -----
  activeCompilerClass
+ 	^initializationOptions
+ 		at: #CogCompilerClass
+ 		ifPresent: [:compilerClassName| Smalltalk classNamed: compilerClassName]
+ 		ifAbsent:
+ 			[CogAbstractInstruction subclasses detect:
+ 				[:compilerClass|
+ 				 compilerClass ISA == (initializationOptions at: #ISA)]]!
- 	^CogAbstractInstruction subclasses detect: [:compilerClass| compilerClass ISA == (initializationOptions at: #ISA)]!

Item was changed:
  ----- Method: Cogit class>>initializeMiscConstants (in category 'class initialization') -----
  initializeMiscConstants
  	super initializeMiscConstants.
  	Debug := initializationOptions at: #Debug ifAbsent: [false].
  	(initializationOptions includesKey: #EagerInstructionDecoration)
  		ifTrue:
  			[EagerInstructionDecoration := initializationOptions at: #EagerInstructionDecoration]
  		ifFalse:
  			[EagerInstructionDecoration isNil ifTrue:
  				[EagerInstructionDecoration := false]]. "speeds up single stepping but could lose fidelity"
  
  	ProcessorClass := (initializationOptions at: #ISA ifAbsentPut: [#IA32]) caseOf: {
  							[#IA32] 	->	[BochsIA32Alien].
  							[#ARMv5]	->	[GdbARMAlien]. }.
+ 	CogCompilerClass := self activeCompilerClass.
- 
  	"Our criterion for which methods to JIT is literal count.  The default value is 60 literals or less."
  	MaxLiteralCountForCompile := initializationOptions at: #MaxLiteralCountForCompile ifAbsent: [60].
  	"we special-case 0, 1 & 2 argument sends, N is numArgs >= 3"
  	NumSendTrampolines := 4.
  	"Currently not even the ceImplicitReceiverTrampoline contains object references."
  	NumObjRefsInRuntime := 0.
  
  	NSCSelectorIndex := (NSSendCache instVarNames indexOf: #selector) - 1.
  	NSCNumArgsIndex := (NSSendCache instVarNames indexOf: #numArgs) - 1.
  	NSCClassTagIndex := (NSSendCache instVarNames indexOf: #classTag) - 1.
  	NSCEnclosingObjectIndex := (NSSendCache instVarNames indexOf: #enclosingObject) - 1.
  	NSCTargetIndex := (NSSendCache instVarNames indexOf: #target) - 1.
  	NumOopsPerNSC := NSSendCache instVarNames size.
  
  	"Max size to alloca when compiling.
  	 Mac OS X 10.6.8 segfaults approaching 8Mb.
  	 Linux 2.6.9 segfaults above 11Mb.
  	 WIndows XP segfaults approaching 2Mb."
  	MaxStackAllocSize := 1024 * 1024 * 3 / 2 !

Item was changed:
  ----- Method: Cogit>>AddCq:R: (in category 'abstract instructions') -----
  AddCq: quickConstant R: reg
  	<inline: true>
  	<returnTypeC: #'AbstractInstruction *'>
+ 	^self gen: AddCqR quickConstant: quickConstant operand: reg!
- 	^self gen: AddCqR operand: quickConstant operand: reg!

Item was changed:
  ----- Method: Cogit>>AddCw:R: (in category 'abstract instructions') -----
  AddCw: wordConstant R: reg
  	<inline: true>
  	<returnTypeC: #'AbstractInstruction *'>
+ 	^self gen: AddCwR literal: wordConstant operand: reg!
- 	^self gen: AddCwR operand: wordConstant operand: reg!

Item was changed:
  ----- Method: Cogit>>AndCq:R: (in category 'abstract instructions') -----
  AndCq: quickConstant R: reg
  	<inline: true>
  	<returnTypeC: #'AbstractInstruction *'>
+ 	^self gen: AndCqR quickConstant: quickConstant operand: reg!
- 	^self gen: AndCqR operand: quickConstant operand: reg!

Item was changed:
  ----- Method: Cogit>>AndCq:R:R: (in category 'abstract instructions') -----
  AndCq: quickConstant R: srcReg R: destReg
  	<inline: true>
  	<returnTypeC: #'AbstractInstruction *'>
  	| first |
  	<var: 'first' type: #'AbstractInstruction *'>
  	backEnd hasThreeAddressArithmetic ifTrue:
+ 		[^self gen: AndCqRR quickConstant: quickConstant operand: srcReg operand: destReg].
- 		[^self gen: AndCqRR operand: quickConstant operand: srcReg operand: destReg].
  	first := self gen: MoveRR operand: srcReg operand: destReg.
+ 	self gen: AndCqR quickConstant: quickConstant operand: destReg.
- 	self gen: AndCqR operand: quickConstant operand: destReg.
  	^first!

Item was changed:
  ----- Method: Cogit>>AndCw:R: (in category 'abstract instructions') -----
  AndCw: wordConstant R: reg
  	<inline: true>
  	<returnTypeC: #'AbstractInstruction *'>
+ 	^self gen: AndCwR literal: wordConstant operand: reg!
- 	^self gen: AndCwR operand: wordConstant operand: reg!

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

Item was changed:
  ----- Method: Cogit>>CmpCq:R: (in category 'abstract instructions') -----
  CmpCq: quickConstant R: reg
  	<inline: true>
  	<returnTypeC: #'AbstractInstruction *'>
+ 	^self gen: CmpCqR quickConstant: quickConstant operand: reg!
- 	^self gen: CmpCqR operand: quickConstant operand: reg!

Item was changed:
  ----- Method: Cogit>>CmpCw:R: (in category 'abstract instructions') -----
  CmpCw: wordConstant R: reg
  	<inline: true>
  	<returnTypeC: #'AbstractInstruction *'>
+ 	^self gen: CmpCwR literal: wordConstant operand: reg!
- 	^self gen: CmpCwR operand: wordConstant operand: reg!

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

Item was changed:
  ----- Method: Cogit>>LoadEffectiveAddressMw:r:R: (in category 'abstract instructions') -----
  LoadEffectiveAddressMw: offset r: baseReg R: destReg
  	<inline: true>
  	<returnTypeC: #'AbstractInstruction *'>
+ 	^self gen: LoadEffectiveAddressMwrR quickConstant: offset operand: baseReg operand: destReg!
- 	^self gen: LoadEffectiveAddressMwrR operand: offset operand: baseReg operand: destReg!

Item was changed:
  ----- Method: Cogit>>MoveAw:R: (in category 'abstract instructions') -----
  MoveAw: address R: reg 
  	<inline: true>
  	<returnTypeC: #'AbstractInstruction *'>
+ 	^self gen: MoveAwR literal: address operand: reg!
- 	^self gen: MoveAwR operand: address operand: reg!

Item was changed:
  ----- Method: Cogit>>MoveCq:R: (in category 'abstract instructions') -----
  MoveCq: quickConstant R: reg
  	<inline: true>
  	<returnTypeC: #'AbstractInstruction *'>
+ 	^self gen: MoveCqR quickConstant: quickConstant operand: reg!
- 	^self gen: MoveCqR operand: quickConstant operand: reg!

Item was changed:
  ----- Method: Cogit>>MoveCw:R: (in category 'abstract instructions') -----
  MoveCw: wordConstant R: reg
  	<inline: true>
  	<returnTypeC: #'AbstractInstruction *'>
+ 	^self gen: MoveCwR literal: wordConstant operand: reg!
- 	^self gen: MoveCwR operand: wordConstant operand: reg!

Item was changed:
  ----- Method: Cogit>>MoveM16:r:R: (in category 'abstract instructions') -----
  MoveM16: offset r: baseReg R: destReg
  	<inline: true>
  	<returnTypeC: #'AbstractInstruction *'>
+ 	^self gen: MoveM16rR quickConstant: offset operand: baseReg operand: destReg!
- 	^self gen: MoveM16rR operand: offset operand: baseReg operand: destReg!

Item was changed:
  ----- Method: Cogit>>MoveM64:r:Rd: (in category 'abstract instructions') -----
  MoveM64: offset r: baseReg Rd: destDPReg
  	<inline: true>
  	<returnTypeC: #'AbstractInstruction *'>
+ 	^self gen: MoveM64rRd quickConstant: offset operand: baseReg operand: destDPReg!
- 	^self gen: MoveM64rRd operand: offset operand: baseReg operand: destDPReg!

Item was changed:
  ----- Method: Cogit>>MoveMb:r:R: (in category 'abstract instructions') -----
  MoveMb: offset r: baseReg R: destReg
  	"N.B.  This instruction is guaranteed to zero-extend the byte into destReg."
  	<inline: true>
  	<returnTypeC: #'AbstractInstruction *'>
+ 	^self gen: MoveMbrR quickConstant: offset operand: baseReg operand: destReg!
- 	^self gen: MoveMbrR operand: offset operand: baseReg operand: destReg!

Item was changed:
  ----- Method: Cogit>>MoveMw:r:R: (in category 'abstract instructions') -----
  MoveMw: offset r: baseReg R: destReg
  	<inline: true>
  	<returnTypeC: #'AbstractInstruction *'>
+ 	^self gen: MoveMwrR quickConstant: offset operand: baseReg operand: destReg!
- 	^self gen: MoveMwrR operand: offset operand: baseReg operand: destReg!

Item was changed:
  ----- Method: Cogit>>MoveR:Aw: (in category 'abstract instructions') -----
  MoveR: reg Aw: address
  	<inline: true>
  	<returnTypeC: #'AbstractInstruction *'>
+ 	^self gen: MoveRAw operand: reg literal: address!
- 	^self gen: MoveRAw operand: reg operand: address!

Item was changed:
  ----- Method: Cogit>>MoveR:Mb:r: (in category 'abstract instructions') -----
  MoveR: sourceReg Mb: offset r: baseReg 
  	<inline: true>
  	<returnTypeC: #'AbstractInstruction *'>
+ 	^self gen: MoveRMbr operand: sourceReg quickConstant: offset operand: baseReg!
- 	^self gen: MoveRMbr operand: sourceReg operand: offset operand: baseReg!

Item was changed:
  ----- Method: Cogit>>MoveR:Mw:r: (in category 'abstract instructions') -----
  MoveR: sourceReg Mw: offset r: baseReg 
  	<inline: true>
  	<returnTypeC: #'AbstractInstruction *'>
+ 	^self gen: MoveRMwr operand: sourceReg quickConstant: offset operand: baseReg!
- 	^self gen: MoveRMwr operand: sourceReg operand: offset operand: baseReg!

Item was changed:
  ----- Method: Cogit>>MoveRd:M64:r: (in category 'abstract instructions') -----
  MoveRd: sourceDPReg M64: offset r: baseReg
  	<inline: true>
  	<returnTypeC: #'AbstractInstruction *'>
+ 	^self gen: MoveRdM64r operand: sourceDPReg quickConstant: offset operand: baseReg!
- 	^self gen: MoveRdM64r operand: sourceDPReg operand: offset operand: baseReg!

Item was changed:
  ----- Method: Cogit>>OrCq:R: (in category 'abstract instructions') -----
  OrCq: quickConstant R: reg
  	<inline: true>
  	<returnTypeC: #'AbstractInstruction *'>
+ 	^self gen: OrCqR quickConstant: quickConstant operand: reg!
- 	^self gen: OrCqR operand: quickConstant operand: reg!

Item was changed:
  ----- Method: Cogit>>OrCw:R: (in category 'abstract instructions') -----
  OrCw: wordConstant R: reg
  	<inline: true>
  	<returnTypeC: #'AbstractInstruction *'>
+ 	^self gen: OrCwR literal: wordConstant operand: reg!
- 	^self gen: OrCwR operand: wordConstant operand: reg!

Item was changed:
  ----- Method: Cogit>>PrefetchAw: (in category 'abstract instructions') -----
  PrefetchAw: address
  	<inline: true>
  	<returnTypeC: #'AbstractInstruction *'>
+ 	^self gen: PrefetchAw literal: address!
- 	^self gen: PrefetchAw operand: address!

Item was changed:
  ----- Method: Cogit>>PushCq: (in category 'abstract instructions') -----
  PushCq: wordConstant
  	<inline: true>
  	<returnTypeC: #'AbstractInstruction *'>
+ 	^self gen: PushCq quickConstant: wordConstant!
- 	^self gen: PushCq operand: wordConstant!

Item was changed:
  ----- Method: Cogit>>PushCw: (in category 'abstract instructions') -----
  PushCw: wordConstant
  	<inline: true>
  	<returnTypeC: #'AbstractInstruction *'>
+ 	^self gen: PushCw literal: wordConstant!
- 	^self gen: PushCw operand: wordConstant!

Item was changed:
  ----- Method: Cogit>>SubCq:R: (in category 'abstract instructions') -----
  SubCq: quickConstant R: reg
  	<inline: true>
  	<returnTypeC: #'AbstractInstruction *'>
+ 	^self gen: SubCqR quickConstant: quickConstant operand: reg!
- 	^self gen: SubCqR operand: quickConstant operand: reg!

Item was changed:
  ----- Method: Cogit>>SubCw:R: (in category 'abstract instructions') -----
  SubCw: wordConstant R: reg
  	<inline: true>
  	<returnTypeC: #'AbstractInstruction *'>
+ 	^self gen: SubCwR literal: wordConstant operand: reg!
- 	^self gen: SubCwR operand: wordConstant operand: reg!

Item was changed:
  ----- Method: Cogit>>TstCq:R: (in category 'abstract instructions') -----
  TstCq: quickConstant R: reg
  	<inline: true>
  	<returnTypeC: #'AbstractInstruction *'>
+ 	^self gen: TstCqR quickConstant: quickConstant operand: reg!
- 	^self gen: TstCqR operand: quickConstant operand: reg!

Item was changed:
  ----- Method: Cogit>>XorCw:R: (in category 'abstract instructions') -----
  XorCw: wordConstant R: reg
  	<inline: true>
  	<returnTypeC: #'AbstractInstruction *'>
+ 	^self gen: XorCwR literal: wordConstant operand: reg!
- 	^self gen: XorCwR operand: wordConstant operand: reg!

Item was changed:
  ----- Method: Cogit>>allocateOpcodes:bytecodes: (in category 'initialization') -----
  allocateOpcodes: numberOfAbstractOpcodes bytecodes: numberOfBytecodes
  	"Allocate the various arrays needed to compile abstract instructions.
  	 This needs to be a macro since the arrays are alloca'ed (stack allocated)
  	 to ensure their being freed when compilation is done.
  	 Notionally we only need as many fixups as there are bytecodes.  But we
  	 reuse fixups to record pc-dependent instructions in generateInstructionsAt:
  	 and so need at least as many as there are abstract opcodes.
  
  	 N.B. We do one single alloca to save embarrassing C optimizers that
  	 generate incorrect code as both gcc and the intel compiler do on x86."
  	<cmacro: '(numberOfAbstractOpcodes,numberOfBytecodes) do { \
  		int opcodeSize = sizeof(AbstractInstruction) * (numAbstractOpcodes = (numberOfAbstractOpcodes)); \
  		int fixupSize = sizeof(BytecodeFixup) * numAbstractOpcodes; \
  		int annotationSize = sizeof(InstructionAnnotation) * ((numAbstractOpcodes + 3) / 4); \
  		abstractOpcodes = alloca(opcodeSize + fixupSize + annotationSize); \
  		bzero(abstractOpcodes, opcodeSize + fixupSize); \
  		fixups = (void *)((char *)abstractOpcodes + opcodeSize); \
  		annotations = (void *)((char *)fixups + fixupSize); \
  		opcodeIndex = labelCounter = annotationIndex = 0; \
  } while (0)'>
  	numAbstractOpcodes := numberOfAbstractOpcodes.
  	abstractOpcodes := CArrayAccessor on:
  						((1 to: numAbstractOpcodes) collect:
+ 							[:ign| CogCompilerClass for: self]).
- 							[:ign| processor abstractInstructionCompilerClass for: self]).
  	fixups := CArrayAccessor on:
  						((1 to: numAbstractOpcodes) collect:
  							[:ign| self bytecodeFixupClass new]).
  	annotations := CArrayAccessor on:
  						((1 to: numAbstractOpcodes + 3 // 4) collect:
  							[:ign| CogInstructionAnnotation new]).
  	opcodeIndex := labelCounter := annotationIndex := 0!

Item was changed:
  ----- Method: Cogit>>allocateOpcodes:bytecodes:ifFail: (in category 'initialization') -----
  allocateOpcodes: numberOfAbstractOpcodes bytecodes: numberOfBytecodes ifFail: failBlock
  	"Allocate the various arrays needed to compile abstract instructions.
  	 This needs to be a macro since the arrays are alloca'ed (stack allocated)
  	 to ensure their being freed when compilation is done.
  	 Notionally we only need as many fixups as there are bytecodes.  But we
  	 reuse fixups to record pc-dependent instructions in generateInstructionsAt:
  	 and so need at least as many as there are abstract opcodes.
  
  	 N.B. We do one single alloca to save embarrassing C optimizers that
  	 generate incorrect code as both gcc and the intel compiler do on x86."
  	<cmacro: '(numberOfAbstractOpcodes,numberOfBytecodes,failBlock) do { \
  		int opcodeSize = sizeof(AbstractInstruction) * (numAbstractOpcodes = (numberOfAbstractOpcodes)); \
  		int fixupSize = sizeof(BytecodeFixup) * numAbstractOpcodes; \
  		int annotationSize = sizeof(InstructionAnnotation) * ((numAbstractOpcodes + 3) / 4); \
  		int allocSize = opcodeSize + fixupSize + annotationSize; \
  		if (allocSize > MaxStackAllocSize) failBlock; \
  		abstractOpcodes = alloca(allocSize); \
  		bzero(abstractOpcodes, opcodeSize + fixupSize); \
  		fixups = (void *)((char *)abstractOpcodes + opcodeSize); \
  		annotations = (void *)((char *)fixups + fixupSize); \
  		opcodeIndex = labelCounter = annotationIndex = 0; \
  } while (0)'>
  	| opcodeSize fixupSize annotationSize allocSize |
  	opcodeSize := (self sizeof: CogAbstractInstruction) * numberOfAbstractOpcodes.
  	fixupSize := (self sizeof: CogBytecodeFixup) * numberOfAbstractOpcodes.
  	annotationSize := (self sizeof: CogInstructionAnnotation) * ((numberOfAbstractOpcodes + 3) / 4).
  	allocSize := opcodeSize + fixupSize + annotationSize.
  	allocSize > MaxStackAllocSize ifTrue: [^failBlock value].
  	numAbstractOpcodes := numberOfAbstractOpcodes.
  	abstractOpcodes := CArrayAccessor on:
  						((1 to: numAbstractOpcodes) collect:
+ 							[:ign| CogCompilerClass for: self]).
- 							[:ign| processor abstractInstructionCompilerClass for: self]).
  	fixups := CArrayAccessor on:
  						((1 to: numAbstractOpcodes) collect:
  							[:ign| self bytecodeFixupClass new]).
  	annotations := CArrayAccessor on:
  						((1 to: numAbstractOpcodes + 3 // 4) collect:
  							[:ign| CogInstructionAnnotation new]).
  	opcodeIndex := labelCounter := annotationIndex := 0!

Item was changed:
  ----- Method: Cogit>>cCoerceSimple:to: (in category 'translation support') -----
  cCoerceSimple: value to: cTypeString
  	<doNotGenerate>
  	cTypeString == #'CogMethod *' ifTrue:
  		[^(value isInteger and: [value < 0])
  			ifTrue: [value] "it's an error code; leave it be"
  			ifFalse: [self cogMethodSurrogateAt: value asUnsignedInteger]].
  	cTypeString == #'CogBlockMethod *' ifTrue:
  		[^self cogBlockMethodSurrogateAt: value asUnsignedInteger].
  	cTypeString == #'NSSendCache *' ifTrue:
  		[^self nsSendCacheSurrogateAt: value asUnsignedInteger].
  	(cTypeString == #'AbstractInstruction *'
  	 and: [value isBehavior]) ifTrue:
+ 		[^CogCompilerClass].
- 		[^processor abstractInstructionCompilerClass].
  	^super cCoerceSimple: value to: cTypeString!

Item was changed:
  ----- Method: Cogit>>cogExtendPIC:CaseNMethod:tag:isMNUCase: (in category 'in-line cacheing') -----
  cogExtendPIC: cPIC CaseNMethod: caseNMethod tag: caseNTag isMNUCase: isMNUCase
  	"Extend the cPIC with the supplied case.  If caseNMethod is cogged dispatch direct to
  	 its unchecked entry-point.  If caseNMethod is not cogged, jump to the fast interpreter
  	 dispatch, and if isMNUCase then dispatch to fast MNU invocation and mark the cPIC as
  	 having the MNU case for cache flushing."
   	<var: #cPIC type: #'CogMethod *'>
  	| operand target address size end |
  	"stack allocate the various collections so that they
  	 are effectively garbage collected on return."
  	coInterpreter
  		compilationBreak: cPIC selector
  		point: (objectMemory numBytesOf: cPIC selector)
  		isMNUCase: isMNUCase.
  	self allocateOpcodes: 5 bytecodes: 0.
+ 	literalsManager resetLiterals: 5.
  	methodLabel address: cPIC asUnsignedInteger; dependent: nil. "for pc-relative MoveCw: cPIC R: ClassReg"
  	self assert: (objectRepresentation inlineCacheTagIsYoung: caseNTag) not.
  	"Caller patches to open pic if caseNMethod is young."
  	self assert: (caseNMethod notNil and: [(objectMemory isYoung: caseNMethod) not]).
  	(isMNUCase not
  	 and: [coInterpreter methodHasCogMethod: caseNMethod])
  		ifTrue:
  			[operand := 0.
  			 target := (coInterpreter cogMethodOf: caseNMethod) asInteger + cmNoCheckEntryOffset]
  		ifFalse:
  			[operand := caseNMethod.
  			 isMNUCase
  				ifTrue:
  					[cPIC cpicHasMNUCase: true.
  					 target := cPIC asInteger + (self sizeof: CogMethod)]
  				ifFalse:
  					[target := cPIC asInteger + self picInterpretAbortOffset]].
  	self CmpCw: caseNTag R: TempReg.
  	self MoveCw: operand R: SendNumArgsReg.
  	self JumpLongZero: target.
  	self MoveCw: cPIC asUnsignedInteger R: ClassReg.
  	self JumpLong: (self cPICMissTrampolineFor: cPIC cmNumArgs).
  	self computeMaximumSizes.
  	address := self addressOfEndOfCase: cPIC cPICNumCases - 1 inCPIC: cPIC.
  	size := self generateInstructionsAt: address.
  	end := self outputInstructionsAt: address.
  	processor flushICacheFrom: cPIC asUnsignedInteger to: cPIC asUnsignedInteger + closedPICSize.
  	cPIC cPICNumCases: cPIC cPICNumCases + 1.
  	^0!

Item was changed:
  ----- Method: Cogit>>cogMNUPICSelector:receiver:methodOperand:numArgs: (in category 'in-line cacheing') -----
  cogMNUPICSelector: selector receiver: rcvr methodOperand: methodOperand numArgs: numArgs
  	<api>
  	"Attempt to create a one-case PIC for an MNU.
  	 The tag for the case is at the send site and so doesn't need to be generated."
  	<returnTypeC: #'CogMethod *'>
  	| startAddress size end |
  	((objectMemory isYoung: selector)
  	 or: [(objectRepresentation inlineCacheTagForInstance: rcvr) = self picAbortDiscriminatorValue]) ifTrue:
  		[^0].
  	coInterpreter
  		compilationBreak: selector
  		point: (objectMemory numBytesOf: selector)
  		isMNUCase: true.
  	self assert: endCPICCase0 notNil.
  	startAddress := methodZone allocate: closedPICSize.
  	startAddress = 0 ifTrue:
  		[coInterpreter callForCogCompiledCodeCompaction.
  		 ^0].
  	"stack allocate the various collections so that they
  	 are effectively garbage collected on return."
  	self allocateOpcodes: numPICCases * 7 bytecodes: 0.
+ 	literalsManager resetLiterals: numPICCases * 2.
  	methodLabel address: startAddress; dependent: nil. "for pc-relative MoveCw: cPIC R: ClassReg"
  	self compileMNUCPIC: (self cCoerceSimple: startAddress to: #'CogMethod *')
  		methodOperand: methodOperand
  		numArgs: numArgs.
  	self computeMaximumSizes.
  	size := self generateInstructionsAt: startAddress + (self sizeof: CogMethod).
  	end := self outputInstructionsAt: startAddress + (self sizeof: CogMethod).
  	"The missOffset is the same as the interpretOffset. On RISCs it includes an additional instruction."
  	self assert: missOffset = ((backEnd hasLinkRegister ifTrue: [backEnd callInstructionByteSize] ifFalse: [0])
  								+ picInterpretAbort address + picInterpretAbort machineCodeSize - startAddress).
  	self assert: startAddress + cmEntryOffset = entry address.
  	^self
  		fillInCPICHeader: (self cCoerceSimple: startAddress to: #'CogMethod *')
  		numArgs: numArgs
  		numCases: 1
  		hasMNUCase: true
  		selector: selector !

Item was changed:
  ----- Method: Cogit>>cogOpenPICSelector:numArgs: (in category 'in-line cacheing') -----
  cogOpenPICSelector: selector numArgs: numArgs
  	"Create an Open PIC.  Temporarily create a direct call of ceSendFromOpenPIC:.
  	 Should become a probe of the first-level method lookup cache followed by a
  	 call of ceSendFromOpenPIC: if the probe fails."
  	<returnTypeC: #'CogMethod *'>
  	| startAddress codeSize mapSize end |
  	coInterpreter
  		compilationBreak: selector
  		point: (objectMemory numBytesOf: selector)
  		isMNUCase: false.
  	startAddress := methodZone allocate: openPICSize.
  	startAddress = 0 ifTrue:
  		[^self cCoerceSimple: InsufficientCodeSpace to: #'CogMethod *'].
  	methodLabel
  		address: startAddress;
  		dependent: nil.
  	"stack allocate the various collections so that they
  	 are effectively garbage collected on return."
  	self allocateOpcodes: 100 bytecodes: 0.
+ 	literalsManager resetLiterals: 10.
  	self compileOpenPIC: selector numArgs: numArgs.
  	self computeMaximumSizes.
  	methodLabel concretizeAt: startAddress.
  	codeSize := self generateInstructionsAt: startAddress + (self sizeof: CogMethod).
  	mapSize := self generateMapAt: startAddress + openPICSize - 1 start: startAddress + cmNoCheckEntryOffset.
  	self assert: entry address - startAddress = cmEntryOffset.
  	self assert: (methodZone roundUpLength: (self sizeof: CogMethod) + codeSize) + (methodZone roundUpLength: mapSize) <= openPICSize.
  	end := self outputInstructionsAt: startAddress + (self sizeof: CogMethod).
  	^self
  		fillInOPICHeader: (self cCoerceSimple: startAddress to: #'CogMethod *')
  		numArgs: numArgs
  		selector: selector !

Item was changed:
  ----- Method: Cogit>>cogPICSelector:numArgs:Case0Method:Case1Method:tag:isMNUCase: (in category 'in-line cacheing') -----
  cogPICSelector: selector numArgs: numArgs Case0Method: case0CogMethod Case1Method: case1MethodOrNil tag: case1Tag isMNUCase: isMNUCase
  	"Attempt to create a two-case PIC for case0CogMethod and  case1Method,case1Tag.
  	 The tag for case0CogMethod is at the send site and so doesn't need to be generated.
  	 case1Method may be any of
  		- a Cog method; link to its unchecked entry-point
  		- a CompiledMethod; link to ceInterpretMethodFromPIC:
  		- a CompiledMethod; link to ceMNUFromPICMNUMethod:receiver:"
  	<var: #case0CogMethod type: #'CogMethod *'>
  	<returnTypeC: #'CogMethod *'>
  	| startAddress size end |
  	(objectMemory isYoung: selector) ifTrue:
  		[^self cCoerceSimple: YoungSelectorInPIC to: #'CogMethod *'].
  	coInterpreter
  		compilationBreak: selector
  		point: (objectMemory numBytesOf: selector)
  		isMNUCase: isMNUCase.
  	startAddress := methodZone allocate: closedPICSize.
  	startAddress = 0 ifTrue:
  		[^self cCoerceSimple: InsufficientCodeSpace to: #'CogMethod *'].
  	"stack allocate the various collections so that they
  	 are effectively garbage collected on return."
  	self allocateOpcodes: numPICCases * 7 bytecodes: 0.
+ 	literalsManager resetLiterals: numPICCases * 2.
  	methodLabel address: startAddress; dependent: nil. "for pc-relative MoveCw: cPIC R: ClassReg"
  	self compileCPIC: (self cCoerceSimple: startAddress to: #'CogMethod *')
  		Case0: case0CogMethod
  		Case1Method: case1MethodOrNil
  		tag: case1Tag
  		isMNUCase: isMNUCase
  		numArgs: numArgs.
  	self computeMaximumSizes.
  	size := self generateInstructionsAt: startAddress + (self sizeof: CogMethod).
  	end := self outputInstructionsAt: startAddress + (self sizeof: CogMethod).
  	"The missOffset is the same as the interpretOffset. On RISCs it includes an additional instruction."
  	self assert: missOffset = ((backEnd hasLinkRegister ifTrue: [backEnd callInstructionByteSize] ifFalse: [0])
  								+ picInterpretAbort address + picInterpretAbort machineCodeSize - startAddress).
  	self assert: startAddress + cmEntryOffset = entry address.
  	self assert: endCPICCase0 address = (startAddress + firstCPICCaseOffset).
  	self assert: endCPICCase1 address = (startAddress + firstCPICCaseOffset + cPICCaseSize).
  	^self
  		fillInCPICHeader: (self cCoerceSimple: startAddress to: #'CogMethod *')
  		numArgs: numArgs
  		numCases: 2
  		hasMNUCase: isMNUCase
  		selector: selector !

Item was changed:
  ----- Method: Cogit>>compileAbstractInstructionsFrom:through: (in category 'compile abstract instructions') -----
  compileAbstractInstructionsFrom: start through: end
  	"Loop over bytecodes, dispatching to the generator for each bytecode, handling fixups in due course."
  	| nextOpcodeIndex descriptor fixup result nExts |
  	<var: #descriptor type: #'BytecodeDescriptor *'>
  	<var: #fixup type: #'BytecodeFixup *'>
  	bytecodePC := start.
  	nExts := 0.
  	[byte0 := (objectMemory fetchByte: bytecodePC ofObject: methodObj)  + bytecodeSetOffset.
  	 descriptor := self generatorAt: byte0.
  	 self loadSubsequentBytesForDescriptor: descriptor at: bytecodePC.
  	 nextOpcodeIndex := opcodeIndex.
  	 result := self perform: descriptor generator.
  	 descriptor isExtension ifFalse: "extended bytecodes must consume their extensions"
  		[self assert: (extA = 0 and: [extB = 0])].
  	 fixup := self fixupAt: bytecodePC - initialPC.
  	 fixup targetInstruction ~= 0 ifTrue:
  		["There is a fixup for this bytecode.  It must point to the first generated
  		   instruction for this bytecode.  If there isn't one we need to add a label."
  		 opcodeIndex = nextOpcodeIndex ifTrue:
  			[self Label].
  		 fixup targetInstruction: (self abstractInstructionAt: nextOpcodeIndex)].
+ 	 self maybeDumpLiterals: descriptor.
  	 bytecodePC := self nextBytecodePCFor: descriptor at: bytecodePC exts: nExts in: methodObj.
  	 result = 0 and: [bytecodePC <= end]]
  		whileTrue:
  			[nExts := descriptor isExtension ifTrue: [nExts + 1] ifFalse: [0]].
  	self checkEnoughOpcodes.
  	^result!

Item was changed:
  ----- Method: Cogit>>compileCogMethod: (in category 'compile abstract instructions') -----
  compileCogMethod: selector
  	<returnTypeC: #'CogMethod *'>
  	| numBytecodes numBlocks numCleanBlocks result extra |
  	hasYoungReferent := (objectMemory isYoungObject: methodObj)
  						  or: [objectMemory isYoung: selector].
  	methodOrBlockNumArgs := coInterpreter argumentCountOf: methodObj.
  	inBlock := false.
  	primInvokeLabel := nil.
  	postCompileHook := nil.
  	maxLitIndex := -1.
  	extra := ((primitiveIndex := coInterpreter primitiveIndexOf: methodObj) > 0
  			and: [(coInterpreter isQuickPrimitiveIndex: primitiveIndex) not])
  				ifTrue: [30]
  				ifFalse: [10].
  	initialPC := coInterpreter startPCOfMethod: methodObj.
  	"initial estimate.  Actual endPC is determined in scanMethod."
  	endPC := (coInterpreter isQuickPrimitiveIndex: primitiveIndex)
  					ifTrue: [initialPC - 1]
  					ifFalse: [objectMemory numBytesOf: methodObj].
  	numBytecodes := endPC - initialPC + 1.
  	self allocateOpcodes: (numBytecodes + extra) * self estimateOfAbstractOpcodesPerBytecodes
  		bytecodes: numBytecodes
  		ifFail: [^coInterpreter cCoerceSimple: MethodTooBig to: #'CogMethod *'].
+ 	literalsManager resetLiterals: (objectMemory literalCountOf: methodObj).
  	(numBlocks := self scanMethod) < 0 ifTrue:
  		[^coInterpreter cCoerceSimple: numBlocks to: #'CogMethod *'].
  	numCleanBlocks := self scanForCleanBlocks.
  	self allocateBlockStarts: numBlocks + numCleanBlocks.
  	blockCount := 0.
  	numCleanBlocks > 0 ifTrue:
  		[self addCleanBlockStarts].
  	(self maybeAllocAndInitCounters
  	 and: [self maybeAllocAndInitIRCs]) ifFalse: "Inaccurate error code, but it'll do.  This will likely never fail."
  		[^coInterpreter cCoerceSimple: InsufficientCodeSpace to: #'CogMethod *'].
  	
  	blockEntryLabel := nil.
  	methodLabel dependent: nil.
  	(result := self compileEntireMethod) < 0 ifTrue:
  		[^coInterpreter cCoerceSimple: result to: #'CogMethod *'].
  	^self generateCogMethod: selector!

Item was changed:
  ----- Method: Cogit>>computeEntryOffsets (in category 'initialization') -----
  computeEntryOffsets
  	"Generate the entry code for a method to determine cmEntryOffset and cmNoCheckEntryOffset.  We
  	 need cmNoCheckEntryOffset up front to be able to generate the map starting from cmNoCheckEntryOffset"
  	"stack allocate the various collections so that they
  	 are effectively garbage collected on return."
  	| sendMissCall |
  	<var: 'sendMissCall' type: #'AbstractInstruction *'>
  	self allocateOpcodes: 24 bytecodes: 0.
+ 	literalsManager resetLiterals: 5.
  	methodOrBlockNumArgs := 0.
  	sendMissCall := self compileAbort.
  	self compileEntry.
  	self computeMaximumSizes.
  	self generateInstructionsAt: methodZoneBase + (self sizeof: CogMethod).
  	cmEntryOffset := entry address - methodZoneBase.
  	cmNoCheckEntryOffset := noCheckEntry address - methodZoneBase.
  	missOffset := sendMissCall address + sendMissCall machineCodeSize - methodZoneBase.
  	entryPointMask := objectMemory wordSize - 1.
  	[(cmEntryOffset bitAnd: entryPointMask) = (cmNoCheckEntryOffset bitAnd: entryPointMask)] whileTrue:
  		[entryPointMask := entryPointMask + entryPointMask + 1].
  	entryPointMask >= (methodZone roundUpLength: 1) ifTrue:
  		[self error: 'cannot differentiate checked and unchecked entry-points with current cog method alignment'].
  	checkedEntryAlignment := cmEntryOffset bitAnd: entryPointMask.
  	uncheckedEntryAlignment := cmNoCheckEntryOffset bitAnd: entryPointMask.
  	self assert: checkedEntryAlignment ~= uncheckedEntryAlignment!

Item was added:
+ ----- Method: Cogit>>gen:literal: (in category 'compile abstract instructions') -----
+ gen: opcode "<Integer>" literal: operand "<Integer|CogAbstractInstruction>"
+ 	"Literals are constants that either represent objects on the heap that may get updated by
+ 	 the garbage collector, or pc-relative spans that may get changed by code compaction, and
+ 	 must hence always be encoded in a form that allows updating to refer to a different value."
+ 	<inline: true>
+ 	<returnTypeC: #'AbstractInstruction *'>
+ 	<var: #abstractInstruction type: #'AbstractInstruction *'>
+ 	^literalsManager
+ 		checkLiteral: operand
+ 		forInstruction: (self gen: opcode operand: operand)!

Item was added:
+ ----- Method: Cogit>>gen:literal:operand: (in category 'compile abstract instructions') -----
+ gen: opcode "<Integer>" literal: operandOne "<Integer>" operand: operandTwo "<Integer|CogAbstractInstruction>"
+ 	"Literals are constants that either represent objects on the heap that may get updated by
+ 	 the garbage collector, or pc-relative spans that may get changed by code compaction, and
+ 	 must hence always be encoded in a form that allows updating to refer to a different value."
+ 	<inline: true>
+ 	<returnTypeC: #'AbstractInstruction *'>
+ 	<var: #abstractInstruction type: #'AbstractInstruction *'>
+ 	^literalsManager
+ 		checkLiteral: operandOne
+ 		forInstruction: (self gen: opcode operand: operandOne operand: operandTwo)!

Item was added:
+ ----- Method: Cogit>>gen:operand:literal: (in category 'compile abstract instructions') -----
+ gen: opcode "<Integer>" operand: operandOne "<Integer|CogAbstractInstruction>" literal: operandTwo "<Integer>"
+ 	"Literals are constants that either represent objects on the heap that may get updated by
+ 	 the garbage collector, or pc-relative spans that may get changed by code compaction, and
+ 	 must hence always be encoded in a form that allows updating to refer to a different value."
+ 	<inline: true>
+ 	<returnTypeC: #'AbstractInstruction *'>
+ 	<var: #abstractInstruction type: #'AbstractInstruction *'>
+ 	^literalsManager
+ 		checkLiteral: operandTwo
+ 		forInstruction: (self gen: opcode operand: operandOne operand: operandTwo)!

Item was changed:
  ----- Method: Cogit>>gen:operand:operand: (in category 'compile abstract instructions') -----
+ gen: opcode "<Integer>" operand: operandOne "<Integer|CogAbstractInstruction>" operand: operandTwo "<Integer|CogAbstractInstruction>"
- gen: opcode "<Integer>" operand: operandOne "<Integer|CogAbstractInstruction>"  operand: operandTwo "<Integer|CogAbstractInstruction>"
  	| abstractInstruction |
  	<inline: false>
  	<returnTypeC: #'AbstractInstruction *'>
  	<var: #abstractInstruction type: #'AbstractInstruction *'>
  	self assert: opcodeIndex < numAbstractOpcodes.
  	abstractInstruction := self abstractInstructionAt: opcodeIndex.
  	opcodeIndex := opcodeIndex + 1.
  	abstractInstruction opcode: opcode.
  	abstractInstruction operands at: 0 put: operandOne.
  	abstractInstruction operands at: 1 put: operandTwo.
  	self cCode: '' inSmalltalk: [abstractInstruction bcpc: bytecodePC].
  	^abstractInstruction!

Item was changed:
  ----- Method: Cogit>>gen:operand:operand:operand: (in category 'compile abstract instructions') -----
+ gen: opcode "<Integer>" operand: operandOne "<Integer|CogAbstractInstruction>" operand: operandTwo "<Integer|CogAbstractInstruction>" operand: operandThree "<Integer|CogAbstractInstruction>"
- gen: opcode "<Integer>" operand: operandOne "<Integer|CogAbstractInstruction>"  operand: operandTwo "<Integer|CogAbstractInstruction>" operand: operandThree "<Integer|CogAbstractInstruction>"
  	| abstractInstruction |
  	<inline: false>
  	<returnTypeC: #'AbstractInstruction *'>
  	<var: #abstractInstruction type: #'AbstractInstruction *'>
  	self assert: opcodeIndex < numAbstractOpcodes.
  	abstractInstruction := self abstractInstructionAt: opcodeIndex.
  	opcodeIndex := opcodeIndex + 1.
  	abstractInstruction opcode: opcode.
  	abstractInstruction operands at: 0 put: operandOne.
  	abstractInstruction operands at: 1 put: operandTwo.
  	abstractInstruction operands at: 2 put: operandThree.
  	self cCode: '' inSmalltalk: [abstractInstruction bcpc: bytecodePC].
  	^abstractInstruction!

Item was added:
+ ----- Method: Cogit>>gen:operand:quickConstant: (in category 'compile abstract instructions') -----
+ gen: opcode "<Integer>" operand: operandOne "<Integer|CogAbstractInstruction>" quickConstant: operandTwo "Integer>"
+ 	"Quick constants are those the back end is free to encode as compactly as possible."
+ 	<inline: true>
+ 	<returnTypeC: #'AbstractInstruction *'>
+ 	<var: #abstractInstruction type: #'AbstractInstruction *'>
+ 	^literalsManager
+ 		checkQuickConstant: operandTwo
+ 		forInstruction: (self gen: opcode operand: operandOne operand: operandTwo)!

Item was added:
+ ----- Method: Cogit>>gen:operand:quickConstant:operand: (in category 'compile abstract instructions') -----
+ gen: opcode "<Integer>" operand: operandOne "<Integer|CogAbstractInstruction>" quickConstant: operandTwo "<Integer>" operand: operandThree "<Integer|CogAbstractInstruction>"
+ 	"Quick constants are those the back end is free to encode as compactly as possible.""<Integer|CogAbstractInstruction>"
+ 	<inline: true>
+ 	<returnTypeC: #'AbstractInstruction *'>
+ 	<var: #abstractInstruction type: #'AbstractInstruction *'>
+ 	^literalsManager
+ 		checkQuickConstant: operandTwo
+ 		forInstruction: (self gen: opcode operand: operandOne operand: operandTwo operand: operandThree)!

Item was added:
+ ----- Method: Cogit>>gen:quickConstant: (in category 'compile abstract instructions') -----
+ gen: opcode "<Integer>" quickConstant: operand "<Integer>"
+ 	"Quick constants are those the back end is free to encode as compactly as possible."
+ 	<inline: true>
+ 	<returnTypeC: #'AbstractInstruction *'>
+ 	<var: #abstractInstruction type: #'AbstractInstruction *'>
+ 	^literalsManager
+ 		checkQuickConstant: operand
+ 		forInstruction: (self gen: opcode operand: operand)!

Item was added:
+ ----- Method: Cogit>>gen:quickConstant:operand: (in category 'compile abstract instructions') -----
+ gen: opcode "<Integer>" quickConstant: operandOne "<Integer>" operand: operandTwo "<Integer|CogAbstractInstruction>"
+ 	"Quick constants are those the back end is free to encode as compactly as possible."
+ 	<inline: true>
+ 	<returnTypeC: #'AbstractInstruction *'>
+ 	<var: #abstractInstruction type: #'AbstractInstruction *'>
+ 	^literalsManager
+ 		checkQuickConstant: operandOne
+ 		forInstruction: (self gen: opcode operand: operandOne operand: operandTwo)!

Item was added:
+ ----- Method: Cogit>>gen:quickConstant:operand:operand: (in category 'compile abstract instructions') -----
+ gen: opcode "<Integer>" quickConstant: operandOne "<Integer>" operand: operandTwo "<Integer|CogAbstractInstruction>" operand: operandThree "<Integer|CogAbstractInstruction>"
+ 	"Quick constants are those the back end is free to encode as compactly as possible.""<Integer|CogAbstractInstruction>"
+ 	<inline: true>
+ 	<returnTypeC: #'AbstractInstruction *'>
+ 	<var: #abstractInstruction type: #'AbstractInstruction *'>
+ 	^literalsManager
+ 		checkQuickConstant: operandOne
+ 		forInstruction: (self gen: opcode operand: operandOne operand: operandTwo operand: operandThree)!

Item was changed:
  ----- Method: Cogit>>genEnilopmartFor:and:and:forCall:called: (in category 'initialization') -----
  genEnilopmartFor: regArg1 and: regArg2 and: regArg3 forCall: forCall called: trampolineName
  	"An enilopmart (the reverse of a trampoline) is a piece of code that makes
  	 the system-call-like transition from the C runtime into generated machine
  	 code.  The desired arguments and entry-point are pushed on a stackPage's
  	 stack.  The enilopmart pops off the values to be loaded into registers and
  	 then executes a return instruction to pop off the entry-point and jump to it.
  
  						BEFORE				AFTER			(stacks grow down)
  						whatever			stackPointer ->	whatever
  						target address =>	reg1 = reg1val, etc
  						reg1val				pc = target address
  						reg2val
  		stackPointer ->	reg3val"
  
  	<var: #trampolineName type: #'char *'>
  	<returnTypeC: #'void (*genEnilopmartForandandforCallcalled(sqInt regArg1, sqInt regArg2, sqInt regArg3, sqInt forCall, char *trampolineName))(void)'>
  
  	| size endAddress enilopmart |
  	opcodeIndex := 0.
  	backEnd maybeEstablishVarBase. "Must happen first; value may be used in genLoadStackPointers"
  	backEnd genLoadStackPointers.
  	regArg3 ifNotNil: [self PopR: regArg3].
  	regArg2 ifNotNil: [self PopR: regArg2].
  	self PopR: regArg1.
  	self genEnilopmartReturn: forCall.
+ 	literalsManager dumpLiterals.
  	self computeMaximumSizes.
  	size := self generateInstructionsAt: methodZoneBase.
  	endAddress := self outputInstructionsAt: methodZoneBase.
  	self assert: methodZoneBase + size = endAddress.
  	enilopmart := methodZoneBase.
  	methodZoneBase := self alignUptoRoutineBoundary: endAddress.
  	backEnd nopsFrom: endAddress to: methodZoneBase - 1.
  	self recordGeneratedRunTime: trampolineName address: enilopmart.
  	^self cCoerceSimple: enilopmart to: #'void (*)(void)'!

Item was changed:
  ----- Method: Cogit>>genGetLeafCallStackPointer (in category 'initialization') -----
  genGetLeafCallStackPointer
  	"Generate a routine that answers the stack pointer immedately
  	 after a leaf call, used for checking stack pointer alignment."
  	| startAddress |
  	<inline: false>
  	self allocateOpcodes: 32 bytecodes: 0.
+ 	literalsManager resetLiterals: 5.
  	initialPC := 0.
  	endPC := numAbstractOpcodes - 1.
  	startAddress := methodZoneBase.
  	backEnd genGetLeafCallStackPointerFunction.
  	self outputInstructionsForGeneratedRuntimeAt: startAddress.
  	self recordGeneratedRunTime: 'ceGetSP' address: startAddress.
  	^startAddress!

Item was changed:
  ----- Method: Cogit>>genTrampolineFor:called:numArgs:arg:arg:arg:arg:saveRegs:pushLinkReg:resultReg:appendOpcodes: (in category 'initialization') -----
  genTrampolineFor: aRoutine called: trampolineName numArgs: numArgs arg: regOrConst0 arg: regOrConst1 arg: regOrConst2 arg: regOrConst3 saveRegs: saveRegs pushLinkReg: pushLinkReg resultReg: resultRegOrNil appendOpcodes: appendBoolean
  	"Generate a trampoline with up to four arguments.  Generate either a call or a jump to aRoutineOrNil
  	 as requested by callJumpBar.  If generating a call and resultRegOrNil is non-zero pass the C result
  	 back in resultRegOrNil.
  	 Hack: a negative value indicates an abstract register, a non-negative value indicates a constant."
  	<var: #aRoutine type: #'void *'>
  	<var: #trampolineName type: #'char *'>
  	| startAddress |
  	<inline: false>
  	startAddress := methodZoneBase.
  	appendBoolean ifFalse:
+ 		[self zeroOpcodeIndex].
- 		[opcodeIndex := 0].
  	self compileTrampolineFor: aRoutine
  		numArgs: numArgs
  		arg: regOrConst0
  		arg: regOrConst1
  		arg: regOrConst2
  		arg: regOrConst3
  		saveRegs: saveRegs
  		pushLinkReg: pushLinkReg
  		resultReg: resultRegOrNil.
  	self outputInstructionsForGeneratedRuntimeAt: startAddress.
  	self recordGeneratedRunTime: trampolineName address: startAddress.
  	self recordRunTimeObjectReferences.
  	^startAddress!

Item was changed:
  ----- Method: Cogit>>generateCaptureCStackPointers: (in category 'initialization') -----
  generateCaptureCStackPointers: captureFramePointer
  	"Generate the routine that writes the current values of the C frame and stack pointers into
  	 variables.  These are used to establish the C stack in trampolines back into the C run-time.
  
  	 This is a presumptuous quick hack for x86.  It is presumptuous for two reasons.  Firstly
  	 the system's frame and stack pointers may differ from those we use in generated code,
  	 e.g. on register-rich RISCs.  Secondly the ABI may not support a simple frameless call
  	 as written here (for example 128-bit stack alignment on Mac OS X)."
  	| startAddress |
  	<inline: false>
  	self allocateOpcodes: 32 bytecodes: 0.
+ 	literalsManager resetLiterals: 5.
  	initialPC := 0.
  	endPC := numAbstractOpcodes - 1.
  	startAddress := methodZoneBase.
  	captureFramePointer ifTrue:
  		[self MoveR: FPReg Aw: self cFramePointerAddress].
  	"Capture the stack pointer prior to the call."
  	backEnd leafCallStackPointerDelta = 0
  		ifTrue: [self MoveR: SPReg Aw: self cStackPointerAddress]
  		ifFalse: [self MoveR: SPReg R: TempReg.
  				self AddCq: backEnd leafCallStackPointerDelta R: TempReg.
  				self MoveR: TempReg Aw: self cStackPointerAddress].
  	self RetN: 0.
  	self outputInstructionsForGeneratedRuntimeAt: startAddress.
  	processor flushICacheFrom: startAddress asUnsignedInteger to: methodZoneBase asUnsignedInteger.
  	self recordGeneratedRunTime: 'ceCaptureCStackPointers' address: startAddress.
  	ceCaptureCStackPointers := self cCoerceSimple: startAddress to: #'void (*)(void)'!

Item was changed:
  ----- Method: Cogit>>generateClosedPICPrototype (in category 'initialization') -----
  generateClosedPICPrototype
  	"Generate the prototype ClosedPIC to determine how much space as full PIC takes.
  	 When we first allocate a closed PIC it only has one or two cases and we want to grow it.
  	 So we have to determine how big a full one is before hand."
  	numPICCases := 6.
  	"stack allocate the various collections so that they
  	 are effectively garbage collected on return."
  	self allocateOpcodes: numPICCases * 7 bytecodes: 0.
+ 	literalsManager resetLiterals: numPICCases * 2.
  	methodLabel address: methodZoneBase; dependent: nil. "for pc-relative MoveCw: cPIC R: ClassReg"
  	self compileClosedPICPrototype.
  	self computeMaximumSizes.
  	closedPICSize := (self sizeof: CogMethod) + (self generateInstructionsAt: methodZoneBase + (self sizeof: CogMethod)).
  	firstCPICCaseOffset := endCPICCase0 address - methodZoneBase.
  	cPICCaseSize := endCPICCase1 address - endCPICCase0 address.
  	cPICEndSize := closedPICSize - (numPICCases - 1 * cPICCaseSize + firstCPICCaseOffset).
  	closedPICSize := methodZone roundUpLength: closedPICSize.
  	self assert: picInterpretAbort address = (methodLabel address + self picInterpretAbortOffset)
  	"self cCode: ''
  		inSmalltalk:
  			[| end |
  			 end := self outputInstructionsAt: methodZoneBase + headerSize.
  			 self disassembleFrom: methodZoneBase + headerSize to: end - 1.
  			 self halt]"!

Item was changed:
  ----- Method: Cogit>>generateOpenPICPrototype (in category 'initialization') -----
  generateOpenPICPrototype
  	"Generate the prototype ClosedPIC to determine how much space as full PIC takes.
  	 When we first allocate a closed PIC it only has one or two cases and we want to grow it.
  	 So we have to determine how big a full one is before hand."
  	| codeSize mapSize |
  	"stack allocate the various collections so that they
  	 are effectively garbage collected on return."
  	self allocateOpcodes: 100 bytecodes: 0.
+ 	literalsManager resetLiterals: 10.
  	methodLabel
  		address: methodZoneBase;
  		dependent: nil.
  	"Need a real selector here so that the map accomodates the annotations for the selector.
  	 Use self numRegArgs to generate the longest possible code sequence due to
  	 genPushRegisterArgsForNumArgs:"
  	self compileOpenPIC: (coInterpreter specialSelector: 0) numArgs: self numRegArgs.
  	self computeMaximumSizes.
  	methodLabel concretizeAt: methodZoneBase.
  	codeSize := self generateInstructionsAt: methodZoneBase + (self sizeof: CogMethod).
  	mapSize := self generateMapAt: nil start: methodZoneBase + cmNoCheckEntryOffset.
  	openPICSize := (methodZone roundUpLength: (self sizeof: CogMethod) + codeSize) + (methodZone roundUpLength: mapSize).
  	"self cCode: ''
  		inSmalltalk:
  			[| end |
  			 end := self outputInstructionsAt: methodZoneBase + headerSize.
  			 self disassembleFrom: methodZoneBase + (self sizeof: CogMethod) to: end - 1.
  			 self halt]"!

Item was changed:
  ----- Method: Cogit>>generateVMOwnerLockFunctions (in category 'initialization') -----
  generateVMOwnerLockFunctions
  	| startAddress |
  	<inline: false>
  	self cppIf: COGMTVM
  		ifTrue:
  			[self allocateOpcodes: backEnd numLowLevelLockOpcodes bytecodes: 0.
  			initialPC := 0.
  			endPC := numAbstractOpcodes - 1.
  			startAddress := methodZoneBase.
  			backEnd generateLowLevelTryLock: coInterpreter vmOwnerLockAddress.
  			self outputInstructionsForGeneratedRuntimeAt: startAddress.
  			self recordGeneratedRunTime: 'ceTryLockVMOwner' address: startAddress.
  			ceTryLockVMOwner := self cCoerceSimple: startAddress to: #'unsigned long (*)(void)'.
  
  			opcodeIndex := 0.
+ 			literalsManager resetLiterals: 1.
  			initialPC := 0.
  			endPC := numAbstractOpcodes - 1.
  			startAddress := methodZoneBase.
  			backEnd generateLowLevelUnlock: coInterpreter vmOwnerLockAddress.
  			self outputInstructionsForGeneratedRuntimeAt: startAddress.
  			self recordGeneratedRunTime: 'ceUnlockVMOwner' address: startAddress.
  			ceUnlockVMOwner := self cCoerceSimple: startAddress to: #'void (*)(void)']!

Item was added:
+ ----- Method: Cogit>>getOpcodeIndex (in category 'accessing') -----
+ getOpcodeIndex
+ 	"Access for the literal manager."
+ 	<inline: true>
+ 	^opcodeIndex!

Item was changed:
  ----- Method: Cogit>>initializeBackend (in category 'initialization') -----
  initializeBackend
- 	"A hook for the StackToregisterMappingCogit to override.
- 	 We just initialize the methodLabel here because backEnd is static."
  	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: callerSavedRegMask)].
+ 	literalsManager allocateLiterals: 4; resetLiterals: 4!
- 		[self assert: ((self registerMaskFor: VarBaseReg) noMask: callerSavedRegMask)]!

Item was added:
+ ----- Method: Cogit>>maybeDumpLiterals: (in category 'compile abstract instructions') -----
+ maybeDumpLiterals: descriptor
+ 	<inline: true>
+ 	<var: #descriptor type: #'BytecodeDescriptor *'>
+ 	((literalsManager mustDumpLiterals: opcodeIndex)
+ 	  or: [descriptor isUnconditionalBranch
+ 	  or: [descriptor isReturn]]) ifTrue:
+ 		[literalsManager dumpLiterals]!

Item was changed:
  ----- Method: Cogit>>maybeGenerateCheckFeatures (in category 'initialization') -----
  maybeGenerateCheckFeatures
  	| startAddress |
  	<inline: false>
  	backEnd numCheckFeaturesOpcodes = 0 ifTrue:
  		[^nil].
  	self allocateOpcodes: backEnd numCheckFeaturesOpcodes bytecodes: 0.
+ 	literalsManager resetLiterals: 1.
  	initialPC := 0.
  	endPC := numAbstractOpcodes - 1.
  	startAddress := methodZoneBase.
  	backEnd generateCheckFeatures.
  	self outputInstructionsForGeneratedRuntimeAt: startAddress.
  	self recordGeneratedRunTime: 'ceCheckFeaturesFunction' address: startAddress.
  	ceCheckFeaturesFunction := self cCoerceSimple: startAddress to: #'unsigned long (*)(void)'!

Item was changed:
  ----- Method: Cogit>>maybeGenerateICacheFlush (in category 'initialization') -----
  maybeGenerateICacheFlush
  	| startAddress |
  	<inline: false>
  	backEnd numICacheFlushOpcodes = 0 ifTrue:
  		[^nil].
  	self allocateOpcodes: backEnd numICacheFlushOpcodes bytecodes: 0.
+ 	literalsManager resetLiterals: 1.
  	initialPC := 0.
  	endPC := numAbstractOpcodes - 1.
  	startAddress := methodZoneBase.
  	backEnd generateICacheFlush.
  	self outputInstructionsForGeneratedRuntimeAt: startAddress.
  	self recordGeneratedRunTime: 'ceFlushICache' address: startAddress.
  	ceFlushICache := self cCoerceSimple: startAddress to: #'void (*)(unsigned long,unsigned long)'!

Item was changed:
  ----- Method: Cogit>>outputInstructionsForGeneratedRuntimeAt: (in category 'initialization') -----
  outputInstructionsForGeneratedRuntimeAt: startAddress
  	"Output instructions generated for one of the generated run-time routines, a trampoline, etc"
  	| size endAddress |
  	<inline: false>
+ 	literalsManager dumpLiterals.
  	self computeMaximumSizes.
  	size := self generateInstructionsAt: startAddress.
  	endAddress := self outputInstructionsAt: startAddress.
  	self assert: startAddress + size = endAddress.
  	methodZoneBase := self alignUptoRoutineBoundary: endAddress.
  	backEnd nopsFrom: endAddress to: methodZoneBase - 1.
  	self cCode: '' inSmalltalk: [methodZone freeStart: methodZoneBase].
  	^startAddress!

Item was changed:
  ----- Method: Cogit>>setInterpreter: (in category 'initialization') -----
  setInterpreter: aCoInterpreter
  	"Initialization of the code generator in the simulator.
  	 These objects already exist in the generated C VM
  	 or are used only in the simulation."
  	<doNotGenerate>
  	coInterpreter := aCoInterpreter.
  	objectMemory := aCoInterpreter objectMemory.
  	threadManager := aCoInterpreter threadManager. "N.B. may be nil"
  	methodZone := CogMethodZone new.
  	objectRepresentation := objectMemory objectRepresentationClass
  								forCogit: self methodZone: methodZone.
  	methodZone setInterpreter: aCoInterpreter
  				objectRepresentation: objectRepresentation
  				cogit: self.
  	generatorTable := self class generatorTable.
  	primitiveGeneratorTable := self class primitiveTable.
  	processor := ProcessorClass new.
  	simulatedAddresses := Dictionary new.
  	simulatedTrampolines := Dictionary new.
  	simulatedVariableGetters := Dictionary new.
  	simulatedVariableSetters := Dictionary new.
  	traceStores := 0.
  	traceFlags := (self class initializationOptions at: #recordPrimTrace ifAbsent: [true])
  					ifTrue: [8] "record prim trace on by default (see Cogit class>>decareCVarsIn:)"
  					ifFalse: [0].
  	debugPrimCallStackOffset := 0.
  	singleStep := printRegisters := printInstructions := clickConfirm := false.
  	breakBlock ifNil: [self breakPC: breakPC].
+ 	backEnd := CogCompilerClass for: self.
+ 	methodLabel := CogCompilerClass for: self.
+ 	(literalsManager := backEnd class literalsManagerClass new) cogit: self.
- 	(backEnd := processor abstractInstructionCompilerClass new) cogit: self.
- 	(methodLabel := processor abstractInstructionCompilerClass new) cogit: self.
  	ordinarySendTrampolines := CArrayAccessor on: (Array new: NumSendTrampolines).
  	superSendTrampolines := CArrayAccessor on: (Array new: NumSendTrampolines).
  	BytecodeSetHasDirectedSuperSend ifTrue:
  		[directedSuperSendTrampolines := CArrayAccessor on: (Array new: NumSendTrampolines)].
  	NewspeakVM ifTrue:
  		[selfSendTrampolines := CArrayAccessor on: (Array new: NumSendTrampolines).
  		dynamicSuperSendTrampolines := CArrayAccessor on: (Array new: NumSendTrampolines).
  		implicitReceiverSendTrampolines := CArrayAccessor on: (Array new: NumSendTrampolines).
  		outerSendTrampolines := CArrayAccessor on: (Array new: NumSendTrampolines)].
  	"debug metadata"
  	objectReferencesInRuntime := CArrayAccessor on: (Array new: NumObjRefsInRuntime).
  	runtimeObjectRefIndex := 0.
  	"debug metadata"
  	trampolineAddresses := CArrayAccessor on: (Array new: NumTrampolines * 2).
  	trampolineTableIndex := 0.
  
  	compilationTrace ifNil: [compilationTrace := self class initializationOptions at: #compilationTrace ifAbsent: [0]].
  	extA := extB := 0!

Item was changed:
  ----- Method: Cogit>>zeroOpcodeIndex (in category 'accessing') -----
  zeroOpcodeIndex
  	"Access for the object representations when they need to prepend code to trampolines."
+ 	opcodeIndex := 0.
+ 	literalsManager resetLiterals: 1!
- 	opcodeIndex := 0!

Item was added:
+ VMClass subclass: #InLineLiteralsManager
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'VMMaker-JIT'!
+ 
+ !InLineLiteralsManager commentStamp: 'eem 6/7/2015 12:07' prior: 0!
+ An InLineLiteralsManager is a dummy class that understands the OutOfLineLiteralsManager API but does nothing.  It is used to allow the Cogits to work with back-ends that generate either in-line or out-of-line literals.!

Item was added:
+ ----- Method: InLineLiteralsManager>>allocateLiterals: (in category 'initialization') -----
+ allocateLiterals: initialNumLiterals
+ 	<inline: true>!

Item was added:
+ ----- Method: InLineLiteralsManager>>checkLiteral:forInstruction: (in category 'compile abstract instructions') -----
+ checkLiteral: literal forInstruction: anInstruction
+ 	<var: #anInstruction type: #'AbstractInstruction *'>
+ 	<returnTypeC: #'AbstractInstruction *'>
+ 	<inline: true>
+ 	^anInstruction!

Item was added:
+ ----- Method: InLineLiteralsManager>>checkQuickConstant:forInstruction: (in category 'compile abstract instructions') -----
+ checkQuickConstant: literal forInstruction: anInstruction
+ 	<var: #anInstruction type: #'AbstractInstruction *'>
+ 	<returnTypeC: #'AbstractInstruction *'>
+ 	<inline: true>
+ 	^anInstruction!

Item was added:
+ ----- Method: InLineLiteralsManager>>cogit: (in category 'initialization') -----
+ cogit: aCogit
+ 	<doNotGenerate>!

Item was added:
+ ----- Method: InLineLiteralsManager>>dumpLiterals (in category 'compile abstract instructions') -----
+ dumpLiterals
+ 	<inline: true>!

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

Item was added:
+ ----- Method: InLineLiteralsManager>>resetLiterals: (in category 'initialization') -----
+ resetLiterals: numLiteralsHint
+ 	<inline: true>!

Item was removed:
- VMClass subclass: #NullLiteralsManager
- 	instanceVariableNames: ''
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'VMMaker-JIT'!

Item was added:
+ VMClass subclass: #OutOfLineLiteralsManager
+ 	instanceVariableNames: 'cogit firstOpcodeIndex nextLiteralIndex lastDumpedLiteralIndex literals literalsSize'
+ 	classVariableNames: ''
+ 	poolDictionaries: 'CogCompilationConstants CogRTLOpcodes'
+ 	category: 'VMMaker-JIT'!
+ 
+ !OutOfLineLiteralsManager commentStamp: 'eem 6/7/2015 12:10' prior: 0!
+ An OutOfLineLiteralsManager manages the dumping of literals for backends that wat to keep literals out-of-line, accessed by pc-relative addressing.
+ 
+ Instance Variables
+ 	cogit:		<Cogit>!

Item was added:
+ ----- Method: OutOfLineLiteralsManager>>allocateLiterals: (in category 'initialization') -----
+ allocateLiterals: initialNumLiterals
+ 	<inline: true>
+ 	initialNumLiterals > literalsSize ifTrue:
+ 		[self cCode:
+ 				[literals := self re: literals alloc: initialNumLiterals * (self sizeof: CogAbstractInstruction)]
+ 			inSmalltalk:
+ 				[| newLiterals |
+ 				 newLiterals := Array new: initialNumLiterals.
+ 				 literals ifNotNil:
+ 					[:existingLiterals| newLiterals replaceFrom: 1 to: literalsSize with: existingLiterals object startingAt: 1].
+ 				 literals := CArrayAccessor on: newLiterals].
+ 		 literalsSize := initialNumLiterals]!

Item was added:
+ ----- Method: OutOfLineLiteralsManager>>checkLiteral:forInstruction: (in category 'compile abstract instructions') -----
+ checkLiteral: literal forInstruction: anInstruction
+ 	<var: #anInstruction type: #'AbstractInstruction *'>
+ 	<returnTypeC: #'AbstractInstruction *'>
+ 	anInstruction usesOutOfLineLiteral ifTrue:
+ 		[anInstruction dependent: (self locateLiteral: literal)].
+ 	^anInstruction!

Item was added:
+ ----- Method: OutOfLineLiteralsManager>>checkQuickConstant:forInstruction: (in category 'compile abstract instructions') -----
+ checkQuickConstant: literal forInstruction: anInstruction
+ 	<var: #anInstruction type: #'AbstractInstruction *'>
+ 	<returnTypeC: #'AbstractInstruction *'>
+ 	anInstruction usesOutOfLineLiteral ifTrue:
+ 		[anInstruction dependent: (self locateLiteral: literal)].
+ 	^anInstruction!

Item was added:
+ ----- Method: OutOfLineLiteralsManager>>cogit: (in category 'initialization') -----
+ cogit: aCogit
+ 	<doNotGenerate>
+ 	cogit := aCogit.
+ 	literalsSize := 0!

Item was added:
+ ----- Method: OutOfLineLiteralsManager>>dumpLiterals (in category 'compile abstract instructions') -----
+ dumpLiterals
+ 	"Output all pending literal instructions, making the originals dependents of the generated ones
+ 	 so that a later pass will copy the address of each generated literl inst to its original in literals,
+ 	 and hence allow the instruction using the literal to compute the correct address.."
+ 	| litInst |
+ 	<var: 'litInst' type: #'AbstractInstruction *'>
+ 	lastDumpedLiteralIndex to: nextLiteralIndex - 1 do:
+ 		[:i|
+ 		litInst := self literalInstructionAt: i.
+ 		(cogit gen: Literal operand: (litInst operands at: 0)) dependent: litInst].
+ 	firstOpcodeIndex := cogit getOpcodeIndex.
+ 	lastDumpedLiteralIndex := nextLiteralIndex!

Item was added:
+ ----- Method: OutOfLineLiteralsManager>>literalInstructionAt: (in category 'compile abstract instructions') -----
+ literalInstructionAt: index
+ 	<cmacro: '(index) (&literals[index])'>
+ 	^(literals at: index)
+ 		ifNil: [literals at: index put: (CogCompilerClass for: cogit)]
+ 		ifNotNil: [:litInst| litInst]!

Item was added:
+ ----- Method: OutOfLineLiteralsManager>>literalInstructionInRange: (in category 'testing') -----
+ literalInstructionInRange: litInst
+ 	"A literal is in range if its opcode index is within outOfLineLiteralOpcodeLimit, or if
+ 	 its index has yet to be assigned."
+ 	| opcodeIndex |
+ 	opcodeIndex := litInst literalOpcodeIndex.
+ 	^opcodeIndex asInteger < 0
+ 	  or: [self assert cogit opcodeIndex >= opcodeIndex.
+ 		cogit getOpcodeIndex - opcodeIndex < cogit backEnd outOfLineLiteralOpcodeLimit]!

Item was added:
+ ----- Method: OutOfLineLiteralsManager>>locateLiteral: (in category 'compile abstract instructions') -----
+ locateLiteral: aLiteral
+ 	"Search for a Literal instruction that is in-range and answer it.  Otherwise
+ 	 allocate a new Literal instruction for the literal and answer it."
+ 	<returnTypeC: #'AbstractInstruction *'>
+ 	<inline: false>
+ 	| litInst |
+ 	<var: 'litInst' type: #'AbstractInstruction *'>
+ 	0 to: nextLiteralIndex - 1 do:
+ 		[:i|
+ 		litInst := self literalInstructionAt: i.
+ 		((litInst operands at: 0) = aLiteral
+ 		 and: [self literalInstructionInRange: litInst]) ifTrue:
+ 			[^litInst]].
+ 	nextLiteralIndex >= literalsSize ifTrue:
+ 		[self allocateLiterals: literalsSize + 8].
+ 	litInst := self literalInstructionAt: nextLiteralIndex.
+ 	litInst
+ 		opcode: Literal;
+ 		operand0: aLiteral;
+ 		setLiteralOpcodeIndex: -1. "means as-yet-unassigned; see literalInstructionInRange:"
+ 	nextLiteralIndex := nextLiteralIndex + 1.
+ 	"Record the opcodeIndex of the first dependent instructuon (the first instruction that references an out-of-line literal)"
+ 	firstOpcodeIndex > cogit getOpcodeIndex ifTrue:
+ 		[firstOpcodeIndex := cogit getOpcodeIndex - 1].
+ 	^litInst!

Item was added:
+ ----- Method: OutOfLineLiteralsManager>>mustDumpLiterals: (in category 'testing') -----
+ mustDumpLiterals: opcodeIndex
+ 	<inline: true>
+ 	^cogit opcodeIndex >= firstOpcodeIndex
+ 	  and: [cogit opcodeIndex - firstOpcodeIndex >= cogit backEnd outOfLineLiteralOpcodeLimit]!

Item was added:
+ ----- Method: OutOfLineLiteralsManager>>resetLiterals: (in category 'initialization') -----
+ resetLiterals: numLiteralsHint
+ 	<inline: true>
+ 	self cCode:
+ 			[self me: literals ms: 0 et: literalsSize * (self sizeof: CogAbstractInstruction)]
+ 		inSmalltalk:
+ 			[0 to: literalsSize - 1 do: [:i| literals at: i put: nil]].
+ 	firstOpcodeIndex := 1 << 16. "an impossibly high value"
+ 	nextLiteralIndex := lastDumpedLiteralIndex := 0!

Item was changed:
  ----- Method: SistaStackToRegisterMappingCogit>>compileBlockBodies (in category 'compile abstract instructions') -----
  compileBlockBodies
  	"override to maintain counterIndex when recompiling blocks; sigh."
  	<inline: false>
  	| result compiledBlocksCount blockStart savedNeedsFrame savedNumArgs savedNumTemps
  	  initialStackPtr initialOpcodeIndex initialAnnotationIndex initialCounterIndex initialIndexOfIRC |
  	<var: #blockStart type: #'BlockStart *'>
  	self assert: blockCount > 0.
  	"scanBlock: in compileBlockEntry: sets both of these appropriately for each block."
  	savedNeedsFrame := needsFrame.
  	savedNumArgs := methodOrBlockNumArgs.
  	savedNumTemps := methodOrBlockNumTemps.
  	inBlock := true.
  	compiledBlocksCount := 0.
  	[compiledBlocksCount < blockCount] whileTrue:
  		[blockStart := self blockStartAt: compiledBlocksCount.
  		 self scanBlock: blockStart.
  		 initialOpcodeIndex := opcodeIndex.
  		 initialAnnotationIndex := annotationIndex.
  		 initialCounterIndex := counterIndex.
  		 self cppIf: #NewspeakVM ifTrue:
  			[initialIndexOfIRC := indexOfIRC].
  		 [self compileBlockEntry: blockStart.
  		  initialStackPtr := simStackPtr.
  		  (result := self compileAbstractInstructionsFrom: blockStart startpc + (self pushNilSize: methodObj numInitialNils: blockStart numInitialNils)
  						through: blockStart startpc + blockStart span - 1) < 0 ifTrue:
  			[^result].
  		  "If the final simStackPtr is less than the initial simStackPtr then scanBlock: over-
  		   estimated the number of initial nils (because it assumed one or more pushNils to
  		   produce an operand were pushNils to initialize temps.  This is very rare, so
  		   compensate by checking, adjusting numInitialNils and recompiling the block body."
  		  initialStackPtr = simStackPtr]
  			whileFalse:
  				[self assert: initialStackPtr > simStackPtr.
  				 blockStart numInitialNils: blockStart numInitialNils + simStackPtr - initialStackPtr.
  				 blockStart fakeHeader dependent: nil.
  				 self reinitializeFixupsFrom: blockStart startpc + blockStart numInitialNils
  					through: blockStart startpc + blockStart span - 1.
  				 self cCode: 'bzero(abstractOpcodes + initialOpcodeIndex,
  									(opcodeIndex - initialOpcodeIndex) * sizeof(AbstractInstruction))'
  					inSmalltalk: [initialOpcodeIndex to: opcodeIndex - 1 do:
+ 									[:i| abstractOpcodes at: i put: (CogCompilerClass for: self)]].
- 									[:i|
- 									abstractOpcodes
- 										at: i
- 										put: (processor abstractInstructionCompilerClass for: self)]].
  				 opcodeIndex := initialOpcodeIndex.
  				 annotationIndex := initialAnnotationIndex.
  				 counterIndex := initialCounterIndex.
  				 self cppIf: #NewspeakVM ifTrue:
  					[indexOfIRC := initialIndexOfIRC]].
  		compiledBlocksCount := compiledBlocksCount + 1].
  	needsFrame := savedNeedsFrame.
  	methodOrBlockNumArgs := savedNumArgs.
  	methodOrBlockNumTemps := savedNumTemps.
  	^0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>compileAbstractInstructionsFrom:through: (in category 'compile abstract instructions') -----
  compileAbstractInstructionsFrom: start through: end
  	"Loop over bytecodes, dispatching to the generator for each bytecode, handling fixups in due course."
  	| nextOpcodeIndex descriptor nExts fixup result |
  	<var: #descriptor type: #'BytecodeDescriptor *'>
  	<var: #fixup type: #'BytecodeFixup *'>
  	self traceSimStack.
  	bytecodePC := start.
  	nExts := 0.
  	descriptor := nil.
  	deadCode := false.
  	[self cCode: '' inSmalltalk:
  		[(debugBytecodePointers includes: bytecodePC) ifTrue: [self halt]].
  	fixup := self fixupAt: bytecodePC - initialPC.
  	"If there's no fixup following a return there's no jump to that code and it is dead."
  	(descriptor notNil and: [descriptor isReturn]) ifTrue: [deadCode := true].
  	fixup targetInstruction asUnsignedInteger > 0 ifTrue:
  		[fixup targetInstruction asUnsignedInteger >= 2 ifTrue:
  			[self merge: fixup afterContinuation: deadCode not].
  		deadCode := false].
  	 self cCode: '' inSmalltalk:
  		[deadCode ifFalse:
  			[self assert: simStackPtr + (needsFrame ifTrue: [0] ifFalse: [1])
  						= (self debugStackPointerFor: bytecodePC)]].
  	 byte0 := (objectMemory fetchByte: bytecodePC ofObject: methodObj) + bytecodeSetOffset.
  	 descriptor := self generatorAt: byte0.
  	 self loadSubsequentBytesForDescriptor: descriptor at: bytecodePC.
  	 nextOpcodeIndex := opcodeIndex.
  	 result := deadCode
  				ifTrue: "insert nops for dead code that is mapped so that bc to mc mapping is not many to one"
  					[(descriptor isMapped
  					  or: [inBlock and: [descriptor isMappedInBlock]]) ifTrue:
  						[self annotateBytecode: self Nop].
  						0]
  				ifFalse:
  					[self perform: descriptor generator].
  	 descriptor isExtension ifFalse: "extended bytecodes must consume their extensions"
  		[self assert: (extA = 0 and: [extB = 0])].
  	 self traceDescriptor: descriptor; traceSimStack.
  	 (fixup targetInstruction asUnsignedInteger between: 1 and: 2) ifTrue:
  		["There is a fixup for this bytecode.  It must point to the first generated
  		   instruction for this bytecode.  If there isn't one we need to add a label."
  		 opcodeIndex = nextOpcodeIndex ifTrue:
  			[self Label].
  		 fixup targetInstruction: (self abstractInstructionAt: nextOpcodeIndex)].
+ 	 self maybeDumpLiterals: descriptor.
  	 bytecodePC := self nextBytecodePCFor: descriptor at: bytecodePC exts: nExts in: methodObj.
  	 result = 0 and: [bytecodePC <= end]] whileTrue:
  		[nExts := descriptor isExtension ifTrue: [nExts + 1] ifFalse: [0]].
  	self checkEnoughOpcodes.
  	^result!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>compileBlockBodies (in category 'compile abstract instructions') -----
  compileBlockBodies
  	<inline: false>
  	| result compiledBlocksCount blockStart savedNeedsFrame savedNumArgs savedNumTemps
  	  initialStackPtr initialOpcodeIndex initialAnnotationIndex initialIndexOfIRC |
  	<var: #blockStart type: #'BlockStart *'>
  	self assert: blockCount > 0.
  	"scanBlock: in compileBlockEntry: sets both of these appropriately for each block."
  	savedNeedsFrame := needsFrame.
  	savedNumArgs := methodOrBlockNumArgs.
  	savedNumTemps := methodOrBlockNumTemps.
  	inBlock := true.
  	compiledBlocksCount := 0.
  	[compiledBlocksCount < blockCount] whileTrue:
  		[blockStart := self blockStartAt: compiledBlocksCount.
  		 self scanBlock: blockStart.
  		 initialOpcodeIndex := opcodeIndex.
  		 initialAnnotationIndex := annotationIndex.
  		 self cppIf: #NewspeakVM ifTrue:
  			[initialIndexOfIRC := indexOfIRC].
  		 [self compileBlockEntry: blockStart.
  		  initialStackPtr := simStackPtr.
  		  (result := self compileAbstractInstructionsFrom: blockStart startpc + (self pushNilSize: methodObj numInitialNils: blockStart numInitialNils)
  						through: blockStart startpc + blockStart span - 1) < 0 ifTrue:
  			[^result].
  		  "If the final simStackPtr is less than the initial simStackPtr then scanBlock: over-
  		   estimated the number of initial nils (because it assumed one or more pushNils to
  		   produce an operand were pushNils to initialize temps.  This is very rare, so
  		   compensate by checking, adjusting numInitialNils and recompiling the block body."
  		  initialStackPtr = simStackPtr]
  			whileFalse:
  				[self assert: initialStackPtr > simStackPtr.
  				 blockStart numInitialNils: blockStart numInitialNils + simStackPtr - initialStackPtr.
  				 blockStart fakeHeader dependent: nil.
  				 self reinitializeFixupsFrom: blockStart startpc + blockStart numInitialNils
  					through: blockStart startpc + blockStart span - 1.
  				 self cCode: 'bzero(abstractOpcodes + initialOpcodeIndex,
  									(opcodeIndex - initialOpcodeIndex) * sizeof(AbstractInstruction))'
  					inSmalltalk: [initialOpcodeIndex to: opcodeIndex - 1 do:
+ 									[:i| abstractOpcodes at: i put: (CogCompilerClass for: self)]].
- 									[:i|
- 									abstractOpcodes
- 										at: i
- 										put: (processor abstractInstructionCompilerClass for: self)]].
  				 opcodeIndex := initialOpcodeIndex.
  				 annotationIndex := initialAnnotationIndex.
  				 self cppIf: #NewspeakVM ifTrue:
  					[indexOfIRC := initialIndexOfIRC]].
  		compiledBlocksCount := compiledBlocksCount + 1].
  	needsFrame := savedNeedsFrame.
  	methodOrBlockNumArgs := savedNumArgs.
  	methodOrBlockNumTemps := savedNumTemps.
  	^0!



More information about the Vm-dev mailing list