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

commits at source.squeak.org commits at source.squeak.org
Sat Mar 28 21:02:45 UTC 2015


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

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

Name: VMMaker.oscog-eem.1127
Author: eem
Time: 28 March 2015, 2:00:26.196 pm
UUID: 5f21363d-74e9-4c95-8c48-6f6d18ef3890
Ancestors: VMMaker.oscog-tpr.1126

Rename executeCogMethod:... to executeCogPIC:...

Add support for a variable base register for
referring to the CoInterpreter variables from
machine code on RISCs (ARM).  Load the VarBaseReg
in enilopmarts.  It must be a callee-saved reg.

Add support for a 3 argument AndCqRR and use it
in the entry-point sequence.  This has the nice side-
effect of fixing the inability to differentiate the
checked and unchecked entry-points on ARM if we
use the MoveRR, AndCqR two instruction sequence ;)

Nuke the unused and misleading callsAreRelative.

Mark the other backEnd ability test methods as
<inline: true>.

Simulator:
Add print cog methods with selector... to the utils menu.

=============== Diff against VMMaker.oscog-tpr.1126 ===============

Item was removed:
- ----- Method: CoInterpreter>>executeCogMethod:fromLinkedSendWithReceiver:andCacheTag: (in category 'enilopmarts') -----
- executeCogMethod: cogMethod fromLinkedSendWithReceiver: rcvr andCacheTag: cacheTag
- 	<api>
- 	"Execute a CogMethod from a linked send.  The receiver,
- 	 arguments and return address are on the Smalltalk stack.  First
- 	 push the entry-point and finally the register argument(s).  Then write
- 	 back the frame pointers and call the routine that will pop off the register
- 	 argument(s) and jump to the entry by executing a return instruction.
- 
- 	 In the simple jit only the receiver gets passed in registers, so only the
- 	 receiver gets pushed."
- 	<var: #cogMethod type: #'CogMethod *'>
- 	cogit assertCStackWellAligned.
- 	self assert: (self isMachineCodeFrame: framePointer).
- 	self assertValidExecutionPointe: self stackTop r: framePointer s: stackPointer imbar: false line: #'__LINE__'.
- 	self push: cogMethod asInteger + cogit entryOffset.
- 	cogit numRegArgs > 0 ifTrue:"dont use and: so as to get Slang to inline cogit numRegArgs > 0"
- 		[cogMethod cmNumArgs <= cogit numRegArgs ifTrue:
- 			[self push: cacheTag.
- 			 cogMethod cmNumArgs caseOf: {
- 				[0]	->	[cogit ceCall0ArgsPIC].
- 				[1]	->	[cogit ceCall1ArgsPIC].
- 				[2]	->	[cogit ceCall2ArgsPIC]
- 			 	}
- 				otherwise: [].
- 			 self error: 'not reached']].
- 	self
- 		push: rcvr;
- 		push: cacheTag.
- 	cogit ceCallCogCodePopReceiverAndClassRegs
- 	"NOTREACHED"!

Item was added:
+ ----- Method: CoInterpreter>>executeCogPIC:fromLinkedSendWithReceiver:andCacheTag: (in category 'enilopmarts') -----
+ executeCogPIC: cogPIC fromLinkedSendWithReceiver: rcvr andCacheTag: cacheTag
+ 	<api>
+ 	"Execute a closed PIC from a linked send, to redispatch based on the rcvr.
+ 	 The receiver, arguments and return address are on the Smalltalk stack.
+ 	 First push the entry-point and finally the register argument(s).  Then write
+ 	 back the frame pointers and call the routine that will pop off the register
+ 	 argument(s) and jump to the entry by executing a return instruction.
+ 
+ 	 In the simple jit only the receiver gets passed in registers, so only the
+ 	 receiver gets pushed."
+ 	<var: #cogPIC type: #'CogMethod *'>
+ 	cogit assertCStackWellAligned.
+ 	self assert: (self isMachineCodeFrame: framePointer).
+ 	self assertValidExecutionPointe: self stackTop r: framePointer s: stackPointer imbar: false line: #'__LINE__'.
+ 	self push: cogPIC asInteger + cogit entryOffset.
+ 	cogit numRegArgs > 0 ifTrue:"dont use and: so as to get Slang to inline cogit numRegArgs > 0"
+ 		[cogPIC cmNumArgs <= cogit numRegArgs ifTrue:
+ 			[self push: cacheTag.
+ 			 cogPIC cmNumArgs caseOf: {
+ 				[0]	->	[cogit ceCall0ArgsPIC].
+ 				[1]	->	[cogit ceCall1ArgsPIC].
+ 				[2]	->	[cogit ceCall2ArgsPIC]
+ 			 	}
+ 				otherwise: [].
+ 			 self error: 'not reached']].
+ 	self
+ 		push: rcvr;
+ 		push: cacheTag.
+ 	cogit ceCallCogCodePopReceiverAndClassRegs
+ 	"NOTREACHED"!

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

Item was removed:
- ----- Method: CogARMCompiler class>>ARMTempReg (in category 'accessing') -----
- ARMTempReg
- "return the name of the general temp reg in the ARM APCS convention"
- 	^RISCTempReg!

Item was added:
+ ----- Method: CogARMCompiler class>>IPReg (in category 'accessing') -----
+ IPReg
+ 	"Answer the number of the general temp reg in the ARM APCS convention, IP"
+ 	^ConcreteIPReg!

Item was added:
+ ----- Method: CogARMCompiler class>>VarBaseReg (in category 'accessing') -----
+ VarBaseReg
+ 	"Answer the number of the reg we use to hold the base address of CoInterpreter variables"
+ 	^ConcreteVarBaseReg!

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

Item was added:
+ ----- Method: CogARMCompiler>>abstractRegisterForConcreteRegister: (in category 'private') -----
+ abstractRegisterForConcreteRegister: reg
+ 	(self concreteRegister: TempReg) = reg ifTrue: [^TempReg].
+ 	(self concreteRegister: ReceiverResultReg) = reg ifTrue: [^ReceiverResultReg].
+ 	(self concreteRegister: ClassReg) = reg ifTrue: [^ClassReg].
+ 	(self concreteRegister: SendNumArgsReg) = reg ifTrue: [^SendNumArgsReg].
+ 	(self concreteRegister: Arg0Reg) = reg ifTrue: [^Arg0Reg].
+ 	(self concreteRegister: Arg1Reg) = reg ifTrue: [^Arg1Reg].
+ 	(self concreteRegister: FPReg) = reg ifTrue: [^FPReg].
+ 	(self concreteRegister: SPReg) = reg ifTrue: [^SPReg].
+ 	(self concreteRegister: LinkReg) = reg ifTrue: [^LinkReg].
+ 	(self concreteRegister: RISCTempReg) = reg ifTrue: [^RISCTempReg].
+ 	(self concreteRegister: PCReg) = reg ifTrue: [^PCReg].
+ 	(self concreteRegister: VarBaseReg) = reg ifTrue: [^VarBaseReg].
+ 	self error: 'could not find abstract register'.
+ 	^0
+ 
+ 	"({	TempReg. ReceiverResultReg. ClassReg. SendNumArgsReg. Arg0Reg. Arg1Reg.
+ 		FPReg. SPReg.
+ 		LinkReg. RISCTempReg. PCReg. VarBaseReg} collect: [:i| self basicNew concreteRegister: i]) sort"
+ 
+ 	"While the below works fine in Smalltalk it of course doesn't work in C ;)"
+ 	
+ 	"^reg caseOf: {
+ 		[self concreteRegister: TempReg] -> [TempReg].
+ 		[self concreteRegister: ReceiverResultReg] -> [ReceiverResultReg].
+ 		[self concreteRegister: ClassReg] -> [ClassReg].
+ 		[self concreteRegister: SendNumArgsReg] -> [SendNumArgsReg].
+ 		[self concreteRegister: Arg0Reg] -> [Arg0Reg].
+ 		[self concreteRegister: Arg1Reg] -> [Arg1Reg].
+ 		[self concreteRegister: FPReg] -> [FPReg].
+ 		[self concreteRegister: SPReg] -> [SPReg] }"!

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

