[Vm-dev] VM Maker: VMMaker.oscog-tpr.1511.mcz

commits at source.squeak.org commits at source.squeak.org
Fri Nov 6 20:10:11 UTC 2015


tim Rowledge uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-tpr.1511.mcz

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

Name: VMMaker.oscog-tpr.1511
Author: tpr
Time: 6 November 2015, 1:08:47.44 pm
UUID: c040c1b1-b67f-45ec-973e-4ffd34322ea5
Ancestors: VMMaker.oscog-eem.1510

Merge in a fairly large change to closed PICs; they are no longer compiled each time we make on or extend one, but rather  copied from a prototype and updated as needed.
Take a look at  http://wiki.squeak.org/squeak/6205 for some explanations.

Oh, and fix the div/mod simulation so it actually works. This makes simulating the stdio reading test images actually work on ARM.

Clement - there is a single Sista related change in here that may or may not break things for you ;-)

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

Item was changed:
  ----- Method: CogARMCompiler>>aeabiDiv:Mod: (in category 'simulation') -----
  aeabiDiv: dividend Mod: divisor
  "simulate the __aeabi_idivmod call"
  	<doNotGenerate>
+ 	|result top bottom|
- 	|result|
  
+ 	top:= dividend signedIntFromLong.
+ 	bottom := divisor signedIntFromLong.
+ 	
+ 	cogit processor r0: (result :=(top quo: bottom) signedIntToLong).
+ 	cogit processor r1: (top rem: bottom) signedIntToLong.
- 	cogit processor r0: (result :=dividend quo: divisor).
- 	cogit processor r1: (dividend rem: divisor).
  	^result!

Item was changed:
  ----- Method: CogARMCompiler>>callTargetFromReturnAddress: (in category 'inline cacheing') -----
  callTargetFromReturnAddress: callSiteReturnAddress
  	"Answer the address that the call immediately preceding callSiteReturnAddress will jump to."
  	"this is also used by #jumpLongTargetBeforeFollowingAddress:."
  	| callDistance call |
  	call := self instructionBeforeAddress: callSiteReturnAddress.
  	self assert: ((self instructionIsB: call) or: [self instructionIsBL: call]).
  	callDistance := self extractOffsetFromBL: call.
+ 	^callSiteReturnAddress + 4 "this is the pc's +8 offset, - the 4 byte correction for the previous instruction address" + callDistance signedIntFromLong!
- 	^callSiteReturnAddress + 4 + callDistance signedIntFromLong!

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

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

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

Item was changed:
  ----- Method: CogARMCompiler>>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].
  		"Control"
  		[Call]						-> [^self concretizeCall]. "call code within code space"
  		[CallFull]					-> [^self concretizeCallFull]. "call code anywhere in address space"
  		[JumpR]						-> [^self concretizeJumpR].
  		[JumpFull]					-> [^self concretizeJumpFull]."jump within address space"
  		[JumpLong]					-> [^self concretizeConditionalJump: AL]."jumps witihn code space"
  		[JumpLongZero]			-> [^self concretizeConditionalJump: EQ].
  		[JumpLongNonZero]		-> [^self concretizeConditionalJump: NE].
  		[Jump]						-> [^self concretizeConditionalJump: AL].
  		[JumpZero]					-> [^self concretizeConditionalJump: EQ].
  		[JumpNonZero]				-> [^self concretizeConditionalJump: NE].
  		[JumpNegative]				-> [^self concretizeConditionalJump: MI].
  		[JumpNonNegative]			-> [^self concretizeConditionalJump: PL].
  		[JumpOverflow]				-> [^self concretizeConditionalJump: VS].
  		[JumpNoOverflow]			-> [^self concretizeConditionalJump: VC].
  		[JumpCarry]				-> [^self concretizeConditionalJump: CS].
  		[JumpNoCarry]				-> [^self concretizeConditionalJump: CC].
  		[JumpLess]					-> [^self concretizeConditionalJump: LT].
  		[JumpGreaterOrEqual]		-> [^self concretizeConditionalJump: GE].
  		[JumpGreater]				-> [^self concretizeConditionalJump: GT].
  		[JumpLessOrEqual]			-> [^self concretizeConditionalJump: LE].
  		[JumpBelow]				-> [^self concretizeConditionalJump: CC]. "unsigned lower"
  		[JumpAboveOrEqual]		-> [^self concretizeConditionalJump: CS]. "unsigned greater or equal"
  		[JumpAbove]				-> [^self concretizeConditionalJump: HI].
  		[JumpBelowOrEqual]		-> [^self concretizeConditionalJump: LS].
  		[JumpFPEqual]				-> [^self concretizeFPConditionalJump: EQ].
  		[JumpFPNotEqual]			-> [^self concretizeFPConditionalJump: NE].
  		[JumpFPLess]				-> [^self concretizeFPConditionalJump: LT].
  		[JumpFPGreaterOrEqual]	-> [^self concretizeFPConditionalJump: GE].
  		[JumpFPGreater]			-> [^self concretizeFPConditionalJump: GT].
  		[JumpFPLessOrEqual]		-> [^self concretizeFPConditionalJump: LE].
  		[JumpFPOrdered]			-> [^self concretizeFPConditionalJump: VC].
  		[JumpFPUnordered]			-> [^self concretizeFPConditionalJump: VS].
  		[RetN]						-> [^self concretizeRetN].
  		[Stop]						-> [^self concretizeStop].
  		"Arithmetic"
  		[AddCqR]					-> [^self concretizeNegateableDataOperationCqR: AddOpcode].
  		[AndCqR]					-> [^self concretizeInvertibleDataOperationCqR: AndOpcode].
  		[AndCqRR]					-> [^self concretizeAndCqRR].
  		[CmpCqR]					-> [^self concretizeNegateableDataOperationCqR: CmpOpcode].
  		[OrCqR]						-> [^self concretizeDataOperationCqR: OrOpcode].
  		[SubCqR]					-> [^self concretizeSubCqR].
  		[TstCqR]					-> [^self concretizeTstCqR].
  		[XorCqR]					-> [^self concretizeInvertibleDataOperationCqR: XorOpcode].
  		[AddCwR]					-> [^self concretizeDataOperationCwR: AddOpcode].
  		[AndCwR]					-> [^self concretizeDataOperationCwR: AndOpcode].
  		[CmpCwR]					-> [^self concretizeDataOperationCwR: CmpOpcode].
  		[OrCwR]					-> [^self concretizeDataOperationCwR: OrOpcode].
  		[SubCwR]					-> [^self concretizeDataOperationCwR: SubOpcode].
  		[XorCwR]					-> [^self concretizeDataOperationCwR: XorOpcode].
  		[AddRR]						-> [^self concretizeDataOperationRR: AddOpcode].
  		[AndRR]						-> [^self concretizeDataOperationRR: AndOpcode].
  		[CmpRR]					-> [^self concretizeDataOperationRR: CmpOpcode].
  		[OrRR]						-> [^self concretizeDataOperationRR: OrOpcode].
  		[SubRR]						-> [^self concretizeDataOperationRR: SubOpcode].
  		[XorRR]						-> [^self concretizeDataOperationRR: XorOpcode].
  		[AddRdRd]					-> [^self concretizeAddRdRd].
  		[CmpRdRd]					-> [^self concretizeCmpRdRd].
  		[DivRdRd]					-> [^self concretizeDivRdRd].
  		[MulRdRd]					-> [^self concretizeMulRdRd].
  		[SubRdRd]					-> [^self concretizeSubRdRd].
  		[SqrtRd]					-> [^self concretizeSqrtRd].
  		[NegateR]						-> [^self concretizeNegateR].
  		[LoadEffectiveAddressMwrR]	-> [^self concretizeLoadEffectiveAddressMwrR].
  		[ArithmeticShiftRightCqR]		-> [^self concretizeArithmeticShiftRightCqR].
  		[LogicalShiftRightCqR]			-> [^self concretizeLogicalShiftRightCqR].
  		[LogicalShiftLeftCqR]			-> [^self concretizeLogicalShiftLeftCqR].
  		[ArithmeticShiftRightRR]			-> [^self concretizeArithmeticShiftRightRR].
  		[LogicalShiftLeftRR]				-> [^self concretizeLogicalShiftLeftRR].
  		[LogicalShiftRightRR]			-> [^self concretizeLogicalShiftRightRR].
  		"ARM Specific Arithmetic" 
  		[SMULL]			-> [^self concretizeSMULL]	.
  		[CMPSMULL]		-> [^self concretizeCMPSMULL].
  		[MSR]				-> [^self concretizeMSR].
  		"Data Movement"
  		[MoveCqR]			-> [^self concretizeMoveCqR].
  		[MoveCwR]			-> [^self concretizeMoveCwR].
  		[MoveRR]			-> [^self concretizeMoveRR].
  		[MoveAwR]			-> [^self concretizeMoveAwR].
  		[MoveRAw]			-> [^self concretizeMoveRAw].