Item was changed:
  ----- Method: CogARMCompiler>>canDivQuoRem (in category 'testing') -----
  canDivQuoRem
+ 	<inline: true>
  	^false!

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

Item was changed:
  ----- Method: CogARMCompiler>>computeMaximumSize (in category 'generate machine code') -----
  computeMaximumSize
  	"Because we don't use Thumb, each ARM instruction has 4 bytes. Some abstract opcodes need more than one instruction."
  	
  	(opcode between: FirstShortJump and: LastJump) ifTrue:
  		[^maxSize := 16].
  	
  	opcode
  		caseOf: {
  			[Label]					-> [^maxSize := 0].
  			[AlignmentNops]		-> [^maxSize := (operands at: 0) - 1].
+ 			[MoveAwR]				-> [^maxSize := (self isAddressRelativeToVarBase: (operands at: 0))
+ 														ifTrue: [4]
+ 														ifFalse: [20]].
- 			[MoveAwR]				-> [^maxSize := 20].
  			[MoveCqR]				-> [^self rotateable8bitImmediate: (operands at: 0)
  											ifTrue: [:r :i| maxSize := 4]
  											ifFalse: [maxSize := 16]].
  			[MoveCwR]				-> [^maxSize := 16].
+ 			[MoveRAw]				-> [^maxSize := (self isAddressRelativeToVarBase: (operands at: 1))
+ 														ifTrue: [4]
+ 														ifFalse: [20]].
- 			[MoveRAw]				-> [^maxSize := 20].
  			[MoveRMwr]			-> [self is12BitValue: (operands at: 1)
  											ifTrue: [ :u :i | ^maxSize := 4]
  											ifFalse: [ ^maxSize := 20 ]].
  			[MoveRMbr]				-> [self is12BitValue: (operands at: 1)
  											ifTrue: [ :u :i | ^maxSize := 4]
  											ifFalse: [ ^maxSize := 20 ]].
  			[MoveMwrR]			-> [self is12BitValue: (operands at: 0)
  											ifTrue: [ :u :i | ^maxSize := 4]
  											ifFalse: [ ^maxSize := 20 ]].
  			[MoveMbrR]				-> [self is12BitValue: (operands at: 0)
  											ifTrue: [ :u :i | ^maxSize := 4]
  											ifFalse: [ ^maxSize := 20 ]].
+ 			[PrefetchAw] 			-> [^maxSize := (self isAddressRelativeToVarBase: (operands at: 1))
+ 														ifTrue: [4]
+ 														ifFalse: [20]].
- 			[PrefetchAw] 			-> [^maxSize := 20].
  			[Call]					-> [^maxSize := 20 "recomputed in #sizePCDependentInstruction."].
  			[RetN]					-> [^(operands at: 0) = 0 
  											ifTrue: [maxSize := 4]
  											ifFalse: [maxSize := 8]].
  			[CmpCqR]				-> [^self rotateable8bitImmediate: (operands at: 0)
  											ifTrue: [:r :i| maxSize := 4]
  											ifFalse: [maxSize := 20]].
  			[AddCqR]				-> [^self rotateable8bitImmediate: (operands at: 0)
  											ifTrue: [:r :i| maxSize := 4]
  											ifFalse: [maxSize := 20]].
  			[BICCqR]				-> [^self rotateable8bitImmediate: (operands at: 0)
  											ifTrue: [:r :i| maxSize := 4]
  											ifFalse: [maxSize := 20]].
  			[SubCqR]				-> [^self rotateable8bitImmediate: (operands at: 0)
  											ifTrue: [:r :i| maxSize := 4]
  											ifFalse: [maxSize := 20]].
  			[AndCqR]				-> [^self rotateable8bitImmediate: (operands at: 0)
  											ifTrue: [:r :i| maxSize := 4]
  											ifFalse: [maxSize := 20]].
+ 			[AndCqRR]				-> [^self rotateable8bitImmediate: (operands at: 0)
+ 											ifTrue: [:r :i| maxSize := 4]
+ 											ifFalse: [maxSize := 20]].
  			[OrCqR]					-> [^self rotateable8bitImmediate: (operands at: 0)
  											ifTrue: [:r :i| maxSize := 4]
  											ifFalse: [maxSize := 20]].
  			[TstCqR]				-> [^self rotateable8bitImmediate: (operands at: 0)
  											ifTrue: [:r :i| maxSize := 4]
  											ifFalse: [maxSize := 20]].
  			[XorCqR]				-> [^self rotateable8bitImmediate: (operands at: 0)
  											ifTrue: [:r :i| maxSize := 4]
  											ifFalse: [maxSize := 20]].
  			[CmpCwR]				-> [^maxSize := 20].
  			[AddCwR]				-> [^maxSize := 20].
  			[SubCwR]				-> [^maxSize := 20].
  			[AndCwR]				-> [^maxSize := 20].
  			[OrCwR]				-> [^maxSize := 20].
  			[XorCwR]				-> [^maxSize := 20].
  			[JumpR]					-> [^maxSize := 4].
  			[JumpFPEqual]			-> [^maxSize := 8].
  			[JumpFPNotEqual]		-> [^maxSize := 8].
  			[JumpFPLess]			-> [^maxSize := 8].
  			[JumpFPGreaterOrEqual]-> [^maxSize := 8].
  			[JumpFPGreater]		-> [^maxSize := 8].
  			[JumpFPLessOrEqual]	-> [^maxSize := 8].
  			[JumpFPOrdered]		-> [^maxSize := 8].
  			[JumpFPUnordered]		-> [^maxSize := 8].
  			[JumpLong]				-> [^maxSize := 20].
  			[JumpLongZero]		-> [^maxSize := 20].
  			[JumpLongNonZero]	-> [^maxSize := 20].
  			[LoadEffectiveAddressMwrR]
  									-> [^self rotateable8bitImmediate: (operands at: 0)
  											ifTrue: [:r :i| maxSize := 4]
  											ifFalse: [maxSize := 20]].
  			[PushCw]				-> [^maxSize := 20].
  		}
  		otherwise: [^maxSize := 4].
  	^4 "to keep C compiler quiet"
  !

Item was added:
+ ----- Method: CogARMCompiler>>concreteCalleeSavedRegisterMask (in category 'accessing') -----
+ concreteCalleeSavedRegisterMask
+ 	"According to IHI0042E ARM Architecture Procedure Calling Standard, in section 5.1.1:
+ 		A subroutine must preserve the contents of the registers r4-r8, r10, r11 and SP (and r9 in PCS variants that designate r9 as v6).
+ 	 SP = r13, so..."
+ 	^2r0000110111110000!

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

Item was changed:
  ----- Method: CogARMCompiler>>concreteRegister: (in category 'encoding') -----
  concreteRegister: registerIndex
  	 "Map a possibly abstract register into a concrete one.  Abstract registers
  	  (defined in CogAbstractOpcodes) are all negative.  If registerIndex is
  	  negative assume it is an abstract register."
  	
  	"N.B. According to BSABI, R0-R3 are caller-save, R4-R12 are callee save.
  	 Note that R9 might be a special register for the implementation. In some slides
  	 it is refered to as sb. R10 can contain the stack limit (sl), R11 the fp. R12 is an
  	 intra-procedure scratch instruction pointer for link purposes. It can also be used.
  	 R10 is used as temporary inside a single abstract opcode implementation"
  	"R0-R3 are used when calling back to the interpreter. Using them would require
  	 saving and restoring their values, so they are omitted so far. R12 is the only
  	 unused register at the moment.."
  	^registerIndex
  		caseOf: {
  			[TempReg]				-> [R7].
  			[ClassReg]				-> [R8].
  			[ReceiverResultReg]	-> [R9].
  			[SendNumArgsReg]		-> [R6].
+ 			[SPReg]					-> [SP]. "R13"
- 			[SPReg]					-> [SP].
  			[FPReg]					-> [R11].
  			[Arg0Reg]				-> [R4].
  			[Arg1Reg]				-> [R5].
+ 			[VarBaseReg]			-> [ConcreteVarBaseReg]. "Must be callee saved"
+ 			[RISCTempReg]			-> [ConcreteIPReg]. "a.k.a. IP"
+ 			[LinkReg]				-> [LR]. "R14"
+ 			[PCReg]					-> [PC] "R15" }
- 			[LinkReg]				-> [LR].
- 			[PCReg]					-> [PC] }
  		otherwise:
  			[self assert: (registerIndex between: R0 and: PC).
  			 registerIndex]!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeAndCqR (in category 'generate machine code - concretize') -----
  concretizeAndCqR
  	"Will get inlined into concretizeAt: switch."
  	"AND is very important since it's used to mask all sorts of flags in the jit. We take special care to try to find fast ways to make the masks"
  	<inline: true>
  	|val|
  	val := operands at: 0.
  	self rotateable8bitImmediate: val
  		ifTrue: [ :rot :immediate | | reg |
  			reg := self concreteRegister: (operands at: 1).
  			self machineCodeAt: 0 put: (self ands: reg rn: reg imm: immediate ror: rot).
  			^machineCodeSize := 4]
  		ifFalse: [
  			"see if the constant bit-inverted makes a quick value and if so BIC it instead
  			If the value is -ve, we 2s complement it instead"
  			|invVal|
  			val <0
  				ifTrue:[invVal := -1 - val]
  				ifFalse:[invVal := val bitInvert32].
  			self rotateable8bitImmediate: invVal
  				ifTrue: [ :rot :immediate | |reg|
  					reg := self concreteRegister: (operands at: 1).
  					self machineCodeAt: 0 put: (self bics: reg rn: reg imm: immediate ror: rot).
  					^machineCodeSize := 4]
  				ifFalse: ["let's try to see if the constant can be made from a simple shift of 0xFFFFFFFF"
  					|hb reg|
  					reg := self concreteRegister: (operands at: 1).
  					hb := (operands at: 0) highBit.
  					1 << hb = (val +1)
  						ifTrue: [ "MVN temp reg, 0, making 0xffffffff"
+ 							self machineCodeAt: 0 put:(self mvn: ConcreteIPReg imm: 0 ror: 0).
- 							self machineCodeAt: 0 put:(self mvn: RISCTempReg imm: 0 ror: 0).
  							"Then AND reg, temp reg, lsr #(32-hb)"
+ 							 self machineCodeAt: 4 put:(self ands: reg rn: reg rm: ConcreteIPReg lsr: (32-hb )).
- 							 self machineCodeAt: 4 put:(self ands: reg rn: reg rm: RISCTempReg lsr: (32-hb )).
  							^machineCodeSize :=8]
  						ifFalse: [^self concretizeDataOperationCwR: AndOpcode]]]!

Item was added:
+ ----- Method: CogARMCompiler>>concretizeAndCqRR (in category 'generate machine code - concretize') -----
+ concretizeAndCqRR
+ 	"Will get inlined into concretizeAt: switch."
+ 	"AND is very important since it's used to mask all sorts of flags in the jit. We take special care to try to find fast ways to make the masks"
+ 	<inline: true>
+ 	| val srcReg dstReg |
+ 	val := operands at: 0.
+ 	srcReg := self concreteRegister: (operands at: 1).
+ 	dstReg := self concreteRegister: (operands at: 2).
+ 	self rotateable8bitImmediate: val
+ 		ifTrue:
+ 			[ :rot :immediate |
+ 			self machineCodeAt: 0 put: (self ands: dstReg rn: srcReg imm: immediate ror: rot).
+ 			^machineCodeSize := 4]
+ 		ifFalse:
+ 			["see if the constant bit-inverted makes a quick value and if so BIC it instead
+ 			If the value is -ve, we 2s complement it instead"
+ 			|invVal|
+ 			invVal := val < 0
+ 						ifTrue:[-1 - val]
+ 						ifFalse:[val bitInvert32].
+ 			self rotateable8bitImmediate: invVal
+ 				ifTrue:
+ 					[ :rot :immediate |
+ 					self machineCodeAt: 0 put: (self bics: dstReg rn: srcReg imm: immediate ror: rot).
+ 					^machineCodeSize := 4]
+ 				ifFalse: "let's try to see if the constant can be made from a simple shift of 0xFFFFFFFF"
+ 					[| hb |
+ 					hb := (operands at: 0) highBit.
+ 					1 << hb = (val +1)
+ 						ifTrue: "MVN temp reg, 0, making 0xffffffff"
+ 							[self machineCodeAt: 0 put:(self mvn: ConcreteIPReg imm: 0 ror: 0).
+ 							"Then AND reg, temp reg, lsr #(32-hb)"
+ 							 self machineCodeAt: 4 put: (self ands: dstReg rn: srcReg rm: ConcreteIPReg lsr: 32 - hb).
+ 							^machineCodeSize := 8]
+ 						ifFalse:
+ 							[^self concretizeDataOperationCwR: AndOpcode]]]!

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

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

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

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

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

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

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

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

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

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

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

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

Item was changed:
  ----- Method: CogARMCompiler>>concretizePushCw (in category 'generate machine code - concretize') -----
  concretizePushCw
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| word instrOffset|
  	word := operands at: 0.