+ 		[MoveAbR] 			 -> [^self concretizeMoveAbR].
+  		[MoveRAb]			-> [^self concretizeMoveRAb].
  		[MoveMbrR]			-> [^self concretizeMoveMbrR].
  		[MoveRMbr]			-> [^self concretizeMoveRMbr].
  		[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 added:
+ ----- Method: CogARMCompiler>>instructionAddressBefore: (in category 'inline cacheing') -----
+ instructionAddressBefore: followingAddress
+ 	"Answer the instruction address immediately preceding followingAddress."
+ 	<inline: true>
+ 	^followingAddress -4!

Item was changed:
  ----- Method: CogARMCompiler>>instructionBeforeAddress: (in category 'inline cacheing') -----
  instructionBeforeAddress: followingAddress
  	"Answer the instruction immediately preceding followingAddress."
  	<inline: true>
+ 	^objectMemory longAt: (self instructionAddressBefore: followingAddress)!
- 	^objectMemory longAt: followingAddress -4!

Item was changed:
  ----- Method: CogARMCompiler>>loadLiteralByteSize (in category 'accessing') -----
  loadLiteralByteSize
+ 	"Answer the byte size of a MoveCwR opcode's corresponding machine code. On ARM this is a single instruction pc-relative register load - unless we have made a mistake and not turned on the out of line literals manager"
+ 	^4!
- 	"Answer the byte size of a MoveCwR opcode's corresponding machine code"
- 	^16!

Item was changed:
  ----- Method: CogARMCompiler>>relocateCallBeforeReturnPC:by: (in category 'inline cacheing') -----
  relocateCallBeforeReturnPC: retpc by: delta
  	| instr distanceDiv4 |
  	self assert: delta \\ 4 = 0.
  	delta ~= 0 ifTrue:
  		[instr := self instructionBeforeAddress: retpc.
  		 self assert: ((self instructionIsB: instr) or: [self instructionIsBL: instr]).
  		 distanceDiv4 := instr bitAnd: 16rFFFFFF.
  		 distanceDiv4 := distanceDiv4 + (delta // 4).
+ 		 objectMemory longAt: (self instructionAddressBefore: retpc ) put: ((instr bitAnd: 16rFF000000) bitOr: (distanceDiv4 bitAnd: 16rFFFFFF))]!
- 		 objectMemory longAt: retpc - 4 put: ((instr bitAnd: 16rFF000000) bitOr: (distanceDiv4 bitAnd: 16rFFFFFF))]!

Item was added:
+ ----- Method: CogARMCompiler>>rewriteCPICJumpAt:target: (in category 'inline cacheing') -----
+ rewriteCPICJumpAt: callSiteReturnAddress target: callTargetAddress
+ 	"Rewrite a jump instruction to call a different target.  This variant is used to reset the 
+ 	jumps in the prototype CPIC to suit each use,.   
+ 	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>
+ 	^self rewriteTransferAt: callSiteReturnAddress target: callTargetAddress!

Item was changed:
  ----- Method: CogARMCompiler>>rewriteCallAt:target: (in category 'inline cacheing') -----
  rewriteCallAt: callSiteReturnAddress target: callTargetAddress
  	"Rewrite a call instruction to call a different target.  This variant is used to link PICs
+ 	 in ceSendMiss et al,.   
+ 	Answer the extent of the code change which is used to compute the range of the icache to flush."
- 	 in ceSendMiss et al, and 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>
+ 	^self rewriteTransferAt: callSiteReturnAddress target: callTargetAddress!
- 	| callDistance call |
- 	"self cCode: ''
- 		inSmalltalk: [cogit disassembleFrom: callSiteReturnAddress - 10 to: callSiteReturnAddress - 1]."
- 	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, yet"
- 	call := self bl: callDistance.
- 	objectMemory longAt:  callSiteReturnAddress - 4 put: call.
- 
- 	self assert: (self callTargetFromReturnAddress: callSiteReturnAddress) signedIntToLong = callTargetAddress.
- 	"self cCode: ''
- 		inSmalltalk: [cogit disassembleFrom: callSiteReturnAddress - 10 to: callSiteReturnAddress - 1]."
- 	^4!

Item was changed:
  ----- Method: CogARMCompiler>>rewriteCallFullAt:target: (in category 'inline cacheing') -----
  rewriteCallFullAt: callSiteReturnAddress target: callTargetAddress
  	"Rewrite a callFull instruction to jump to a different target.  This variant
+ 	 is used to rewrite cached primitive calls where we load the target address into ip
+ 	and use the 'blx ip' instruction for the actual call.
+ 	Answer the extent of the
- 	 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."
  	<inline: true>
  	^self
  		rewriteFullTransferAt: callSiteReturnAddress
  		target: callTargetAddress
  		expectedInstruction: 16rE12FFF3C!

Item was changed:
  ----- Method: CogARMCompiler>>rewriteJumpFullAt:target: (in category 'inline cacheing') -----
  rewriteJumpFullAt: callSiteReturnAddress target: callTargetAddress
  	"Rewrite a full jump instruction to jump to a different target.  This variant
+ 	 is used to rewrite cached primitive calls where we load the target address into ip
+ 	and use the 'bx ip' instruction for the actual jump.
+ 	Answer the extent of the
- 	 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."
  	<inline: true>
  	^self
  		rewriteFullTransferAt: callSiteReturnAddress
  		target: callTargetAddress
  		expectedInstruction: 16rE12FFF1C!

Item was added:
+ ----- Method: CogARMCompiler>>rewriteJumpLongAt:target: (in category 'inline cacheing') -----
+ rewriteJumpLongAt: callSiteReturnAddress target: callTargetAddress
+ 	"Rewrite a jump instruction to call a different target.  This variant is used to reset the 
+ 	jumps in the prototype CPIC to suit each use,.   
+ 	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>
+ 	^self rewriteTransferAt: callSiteReturnAddress target: callTargetAddress!

Item was added:
+ ----- Method: CogARMCompiler>>rewriteTransferAt:target: (in category 'inline cacheing') -----
+ rewriteTransferAt: callSiteReturnAddress target: callTargetAddress
+ 	"Rewrite a call/jump instruction to call a different target.  This variant is used to link PICs
+ 	 in ceSendMiss et al, and to rewrite call/jumps in CPICs.
+ 	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>
+ 	| callDistance instr |
+ 	"for debug - [cogit disassembleFrom: callSiteReturnAddress - 10 to: callSiteReturnAddress - 1]."
+ 	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, yet"
+ 
+ 	instr := self instructionBeforeAddress: callSiteReturnAddress.
+ 	self assert: ((self instructionIsB: instr) or: [self instructionIsBL: instr]).
+ 	
+ 	objectMemory longAt:  (self instructionAddressBefore: callSiteReturnAddress) put: ((instr bitAnd: 16rFF000000) bitOr: (callDistance // 4 bitAnd: 16rFFFFFF)).
+ 
+ 	self assert: (self callTargetFromReturnAddress: callSiteReturnAddress) signedIntToLong = callTargetAddress.
+ 
+ 	^4!

Item was added:
+ ----- Method: CogAbstractInstruction>>rewriteCPICCaseAt:tag:objRef:target: (in category 'inline cacheing') -----
+ rewriteCPICCaseAt: followingAddress tag: newTag objRef: newObjRef target: newTarget
+ 	"rewrite the three values involved in a CPIC case. Used by the create & extend cpcic methods"
+ 	self subclassResponsibility
+ 	!

Item was added:
+ ----- Method: CogIA32Compiler>>rewriteCPICCaseAt:tag:objRef:target: (in category 'inline cacheing') -----
+ rewriteCPICCaseAt: followingAddress tag: newTag objRef: newObjRef target: newTarget
+ 	"rewrite the three values involved in a CPIC case. Used by the create & extend cpcic methods"
+ 
+ 	"IA32 CPIC cases are
+ 	cmpl $0x newTag, %eax
+ 	movl $0x newObjRef, %ebx
+ 	jz .+0x newTarget (0x00010924)
+ "
+ 	"rewite the tag via the first ldr"	
+ 	self storeLiteral: newTag beforeFollowingAddress: (followingAddress -11).
+ 
+ 	"write the obj ref/operand via the second ldr"
+ 	self storeLiteral: newObjRef beforeFollowingAddress: (followingAddress - 6).
+ 	
+ 	"write the jump address for the new target address"
+ 	self rewriteJumpLongAt: followingAddress target: newTarget!

Item was added:
+ ----- Method: CogIA32Compiler>>rewriteCPICJumpAt:target: (in category 'inline cacheing') -----
+ rewriteCPICJumpAt: callSiteReturnAddress target: callTargetAddress
+ 	"Rewrite the short jump instruction to jump to a new cpic case target. "
+ 	<var: #callSiteReturnAddress type: #usqInt>
+ 	<var: #callTargetAddress type: #usqInt>
+ 	| callDistance |
+ 	callDistance := (callTargetAddress - callSiteReturnAddress) signedIntToLong.
+ 	self assert: (callDistance < 256).
+ 	objectMemory
+ 		byteAt: callSiteReturnAddress - 1 put:  (callDistance  bitAnd: 16rFF).
+ 	"self cCode: ''
+ 		inSmalltalk: [cogit disassembleFrom: callSiteReturnAddress - 10 to: callSiteReturnAddress - 1]."
+ 	^2!

Item was changed:
  ----- 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."
  	<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: (self instructionAddressBefore: callSiteReturnAddress ) put: call.
+ 	self insert32BitOperand: cacheTag into4InstructionsPreceding: (self instructionAddressBefore: callSiteReturnAddress ).
- 	objectMemory longAt: callSiteReturnAddress - 4 put: call.
- 	self insert32BitOperand: cacheTag into4InstructionsPreceding: callSiteReturnAddress - 4.
  	self assert: (self callTargetFromReturnAddress: callSiteReturnAddress) signedIntToLong = callTargetAddress.
+ 	self assert: (self extract32BitOperandFrom4InstructionsPreceding: (self instructionAddressBefore: callSiteReturnAddress )) = cacheTag.
- 	self assert: (self extract32BitOperandFrom4InstructionsPreceding: callSiteReturnAddress - 4) = cacheTag.
  	"self cCode: ''
  		inSmalltalk: [cogit disassembleFrom: callSiteReturnAddress - 20 to: callSiteReturnAddress - 1]."
  	^20!

Item was changed:
  ----- Method: CogMethod>>containsAddress: (in category 'testing') -----
  containsAddress: anAddress
+ 	"is anAddress within my bounds; not a test of addresses referred to within instructions in the method"
  	<inline: true>
  	^self asUnsignedInteger <= anAddress asUnsignedInteger
  	  and: [self asUnsignedInteger + self blockSize >= anAddress asUnsignedInteger]!

Item was changed:
  ----- Method: CogMethodZone>>printOpenPICList (in category 'accessing') -----
  printOpenPICList
  	<api>
  	| openPIC |
  	<var: #openPIC type: #'CogMethod *'>
  	openPIC := openPICList.
  	[openPIC == nil] whileFalse:
+ 		[coInterpreter printCogMethod: openPIC.
- 		[self printCogMethod: openPIC.
  		 openPIC := self cCoerceSimple: openPIC nextOpenPIC to: #'CogMethod *']!

Item was added:
+ ----- Method: CogOutOfLineLiteralsARMCompiler>>literalBeforeFollowingAddress: (in category 'inline cacheing') -----
+ literalBeforeFollowingAddress: followingAddress
+ 	"Return the literal referenced by the instruction immediately preceding followingAddress."
+ 	^objectMemory longAt: (self pcRelativeAddressAt: (self instructionAddressBefore: followingAddress))!

Item was added:
+ ----- Method: CogOutOfLineLiteralsARMCompiler>>rewriteCPICCaseAt:tag:objRef:target: (in category 'inline cacheing') -----
+ rewriteCPICCaseAt: followingAddress tag: newTag objRef: newObjRef target: newTarget
+ 	"rewrite the three values involved in a CPIC case. Used by the create & extend cpcic methods"
+ 
+ 	"ARM CPIC cases are
+ 	ldr TempReg, [pc relative -> tag]
+ 	cmp TempReg0, TempReg 
+ 	ldr SendNumArgs, [pc relative -> obj ref]
+ 	beq target"
+ 	"rewite the tag via the first ldr"	
+ 	objectMemory longAt: (self pcRelativeAddressAt: followingAddress - 16) put: newTag.
+ 
+ 	"write the obj ref/operand via the second ldr"
+ 	objectMemory longAt: (self pcRelativeAddressAt: followingAddress - 8) put: newObjRef.
+ 	
+ 	"write the jump address for the new target address"
+ 	self rewriteJumpLongAt: followingAddress target: newTarget!

Item was changed:
  ----- Method: CogOutOfLineLiteralsARMCompiler>>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 where we load the target address into ip
+ 	and use the 'bx ip' or 'blx ip' instruction for the actual jump or call.
+ 	Answer the extent
- 	 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>
  	self assert: (self instructionBeforeAddress: callSiteReturnAddress) = expectedInstruction.
  	objectMemory longAt: (self pcRelativeAddressAt: callSiteReturnAddress - 8) put: callTargetAddress.
  	"self cCode: ''
  		inSmalltalk: [cogit disassembleFrom: callSiteReturnAddress - 8 to: (self pcRelativeAddressAt: callSiteReturnAddress - 8)]."
  	^0!

Item was changed:
  ----- Method: CogOutOfLineLiteralsARMCompiler>>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."
  	<var: #callSiteReturnAddress type: #usqInt>
  	<var: #callTargetAddress type: #usqInt>
  	| call callDistance |
  	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: (self instructionAddressBefore: callSiteReturnAddress ) put: call;
- 		longAt: callSiteReturnAddress - 4 put: call;
  		longAt: (self pcRelativeAddressAt: callSiteReturnAddress - 8) put: cacheTag.
  	self assert: (self inlineCacheTagAt: callSiteReturnAddress) = cacheTag.
  	"self cCode: ''
  		inSmalltalk: [cogit disassembleFrom: callSiteReturnAddress - 8 to: (self pcRelativeAddressAt: callSiteReturnAddress - 8)]."
  	^4!

Item was changed:
  ----- Method: CogOutOfLineLiteralsARMCompiler>>storeLiteral:beforeFollowingAddress: (in category 'inline cacheing') -----
  storeLiteral: literal beforeFollowingAddress: followingAddress
  	"Rewrite the literal in the instruction immediately preceding followingAddress."
+ 	objectMemory longAt: (self pcRelativeAddressAt: (self instructionAddressBefore: followingAddress )) put: literal!
- 	objectMemory longAt: (self pcRelativeAddressAt: followingAddress - 4) put: literal!

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 methodLabel stackCheckLabel blockEntryLabel blockEntryNoContextSwitch blockNoContextSwitchOffset stackOverflowCall sendMiss missOffset entryPointMask checkedEntryAlignment uncheckedEntryAlignment cmEntryOffset entry cmNoCheckEntryOffset noCheckEntry picMNUAbort picInterpretAbort endCPICCase0 endCPICCase1 firstCPICCaseOffset cPICCaseSize cPICEndSize closedPICSize openPICSize fixups abstractOpcodes generatorTable primitiveGeneratorTable byte0 byte1 byte2 byte3 bytecodePC bytecodeSetOffset opcodeIndex numAbstractOpcodes blockStarts blockCount labelCounter cStackAlignment expectedSPAlignment expectedFPAlignment codeModified maxLitIndex ceMethodAbortTrampoline cePICAbortTrampoline ceCheckForInterruptTrampoline ceCPICMissTrampoline ceReturnToInterpreterTrampoline ceBaseFrameReturnTrampoline ceSendMustBeBooleanAddTrueTrampoline ceSendMustBeBooleanAddFalseTrampoline ceCannotResumeTrampoline ceEnterCogCodePopReceiverReg ceCallCogCodePopReceiverReg ceCallCogCodePopReceiverAndClassRegs cePrimReturnEnterCogCode cePrimReturnEnterCogCodeProfiling ceNonLocalReturnTrampoline ceFetchContextInstVarTrampoline ceStoreContextInstVarTrampoline ceEnclosingObjectTrampoline 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 extA extB tempOop numIRCs indexOfIRC theIRCs implicitReceiverSendTrampolines cogMethodSurrogateClass cogBlockMethodSurrogateClass nsSendCacheSurrogateClass CStackPointer CFramePointer cPICPrototype cPICEndOfCodeOffset cPICEndOfCodeLabel maxCPICCases'
- 	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 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 generatorTable primitiveGeneratorTable byte0 byte1 byte2 byte3 bytecodePC bytecodeSetOffset opcodeIndex numAbstractOpcodes blockStarts blockCount labelCounter cStackAlignment expectedSPAlignment expectedFPAlignment codeModified maxLitIndex ceMethodAbortTrampoline cePICAbortTrampoline ceCheckForInterruptTrampoline ceCPICMissTrampoline ceReturnToInterpreterTrampoline ceBaseFrameReturnTrampoline ceSendMustBeBooleanAddTrueTrampoline ceSendMustBeBooleanAddFalseTrampoline ceCannotResumeTrampoline ceEnterCogCodePopReceiverReg ceCallCogCodePopReceiverReg ceCallCogCodePopReceiverAndClassRegs cePrimReturnEnterCogCode cePrimReturnEnterCogCodeProfiling ceNonLocalReturnTrampoline ceFetchContextInstVarTrampoline ceStoreContextInstVarTrampoline ceEnclosingObjectTrampoline 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 extA extB tempOop numIRCs indexOfIRC theIRCs implicitReceiverSendTrampolines cogMethodSurrogateClass cogBlockMethodSurrogateClass nsSendCacheSurrogateClass CStackPointer CFramePointer'
  	classVariableNames: 'AltBlockCreationBytecodeSize AltFirstSpecialSelector AltNSSendIsPCAnnotated AltNumSpecialSelectors AnnotationConstantNames AnnotationShift AnnotationsWithBytecodePCs BlockCreationBytecodeSize Debug DisplacementMask DisplacementX2N EagerInstructionDecoration FirstAnnotation FirstSpecialSelector HasBytecodePC IsAbsPCReference IsAnnotationExtension IsDirectedSuperSend IsDisplacementX2N IsNSDynamicSuperSend IsNSImplicitReceiverSend IsNSSelfSend IsNSSendCall IsObjectReference IsRelativeCall IsSendCall IsSuperSend MapEnd MaxCompiledPrimitiveIndex MaxStackAllocSize MaxX2NDisplacement NSCClassTagIndex NSCEnclosingObjectIndex NSCNumArgsIndex NSCSelectorIndex NSCTargetIndex NSSendIsPCAnnotated NumObjRefsInRuntime NumOopsPerNSC NumSpecialSelectors 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>>declareCVarsIn: (in category 'translation') -----
  declareCVarsIn: aCCodeGenerator
  	#(	'coInterpreter' 'objectMemory' 'methodZone' 'objectRepresentation'
  		'cogBlockMethodSurrogateClass' 'cogMethodSurrogateClass' 'nsSendCacheSurrogateClass'
  		'threadManager' 'processor' 'lastNInstructions' 'simulatedAddresses'
  		'simulatedTrampolines' 'simulatedVariableGetters' 'simulatedVariableSetters'
  		'printRegisters' 'printInstructions' 'clickConfirm' 'singleStep') do:
  			[:simulationVariableNotNeededForRealVM|
  			aCCodeGenerator removeVariable: simulationVariableNotNeededForRealVM].
  	NewspeakVM ifFalse:
  		[#(	'selfSendTrampolines' 'dynamicSuperSendTrampolines'
  			'implicitReceiverSendTrampolines' 'outerSendTrampolines'
  			'ceEnclosingObjectTrampoline' 'numIRCs' 'indexOfIRC' 'theIRCs') do:
  				[:variableNotNeededInNormalVM|
  				aCCodeGenerator removeVariable: variableNotNeededInNormalVM]].
  	aCCodeGenerator removeConstant: #COGMTVM. "this should be defined at compile time"
  	aCCodeGenerator
  		addHeaderFile:'<stddef.h>'; "for e.g. offsetof"
  		addHeaderFile:'"sqCogStackAlignment.h"';
  		addHeaderFile:'"dispdbg.h"'; "must precede cointerp.h & cogit.h otherwise NoDbgRegParms gets screwed up"
  		addHeaderFile:'"cogmethod.h"'.
  	NewspeakVM ifTrue:
  		[aCCodeGenerator addHeaderFile:'"nssendcache.h"'].
  	aCCodeGenerator
  		addHeaderFile:'#if COGMTVM';
  		addHeaderFile:'"cointerpmt.h"';
  		addHeaderFile:'#else';
  		addHeaderFile:'"cointerp.h"';
  		addHeaderFile:'#endif';
  		addHeaderFile:'"cogit.h"'.
  	aCCodeGenerator
  		var: #ceGetSP
  			declareC: 'unsigned long (*ceGetSP)(void)';
  		var: #ceCaptureCStackPointers
  			declareC: 'void (*ceCaptureCStackPointers)(void)';
  		var: #ceEnterCogCodePopReceiverReg
  			declareC: 'void (*ceEnterCogCodePopReceiverReg)(void)';
  		var: #realCEEnterCogCodePopReceiverReg
  			declareC: 'void (*realCEEnterCogCodePopReceiverReg)(void)';
  		var: #ceCallCogCodePopReceiverReg
  			declareC: 'void (*ceCallCogCodePopReceiverReg)(void)';
  		var: #realCECallCogCodePopReceiverReg
  			declareC: 'void (*realCECallCogCodePopReceiverReg)(void)';
  		var: #ceCallCogCodePopReceiverAndClassRegs
  			declareC: 'void (*ceCallCogCodePopReceiverAndClassRegs)(void)';
  		var: #realCECallCogCodePopReceiverAndClassRegs
  			declareC: 'void (*realCECallCogCodePopReceiverAndClassRegs)(void)';
  		var: #ceFlushICache
  			declareC: 'static void (*ceFlushICache)(unsigned long from, unsigned long to)';
  		var: #ceCheckFeaturesFunction
  			declareC: 'static unsigned long (*ceCheckFeaturesFunction)(void)';
  		var: #ceTryLockVMOwner
  			declareC: 'unsigned long (*ceTryLockVMOwner)(void)';
  		var: #ceUnlockVMOwner
  			declareC: 'void (*ceUnlockVMOwner)(void)';
  		var: #postCompileHook
  			declareC: 'void (*postCompileHook)(CogMethod *)';
  		var: #openPICList declareC: 'CogMethod *openPICList = 0';
  		var: #maxMethodBefore type: #'CogBlockMethod *'.
  	aCCodeGenerator
  		declareVar: 'aMethodLabel' type: #'AbstractInstruction'; "Has to come lexicographically before backEnd & methodLabel"
  		var: #backEnd declareC: 'AbstractInstruction * const backEnd = &aMethodLabel';
  		var: #methodLabel declareC: 'AbstractInstruction * const methodLabel = &aMethodLabel'.
  	self declareC: #(abstractOpcodes stackCheckLabel
  					blockEntryLabel blockEntryNoContextSwitch
  					stackOverflowCall sendMiss
  					entry noCheckEntry selfSendEntry dynSuperEntry
+ 					picMNUAbort picInterpretAbort  endCPICCase0 endCPICCase1 cPICEndOfCodeLabel)
- 					picMNUAbort picInterpretAbort endCPICCase0 endCPICCase1)
  			as: #'AbstractInstruction *'
  				in: aCCodeGenerator.
  	aCCodeGenerator
  		declareVar: #blockStarts type: #'BlockStart *';
  		declareVar: #fixups type: #'BytecodeFixup *'.
  	aCCodeGenerator
  		var: #ordinarySendTrampolines
  			declareC: 'sqInt ordinarySendTrampolines[NumSendTrampolines]';
  		var: #superSendTrampolines
  			declareC: 'sqInt superSendTrampolines[NumSendTrampolines]';
  		var: #directedSuperSendTrampolines
  			declareC: 'sqInt directedSuperSendTrampolines[NumSendTrampolines]';
  		var: #selfSendTrampolines
  			declareC: 'sqInt selfSendTrampolines[NumSendTrampolines]';
  		var: #dynamicSuperSendTrampolines
  			declareC: 'sqInt dynamicSuperSendTrampolines[NumSendTrampolines]';
  		var: #implicitReceiverSendTrampolines
  			declareC: 'sqInt implicitReceiverSendTrampolines[NumSendTrampolines]';
  		var: #outerSendTrampolines
  			declareC: 'sqInt outerSendTrampolines[NumSendTrampolines]';
  		var: #trampolineAddresses
  			declareC: 'static char *trampolineAddresses[NumTrampolines*2]';
  		var: #objectReferencesInRuntime
  			declareC: 'static usqInt objectReferencesInRuntime[NumObjRefsInRuntime]';
  		var: #labelCounter
  			type: #int;
  		var: #traceFlags
  			declareC: 'int traceFlags = 8 /* prim trace log on by default */';
  		var: #cStackAlignment
  			declareC: 'const int cStackAlignment = STACK_ALIGN_BYTES'.
  	aCCodeGenerator
  		declareVar: #CFramePointer type: #'void *';
  		declareVar: #CStackPointer type: #'void *';
  		declareVar: #minValidCallAddress type: #'unsigned long';
  		declareVar: #debugPrimCallStackOffset type: #'unsigned long'.
  	aCCodeGenerator vmClass generatorTable ifNotNil:
  		[:bytecodeGenTable|
  		aCCodeGenerator
  			var: #generatorTable
  				declareC: 'static BytecodeDescriptor generatorTable[', bytecodeGenTable size, ']',
  							(self tableInitializerFor: bytecodeGenTable
  								in: aCCodeGenerator);
  			var: #primitiveGeneratorTable
  				declareC: 'static PrimitiveDescriptor primitiveGeneratorTable[MaxCompiledPrimitiveIndex+1]',
  							(self tableInitializerFor: aCCodeGenerator vmClass primitiveTable
  								in: aCCodeGenerator)].
  	"In C the abstract opcode names clash with the Smalltak generator syntactic sugar.
  	 Most of the syntactic sugar is inlined, but alas some remains.  Rename the syntactic
  	 sugar to avoid the clash."
  	(self organization listAtCategoryNamed: #'abstract instructions') do:
  		[:s|
  		aCCodeGenerator addSelectorTranslation: s to: 'g', (aCCodeGenerator cFunctionNameFor: s)].
  	aCCodeGenerator addSelectorTranslation: #halt: to: 'haltmsg'!

Item was changed:
  ----- Method: Cogit>>addressOfEndOfCase:inCPIC: (in category 'in-line cacheing') -----
+ addressOfEndOfCase: n inCPIC: cPIC 
+ 	"calculate the end of the n'th case statement - which is complicated because we have case 1 right at the top of our CPIC and then build up from the last one. Yes I know this sounds strange, but trust me - I'm an Engineer, we do things backwards all the emit"
+ 
- addressOfEndOfCase: n inCPIC: cPIC
- 	"N.B. zero-relative"
  	<var: #cPIC type: #'CogMethod *'>
+ 	self assert: (n >= 1and: [n <= maxCPICCases]).
+ 	n = 1
+ 		ifTrue: [^ cPIC asInteger + firstCPICCaseOffset]
+ 		ifFalse: [^ cPIC asInteger + firstCPICCaseOffset + (maxCPICCases + 1 - n * cPICCaseSize)]!
- 	^cPIC asInteger + firstCPICCaseOffset + (n * cPICCaseSize)!

Item was changed:
  ----- Method: Cogit>>cPIC:HasTarget: (in category 'in-line cacheing') -----
  cPIC: cPIC HasTarget: targetMethod
+ 	"Are any of the jumps from this CPIC to targetMethod?"
  	<var: #cPIC type: #'CogMethod *'>
  	<var: #targetMethod type: #'CogMethod *'>
  	| pc target |
  	target := targetMethod asUnsignedInteger + cmNoCheckEntryOffset.
  	pc := cPIC asInteger + firstCPICCaseOffset.
+ 	"Since this is a fast test doing simple compares we don't need to care that some
+ 	cases have nonsense addresses in there. Just zip on through"
  	1 to: cPIC cPICNumCases do:
  		[:i|
+ 		target = (backEnd jumpLongTargetBeforeFollowingAddress: pc) ifTrue:
- 		target = (literalsManager cPICCase: i jumpTargetBefore: pc) ifTrue:
  			[^true].
  		pc := pc + cPICCaseSize].
  	^false!

Item was changed:
  ----- Method: Cogit>>cPICHasForwardedClass: (in category 'in-line cacheing') -----
+ cPICHasForwardedClass: cPIC 
+ 	"The first case in a CPIC doesn't have a class reference so we need only step over actually usd subsequent cases."
- cPICHasForwardedClass: cPIC
- 	<var: #cPIC type: #'CogMethod *'>
  	| pc |
+ 	<var: #cPIC type: #'CogMethod *'>
+ 	"start by finding the address of the topmost case, the cPICNumCases'th one"
+ 	pc := (self addressOfEndOfCase: cPIC cPICNumCases inCPIC: cPIC)
+ 				- backEnd jumpLongConditionalByteSize.
+ 	2 to: cPIC cPICNumCases do: 
+ 			[:i |  | classIndex |
+ 			classIndex := literalsManager classRefInClosedPICAt: pc.
+ 			(objectMemory isForwardedClassIndex: classIndex)
+ 				ifTrue: [^ true].
+ 			"since we started at the top, we can just add the case size each time to move on to the next case"
+ 			pc := pc + cPICCaseSize].
+ 	^ false!
- 	pc := cPIC asUnsignedInteger
- 		+ firstCPICCaseOffset
- 		+ cPICCaseSize
- 		- backEnd jumpLongConditionalByteSize.
- 	2 to: cPIC cPICNumCases do:
- 		[:i| | classIndex |
- 		classIndex := literalsManager classRefInClosedPICAt: pc.
- 		(objectMemory isForwardedClassIndex: classIndex) ifTrue:
- 			[^true].
- 		pc := pc + cPICCaseSize].
- 	^false!

Item was changed:
  ----- Method: Cogit>>cPICHasFreedTargets: (in category 'in-line cacheing') -----
  cPICHasFreedTargets: cPIC
+ 	"scan the CPIC for target methods that have been freed. "
  	<var: #cPIC type: #'CogMethod *'>
  	| pc entryPoint targetMethod |
  	<var: #targetMethod type: #'CogMethod *'>
+ 
- 	pc := cPIC asInteger + firstCPICCaseOffset.
  	1 to: cPIC cPICNumCases do:
  		[:i|
+ 		pc := self addressOfEndOfCase: i inCPIC: cPIC.
+ 		entryPoint := backEnd jumpLongTargetBeforeFollowingAddress: pc.
- 		entryPoint := literalsManager cPICCase: i jumpTargetBefore: pc.
  		"Find target from jump.  Ignore jumps to the interpret and MNU calls within this PIC"
  		(cPIC containsAddress: entryPoint) ifFalse:
  			[targetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
  			 self assert: (targetMethod cmType = CMMethod or: [targetMethod cmType = CMFree]).
  			 targetMethod cmType = CMFree ifTrue:
+ 				[^true]]].
- 				[^true]].
- 		pc := pc + cPICCaseSize].
  	^false!