+ 	instrOffset := self at: 0 moveCw: word intoR: ConcreteIPReg.
+ 	self machineCodeAt: instrOffset put: (self pushR: ConcreteIPReg).
- 	instrOffset := self at: 0 moveCw: word intoR: RISCTempReg.
- 	self machineCodeAt: instrOffset put: (self pushR: RISCTempReg).
  	^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>
  	cond ifNotNil:
  		[self concretizeConditionalInstruction.
  		 ^self].
  		 
  	opcode caseOf: {
  		"Noops & Pseudo Ops"
  		[Label]					-> [^self concretizeLabel].
  		[AlignmentNops]		-> [^self concretizeAlignmentNops].
  		[Fill16]					-> [^self concretizeFill16].
  		[Fill32]					-> [^self concretizeFill32].
  		[FillFromWord]			-> [^self concretizeFillFromWord].
  		[Nop]					-> [^self concretizeNop].
  		"Control"
  		[Call]						-> [^self concretizeCall].
  		[JumpR]						-> [^self concretizeJumpR].
  		[JumpLong]					-> [^self concretizeConditionalJumpLong: AL].
  		[JumpLongZero]			-> [^self concretizeConditionalJumpLong: EQ].
  		[JumpLongNonZero]		-> [^self concretizeConditionalJumpLong: 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].
  		"Arithmetic"
  		[AddCqR]					-> [^self concretizeAddCqR].
  		[AddCwR]					-> [^self concretizeDataOperationCwR: AddOpcode].
  		[AddRR]						-> [^self concretizeDataOperationRR: AddOpcode].
  		"[AddRdRd]					-> [^self concretizeSEE2OpRdRd: 16r58]."
  		[AndCqR]					-> [^self concretizeAndCqR].
+ 		[AndCqRR]					-> [^self concretizeAndCqRR].
  		[AndCwR]					-> [^self concretizeDataOperationCwR: AndOpcode].
  		[AndRR]						-> [^self concretizeDataOperationRR: AndOpcode].
  		[BICCqR]					-> [^self concretizeDataOperationCqR: BicOpcode].
  		[CmpCqR]					-> [^self concretizeDataOperationCqR: CmpOpcode].
  		[CmpCwR]					-> [^self concretizeDataOperationCwR: CmpOpcode].
  		[CmpRR]					-> [^self concretizeDataOperationRR: CmpOpcode].
  		[CmpRdRd]					-> [^self concretizeCmpRdRd].
  		"[DivRdRd]					-> [^self concretizeSEE2OpRdRd: 16r5E].
  		[MulRdRd]					-> [^self concretizeSEE2OpRdRd: 16r59]."
  		[OrCqR]						-> [^self concretizeDataOperationCqR: OrOpcode].
  		[OrCwR]					-> [^self concretizeDataOperationCwR: OrOpcode].
  		[OrRR]						-> [^self concretizeDataOperationRR: OrOpcode].
  		[SubCqR]					-> [^self concretizeSubCqR].
  		[SubCwR]					-> [^self concretizeDataOperationCwR: SubOpcode].
  		[SubRR]						-> [^self concretizeDataOperationRR: SubOpcode].
  		"[SubRdRd]					-> [^self concretizeSEE2OpRdRd: 16r5C]."
  		[SqrtRd]						-> [^self concretizeSqrtRd].
  		[TstCqR]					-> [^self concretizeTstCqR].
  		[XorCqR]						-> [^self concretizeDataOperationCqR: XorOpcode].
  		[XorCwR]						-> [^self concretizeDataOperationCwR: XorOpcode].
  		[XorRR]							-> [^self concretizeDataOperationRR: XorOpcode].
  		[NegateR]						-> [^self concretizeNegateR].
  		[LoadEffectiveAddressMwrR]	-> [^self concretizeLoadEffectiveAddressMwrR].
  		[ArithmeticShiftRightCqR]		-> [^self concretizeArithmeticShiftRightCqR].
  		[LogicalShiftRightCqR]			-> [^self concretizeLogicalShiftRightCqR].
  		[LogicalShiftLeftCqR]			-> [^self concretizeLogicalShiftLeftCqR].
  		[ArithmeticShiftRightRR]			-> [^self concretizeArithmeticShiftRightRR].
  		[LogicalShiftLeftRR]				-> [^self concretizeLogicalShiftLeftRR].
  		[LogicalShiftRightRR]			-> [^self concretizeLogicalShiftRightRR].
  		"Data Movement"
  		[MoveCqR]			-> [^self concretizeMoveCqR].
  		[MoveCwR]			-> [^self concretizeMoveCwR].
  		[MoveRR]			-> [^self concretizeMoveRR].
  		[MoveAwR]			-> [^self concretizeMoveAwR].
  		[MoveRAw]			-> [^self concretizeMoveRAw].
  		"While the two MoveMbR and MoveMwR are quite similar (off by 1 bit), they differ way more to
  		MoveM16R and MoveM64R. Because of that, they are not merged."
  		[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].
  		[PushCw]			-> [^self concretizePushCw].
  		[PrefetchAw]		-> [^self concretizePrefetchAw].
  		"Conversion"
  		[ConvertRRd]		-> [^self concretizeConvertRRd].
  		"ARM specific opcodes" 
  		[LDMFD]			-> [^self concretizeLDMFD].
  		[STMFD]			-> [^self concretizeSTMFD].
  		[SMULL]			-> [^self concretizeSMULL]	}!

Item was added:
+ ----- Method: CogARMCompiler>>hasThreeAddressArithmetic (in category 'testing') -----
+ hasThreeAddressArithmetic
+ 	"Answer if the receiver supports three-address arithmetic instructions (currently only AndCqRR)"
+ 	<inline: true>
+ 	^true!

Item was added:
+ ----- Method: CogARMCompiler>>hasVarBaseRegister (in category 'testing') -----
+ hasVarBaseRegister
+ 	"Answer if the processor has a dedicated callee-saved register to point to
+ 	 the base of commonly-accessed variables. On ARM we use R10 for this."
+ 	<inline: true>
+ 	^true "r10/sl"!

Item was removed:
- ----- Method: CogARMCompiler>>instructionIsAnyB: (in category 'testing') -----
- instructionIsAnyB: instr
- 	"is this any of the B BX BL or BLX <offset> instructions?"
- 	^(instr >> 25 bitAnd: 7) = 5!

Item was added:
+ ----- Method: CogARMCompiler>>isAddressRelativeToVarBase: (in category 'testing') -----
+ isAddressRelativeToVarBase: address
+ 	^address notNil
+ 	  and: [address >= cogit varBaseAddress
+ 	  and: [address - cogit varBaseAddress < (1 << 12)]]!

Item was added:
+ ----- Method: CogARMCompiler>>maybeEstablishVarBase (in category 'abstract instructions') -----
+ maybeEstablishVarBase
+ 	"The receiver has a VarBaseReg; generate the code to set it to its value."
+ 	cogit MoveCq: cogit varBaseAddress R: VarBaseReg!

Item was removed:
- ----- Method: CogARMCompiler>>riscTempReg (in category 'accessing') -----
- riscTempReg
- 	^RISCTempReg!