Item was changed:
  ----- Method: Cogit>>ceCPICMiss:receiver: (in category 'in-line cacheing') -----
  ceCPICMiss: cPIC receiver: receiver
  	"Code entry closed PIC miss.  A send has fallen
  	 through a closed (finite) polymorphic inline cache.
  	 Either extend it or patch the send site to an open PIC.
  	 The stack looks like:
  			receiver
  			args
  	  sp=>	sender return address"
  	<var: #cPIC type: #'CogMethod *'>
  	<api>
  	| outerReturn newTargetMethodOrNil errorSelectorOrNil cacheTag result |
  	self cCode: ''
  		inSmalltalk:
  			[cPIC isInteger ifTrue:
  				[^self ceCPICMiss: (self cogMethodSurrogateAt: cPIC) receiver: receiver]].
  	(objectMemory isOopForwarded: receiver) ifTrue:
  		[^coInterpreter ceSendFromInLineCacheMiss: cPIC].
  	outerReturn := coInterpreter stackTop.
  	self deny: (backEnd inlineCacheTagAt: outerReturn) = self picAbortDiscriminatorValue. 
+ 	cPIC cPICNumCases < maxCPICCases
- 	cPIC cPICNumCases < numPICCases
  		ifTrue:
  			[self lookup: cPIC selector
  				for: receiver
  				methodAndErrorSelectorInto:
  					[:method :errsel|
  					newTargetMethodOrNil := method.
  					errorSelectorOrNil := errsel]]
  		ifFalse: [newTargetMethodOrNil := errorSelectorOrNil := nil].
  	"We assume lookupAndCog:for: will *not* reclaim the method zone"
  	self assert: outerReturn = coInterpreter stackTop.
  	cacheTag := objectRepresentation inlineCacheTagForInstance: receiver.