Item was removed:
- ----- Method: CogAbstractInstruction>>callsAreRelative (in category 'testing') -----
- callsAreRelative
- 	^self subclassResponsibility!

Item was changed:
  ----- Method: CogAbstractInstruction>>canDivQuoRem (in category 'testing') -----
  canDivQuoRem
+ 	<inline: true>
  	^self subclassResponsibility!

Item was changed:
  ----- Method: CogAbstractInstruction>>canMulRR (in category 'testing') -----
  canMulRR
+ 	<inline: true>
  	^self subclassResponsibility!

Item was added:
+ ----- Method: CogAbstractInstruction>>hasThreeAddressArithmetic (in category 'testing') -----
+ hasThreeAddressArithmetic
+ 	"Answer if the receiver supports three-address arithmetic instructions (currently only AndCqRR)"
+ 	<inline: true>
+ 	^self subclassResponsibility!

Item was added:
+ ----- Method: CogAbstractInstruction>>hasVarBaseRegister (in category 'testing') -----
+ hasVarBaseRegister
+ 	"Answer if the processor has a dedicated callee-saved register to point to
+ 	 the base of commonly-accessed variables. By default this is false."
+ 	<inline: true>
+ 	^false!

Item was added:
+ ----- Method: CogAbstractInstruction>>maybeEstablishVarBase (in category 'abstract instructions') -----
+ maybeEstablishVarBase
+ 	"If the receiver has a VarBaseReg, generate the code to set it to its value."
+ 	self subclassResponsibility!

Item was removed:
- ----- Method: CogIA32Compiler>>callsAreRelative (in category 'testing') -----
- callsAreRelative
- 	^true!

Item was changed:
  ----- Method: CogIA32Compiler>>canDivQuoRem (in category 'testing') -----
  canDivQuoRem
+ 	<inline: true>
  	^true!

Item was changed:
  ----- Method: CogIA32Compiler>>canMulRR (in category 'testing') -----
  canMulRR
+ 	<inline: true>
  	^true!

Item was added:
+ ----- Method: CogIA32Compiler>>hasThreeAddressArithmetic (in category 'testing') -----
+ hasThreeAddressArithmetic
+ 	"Answer if the receiver supports three-address arithmetic instructions"
+ 	<inline: true>
+ 	^false!

Item was added:
+ ----- Method: CogIA32Compiler>>maybeEstablishVarBase (in category 'abstract instructions') -----
+ maybeEstablishVarBase
+ 	"The receiver does not have a VarBaseReg; do nothing."!

Item was changed:
  ----- Method: CogObjectRepresentationFor32BitSpur>>genGetInlineCacheClassTagFrom:into:forEntry: (in category 'compile abstract instructions') -----
  genGetInlineCacheClassTagFrom: sourceReg into: destReg forEntry: forEntry
  	"Extract the inline cache tag for the object in sourceReg into destReg. The inline
  	 cache tag for a given object is the value loaded in inline caches to distinguish
  	 objects of different classes.  In Spur this is either the tags for immediates, (with
  	 1 & 3 collapsed to 1 for SmallIntegers, and 2 collapsed to 0 for Characters), or
  	 the receiver's classIndex.
  	 If forEntry is true answer the entry label at which control is to enter (cmEntryOffset).
  	 If forEntry is false, control enters at the start.
  	If forEntry is false, generate something like this:
  		Limm:
  			andl $0x1, rDest
  			j Lcmp
  		Lentry:
  			movl rSource, rDest
  			andl $0x3, rDest
  			jnz Limm
  			movl 0(%edx), rDest
  			andl $0x3fffff, rDest
  		Lcmp:
  	 If forEntry is true, generate something like the following.
  	 At least on a 2.2GHz Intel Core i7 the following is slightly faster than the above,
  	 136m sends/sec vs 130m sends/sec for nfib in tinyBenchmarks
  		Lentry:
  			movl rSource, rDest
  			andl $0x3, rDest
  			jz LnotImm
  			andl $1, rDest
  			j Lcmp
  		LnotImm:
  			movl 0(%edx), rDest
  			andl $0x3fffff, rDest
  		Lcmp:
  	 But we expect most SmallInteger arithmetic to be performed in-line and so prefer the
  	 version that is faster for non-immediates (because it branches for immediates only)."
  	| immLabel jumpNotImm entryLabel jumpCompare |
  	<var: #immLabel type: #'AbstractInstruction *'>
  	<var: #jumpNotImm type: #'AbstractInstruction *'>
  	<var: #entryLabel type: #'AbstractInstruction *'>
  	<var: #jumpCompare type: #'AbstractInstruction *'>
  	forEntry
  		ifFalse:
  			[entryLabel := cogit Label.
+ 			 cogit AndCq: objectMemory tagMask R: sourceReg R: destReg.
- 			 cogit MoveR: sourceReg R: destReg.
- 			 cogit AndCq: objectMemory tagMask R: destReg.
  			 jumpNotImm := cogit JumpZero: 0.
  			 cogit AndCq: 1 R: destReg.
  			 jumpCompare := cogit Jump: 0.
  			 "Get least significant half of header word in destReg"
  			 self flag: #endianness.
  			 jumpNotImm jmpTarget:
  				(cogit MoveMw: 0 r: sourceReg R: destReg).
  			 jumpCompare jmpTarget:
  				(cogit AndCq: objectMemory classIndexMask R: destReg)]
  		ifTrue:
  			[cogit AlignmentNops: objectMemory wordSize.
  			 immLabel := cogit Label.
  			 cogit AndCq: 1 R: destReg.
  			 jumpCompare := cogit Jump: 0.
  			 cogit AlignmentNops: objectMemory wordSize.
  			 entryLabel := cogit Label.
+ 			 cogit AndCq: objectMemory tagMask R: sourceReg R: destReg.
- 			 cogit MoveR: sourceReg R: destReg.
- 			 cogit AndCq: objectMemory tagMask R: destReg.
  			 cogit JumpNonZero: immLabel.
  			 self flag: #endianness.
  			 "Get least significant half of header word in destReg"
  			 cogit MoveMw: 0 r: sourceReg R: destReg.
  			 cogit AndCq: objectMemory classIndexMask R: destReg.
  			 jumpCompare jmpTarget: cogit Label].
  	^entryLabel!

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

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

Item was changed:
  ----- Method: CogVMSimulator>>utilitiesMenu: (in category 'UI') -----
  utilitiesMenu: aMenuMorph
  	aMenuMorph
  		add: 'toggle transcript' action: #toggleTranscript;
  		add: 'clone VM' action: #cloneSimulationWindow;
  		addLine;
  		add: 'print ext head frame' action: #printExternalHeadFrame;
  		add: 'print int head frame' action: #printHeadFrame;
  		add: 'print mc/cog frame' action: [self printFrame: cogit processor fp WithSP: cogit processor sp];
  		add: 'short print ext frame & callers' action: [self shortPrintFrameAndCallers: framePointer];
  		add: 'short print int frame & callers' action: [self shortPrintFrameAndCallers: localFP];
  		add: 'short print mc/cog frame & callers' action: [self shortPrintFrameAndCallers: cogit processor fp];
  		add: 'long print ext frame & callers' action: [self printFrameAndCallers: framePointer SP: stackPointer];
  		add: 'long print int frame & callers' action: [self printFrameAndCallers: localFP SP: localSP];
  		add: 'long print mc/cog frame & callers' action: [self printFrameAndCallers: cogit processor fp SP: cogit processor sp];
  		add: 'print frame...' action: [(self promptHex: 'print frame') ifNotNil: [:fp| self printFrame: fp]];
  		add: 'print call stack' action: #printCallStack;
  		add: 'print stack call stack' action: #printStackCallStack;
  		add: 'print stack call stack of...' action: [(self promptHex: 'frame') ifNotNil: [:fp| self printStackCallStackOf: fp]];
  		add: 'print call stack of...' action: [(self promptHex: 'context or process oop') ifNotNil: [:obj| self printCallStackOf: obj]];
  		add: 'print call stack of frame...' action: [(self promptHex: 'frame') ifNotNil: [:fp| self printCallStackFP: fp]];
  		add: 'print all stacks' action: #printAllStacks;
  		add: 'write back local ptrs' action: [stackPointer := localSP. framePointer := localFP. instructionPointer := localIP.
  											self writeBackHeadFramePointers];
  		add: 'write back mc ptrs' action: [stackPointer := cogit processor sp. framePointer := cogit processor fp. instructionPointer := cogit processor eip.
  											self writeBackHeadFramePointers];
  		addLine;
  		add: 'print rump C stack' action: [objectMemory printMemoryFrom: cogit processor sp to: self CStackPointer];
  		add: 'print registers' action: [cogit processor printRegistersOn: transcript];
  		add: 'print register map' action: [cogit printRegisterMapOn: transcript];
  		add: 'disassemble method/trampoline...' action: [(self promptHex: 'pc') ifNotNil: [:pc| cogit disassembleCodeAt: pc]];
  		add: 'disassemble method/trampoline at pc' action: [cogit disassembleCodeAt: cogit processor pc];
  		add: 'disassemble ext head frame method' action: [cogit disassembleMethod: (self frameMethod: framePointer)];
  		add: 'print oop...' action: [(self promptHex: 'print oop') ifNotNil: [:oop| self printOop: oop]];
  		add: 'long print oop...' action: [(self promptHex: 'print oop') ifNotNil: [:oop| self longPrintOop: oop]];
  		add: 'print context...' action: [(self promptHex: 'print context') ifNotNil: [:oop| self printContext: oop]];
  		addLine;
  		add: 'inspect object memory' target: objectMemory action: #inspect;
  		add: 'inspect cointerpreter' action: #inspect;
  		add: 'inspect cogit' target: cogit action: #inspect;
  		add: 'inspect method zone' target: cogit methodZone action: #inspect.
  	self isThreadedVM ifTrue:
  		[aMenuMorph add: 'inspect thread manager' target: self threadManager action: #inspect].
  	aMenuMorph
  		addLine;
  		add: 'print cog methods' target: cogMethodZone action: #printCogMethods;
  		add: 'print cog methods with prim...' action: [(self promptNum: 'prim index') ifNotNil: [:pix| cogMethodZone printCogMethodsWithPrimitive: pix]];
+ 		add: 'print cog methods with selector...' action:
+ 			[|s| s := UIManager default request: 'selector'.
+ 			s notEmpty ifTrue:
+ 				[s = 'nil' ifTrue: [s := nil].
+ 				 cogMethodZone methodsDo:
+ 					[:m|
+ 					(s ifNil: [m selector = objectMemory nilObject]
+ 					 ifNotNil: [(objectMemory numBytesOf: m selector) = s size
+ 							and: [(self str: s
+ 									n: (m selector + objectMemory baseHeaderSize)
+ 									cmp: (objectMemory numBytesOf: m selector)) = 0]]) ifTrue:
+ 						[cogit printCogMethod: m]]]];
  		add: 'print cog method for...' action: [(self promptHex: 'pc') ifNotNil: [:pc| cogit printCogMethodFor: pc]];
  		add: 'print trampoline table' target: cogit action: #printTrampolineTable;
  		add: 'print prim trace log' action: #dumpPrimTraceLog;
  		add: 'report recent instructions' target: cogit action: #reportLastNInstructions;
  		add: 'set break pc (', (cogit breakPC isInteger ifTrue: [cogit breakPC hex] ifFalse: [cogit breakPC printString]), ')...' action: [(self promptHex: 'break pc') ifNotNil: [:bpc| cogit breakPC: bpc]];
  		add: (cogit singleStep
  				ifTrue: ['no single step']
  				ifFalse: ['single step'])
  			action: [cogit singleStep: cogit singleStep not];
  		add: (cogit printRegisters
  				ifTrue: ['no print registers each instruction']
  				ifFalse: ['print registers each instruction'])
  			action: [cogit printRegisters: cogit printRegisters not];
  		add: (cogit printInstructions
  				ifTrue: ['no print instructions each instruction']
  				ifFalse: ['print instructions each instruction'])
  			action: [cogit printInstructions: cogit printInstructions not];
  		addLine;
  		add: 'set break count...' action: [|s| s := UIManager default request: 'break count (dec)'.
  											s notEmpty ifTrue: [breakCount := Integer readFrom: s readStream]];
  		add: 'set break selector...' action: [|s| s := UIManager default request: 'break selector'.
  											s notEmpty ifTrue: [self setBreakSelector: s]];
  		add: 'set break block...' action: [|s| s := UIManager default request: 'break block' initialAnswer: '[:theCogit| false]'.
  											s notEmpty ifTrue: [self setBreakBlockFromString: s]];
  		add: 'set cogit break method...' action: [(self promptHex: 'cogit breakMethod') ifNotNil: [:bm| cogit setBreakMethod: bm]];
  		add: (printBytecodeAtEachStep
  				ifTrue: ['no print bytecode each bytecode']
  				ifFalse: ['print bytecode each bytecode'])
  			action: [self ensureDebugAtEachStepBlock.
  					printBytecodeAtEachStep := printBytecodeAtEachStep not];
  		add: (printFrameAtEachStep
  				ifTrue: ['no print frame each bytecode']
  				ifFalse: ['print frame each bytecode'])
  			action: [self ensureDebugAtEachStepBlock.
  					printFrameAtEachStep := printFrameAtEachStep not].
  	^aMenuMorph!

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

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 < 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 >= 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
- 		executeCogMethod: cPIC
  		fromLinkedSendWithReceiver: receiver
  		andCacheTag: (backEnd inlineCacheTagAt: outerReturn).
  	"NOTREACHED"
  	^nil!

Item was changed:
  ----- Method: Cogit>>ceSICMiss: (in category 'in-line cacheing') -----
  ceSICMiss: receiver
  	"An in-line cache check in a method has failed.  The failing entry check has jumped
  	 to the ceMethodAbort abort call at the start of the method which has called this routine.
  	 If possible allocate a closed PIC for the current and existing classes.
  	 The stack looks like:
  			receiver
  			args
  			sender return address
  	  sp=>	ceMethodAbort call return address
  	 So we can find the method that did the failing entry check at
  		ceMethodAbort call return address - missOffset
  	 and we can find the send site from the outer return address."
  	<api>
  	| pic innerReturn outerReturn entryPoint targetMethod newTargetMethodOrNil errorSelectorOrNil cacheTag extent result |
  	<var: #pic type: #'CogMethod *'>
  	<var: #targetMethod type: #'CogMethod *'>
  	"Whether we can relink to a PIC or not we need to pop off the inner return and identify the target method."
  	innerReturn := coInterpreter popStack.
  	targetMethod := self cCoerceSimple: innerReturn - missOffset to: #'CogMethod *'.
  	(objectMemory isOopForwarded: receiver) ifTrue:
  		[^coInterpreter ceSendFromInLineCacheMiss: targetMethod].
  	outerReturn := coInterpreter stackTop.
  	self assert: (outerReturn between: methodZoneBase and: methodZone freeStart).
  	entryPoint := backEnd callTargetFromReturnAddress: outerReturn.
  
  	self assert: targetMethod selector ~= objectMemory nilObject.
  	self cppIf: NewspeakVM ifTrue:
  		[self assert: (targetMethod asInteger + cmEntryOffset = entryPoint
  					or: [targetMethod asInteger + cmDynSuperEntryOffset = entryPoint]).
  		 "Avoid the effort of implementing PICs for the relatively low dynamic frequency
  		  dynamic super send and simply rebind the send site."
  		 targetMethod asInteger + cmDynSuperEntryOffset = entryPoint ifTrue:
  			[^coInterpreter
  				ceDynamicSuperSend: targetMethod selector
  				to: receiver
  				numArgs: targetMethod cmNumArgs]].
  	self assert: targetMethod asInteger + cmEntryOffset = entryPoint.
  
  	self lookup: targetMethod selector
  		for: receiver
  		methodAndErrorSelectorInto:
  			[:method :errsel|
  			newTargetMethodOrNil := method.
  			errorSelectorOrNil := errsel].
  	"We assume lookupAndCog:for: will *not* reclaim the method zone"
  	self assert: outerReturn = coInterpreter stackTop.
  	cacheTag := objectRepresentation inlineCacheTagForInstance: receiver.
  	((errorSelectorOrNil notNil and: [errorSelectorOrNil ~= SelectorDoesNotUnderstand])
  	 or: [(objectRepresentation inlineCacheTagIsYoung: cacheTag)
  	 or: [(backEnd inlineCacheTagAt: outerReturn) = self picAbortDiscriminatorValue
  	 or: [newTargetMethodOrNil isNil
  	 or: [objectMemory isYoung: newTargetMethodOrNil]]]]) ifTrue:
  		[result := self patchToOpenPICFor: targetMethod selector
  					numArgs: targetMethod cmNumArgs
  					receiver: receiver.
  		 self assert: result not. "If patchToOpenPICFor:.. returns we're out of code memory"
  		 ^coInterpreter ceSendFromInLineCacheMiss: targetMethod].
  	"See if an Open PIC is already available."
  	pic := methodZone openPICWithSelector: targetMethod selector.
  	pic isNil ifTrue:
  		["otherwise attempt to create a closed PIC for the two cases."
  		 pic := self cogPICSelector: targetMethod selector
  					numArgs: targetMethod cmNumArgs
  					Case0Method: targetMethod
  					Case1Method: newTargetMethodOrNil
  					tag: cacheTag
  					isMNUCase: errorSelectorOrNil = SelectorDoesNotUnderstand.
  		 (pic asInteger between: MaxNegativeErrorCode and: -1) ifTrue:
  			["For some reason the PIC couldn't be generated, most likely a lack of code memory.
  			  Continue as if this is an unlinked send."
  			 pic asInteger = InsufficientCodeSpace ifTrue:
  				[coInterpreter callForCogCompiledCodeCompaction].
  			^coInterpreter ceSendFromInLineCacheMiss: targetMethod].
  		 processor flushICacheFrom: pic asInteger to: pic asInteger + closedPICSize].
  	"Relink the send site to the pic.  If to an open PIC then reset the cache tag to the selector,
  	 for the benefit of the cacheTag assert check in checkIfValidObjectRef:pc:cogMethod:."
  	extent := pic cmType = CMOpenPIC
  				ifTrue:
  					[backEnd
  						rewriteInlineCacheAt: outerReturn
  						tag: targetMethod selector
  						target: pic asInteger + cmEntryOffset]
  				ifFalse:
  					[backEnd
  						rewriteCallAt: outerReturn
  						target: pic asInteger + cmEntryOffset].
  	processor flushICacheFrom: outerReturn - 1 - extent to: outerReturn - 1.
  	"Jump back into the pic at its entry in case this is an MNU (newTargetMethodOrNil is nil)"
  	coInterpreter
+ 		executeCogPIC: pic
- 		executeCogMethod: pic
  		fromLinkedSendWithReceiver: receiver
  		andCacheTag: (backEnd inlineCacheTagAt: outerReturn).
  	"NOTREACHED"
  	^nil!

Item was added:
+ ----- Method: Cogit>>fakeAddressFor:index: (in category 'initialization') -----
+ fakeAddressFor: anObject index: index
+ 	"Answer a fake address for some variable based on some index.
+ 	 The index will usually be the size of simulatedAddresses, but
+ 	 in determining the varBaseAddress we take a guess at the final
+ 	 size of simulatedAddresses."
+ 	<doNotGenerate>
+ 	^(index + 101 * objectMemory wordSize) negated
+ 		bitAnd: ((backEnd wantsNearAddressFor: anObject)
+ 					ifTrue: [self addressSpaceMask]
+ 					ifFalse: [self allButTopBitOfAddressSpaceMask])!

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

Item was changed:
  ----- Method: Cogit>>initializeBackend (in category 'initialization') -----
  initializeBackend
  	"A hook for the StackToregisterMappingCogit to override.
  	 We just initialize the methodLabel here because backEnd is static."
  	methodLabel machineCodeSize: 0.
  	methodLabel opcode: Label.
  	methodLabel operands at: 0 put: 0.
  	methodLabel operands at: 1 put: 0. "label offset"
+ 	callerSavedRegMask := backEnd callerSavedRegisterMask.
+ 	backEnd hasVarBaseRegister ifTrue:
+ 		[self assert: ((self registerMaskFor: VarBaseReg) noMask: callerSavedRegMask)]!
- 	callerSavedRegMask := backEnd callerSavedRegisterMask!

Item was added:
+ ----- Method: Cogit>>registerMaskFor:and:and:and:and: (in category 'register management') -----
+ registerMaskFor: reg1 and: reg2 and: reg3 and: reg4 and: reg5
+ 	"Answer a bit mask identifying the symbolic registers.
+ 	 Registers are negative numbers."
+ 	^(((1 << (1 - reg1) bitOr: 1 << (1 - reg2)) bitOr: 1 << (1 - reg3)) bitOr: 1 << (1 - reg4)) bitOr: 1 << (1 - reg5)!

Item was added:
+ ----- Method: Cogit>>registerMaskFor:and:and:and:and:and: (in category 'register management') -----
+ registerMaskFor: reg1 and: reg2 and: reg3 and: reg4 and: reg5 and: reg6
+ 	"Answer a bit mask identifying the symbolic registers.
+ 	 Registers are negative numbers."
+ 	^((((1 << (1 - reg1) bitOr: 1 << (1 - reg2)) bitOr: 1 << (1 - reg3)) bitOr: 1 << (1 - reg4)) bitOr: 1 << (1 - reg5)) bitOr: 1 << (1 - reg6)!

Item was changed:
  ----- Method: Cogit>>simulatedAddressFor: (in category 'initialization') -----
  simulatedAddressFor: anObject
  	"Answer a simulated address for a block or a symbol.  This is an address that
  	 can be called, read or written by generated machine code, and will be mapped
  	 into a Smalltalk message send or block evaluation.
  
  	 N.B. These addresses are at the top end of the bottom half of the address space
  	 so that they don't have the sign bit set and so will not look like negative numbers,
  	 unless they're the short-cut routines on ARM, where we want to use a bl, not a blx."
  	<doNotGenerate>
  	^simulatedAddresses
  		at: anObject
+ 		ifAbsentPut: [self fakeAddressFor: anObject index: simulatedAddresses size]!
- 		ifAbsentPut:
- 			[(simulatedAddresses size + 101 * objectMemory wordSize) negated
- 				bitAnd: ((backEnd wantsNearAddressFor: anObject)
- 							ifTrue: [self addressSpaceMask]
- 							ifFalse: [self allButTopBitOfAddressSpaceMask])]!

Item was added:
+ ----- Method: Cogit>>varBaseAddress (in category 'accessing') -----
+ varBaseAddress
+ 	"We expect simulatedAddresses to have around 40 entries.  48 is hopefully a good maximum."
+ 	<doNotGenerate>
+ 	^self cCode: [coInterpreter varBaseAddress]
+ 		inSmalltalk: [self fakeAddressFor: nil index: 48]!

Item was changed:
  ----- Method: SpurMemoryManager>>lookupAddress: (in category 'simulation only') -----
  lookupAddress: address
  	"If address appears to be that of a Symbol or a few well-known objects (such as classes) answer it, otherwise answer nil.
  	 For code disassembly"
  	<doNotGenerate>
  	| fmt size string class classSize maybeThisClass classNameIndex thisClassIndex |
  	((self addressCouldBeObj: address)
  	 and: [(self classIndexOf: address) > 0]) ifFalse:
  		[^address = scavengeThreshold ifTrue:
  			['scavengeThreshold']].
  	address - self baseHeaderSize = hiddenRootsObj ifTrue:
  		[^'(hiddenRootsObj+baseHeaderSize)'].
  	fmt := self formatOf: address.
  	size := self lengthOf: address baseHeader: (self baseHeader: address) format: fmt.
  	size = 0 ifTrue:
  		[^address caseOf: { [nilObj] -> ['nil']. [trueObj] -> ['true']. [falseObj] -> ['false'] } otherwise: []].
  	((fmt between: self firstByteFormat and: self firstCompiledMethodFormat - 1) "indexable byte fields"
  	and: [(size between: 1 and: 64)
  	and: [Scanner isLiteralSymbol: (string := (0 to: size - 1) collect: [:i| Character value: (self fetchByte: i ofObject: address)])]]) ifTrue:
  		[^'#', (ByteString withAll: string)].
  	class := self fetchClassOfNonImm: address.
  	(class isNil or: [class = nilObj]) ifTrue:
  		[^nil].
  	"address is either a class or a metaclass, or an instance of a class or invalid.  determine which."
  	classNameIndex := coInterpreter classNameIndex.
  	thisClassIndex := coInterpreter thisClassIndex.
  	((classSize := self numSlotsOf: class) <= (classNameIndex max: thisClassIndex)
  	 or: [classSize > 255]) ifTrue:
  		[^nil].
  	"Address could be a class or a metaclass"
+ 	(fmt = 1 and: [size > classNameIndex]) ifTrue:
- 	(fmt = 1 and: [size >= classNameIndex]) ifTrue:
  		["Is address a class? If so class's thisClass is address."
  		 (self lookupAddress: (self fetchPointer: classNameIndex ofObject: address)) ifNotNil:
  			[:maybeClassName|
  			(self fetchPointer: thisClassIndex ofObject: class) = address ifTrue:
  				[^maybeClassName allButFirst]].
  		"Is address a Metaclass?  If so class's name is Metaclass and address's thisClass holds the class name"
  		((self isBytes: (self fetchPointer: classNameIndex ofObject: class))
  		 and: [(self lookupAddress: (self fetchPointer: classNameIndex ofObject: class)) = '#Metaclass'
  		 and: [size >= thisClassIndex]]) ifTrue:
  			[maybeThisClass := self fetchPointer: thisClassIndex ofObject: address.
  			(self lookupAddress: (self fetchPointer: classNameIndex ofObject: maybeThisClass)) ifNotNil:
  				[:maybeThisClassName| ^maybeThisClassName allButFirst, ' class']]].
  	^(self lookupAddress: (self fetchPointer: classNameIndex ofObject: class)) ifNotNil:
  		[:maybeClassName| 'a(n) ', maybeClassName allButFirst]!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genCallPICEnilopmartNumArgs: (in category 'initialization') -----
  genCallPICEnilopmartNumArgs: numArgs
  	"Generate special versions of the ceCallCogCodePopReceiverAndClassRegs
  	 enilopmart that also pop register args from the stack to undo the pushing of
  	 register args in the abort/miss trampolines."
  	<returnTypeC: 'void (*genCallPICEnilopmartNumArgs(sqInt numArgs))(void)'>
  	| size endAddress enilopmart |
  	opcodeIndex := 0.
+ 	backEnd maybeEstablishVarBase. "Must happen first; value may be used in genLoadStackPointers"
  	backEnd genLoadStackPointers.
  	self PopR: ClassReg. "cacheTag"
  	self PopR: TempReg. "entry-point"
  	self PopR: (backEnd hasLinkRegister ifTrue: [LinkReg] ifFalse: [SendNumArgsReg]). "retpc"
  	numArgs > 0 ifTrue:
  		[numArgs > 1 ifTrue:
  			[self PopR: Arg1Reg.
  			 self assert: self numRegArgs = 2].
  		 self PopR: Arg0Reg].
  	self PopR: ReceiverResultReg.
  	backEnd hasLinkRegister ifFalse: [self PushR: SendNumArgsReg]. "retpc"
  	self JumpR: TempReg.
  	self computeMaximumSizes.
  	size := self generateInstructionsAt: methodZoneBase.
  	endAddress := self outputInstructionsAt: methodZoneBase.
  	self assert: methodZoneBase + size = endAddress.
  	enilopmart := methodZoneBase.
  	methodZoneBase := self alignUptoRoutineBoundary: endAddress.
  	backEnd nopsFrom: endAddress to: methodZoneBase - 1.
  	self recordGeneratedRunTime: (self trampolineName: 'ceCallPIC' numArgs: numArgs) address: enilopmart.
  	^self cCoerceSimple: enilopmart to: #'void (*)(void)'!



More information about the Vm-dev mailing list