+ 	(cPIC cPICNumCases >= maxCPICCases
- 	(cPIC cPICNumCases >= numPICCases
  	 or: [(errorSelectorOrNil notNil and: [errorSelectorOrNil ~= SelectorDoesNotUnderstand])
  	 or: [(objectRepresentation inlineCacheTagIsYoung: cacheTag)
  	 or: [newTargetMethodOrNil isNil
  	 or: [objectMemory isYoung: newTargetMethodOrNil]]]]) ifTrue:
  		[result := self patchToOpenPICFor: cPIC selector
  					numArgs: cPIC cmNumArgs
  					receiver: receiver.
  		 self assert: result not. "If patchToOpenPICFor:.. returns we're out of code memory"
  		 ^coInterpreter ceSendFromInLineCacheMiss: cPIC].
  	"Now extend the PIC with the new case."
  	self cogExtendPIC: cPIC
  		CaseNMethod: newTargetMethodOrNil
  		tag: cacheTag
  		isMNUCase: errorSelectorOrNil = SelectorDoesNotUnderstand.
  	"Jump back into the pic at its entry in case this is an MNU."
  	coInterpreter
  		executeCogPIC: cPIC
  		fromLinkedSendWithReceiver: receiver
  		andCacheTag: (backEnd inlineCacheTagAt: outerReturn).
  	"NOTREACHED"
  	^nil!

Item was changed:
  ----- Method: Cogit>>checkValidObjectReferencesInClosedPIC: (in category 'garbage collection') -----
  checkValidObjectReferencesInClosedPIC: cPIC
  	<var: #cPIC type: #'CogMethod *'>
  	| ok pc |
  	ok := true.
  	pc := cPIC asInteger + firstCPICCaseOffset.
+ 	
+ 	"first we check the obj ref at the beginning of the CPIC"
  	(self checkMaybeObjRefInClosedPIC: (literalsManager objRefInClosedPICAt: pc - backEnd jumpLongByteSize)) ifFalse:
  		[self print: 'object leak in CPIC '; printHex: cPIC asInteger;
  			print: ' @ '; printHex: pc - backEnd jumpLongByteSize; cr.
  		 ok := false].
+ 	
+ 	"Next we step over each case that is in use. We find the end address of the cPICNumCases'th case and can then just step forward by the case size thereafter"
+ 	pc := self addressOfEndOfCase: cPIC cPICNumCases inCPIC: cPIC.
+ 	
+ 	"For each case we check any object reference at the end address - sizeof(conditional instruction) and then increment the end address by case size"
- 	pc := pc + cPICCaseSize.
  	2 to: cPIC cPICNumCases do:
  		[:i|
  		objectRepresentation inlineCacheTagsMayBeObjects ifTrue:
  			[(self checkMaybeObjRefInClosedPIC: (literalsManager classRefInClosedPICAt: pc - backEnd jumpLongConditionalByteSize)) ifFalse:
  				[self print: 'object leak in CPIC '; printHex: cPIC asInteger;
  					print: ' @ '; printHex: pc - backEnd jumpLongConditionalByteSize - backEnd loadLiteralByteSize; cr.
  				 ok := false]].
  		(self checkMaybeObjRefInClosedPIC: (literalsManager objRefInClosedPICAt: pc - backEnd jumpLongConditionalByteSize)) ifFalse:
  			[self print: 'object leak in CPIC '; printHex: cPIC asInteger;
  				print: ' @ '; printHex: pc - backEnd jumpLongConditionalByteSize; cr.
  			 ok := false].
  		pc := pc + cPICCaseSize].
  	^ok!

Item was changed:
  ----- Method: Cogit>>closedPICRefersToUnmarkedObject: (in category 'garbage collection') -----
  closedPICRefersToUnmarkedObject: cPIC
  	"Answer if the ClosedPIC refers to any unmarked objects or freed/freeable target methods,
  	 applying markAndTraceOrFreeCogMethod:firstVisit: to those targets to determine if freed/freeable."
  	<var: #cPIC type: #'CogMethod *'>
  	| pc offsetToLiteral object entryPoint targetMethod |
  	<var: #targetMethod type: #'CogMethod *'>
  	(objectMemory isImmediate: cPIC selector) ifFalse:
  		[(objectMemory isMarked: cPIC selector) ifFalse:
  			[^true]].
- 	pc := cPIC asInteger + firstCPICCaseOffset.
  	"First jump is unconditional; subsequent ones are conditional"
  	offsetToLiteral := backEnd jumpLongByteSize.
  	1 to: cPIC cPICNumCases do:
+ 		[:i| 
+ 		pc := self addressOfEndOfCase: i inCPIC: cPIC.
+ 		(objectRepresentation inlineCacheTagsMayBeObjects and: [i>1] ) "inline cache tags for the 0th case are at the send site" ifTrue:
- 		[:i|
- 		objectRepresentation inlineCacheTagsMayBeObjects ifTrue:
  			[object := literalsManager classRefInClosedPICAt: pc - offsetToLiteral.
  			 ((objectRepresentation couldBeObject: object)
  			  and: [(objectMemory isMarked: object) not]) ifTrue:
  				[^true]].
  		object := literalsManager objRefInClosedPICAt: pc - offsetToLiteral.
  		((objectRepresentation couldBeObject: object)
  		 and: [(objectMemory isMarked: object) not]) ifTrue:
  			[^true].
  		offsetToLiteral := backEnd jumpLongConditionalByteSize.
+ 		entryPoint := backEnd jumpLongTargetBeforeFollowingAddress: pc.
- 		entryPoint := literalsManager cPICCase: i jumpTargetBefore: pc.
  		"Find target from jump.  Ignore jumps to the interpret and MNU calls within this PIC"
  		self assert: (entryPoint > methodZoneBase and: [entryPoint < methodZone freeStart]).
  		(cPIC containsAddress: entryPoint) ifFalse:
  			[targetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
  			 self assert: (targetMethod cmType = CMMethod
  						or: [targetMethod cmType = CMFree]).
  			 (self markAndTraceOrFreeCogMethod: targetMethod
  				  firstVisit: targetMethod asUnsignedInteger > pc asUnsignedInteger) ifTrue:
  				[^true]].
+ 		].
- 		pc := pc + cPICCaseSize].
  	^false!

Item was changed:
  ----- Method: Cogit>>codeRangesFor: (in category 'disassembly') -----
  codeRangesFor: cogMethod
  	"Answer a sequence of ranges of code for the main method and all of the blocks in a CogMethod.
  	 N.B.  These are in order of block dispatch, _not_ necessarily address order in the method."
  	<doNotGenerate>
  	| pc end blockEntry starts |
  	cogMethod cmType = CMClosedPIC ifTrue:
+ 		[end := cogMethod asInteger + cPICEndOfCodeOffset - backEnd jumpLongByteSize.
- 		[end := (self addressOfEndOfCase: cogMethod cPICNumCases - 1 inCPIC: cogMethod) + cPICEndSize.
  		 ^{ CogCodeRange
  				from: cogMethod asInteger + (self sizeof: CogMethod)
  				to: end
  				cogMethod: cogMethod
  				startpc: nil }].
  	end := (self mapEndFor: cogMethod) - 1.
  	cogMethod blockEntryOffset = 0 ifTrue:
  		[^{ CogCodeRange
  				from: cogMethod asInteger + (self sizeof: CogMethod)
  				to: end
  				cogMethod: cogMethod
  				startpc: (cogMethod cmType ~= CMOpenPIC ifTrue:
  							[coInterpreter startPCOfMethodHeader: cogMethod methodHeader]) }].
  	pc := blockEntry := cogMethod blockEntryOffset + cogMethod asInteger.
  	starts := OrderedCollection with: cogMethod.
  	[pc < end] whileTrue:
  		[| targetpc |
  		 targetpc := blockEntry.
  		 (backEnd isJumpAt: pc) ifTrue:
  			[targetpc := backEnd jumpTargetPCAt: pc.
  			 targetpc < blockEntry ifTrue:
  				[starts add: (self cCoerceSimple: targetpc - (self sizeof: CogBlockMethod) to: #'CogBlockMethod *')]].
  		 pc := pc + (backEnd instructionSizeAt: pc)].
  	starts := starts asSortedCollection.
  	^(1 to: starts size + 1) collect:
  		[:i| | cogSubMethod nextpc |
  		i <= starts size
  			ifTrue:
  				[cogSubMethod := starts at: i.
  				 nextpc := i < starts size ifTrue: [(starts at: i + 1) address] ifFalse: [blockEntry].
  				 CogCodeRange
  					from: cogSubMethod address + (self sizeof: cogSubMethod)
  					to: nextpc - 1
  					cogMethod: cogSubMethod
  					startpc: (i = 1
  								ifTrue: [coInterpreter startPCOfMethodHeader: cogMethod methodHeader]
  								ifFalse: [cogSubMethod startpc])]
  			ifFalse:
  				[CogCodeRange
  					from: blockEntry
  					to: end]]!

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 |
+ 
- 	| 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: 8 bytecodes: 0.
- 	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: "this isn't an mNU and we have an already cogged method to jump to"
- 	(isMNUCase not
- 	 and: [coInterpreter methodHasCogMethod: caseNMethod])
- 		ifTrue:
  			[operand := 0.
  			 target := (coInterpreter cogMethodOf: caseNMethod) asInteger + cmNoCheckEntryOffset]
+ 		ifFalse: 
- 		ifFalse:
  			[operand := caseNMethod.
  			 isMNUCase
+ 				ifTrue: "this is an mNU so tag the CPIC header and setup a jump to the mNUAbort"
- 				ifTrue:
  					[cPIC cpicHasMNUCase: true.
  					 target := cPIC asInteger + (self sizeof: CogMethod)]
+ 				ifFalse: "setup a jump to the interpretAborth so we can cog the target method"
- 				ifFalse:
  					[target := cPIC asInteger + self picInterpretAbortOffset]].
+ 
+ 	"find the end address of the new case"
+ 	address := self addressOfEndOfCase: cPIC cPICNumCases +1 inCPIC: cPIC.
+ 	
+ 	backEnd rewriteCPICCaseAt: address tag: caseNTag objRef: operand target: target.
+ 
+ 	"finally, rewrite the jump 3 instr  before firstCPICCaseOffset to jump to the beginning of this new case"
+ 	self rewriteCPIC: cPIC caseJumpTo: address - cPICCaseSize. 
+ 
- 	self CmpCw: caseNTag R: TempReg.
- 	self MoveUniqueCw: operand R: SendNumArgsReg.
- 	self DumpJumpLongZero: 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.
+ 	"update the header flag for the number of cases"
  	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 |
- 	| 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.
+ 	"get memory in the code zone for the CPIC; if that fails we return an error code for the sender to use to work out how to blow up"
  	startAddress := methodZone allocate: closedPICSize.
  	startAddress = 0 ifTrue:
  		[coInterpreter callForCogCompiledCodeCompaction.
  		 ^0].
+ 
+ 	"memcpy the prototype across to our allocated space; because anything else would be silly"
+ 	objectMemory mem: startAddress cp: cPICPrototype y: closedPICSize.
+ 	
+ 	self configureMNUCPIC: (self cCoerceSimple: startAddress to: #'CogMethod *')
- 	"stack allocate the various collections so that they
- 	 are effectively garbage collected on return."
- 	self allocateOpcodes: numPICCases * 9 bytecodes: 0.
- 	methodLabel address: startAddress; dependent: nil. "for pc-relative MoveCw: cPIC R: ClassReg"
- 	self compileMNUCPIC: (self cCoerceSimple: startAddress to: #'CogMethod *')
  		methodOperand: methodOperand
+ 		numArgs: numArgs
+ 		delta: startAddress - cPICPrototype.
+ 
- 		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>>cogMethodDoesntLookKosher: (in category 'debugging') -----
  cogMethodDoesntLookKosher: cogMethod
  	"Check that the header fields onf a non-free method are consistent with
  	 the type. Answer 0 if it is ok, otherwise answer a code for the error."
  	<api>
  	<inline: false>
  	<var: #cogMethod type: #'CogMethod *'>
  	((cogMethod blockSize bitAnd: objectMemory wordSize - 1) ~= 0
  	 or: [cogMethod blockSize < (self sizeof: CogMethod)
  	 or: [cogMethod blockSize >= 32768]]) ifTrue:
  		[^1].
  
  	cogMethod cmType = CMFree ifTrue: [^2].
  
  	cogMethod cmType = CMMethod ifTrue:
  		[(objectMemory isIntegerObject: cogMethod methodHeader) ifFalse:
  			[^11].
  		 (objectRepresentation couldBeObject: cogMethod methodObject) ifFalse:
  			[^12].
  		 (cogMethod stackCheckOffset > 0
  		 and: [cogMethod stackCheckOffset < cmNoCheckEntryOffset]) ifTrue:
  			[^13].
  		 ^0].
  
  	cogMethod cmType = CMOpenPIC ifTrue:
  		[cogMethod blockSize ~= openPICSize ifTrue:
  			[^21].
  		 cogMethod methodHeader ~= 0 ifTrue:
  			[^22].
  		
  		 "Check the nextOpenPIC link unless we're compacting"
  		 cogMethod objectHeader >= 0 ifTrue:
  			[(cogMethod methodObject ~= 0
  			 and: [cogMethod methodObject < methodZoneBase
  				   or: [cogMethod methodObject > (methodZone freeStart - openPICSize)
  				   or: [(cogMethod methodObject bitAnd: objectMemory wordSize - 1) ~= 0
  				   or: [(self cCoerceSimple: cogMethod methodObject
  							to: #'CogMethod *') cmType ~= CMOpenPIC]]]]) ifTrue:
  				[^23]].
  		 cogMethod stackCheckOffset ~= 0 ifTrue:
  			[^24].
  		 ^0].
  
  	cogMethod cmType = CMClosedPIC ifTrue:
  		[cogMethod blockSize ~= closedPICSize ifTrue:
  			[^31].
+ 		 (cogMethod cPICNumCases between: 1 and: maxCPICCases) ifFalse:
- 		 (cogMethod cPICNumCases between: 1 and: numPICCases) ifFalse:
  			[^32].
  		 cogMethod methodHeader ~= 0 ifTrue:
  			[^33].
  		 cogMethod methodObject ~= 0 ifTrue:
  			[^34].
  		 ^0].
  
  	^9!

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 |
- 	| startAddress size end |
  	(objectMemory isYoung: selector) ifTrue:
  		[^self cCoerceSimple: YoungSelectorInPIC to: #'CogMethod *'].
  	coInterpreter
  		compilationBreak: selector
  		point: (objectMemory numBytesOf: selector)
  		isMNUCase: isMNUCase.
+ 	
+ 	"get memory in the code zone for the CPIC; if that fails we return an error code for the sender to use to work out how to blow up"
  	startAddress := methodZone allocate: closedPICSize.
  	startAddress = 0 ifTrue:
  		[^self cCoerceSimple: InsufficientCodeSpace to: #'CogMethod *'].
+ 
+ 	"memcpy the prototype across to our allocated space; because anything else would be silly"
+ 	objectMemory mem: startAddress cp: cPICPrototype y: closedPICSize.
+ 	
+ 	self configureCPIC: (self cCoerceSimple: startAddress to: #'CogMethod *')
- 	"stack allocate the various collections so that they
- 	 are effectively garbage collected on return."
- 	self allocateOpcodes: numPICCases * 9 bytecodes: 0.
- 	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
+ 		delta: startAddress - cPICPrototype .
+ 
- 		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 removed:
- ----- Method: Cogit>>compileCPIC:Case0:Case1Method:tag:isMNUCase:numArgs: (in category 'in-line cacheing') -----
- compileCPIC: cPIC Case0: case0CogMethod Case1Method: case1Method tag: case1Tag isMNUCase: isMNUCase numArgs: numArgs
- 	"Compile the code for 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; jump to its unchecked entry-point
- 		- a CompiledMethod; jump to the ceInterpretFromPIC trampoline
- 		- nil; call ceMNUFromPIC"
- 	<var: #cPIC type: #'CogMethod *'>
- 	| operand targetEntry jumpNext |
- 	<var: #case0CogMethod type: #'CogMethod *'>
- 	<var: #targetEntry type: #'void *'>
- 	<var: #jumpNext type: #'AbstractInstruction *'>
- 	self assert: case1Method notNil.
- 	self compilePICAbort: numArgs.
- 	self assert: (objectRepresentation inlineCacheTagIsYoung: case1Tag) not.
- 	(isMNUCase not
- 	 and: [coInterpreter methodHasCogMethod: case1Method])
- 		ifTrue:
- 			[operand := 0.
- 			 targetEntry := ((coInterpreter cogMethodOf: case1Method) asInteger + cmNoCheckEntryOffset) asVoidPointer]
- 		ifFalse: "We do not scavenge PICs, hence we cannot cache the MNU method if it is in new space."
- 			[operand := (case1Method isNil or: [objectMemory isYoungObject: case1Method])
- 							ifTrue: [0]
- 							ifFalse: [case1Method].
- 			 targetEntry := case1Method isNil ifTrue: [picMNUAbort] ifFalse: [picInterpretAbort]].
- 
- 	jumpNext := self compileCPICEntry.
- 	self MoveUniqueCw: 0 R: SendNumArgsReg.
- 	self DumpJumpLong: case0CogMethod asInteger + cmNoCheckEntryOffset.
- 	endCPICCase0 := self CmpCw: case1Tag R: TempReg.
- 	jumpNext jmpTarget: endCPICCase0.
- 	self MoveUniqueCw: operand R: SendNumArgsReg.
- 	self DumpJumpLongZero: (isMNUCase ifTrue: [picMNUAbort] ifFalse: [targetEntry]) asInteger.
- 	endCPICCase1 := self MoveCw: cPIC asUnsignedInteger R: ClassReg.
- 	self JumpLong: (self cPICMissTrampolineFor: numArgs).
- 	^0
- !

Item was changed:
  ----- Method: Cogit>>compileClosedPICPrototype (in category 'in-line cacheing') -----
  compileClosedPICPrototype
  	"Compile the abstract instructions for a full closed PIC used to initialize closedPICSize.
  	 The loads into SendNumArgsReg are those for optional method objects which may be
  	 used in MNU cases."
  	<inline: true>
  	| numArgs jumpNext |
  	<var: #jumpNext type: #'AbstractInstruction *'>
  	numArgs := 0.
  	self compilePICAbort: numArgs.
+ 	jumpNext := self compileCPICEntry. "at the end of the entry code we need to jump to the first case code, which is actually the last chunk - for each entension we must update this jump to move back one case"
- 	jumpNext := self compileCPICEntry.
  	self MoveUniqueCw: 16r5EAF00D R: SendNumArgsReg.
+ 	self JumpLong: self cPICPrototypeCaseOffset + 16rCA5E10.
+ 	endCPICCase0 := self Label.
+ 	1 to: maxCPICCases - 1 do:
- 	self DumpJumpLong: self cPICPrototypeCaseOffset + 16rCA5E10.
- 	jumpNext jmpTarget: (endCPICCase0 := self Label).
- 	1 to: numPICCases - 1 do:
  		[:h|
+ 		h = (maxCPICCases - 1)
+ 				ifTrue: [jumpNext jmpTarget: self Label]. "this is where we jump to for the first case"
  		self CmpCw: 16rBABE1F15+h R: TempReg.
  		self MoveUniqueCw: 16rBADA550 + h R: SendNumArgsReg.
+ 		self JumpLongZero: self cPICPrototypeCaseOffset + 16rCA5E10 + (h * 16).
+ 		h =  1 ifTrue:
- 		self DumpJumpLongZero: self cPICPrototypeCaseOffset + 16rCA5E10 + (h * 16).
- 		h = 1 ifTrue:
  			[endCPICCase1 := self Label]].
  	self MoveCw: methodLabel address R: ClassReg.
  	self JumpLong: (self cPICMissTrampolineFor: numArgs).
+ 	cPICEndOfCodeLabel := self Label.
+ 	literalsManager dumpLiterals: false.
  	^0!

Item was removed:
- ----- Method: Cogit>>compileMNUCPIC:methodOperand:numArgs: (in category 'in-line cacheing') -----
- compileMNUCPIC: cPIC methodOperand: methodOperand numArgs: numArgs
- 	"Compile the code for a one-case MNU PIC that calls ceMNUFromPIC for case0Tag
- 	 The tag for case0 is at the send site and so doesn't need to be generated."
- 	<var: #cPIC type: #'CogMethod *'>
- 	| jumpNext operand |
- 	<var: #jumpNext type: #'AbstractInstruction *'>
- 	self compilePICAbort: numArgs.
- 	jumpNext := self compileCPICEntry.
- 	"We do not scavenge PICs, hence we cannot cache the MNU method if it is in new space."
- 	operand := (methodOperand isNil or: [objectMemory isYoungObject: methodOperand])
- 					ifTrue: [0]
- 					ifFalse: [methodOperand].
- 	self MoveUniqueCw: operand R: SendNumArgsReg.
- 	self DumpJumpLong: picMNUAbort asInteger.
- 	jumpNext jmpTarget: (self MoveCw: cPIC asUnsignedInteger R: ClassReg).
- 	self JumpLong: (self cPICMissTrampolineFor: numArgs).
- 	^0
- !

Item was added:
+ ----- Method: Cogit>>configureCPIC:Case0:Case1Method:tag:isMNUCase:numArgs:delta: (in category 'in-line cacheing') -----
+ configureCPIC: cPIC Case0: case0CogMethod Case1Method: case1Method tag: case1Tag isMNUCase: isMNUCase numArgs: numArgs delta: addrDelta
+ 	"Configure a copy of the prototype CPIC for 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; jump to its unchecked entry-point
+ 		- a CompiledMethod; jump to the ceInterpretFromPIC trampoline
+ 		- nil; call ceMNUFromPIC
+ 	addDelta is the address change from the prototype to the new CPCI location, needed
+ 	because the loading of the CPIC lable at the end may use a literal instead of a pc relative"
+ 	<var: #cPIC type: #'CogMethod *'>
+ 	| operand targetEntry caseEndAddress|
+ 	<var: #case0CogMethod type: #'CogMethod *'>
+ 	<var: #targetEntry type: #'void *'>
+ 	<var: #jumpNext type: #'AbstractInstruction *'>
+ 	self assert: case1Method notNil.
+ 
+ 	"adjust the jump at missOffset, the ceAbortXArgs"
+ 	backEnd rewriteJumpLongAt: cPIC asInteger + missOffset target: (self picAbortTrampolineFor: numArgs).
+ 	
+ 	self assert: (objectRepresentation inlineCacheTagIsYoung: case1Tag) not.
+ 	(isMNUCase not
+ 	 and: [coInterpreter methodHasCogMethod: case1Method])
+ 		ifTrue:
+ 			[operand := 0.
+ 			 targetEntry := ((coInterpreter cogMethodOf: case1Method) asInteger + cmNoCheckEntryOffset) asVoidPointer]
+ 		ifFalse: "We do not scavenge PICs, hence we cannot cache the MNU method if it is in new space."
+ 			[operand := (case1Method isNil or: [objectMemory isYoungObject: case1Method])
+ 							ifTrue: [0]
+ 							ifFalse: [case1Method].
+ 			 targetEntry := case1Method isNil ifTrue: [cPIC asInteger + (self sizeof: CogMethod)] ifFalse: [cPIC asInteger + self picInterpretAbortOffset]].
+ 
+ 	"set the jump to the case0 method"
+ 	backEnd rewriteJumpLongAt: cPIC asInteger + firstCPICCaseOffset target: case0CogMethod asInteger + cmNoCheckEntryOffset.
+ 
+ 	caseEndAddress := self addressOfEndOfCase: 2 inCPIC: cPIC.
+ 
+ 	"update the cpic case - deferred to backend because messy"
+ 	backEnd rewriteCPICCaseAt: caseEndAddress tag: case1Tag objRef: operand target: (isMNUCase ifTrue: [cPIC asInteger + (self sizeof: CogMethod)] ifFalse: [targetEntry]) asInteger.
+ 
+ 	"update the loading of the PCIC label address"
+ 	backEnd relocateMethodReferenceBeforeAddress: cPIC asInteger + cPICEndOfCodeOffset - backEnd jumpLongByteSize by: addrDelta.
+ 
+ 	"write the final desperate jump to cePICMissXArgs"
+ 	backEnd rewriteJumpLongAt: cPIC asInteger + cPICEndOfCodeOffset target: (self cPICMissTrampolineFor: numArgs).
+ 	^0
+ 	"self disassembleFrom: cPIC + (self sizeof: CogMethod) to: cPIC + closedPICSize - 1."!

Item was added:
+ ----- Method: Cogit>>configureMNUCPIC:methodOperand:numArgs:delta: (in category 'in-line cacheing') -----
+ configureMNUCPIC: cPIC methodOperand: methodOperand numArgs: numArgs delta: addrDelta
+ 	"Configure a copy of the prototype CPIC for a one-case MNU PIC that calls ceMNUFromPIC for case0Tag
+ 	 The tag for case0 is at the send site and so doesn't need to be generated.
+ 	addDelta is the address change from the prototype to the new CPCI location, needed
+ 	because the loading of the CPIC label at the end may use a literal instead of a pc relative"
+ 	<var: #cPIC type: #'CogMethod *'>
+ 	| operand |
+ 	<var: #jumpNext type: #'AbstractInstruction *'>
+ 
+ 	"adjust the jump at missOffset, the ceAbortXArgs"
+ 	backEnd rewriteJumpLongAt: cPIC asInteger + missOffset target: (self picAbortTrampolineFor: numArgs).
+ 	
+ 	"We do not scavenge PICs, hence we cannot cache the MNU method if it is in new space."
+ 	operand := (methodOperand isNil or: [objectMemory isYoungObject: methodOperand])
+ 					ifTrue: [0]
+ 					ifFalse: [methodOperand].
+ 	"set the jump to the case0 method"
+ 	backEnd rewriteJumpLongAt: cPIC asInteger + firstCPICCaseOffset target: cPIC asInteger + (self sizeof: CogMethod) .
+ 
+ 	backEnd storeLiteral: operand beforeFollowingAddress: cPIC asInteger + firstCPICCaseOffset - backEnd jumpLongByteSize.
+ 
+ 	"rewrite the final desperate jump to cePICMissXArgs"
+ 	backEnd rewriteJumpLongAt: cPIC asInteger + cPICEndOfCodeOffset target: (self cPICMissTrampolineFor: numArgs).	
+ 
+ 	"update the loading of the PCIC label address"
+ 	backEnd relocateMethodReferenceBeforeAddress: cPIC asInteger + cPICEndOfCodeOffset - backEnd jumpLongByteSize by: addrDelta.
+ 
+ 	"finally, rewrite the jump 3 instr  before firstCPICCaseOffset to jump to the end of case 2, missing the actual case"
+ 	self rewriteCPIC: cPIC caseJumpTo: (self addressOfEndOfCase: 2 inCPIC: cPIC). 
+ 
+ 
+ 	^0
+ !

Item was changed:
  ----- Method: Cogit>>disassembleMethod:on: (in category 'disassembly') -----
  disassembleMethod: surrogateOrAddress on: aStream
  	<doNotGenerate>
  	| cogMethod mapEntries codeRanges |
  	cogMethod := surrogateOrAddress isInteger
  								ifTrue: [self cogMethodSurrogateAt: surrogateOrAddress]
  								ifFalse: [surrogateOrAddress].
  	cogMethod cmType = CMBlock ifTrue:
  		[^self disassembleMethod: cogMethod cmHomeMethod on: aStream].
  	self printMethodHeader: cogMethod on: aStream.
  
  	(mapEntries := Dictionary new)
  		at: cogMethod asInteger + cmEntryOffset put: 'entry'.
  	
  	cogMethod cmType = CMMethod ifTrue:
  		[mapEntries at: cogMethod asInteger + cmNoCheckEntryOffset put: 'noCheckEntry'].
  
  	cogMethod cmType = CMClosedPIC ifTrue:
  		[mapEntries at: cogMethod asInteger + firstCPICCaseOffset put: 'ClosedPICCase0'.
+ 		 1 to: maxCPICCases - 1 do:
- 		 1 to: numPICCases - 1 do:
  			[:i|
  			mapEntries
  				at: cogMethod asInteger + firstCPICCaseOffset + (i * cPICCaseSize)
  				put: 'ClosedPICCase', i printString]].
  
  	self mapFor: cogMethod
  		performUntil: #collectMapEntry:address:into:
  		arg: mapEntries.
  
  	NewspeakVM ifTrue:
  		[objectRepresentation canPinObjects ifFalse:
  			[mapEntries keys do:
  				[:a|
  				(mapEntries at: a) = #IsNSSendCall ifTrue:
  					[mapEntries
  						at: a + backEnd jumpShortByteSize
  							put: {'Class'. #disassembleCachedOop:. (objectMemory wordSize)};
  						at: a + backEnd jumpShortByteSize + objectMemory bytesPerOop
  							put: {'ImplicitReceiver'. #disassembleCachedOop:. (objectMemory wordSize)}]]]].
  
  	"This would all be far more elegant and simple if we used blocks.
  	 But there are no blocks in C and the basic enumerators here need
  	 to be used in the real VM.  Apologies."
  	(codeRanges := self codeRangesFor: cogMethod) do:
  		[:range|
  		(cogMethod cmType = CMMethod) ifTrue:
  			[mapEntries keysAndValuesDo:
  				[:mcpc :label| | bcpc |
  				((range includes: mcpc)
  				 and: [(AnnotationsWithBytecodePCs includes: label)
  				 and: [range cogMethod stackCheckOffset > 0]]) ifTrue:
  					[bcpc := self bytecodePCFor: mcpc startBcpc: range startpc in: range cogMethod.
  					 bcpc ~= 0 ifTrue:
  						[mapEntries at: mcpc put: label, ' bc ', bcpc printString, '/', (bcpc + 1) printString]]]].
  		(cogMethod blockEntryOffset ~= 0
  		 and: [range first = (cogMethod blockEntryOffset + cogMethod asInteger)])
  			ifTrue:
  				[aStream nextPutAll: 'blockEntry:'; cr.
  				 self blockDispatchFor: cogMethod
  					perform: #disassemble:from:to:arg:
  					arg: aStream]
  			ifFalse:
  				[range first > (cogMethod address + cmNoCheckEntryOffset) ifTrue:
  					[self printMethodHeader: range cogMethod
  						on: aStream].
  				self disassembleFrom: range first to: range last labels: mapEntries on: aStream]].
  	aStream nextPutAll: 'startpc: '; print: codeRanges first startpc; cr.
  	(cogMethod cmType = CMMethod
  	 or: [cogMethod cmType = CMOpenPIC]) ifTrue:
  		[[self mapFor: cogMethod
  			performUntil: #printMapEntry:mcpc:args:
  			arg: { aStream. codeRanges. cogMethod }]
  			on: AssertionFailure
  			do: [:ex|
  				ex primitiveChangeClassTo: ResumableVMError basicNew. ":) :) :)"
  				ex resume: nil]].
  	^cogMethod!

Item was changed:
  ----- Method: Cogit>>expectedClosedPICPrototype: (in category 'garbage collection') -----
  expectedClosedPICPrototype: cPIC
  	"Answer 0 if the ClosedPIC is as expected from compileClosedPICPrototype,
  	 otherwise answer an error code identifying the first discrepancy found."
  	"self disassembleFrom: methodZoneBase + (self sizeof: CogMethod) to: methodZoneBase + closedPICSize"
  	<var: #cPIC type: #'CogMethod *'>
  	| pc offsetToLiteral object entryPoint |
  	pc := cPIC asInteger + firstCPICCaseOffset.
  	"First jump is unconditional; subsequent ones are conditional"
  	offsetToLiteral := backEnd jumpLongByteSize.
+ 	1 to: maxCPICCases do:
- 	1 to: numPICCases do:
  		[:i|
  		i > 1 ifTrue:
  			[object := literalsManager classRefInClosedPICAt: pc - offsetToLiteral.
  			 object = (16rBABE1F15 + i - 1) ifFalse:
  				[^1]].
  		object := literalsManager objRefInClosedPICAt: pc - offsetToLiteral.
  		object = (i = 1
  					ifTrue: [16r5EAF00D]
  					ifFalse: [16rBADA550 + i - 1]) ifFalse:
  			[^2].
  		offsetToLiteral := backEnd jumpLongConditionalByteSize.
+ 		entryPoint := backEnd jumpLongTargetBeforeFollowingAddress: pc.
- 		entryPoint := literalsManager cPICCase: i jumpTargetBefore: pc.
  		entryPoint = (self cPICPrototypeCaseOffset + 16rCA5E10 + (i - 1 * 16)) ifFalse:
  				[^3].
  		pc := pc + cPICCaseSize].
  	pc := pc - cPICCaseSize.
+ 	entryPoint := backEnd jumpLongTargetBeforeFollowingAddress: pc + cPICEndSize - literalsManager endSizeOffset.
- 	entryPoint := backEnd jumpLongTargetBeforeFollowingAddress: pc + cPICEndSize.
  	entryPoint = (self cPICMissTrampolineFor: 0) ifFalse:
  		[^4].
  	^0!

Item was changed:
  ----- Method: Cogit>>followMaybeObjRefInClosedPICAt: (in category 'garbage collection') -----
  followMaybeObjRefInClosedPICAt: mcpc
  	"Follow a potential object reference from a closed PIC.
  	 This may be a method reference or null.
+ 	 Answer if the followed literal is young.
+ 	'mcpc' refers to the jump/branch instruction at the end of
+ 	each cpic case"
- 	 Answer if the followed literal is young."
  	| object subject |
  	object := literalsManager objRefInClosedPICAt: mcpc.
  	(objectRepresentation couldBeObject: object) ifFalse:
  		[^false].
  	(objectMemory isForwarded: object) ifFalse:
  		[^objectMemory isYoungObject: object].
  	subject := objectMemory followForwarded: object.
  	literalsManager storeObjRef: subject inClosedPICAt: mcpc.
  	codeModified := true.
  	^objectMemory isYoungObject: subject!

Item was changed:
  ----- Method: Cogit>>followMethodReferencesInClosedPIC: (in category 'garbage collection') -----
  followMethodReferencesInClosedPIC: cPIC
  	"Remap all object references in the closed PIC.  Answer if any references are young.
  	Set codeModified if any modifications are made."
  	<var: #cPIC type: #'CogMethod *'>
  	| pc refersToYoung |
+ 	pc := self addressOfEndOfCase: 1 inCPIC: cPIC.
+ 
+ 	"first we check the method obj ref at the beginning of the CPIC"
- 	pc := cPIC asInteger + firstCPICCaseOffset.
  	refersToYoung := self followMaybeObjRefInClosedPICAt: pc - backEnd jumpLongByteSize.
+ 
+ 	"We find the end address of the cPICNumCases'th case and can then just step forward by the case size thereafter"
+ 	pc := self addressOfEndOfCase:  cPIC cPICNumCases inCPIC: cPIC.
+ 	
+ 	"For each case we check any object reference at the end address - sizeof(conditional instruction) and then increment the end address by case size"
- 	pc := pc + cPICCaseSize.
  	2 to: cPIC cPICNumCases do:
  		[:i|
  		(self followMaybeObjRefInClosedPICAt: pc - backEnd jumpLongConditionalByteSize) ifTrue:
  			[refersToYoung := true].
  		pc := pc + cPICCaseSize].
  	^refersToYoung!

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."
+ 	| cPIC endAddress |
- 	| cPIC |
  	<var: 'cPIC' type: #'CogMethod *'>
+ 	maxCPICCases := 6.
- 	numPICCases := 6.
  	"stack allocate the various collections so that they
  	 are effectively garbage collected on return."
+ 	self allocateOpcodes: maxCPICCases * 9 bytecodes: 0.
- 	self allocateOpcodes: numPICCases * 9 bytecodes: 0.
  	methodLabel address: methodZoneBase; dependent: nil. "for pc-relative MoveCw: cPIC R: ClassReg"
  	self compileClosedPICPrototype.
  	self computeMaximumSizes.
  	cPIC := (self cCoerceSimple: methodZoneBase to: #'CogMethod *').
  	closedPICSize := (self sizeof: CogMethod) + (self generateInstructionsAt: methodZoneBase + (self sizeof: CogMethod)).
+ 	endAddress := self outputInstructionsAt: methodZoneBase + (self sizeof: CogMethod).
+ 	self assert: methodZoneBase + closedPICSize = endAddress.
- 	self outputInstructionsAt: methodZoneBase + (self sizeof: CogMethod).
  	firstCPICCaseOffset := endCPICCase0 address - methodZoneBase.
+ 	cPICEndOfCodeOffset := cPICEndOfCodeLabel address - methodZoneBase.
  	cPICCaseSize := endCPICCase1 address - endCPICCase0 address.
+ 	cPICEndSize := closedPICSize - (maxCPICCases - 1 * cPICCaseSize + firstCPICCaseOffset).
- 	cPICEndSize := closedPICSize - (numPICCases - 1 * cPICCaseSize + firstCPICCaseOffset).
  	closedPICSize := methodZone roundUpLength: closedPICSize.
  	self assert: picInterpretAbort address = (methodLabel address + self picInterpretAbortOffset).
+ 	self assert: (self expectedClosedPICPrototype: cPIC) = 0.
+ 	
+ 	"tpr this is a little tiresome but after any assert checking we need to 0 out the case0 objRef rather than leaving 16r5EAF00D lying around"
+ 
+ 	backEnd storeLiteral: 0 beforeFollowingAddress: endCPICCase0 address - backEnd jumpLongByteSize.
+ 	
+ 	"update the methodZoneBase so we keep the prototype aruond for later use"
+ 	methodZoneBase := self alignUptoRoutineBoundary: endAddress.
+ 	cPICPrototype := cPIC.
- 	self assert: (self expectedClosedPICPrototype: cPIC) = 0
  	"self cCode: ''
  		inSmalltalk:
+ 			[self disassembleFrom: cPIC + (self sizeof: CogMethod) to: cPIC + closedPICSize - 1.
- 			[self disassembleFrom: methodZoneBase + (self sizeof: CogMethod) to: methodZoneBase + closedPICSize - 1.
  			 self halt]"!

Item was changed:
  ----- Method: Cogit>>initializeCodeZoneFrom:upTo: (in category 'initialization') -----
  initializeCodeZoneFrom: startAddress upTo: endAddress
  	<api>
  	self cCode: [self sqMakeMemoryExecutableFrom: startAddress To: endAddress]
  		inSmalltalk: [self initializeProcessor].
  	codeBase := methodZoneBase := startAddress.
  	minValidCallAddress := (codeBase min: coInterpreter interpretAddress)
  								min: coInterpreter primitiveFailAddress.
  	self initializeBackend.
  	methodZone manageFrom: methodZoneBase to: endAddress.
  	self maybeGenerateCheckFeatures.
  	self maybeGenerateICacheFlush.
  	self generateVMOwnerLockFunctions.
  	ceGetSP := self cCoerceSimple: self genGetLeafCallStackPointer to: #'unsigned long (*)(void)'.
  	self generateStackPointerCapture.
  	self generateTrampolines.
- 	methodZone manageFrom: methodZoneBase to: endAddress.
  	self computeEntryOffsets.
  	self generateClosedPICPrototype.
+ 	methodZone manageFrom: methodZoneBase to: endAddress.
  	"N.B. this is assumed to be the last thing done in initialization; see Cogit>>initialized"
  	self generateOpenPICPrototype!

Item was changed:
  ----- Method: Cogit>>mapObjectReferencesInClosedPIC: (in category 'garbage collection') -----
  mapObjectReferencesInClosedPIC: cPIC
  	"Remap all object references in the closed PIC.  Answer if any references are young.
  	Set codeModified if any modifications are made."
  	<var: #cPIC type: #'CogMethod *'>
  	| pc refersToYoung |
+ 	pc := self addressOfEndOfCase:1 inCPIC:cPIC.
+ 
+ 	"first we check the obj ref at the beginning of the CPIC"
- 	pc := cPIC asInteger + firstCPICCaseOffset.
  	refersToYoung := self updateMaybeObjRefInClosedPICAt: pc - backEnd jumpLongByteSize.
+ 
+ 	"We find the end address of the cPICNumCases'th case and can then just step forward by the case size thereafter"
+ 	pc := self addressOfEndOfCase: cPIC cPICNumCases inCPIC: cPIC.
+ 	
+ 	"For each case we check any object reference at the end address - sizeof(conditional instruction) and then increment the end address by case size"
- 	pc := pc + cPICCaseSize.
  	2 to: cPIC cPICNumCases do:
  		[:i|
  		objectRepresentation inlineCacheTagsMayBeObjects ifTrue:
  			[(self updateMaybeClassRefInClosedPICAt: pc - backEnd jumpLongConditionalByteSize) ifTrue:
  				[refersToYoung := true]].
  		(self updateMaybeObjRefInClosedPICAt: pc - backEnd jumpLongConditionalByteSize) ifTrue:
  			[refersToYoung := true].
  		pc := pc + cPICCaseSize].
  	^refersToYoung!

Item was changed:
  ----- Method: Cogit>>noTargetsFreeInClosedPIC: (in category 'compaction') -----
  noTargetsFreeInClosedPIC: cPIC
+ 	"Answer if all targets in the PIC are in-use methods."
- 	"Answerr if all targets in the PIC are in-use methods."
  	<var: #cPIC type: #'CogMethod *'>
  	| pc entryPoint targetMethod |
  	<var: #targetMethod type: #'CogMethod *'>
+ 
- 	pc := cPIC asInteger + firstCPICCaseOffset.
  	1 to: cPIC cPICNumCases do:
  		[:i|
+ 		pc := self addressOfEndOfCase: i inCPIC: cPIC.
+ 		entryPoint := backEnd jumpLongTargetBeforeFollowingAddress: pc.
- 		entryPoint := literalsManager cPICCase: i jumpTargetBefore: pc.
  		"Find target from jump.  Ignore jumps to the interpret and MNU calls within this PIC"
  		(cPIC containsAddress: entryPoint) ifFalse:
  			[targetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
  			 targetMethod cmType ~= CMMethod ifTrue:
+ 				[^false]]].
- 				[^false]].
- 		i < cPIC cPICNumCases ifTrue:
- 			[pc := pc + cPICCaseSize]].
  	^true!

Item was changed:
  ----- Method: Cogit>>relocateCallsInClosedPIC: (in category 'compaction') -----
  relocateCallsInClosedPIC: cPIC
  	<var: #cPIC type: #'CogMethod *'>
  	| delta pc entryPoint targetMethod |
  	<var: #targetMethod type: #'CogMethod *'>
  	delta := cPIC objectHeader.
  	self assert: (backEnd callTargetFromReturnAddress: cPIC asInteger + missOffset)
  					= (self picAbortTrampolineFor: cPIC cmNumArgs).
  	backEnd relocateCallBeforeReturnPC: cPIC asInteger + missOffset by: delta negated.
  
  	pc := cPIC asInteger + firstCPICCaseOffset.
  	1 to: cPIC cPICNumCases do:
  		[:i|
+ 		pc := self addressOfEndOfCase: i inCPIC: cPIC.
+ 		entryPoint := backEnd jumpLongTargetBeforeFollowingAddress: pc.
- 		entryPoint := literalsManager cPICCase: i jumpTargetBefore: pc.
  		"Find target from jump.  Ignore jumps to the interpret and MNU calls within this PIC"
  		(cPIC containsAddress: entryPoint) ifFalse:
  			[targetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
  			 self assert: targetMethod cmType = CMMethod.
+ 			 backEnd
+ 				relocateJumpLongBeforeFollowingAddress: pc
+ 				by: (delta - targetMethod objectHeader) negated]].
- 			 literalsManager
- 				cPICCase: i
- 				relocateJumpLongBefore: pc
- 				by: (delta - targetMethod objectHeader) negated].
- 		pc := pc + cPICCaseSize].
  	self assert: cPIC cPICNumCases > 0.
+ 
- 	pc := pc - cPICCaseSize.
  	"Finally relocate the load of the PIC and the jump to the overflow routine ceCPICMiss:receiver:"
+ 	backEnd relocateMethodReferenceBeforeAddress: (self addressOfEndOfCase: 2 inCPIC: cPIC)+ backEnd loadPICLiteralByteSize by: delta.
+ 	backEnd relocateJumpLongBeforeFollowingAddress: cPIC asInteger + cPICEndOfCodeOffset by: delta negated!
- 	backEnd relocateMethodReferenceBeforeAddress: pc + backEnd loadPICLiteralByteSize by: delta.
- 	backEnd relocateJumpLongBeforeFollowingAddress: pc + cPICEndSize by: delta negated!

Item was added:
+ ----- Method: Cogit>>rewriteCPIC:caseJumpTo: (in category 'in-line cacheing') -----
+ rewriteCPIC: cPIC caseJumpTo: target 
+ 	"adding a new CPIC case, or making an MNU CPIC, requires altering the jump that takes us to the first case to be used"
+ 	<inline: true>
+ 	backEnd rewriteCPICJumpAt: cPIC asInteger + firstCPICCaseOffset - backEnd jumpLongByteSize - backEnd loadPICLiteralByteSize target: target!

Item was changed:
  ----- Method: Cogit>>updateMaybeObjRefInClosedPICAt: (in category 'garbage collection') -----
  updateMaybeObjRefInClosedPICAt: mcpc
  	"Update a potential object reference from a closed PIC.
  	 This may be an object reference, an inline cache tag or null.
+ 	 Answer if the updated literal is young.
+ 	'mcpc' refers to the jump/branch instruction at the end of
+ 	each cpic case"
- 	 Answer if the updated literal is young."
  	| object subject |
  	object := literalsManager objRefInClosedPICAt: mcpc.
  	(objectRepresentation couldBeObject: object) ifFalse:
  		[^false].
  	subject := objectRepresentation remapOop: object.
  	object ~= subject ifTrue:
  		[literalsManager storeObjRef: subject inClosedPICAt: mcpc.
  		 codeModified := true].
  	^objectMemory isYoungObject: subject!

Item was removed:
- ----- Method: InLineLiteralsManager>>cPICCase:jumpTargetBefore: (in category 'closed PIC parsing') -----
- cPICCase: caseIndex jumpTargetBefore: pc
- 	<inline: true>
- 	^cogit backEnd jumpLongTargetBeforeFollowingAddress: pc!

Item was added:
+ ----- Method: InLineLiteralsManager>>endSizeOffset (in category 'closed PIC parsing') -----
+ endSizeOffset
+ 	"return the offset need from the cPICEndSize in order to point to just after the last instruction - here that means 0"
+ 	^0!

Item was changed:
  ----- Method: InLineLiteralsManager>>objRefInClosedPICAt: (in category 'garbage collection') -----
  objRefInClosedPICAt: mcpc
+ 	"'mcpc' refers to the jump/branch instruction at the end of
+ 	each cpic case. The method objRef is the method object referenced by the
+ 	movI $0x0bada553, %ebx 
+ 	or
+ 	ldr    r6, [pc, #64]    ; 0x000017d4 16rBADA553
+ 	type instruction preceeding this"
  	<inline: true>
  	^cogit backEnd literalBeforeFollowingAddress: mcpc!

Item was changed:
  ----- Method: InLineLiteralsManager>>storeObjRef:inClosedPICAt: (in category 'garbage collection') -----
  storeObjRef: literal inClosedPICAt: address
+ 	"'mcpc' refers to the jump/branch instruction at the end of
+ 	each cpic case. The objRef is the literal referenced by the
+ 	movI $0x0bada553, %ebx or
+ 	ldr    r6, [pc, #64]    ; 0x000017d4 16rBADA553
+ 	type instruction preceeding this"
  	<var: #address type: #usqInt>
  	<inline: true>
  	cogit backEnd storeLiteral: literal beforeFollowingAddress: address!

Item was removed:
- ----- Method: OutOfLineLiteralsManager>>cPICCase:jumpTargetBefore: (in category 'closed PIC parsing') -----
- cPICCase: caseIndex jumpTargetBefore: pc
- 	<inline: true>
- 	"With Spur the class tag is always 32-bits and the literal is bytesPerOop.
- 	 With V3 the class and literal are both bytesPerOop."
- 	^cogit backEnd jumpLongTargetBeforeFollowingAddress: pc - (caseIndex <= 1
- 																		ifTrue: [objectMemory bytesPerOop]
- 																		ifFalse: [objectRepresentation inlineCacheTagsMayBeObjects
- 																					ifTrue: [objectMemory bytesPerOop * 2]
- 																					ifFalse: [objectMemory bytesPerOop + 4]])!

Item was changed:
  ----- Method: OutOfLineLiteralsManager>>cPICCase:relocateJumpLongBefore:by: (in category 'closed PIC parsing') -----
  cPICCase: caseIndex relocateJumpLongBefore: pc by: delta
  	<inline: true>
+ 	cogit backEnd relocateJumpLongBeforeFollowingAddress: pc by: delta!
- 	"With Spur the class tag is always 32-bits and the literal is bytesPerOop.
- 	 With V3 the class and literal are both bytesPerOop."
- 	cogit backEnd
- 		relocateJumpLongBeforeFollowingAddress: pc - (caseIndex <= 1
- 															ifTrue: [objectMemory bytesPerOop]
- 															ifFalse: [objectRepresentation inlineCacheTagsMayBeObjects
- 																		ifTrue: [objectMemory bytesPerOop * 2]
- 																		ifFalse: [objectMemory bytesPerOop + 4]])
- 		by: delta!

Item was changed:
  ----- Method: OutOfLineLiteralsManager>>classRefInClosedPICAt: (in category 'garbage collection') -----
  classRefInClosedPICAt: address
  	<inline: true>
  	"If inline cache tags are not objects they will be 32-bit values."
+ 	"Current ARM out-of-line literal CPICs use
+ 	ldr ip, [pc relative address1]
+ 	cmp r0, ip
+ 	ldr r6, [pc relative address2
+ 	beq code
+ 	hence the large backwards stepping here - address is pointing at the beq"
  	^objectRepresentation inlineCacheTagsMayBeObjects
+ 		ifFalse: [cogit backEnd literalBeforeFollowingAddress:  address - 8 "better to use 2 * instructionSize if we could, step back to the cmp so the literal is found properly" ]
+ 		ifTrue: [self break. "not sure about this ? "objectMemory longAt: address - objectMemory bytesPerOop]!
- 		ifFalse: [objectMemory long32At: address - 4]
- 		ifTrue: [objectMemory longAt: address - objectMemory bytesPerOop]!

Item was added:
+ ----- Method: OutOfLineLiteralsManager>>endSizeOffset (in category 'closed PIC parsing') -----
+ endSizeOffset
+ 	"return the offset need from the cPICEndSize in order to point to just after the last instruction - here that means bytesPerOop * list size"
+ 	^nextLiteralIndex * objectMemory bytesPerOop!

Item was changed:
  ----- Method: OutOfLineLiteralsManager>>objRefInClosedPICAt: (in category 'garbage collection') -----
  objRefInClosedPICAt: address
+ 	"'mcpc' refers to the jump/branch instruction at the end of
+ 	each cpic case. The objRef is the literal referenced by the
+ 	 ldr	r6, [pc, #88]	; 16r5EAF00D type instruction preceeding this"
  	<inline: true>
+ 	^cogit backEnd literalBeforeFollowingAddress: address !
- 	^objectMemory longAt: address!

Item was changed:
  ----- Method: OutOfLineLiteralsManager>>storeClassRef:inClosedPICAt: (in category 'garbage collection') -----
  storeClassRef: classObj inClosedPICAt: address
  	<var: #address type: #usqInt>
  	<inline: true>
  	"If inline cache tags are not objects they will be 32-bit values."
+ 	"Current ARM out-of-line literal CPICs use
+ 	ldr ip, [pc relative address1]
+ 	cmp r0, ip
+ 	ldr r6, [pc relative address2
+ 	beq code
+ 	hence the large backwards stepping here"
  	objectRepresentation inlineCacheTagsMayBeObjects
+ 		ifTrue: [self break. objectMemory long32At: address - 4 put: classObj]
+ 		ifFalse: [cogit backEnd storeLiteral: classObj beforeFollowingAddress:  address - 8 "better to use 2 * instructionSize if we could, step back to the cmp so the literal is found properly"]!
- 		ifTrue: [objectMemory long32At: address - 4 put: classObj]
- 		ifFalse: [objectMemory longAt: address - objectMemory bytesPerOop]!

Item was changed:
  ----- Method: OutOfLineLiteralsManager>>storeObjRef:inClosedPICAt: (in category 'garbage collection') -----
  storeObjRef: literal inClosedPICAt: address
+ 	"'mcpc' refers to the jump/branch instruction at the end of
+ 	each cpic case. The objRef is the literal referenced by the
+ 	 ldr	r6, [pc, #88]	; 16r5EAF00D type instruction preceeding this"
  	<var: #address type: #usqInt>
  	<inline: true>
+ 	cogit backEnd storeLiteral: literal beforeFollowingAddress: address!
- 	objectMemory longAt: address put: literal!

Item was changed:
  ----- Method: SistaStackToRegisterMappingCogit>>populate:withPICInfoFor:firstCacheTag: (in category 'method introspection') -----
  populate: tuple withPICInfoFor: cPIC firstCacheTag: firstCacheTag
  	"Populate tuple (which must be large enough) with the ClosedPIC's target method class pairs.
  	 The first entry in tuple contains the bytecode pc for the send, so skip the tuple's first field."
  	<var: #cPIC type: #'CogMethod *'>
  	| pc cacheTag classOop entryPoint targetMethod value |
  	<var: #targetMethod type: #'CogMethod *'>
+ 
- 	pc := cPIC asInteger + firstCPICCaseOffset.
  	1 to: cPIC cPICNumCases do:
  		[:i|
+ 		pc := self addressOfEndOfCase: i inCPIC: cPIC.
  		cacheTag := i = 1
  						ifTrue: [firstCacheTag]
  						ifFalse: [backEnd literalBeforeFollowingAddress: pc
  																		- backEnd jumpLongConditionalByteSize
  																		- backEnd loadLiteralByteSize].
  		classOop := objectRepresentation classForInlineCacheTag: cacheTag.
  		objectMemory storePointer: i * 2 - 1 ofObject: tuple withValue: classOop.
+ 		entryPoint := backEnd jumpLongTargetBeforeFollowingAddress: pc.
- 		entryPoint := literalsManager cPICCase: i jumpTargetBefore: pc.
  		"Find target from jump.  A jump to the MNU entry-point should collect #doesNotUnderstand:"
  		(cPIC containsAddress: entryPoint)
  			ifTrue:
  				[value := objectMemory splObj: SelectorDoesNotUnderstand]
  			ifFalse:
  				[targetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
  				 self assert: targetMethod cmType = CMMethod.
  				 value := targetMethod methodObject].
+ 		objectMemory storePointer: i * 2 ofObject: tuple withValue: value ]!
- 		objectMemory storePointer: i * 2 ofObject: tuple withValue: value.
- 		pc := pc + cPICCaseSize]!



More information about the Vm-dev mailing list