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

commits at source.squeak.org commits at source.squeak.org
Thu Nov 5 02:28:34 UTC 2015


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

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

Name: VMMaker.oscog-eem.1510
Author: eem
Time: 4 November 2015, 6:26:00.671 pm
UUID: f4c6b0cb-dda2-4a50-a0c5-cd7609a53503
Ancestors: VMMaker.oscog-eem.1509

x64 Cogit:
More support in the obj rep to do at: and size prims.

Add MoveX32r:R:R: to index 32-bit indexables.

Add a disassembly convenience on CogAbstractnstruction

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

Item was added:
+ ----- Method: CogAbstractInstruction>>disassemble (in category 'full transfer run-time support') -----
+ disassemble
+ 	<doNotGenerate>
+ 	self disassembleOn: Transcript!

Item was added:
+ ----- Method: CogAbstractInstruction>>disassembleOn: (in category 'full transfer run-time support') -----
+ disassembleOn: aStream
+ 	<doNotGenerate>
+ 	cogit processor
+ 		disassembleFrom: 0
+ 		to: machineCodeSize - 1
+ 		in: machineCode object
+ 		on: aStream!

Item was added:
+ ----- Method: CogObjectRepresentation>>genInnerPrimitiveAt: (in category 'primitive generators') -----
+ genInnerPrimitiveAt: retNoffset
+ 	"Implement the guts of primitiveAt"
+ 	^self subclassResponsibility!

Item was removed:
- ----- Method: CogObjectRepresentationFor32BitSpur>>genGetNumSlotsOf:into: (in category 'compile abstract instructions') -----
- genGetNumSlotsOf: srcReg into: destReg
- 	"Get the size in word-sized slots of the object in srcReg into destReg.
- 	 srcReg may equal destReg."
- 	<var: #jmp type: #'AbstractInstruction *'>
- 	| jmp |
- 	self assert: srcReg ~= destReg.
- 	self genGetRawSlotSizeOfNonImm: srcReg into: destReg.
- 	cogit CmpCq: objectMemory numSlotsMask R: destReg.
- 	jmp := cogit JumpLess: 0.
- 	self genGetOverflowSlotsOf: srcReg into: destReg.
- 	jmp jmpTarget: cogit Label.
- 	^0!

Item was added:
+ ----- Method: CogObjectRepresentationFor64BitSpur>>genGetOverflowSlotsOf:into: (in category 'compile abstract instructions') -----
+ genGetOverflowSlotsOf: srcReg into: destReg
+ 	cogit
+ 		MoveMw: objectMemory baseHeaderSize negated r: srcReg R: destReg;
+ 		LogicalShiftLeftCq: 8 R: destReg;
+ 		LogicalShiftRightCq: 8 R: destReg.
+ 	^0!

Item was added:
+ ----- Method: CogObjectRepresentationFor64BitSpur>>genGetSizeOf:into:formatReg:scratchReg:abortJumpsInto: (in category 'primitive generators') -----
+ genGetSizeOf: sourceReg into: destReg formatReg: formatReg scratchReg: scratchReg abortJumpsInto: aBinaryBlock
+ 	"Get the size of the non-immediate object in sourceReg into destReg using formatReg
+ 	 and scratchReg as temps.  None of these registers can overlap.  Supply the jumps
+ 	 taken if the object in sourceReg is not indexable, or if the object in sourceReg is a
+ 	 context.. Hack: If the object has a pointer format other than 2 leave the number of
+ 	 fixed fields in formatReg.  Used by primitiveSize, primitiveAt, and primitiveAtPut"
+ 	<returnTypeC: #'AbstractInstruction *'>
+ 	| jumpNotIndexable
+ 	  jumpBytesDone jumpShortsDone jumpArrayDone jump32BitLongsDone jump64BitLongsDone
+ 	  jumpIsBytes jumpHasFixedFields jumpIsShorts jumpIs32BitLongs jumpIsContext  |
+ 	<inline: true>
+ 	"c.f. StackInterpreter>>stSizeOf: SpurMemoryManager>>lengthOf:format: fixedFieldsOf:format:length:"
+ 	<var: #jumpIsBytes type: #'AbstractInstruction *'>
+ 	<var: #jumpIsShorts type: #'AbstractInstruction *'>
+ 	<var: #jumpIsContext type: #'AbstractInstruction *'>
+ 	<var: #jumpArrayDone type: #'AbstractInstruction *'>
+ 	<var: #jumpIs32BitLongs type: #'AbstractInstruction *'>
+ 	<var: #jumpNotIndexable type: #'AbstractInstruction *'>
+ 	<var: #jumpHasFixedFields type: #'AbstractInstruction *'>
+ 	<var: #jump32BitLongsDone type: #'AbstractInstruction *'>
+ 	<var: #jump64BitLongsDone type: #'AbstractInstruction *'>
+ 
+ 	"formatReg := self formatOf: sourceReg"
+ 	self genGetFormatOf: sourceReg
+ 		into: formatReg
+ 		leastSignificantHalfOfBaseHeaderIntoScratch: scratchReg.
+ 
+ 	self genGetNumSlotsOf: sourceReg into: destReg.
+ 
+ 	"dispatch on format in a combination of highest dynamic frequency order first and convenience.
+ 		  0 = 0 sized objects (UndefinedObject True False et al)
+ 		  1 = non-indexable objects with inst vars (Point et al)
+ 		  2 = indexable objects with no inst vars (Array et al)
+ 		  3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
+ 		  4 = weak indexable objects with inst vars (WeakArray et al)
+ 		  5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
+ 		  6 unused, reserved for exotic pointer objects?
+ 		  7 Forwarded Object, 1st field is pointer, rest of fields are ignored
+ 		  8 unused, reserved for exotic non-pointer objects?
+ 		  9 64-bit indexable
+ 		10 - 11 32-bit indexable
+ 		12 - 15 16-bit indexable
+ 		16 - 23 byte indexable
+ 		24 - 31 compiled method"
+ 	cogit CmpCq: objectMemory firstByteFormat R: formatReg.
+ 	jumpIsBytes := cogit JumpGreaterOrEqual: 0.
+ 					cogit CmpCq: objectMemory arrayFormat R: formatReg.
+ 	jumpArrayDone := cogit JumpZero: 0.
+ 	jumpNotIndexable := cogit JumpLess: 0.
+ 					cogit CmpCq: objectMemory weakArrayFormat R: formatReg.
+ 	jumpHasFixedFields := cogit JumpLessOrEqual: 0.
+ 					cogit CmpCq: objectMemory firstShortFormat R: formatReg.
+ 	jumpIsShorts := cogit JumpGreaterOrEqual: 0.
+ 					cogit CmpCq: objectMemory firstLongFormat R: formatReg.
+ 	jumpIs32BitLongs := cogit JumpGreaterOrEqual: 0.
+ 					cogit CmpCq: objectMemory sixtyFourBitIndexableFormat R: formatReg.
+ 	jump64BitLongsDone := cogit JumpZero: 0.
+ 	jumpNotIndexable jmpTarget: cogit Label.
+ 	jumpNotIndexable := cogit Jump: 0.
+ 
+ 	jumpIsBytes jmpTarget:
+ 		(cogit LogicalShiftLeftCq: objectMemory shiftForWord R: destReg).
+ 		cogit AndCq: objectMemory wordSize - 1 R: formatReg.
+ 		cogit SubR: formatReg R: destReg.
+ 	jumpBytesDone := cogit Jump: 0.
+ 
+ 	jumpIsShorts jmpTarget:
+ 		(cogit LogicalShiftLeftCq: objectMemory shiftForWord - 1 R: destReg).
+ 		cogit AndCq: objectMemory wordSize >> 1 - 1 R: formatReg.
+ 		cogit SubR: formatReg R: destReg.
+ 	jumpShortsDone := cogit Jump: 0.
+ 
+ 	jumpIs32BitLongs jmpTarget:
+ 		(cogit LogicalShiftLeftCq: objectMemory shiftForWord - 2 R: destReg).
+ 		cogit AndCq: objectMemory wordSize >> 2 - 1 R: formatReg.
+ 		cogit SubR: formatReg R: destReg.
+ 	jump32BitLongsDone := cogit Jump: 0.
+ 
+ 	"formatReg contains fmt, now up for grabs.
+ 	 destReg contains numSlots, precious.
+ 	 sourceReg must be preserved"
+ 	jumpHasFixedFields jmpTarget:
+ 		(cogit AndCq: objectMemory classIndexMask R: scratchReg).
+ 	cogit MoveR: scratchReg R: formatReg.
+ 	cogit CmpCq: ClassMethodContextCompactIndex R: scratchReg.
+ 	jumpIsContext := cogit JumpZero: 0.
+ 	self genGetClassObjectOfClassIndex: formatReg into: Scratch0Reg scratchReg: scratchReg.
+ 	self genLoadSlot: InstanceSpecificationIndex sourceReg: Scratch0Reg destReg: formatReg.
+ 	self genConvertSmallIntegerToIntegerInReg: formatReg.
+ 	cogit
+ 		AndCq: objectMemory fixedFieldsOfClassFormatMask R: formatReg;
+ 		SubR: formatReg R: destReg.
+ 
+ 	jumpArrayDone jmpTarget:
+ 	(jump64BitLongsDone jmpTarget:
+ 	(jump32BitLongsDone jmpTarget:
+ 	(jumpShortsDone jmpTarget:
+ 	(jumpBytesDone jmpTarget:
+ 		cogit Label)))).
+ 	aBinaryBlock value: jumpNotIndexable value: jumpIsContext!

Item was added:
+ ----- Method: CogObjectRepresentationFor64BitSpur>>genInnerPrimitiveAt: (in category 'primitive generators') -----
+ genInnerPrimitiveAt: retNoffset
+ 	"Implement the guts of primitiveAt"
+ 	| formatReg jumpNotIndexable jumpImmediate jumpBadIndex
+ 	  jumpBytesDone jumpShortsDone jumpWordsDone jumpFixedFieldsDone
+ 	  jumpIsBytes jumpIsShorts jumpIsWords jumpIsArray jumpHasFixedFields jumpIsContext
+ 	  jumpBytesOutOfBounds jumpShortsOutOfBounds jumpWordsOutOfBounds jumpArrayOutOfBounds jumpFixedFieldsOutOfBounds |
+ 	<inline: true>
+ 	"c.f. StackInterpreter>>stSizeOf: SpurMemoryManager>>lengthOf:format: fixedFieldsOf:format:length:"
+ 	<var: #jumpIsBytes type: #'AbstractInstruction *'>
+ 	<var: #jumpIsShorts type: #'AbstractInstruction *'>
+ 	<var: #jumpBadIndex type: #'AbstractInstruction *'>
+ 	<var: #jumpIsContext type: #'AbstractInstruction *'>
+ 	<var: #jumpImmediate type: #'AbstractInstruction *'>
+ 	<var: #jumpBytesDone type: #'AbstractInstruction *'>
+ 	<var: #jumpShortsDone type: #'AbstractInstruction *'>
+ 	<var: #jumpWordsDone type: #'AbstractInstruction *'>
+ 	<var: #jumpNotIndexable type: #'AbstractInstruction *'>
+ 	<var: #jumpHasFixedFields type: #'AbstractInstruction *'>
+ 	<var: #jumpFixedFieldsDone type: #'AbstractInstruction *'>
+ 	<var: #jumpArrayOutOfBounds type: #'AbstractInstruction *'>
+ 	<var: #jumpBytesOutOfBounds type: #'AbstractInstruction *'>
+ 	<var: #jumpShortsOutOfBounds type: #'AbstractInstruction *'>
+ 	<var: #jumpWordsOutOfBounds type: #'AbstractInstruction *'>
+ 	<var: #jumpFixedFieldsOutOfBounds type: #'AbstractInstruction *'>
+ 
+ 	jumpImmediate := self genJumpImmediate: ReceiverResultReg.
+ 	cogit MoveR: Arg0Reg R: Arg1Reg.
+ 	jumpBadIndex := self genJumpNotSmallInteger: Arg0Reg.
+ 	jumpBadIndex asInteger = UnimplementedOperation ifTrue:
+ 		[cogit MoveR: Arg0Reg R: TempReg.
+ 		 jumpBadIndex := self genJumpNotSmallIntegerInScratchReg: TempReg].
+ 	self genConvertSmallIntegerToIntegerInReg: Arg1Reg.
+ 	cogit SubCq: 1 R: Arg1Reg. "1-rel => 0-rel"
+ 
+ 	"formatReg := self formatOf: ReceiverResultReg"
+ 	self genGetFormatOf: ReceiverResultReg
+ 		into: (formatReg := SendNumArgsReg)
+ 		leastSignificantHalfOfBaseHeaderIntoScratch: TempReg.
+ 
+ 	self genGetNumSlotsOf: ReceiverResultReg into: ClassReg.
+ 
+ 	"dispatch on format in a combination of highest dynamic frequency order first and convenience.
+ 		  0 = 0 sized objects (UndefinedObject True False et al)
+ 		  1 = non-indexable objects with inst vars (Point et al)
+ 		  2 = indexable objects with no inst vars (Array et al)
+ 		  3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
+ 		  4 = weak indexable objects with inst vars (WeakArray et al)
+ 		  5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
+ 		  6 unused, reserved for exotic pointer objects?
+ 		  7 Forwarded Object, 1st field is pointer, rest of fields are ignored
+ 		  8 unused, reserved for exotic non-pointer objects?
+ 		  9 (?) 64-bit indexable
+ 		10 - 11 32-bit indexable
+ 		12 - 15 16-bit indexable
+ 		16 - 23 byte indexable
+ 		24 - 31 compiled method"
+ 	cogit CmpCq: objectMemory firstByteFormat R: formatReg.
+ 	jumpIsBytes := cogit JumpAboveOrEqual: 0.
+ 					cogit CmpCq: objectMemory arrayFormat R: formatReg.
+ 	jumpIsArray := cogit JumpZero: 0.
+ 	jumpNotIndexable := cogit JumpBelow: 0.
+ 					cogit CmpCq: objectMemory weakArrayFormat R: formatReg.
+ 	jumpHasFixedFields := cogit JumpBelowOrEqual: 0.
+ 					cogit CmpCq: objectMemory firstShortFormat R: formatReg.
+ 	jumpIsShorts := cogit JumpAboveOrEqual: 0.
+ 					cogit CmpCq: objectMemory firstLongFormat R: formatReg.
+ 	jumpIsWords := cogit JumpAboveOrEqual: 0.
+ 	"For now ignore 64-bit indexability."
+ 	jumpNotIndexable jmpTarget: cogit Label.
+ 	jumpNotIndexable := cogit Jump: 0.
+ 
+ 	jumpIsBytes jmpTarget:
+ 		(cogit LogicalShiftLeftCq: objectMemory shiftForWord R: ClassReg).
+ 		cogit AndCq: objectMemory wordSize - 1 R: formatReg.
+ 		cogit SubR: formatReg R: ClassReg;
+ 		CmpR: Arg1Reg R: ClassReg.
+ 	jumpBytesOutOfBounds := cogit JumpBelowOrEqual: 0.
+ 	cogit AddCq: objectMemory baseHeaderSize R: Arg1Reg.
+ 	cogit MoveXbr: Arg1Reg R: ReceiverResultReg R: ReceiverResultReg.
+ 	self genConvertIntegerToSmallIntegerInReg: ReceiverResultReg.
+ 	jumpBytesDone := cogit Jump: 0.
+ 
+ 	jumpIsShorts jmpTarget:
+ 		(cogit LogicalShiftLeftCq: objectMemory shiftForWord - 1 R: ClassReg).
+ 		cogit AndCq: 1 R: formatReg.
+ 		cogit SubR: formatReg R: ClassReg;
+ 		CmpR: Arg1Reg R: ClassReg.
+ 	jumpShortsOutOfBounds := cogit JumpBelowOrEqual: 0.
+ 	cogit AddR: Arg1Reg R: ReceiverResultReg.
+ 	cogit MoveM16: objectMemory baseHeaderSize r: ReceiverResultReg R: ReceiverResultReg.
+ 	self genConvertIntegerToSmallIntegerInReg: ReceiverResultReg.
+ 	jumpShortsDone := cogit Jump: 0.
+ 
+ 	jumpIsWords jmpTarget:
+ 		(cogit CmpR: Arg1Reg R: ClassReg).
+ 	jumpWordsOutOfBounds := cogit JumpBelowOrEqual: 0.
+ 	cogit AddCq: objectMemory baseHeaderSize >>  (objectMemory shiftForWord - 1) R: Arg1Reg.
+ 	cogit MoveX32r: Arg1Reg R: ReceiverResultReg R: TempReg.
+ 	cogit MoveR: TempReg R: ReceiverResultReg.
+ 	self genConvertIntegerToSmallIntegerInReg: ReceiverResultReg.
+ 	jumpWordsDone := cogit Jump: 0.
+ 
+ 	jumpHasFixedFields jmpTarget:
+ 		(cogit AndCq: objectMemory classIndexMask R: TempReg).
+ 	cogit MoveR: TempReg R: formatReg.
+ 	cogit CmpCq: ClassMethodContextCompactIndex R: TempReg.
+ 	jumpIsContext := cogit JumpZero: 0.
+ 	self genGetClassObjectOfClassIndex: formatReg into: Scratch0Reg scratchReg: TempReg.
+ 	self genLoadSlot: InstanceSpecificationIndex sourceReg: Scratch0Reg destReg: formatReg.
+ 	self genConvertSmallIntegerToIntegerInReg: formatReg.
+ 	cogit
+ 		AndCq: objectMemory fixedFieldsOfClassFormatMask R: formatReg;
+ 		SubR: formatReg R: ClassReg;
+ 		CmpR: Arg1Reg R: ClassReg.
+ 	jumpFixedFieldsOutOfBounds := cogit JumpBelowOrEqual: 0.
+ 	"index is (formatReg (fixed fields) + Arg1Reg (0-rel index)) * wordSize + baseHeaderSize"
+ 	cogit AddR: formatReg R: Arg1Reg.
+ 	cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg1Reg.
+ 	cogit MoveXwr: Arg1Reg R: ReceiverResultReg R: ReceiverResultReg.
+ 	jumpFixedFieldsDone := cogit Jump: 0.
+ 
+ 	jumpIsArray jmpTarget:
+ 		(cogit CmpR: Arg1Reg R: ClassReg).
+ 	jumpArrayOutOfBounds := cogit JumpBelowOrEqual: 0.	
+ 	cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg1Reg.
+ 	cogit MoveXwr: Arg1Reg R: ReceiverResultReg R: ReceiverResultReg.
+ 
+ 	jumpFixedFieldsDone jmpTarget:
+ 	(jumpWordsDone jmpTarget:
+ 	(jumpShortsDone jmpTarget:
+ 	(jumpBytesDone jmpTarget:
+ 		(cogit RetN: retNoffset)))).
+ 
+ 	jumpFixedFieldsOutOfBounds jmpTarget:
+ 	(jumpArrayOutOfBounds jmpTarget:
+ 	(jumpBytesOutOfBounds jmpTarget:
+ 	(jumpShortsOutOfBounds jmpTarget:
+ 	(jumpWordsOutOfBounds jmpTarget:
+ 	(jumpNotIndexable jmpTarget:
+ 	(jumpIsContext jmpTarget:
+ 	(jumpBadIndex jmpTarget:
+ 	(jumpImmediate jmpTarget: cogit Label)))))))).
+ 
+ 	^0!

Item was added:
+ ----- Method: CogObjectRepresentationForSpur>>genGetNumSlotsOf:into: (in category 'compile abstract instructions') -----
+ genGetNumSlotsOf: srcReg into: destReg
+ 	"Get the size in word-sized slots of the object in srcReg into destReg.
+ 	 srcReg may equal destReg."
+ 	<var: #jmp type: #'AbstractInstruction *'>
+ 	| jmp |
+ 	self assert: srcReg ~= destReg.
+ 	self genGetRawSlotSizeOfNonImm: srcReg into: destReg.
+ 	cogit CmpCq: objectMemory numSlotsMask R: destReg.
+ 	jmp := cogit JumpLess: 0.
+ 	self genGetOverflowSlotsOf: srcReg into: destReg.
+ 	jmp jmpTarget: cogit Label.
+ 	^0!

Item was changed:
  ----- Method: CogObjectRepresentationForSpur>>genGetRawSlotSizeOfNonImm:into: (in category 'compile abstract instructions') -----
  genGetRawSlotSizeOfNonImm: sourceReg into: destReg
  	"The raw numSlots field is the most significant byte of the 64-bit header word.
  	 MoveMbrR zero-extends."
  	cogit backEnd byteReadsZeroExtend ifFalse:
+ 		[cogit MoveCq: 0 R: destReg].
- 		[self MoveCq: 0 R: destReg].
  	cogit MoveMb: 7 r: sourceReg R: destReg.
  	^0!

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

Item was changed:
  ----- Method: CogX64Compiler>>computeMaximumSize (in category 'generate machine code') -----
  computeMaximumSize
  	"Compute the maximum size for each opcode.  This allows jump offsets to
  	 be determined, provided that all backward branches are long branches."
  	"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].
  		[AlignmentNops]		-> [^(operands at: 0) - 1].
  		[Fill16]					-> [^2].
  		[Fill32]					-> [^4].
  		[FillFromWord]			-> [^4].
  		[Nop]					-> [^1].
  		"Specific Control/Data Movement"
  		[CDQ]					-> [^2].
  		[IDIVR]					-> [^3].
  		[IMULRR]				-> [^4].
  		[CPUID]					-> [^2].
  		[CMPXCHGAwR]			-> [^8].
  		[CMPXCHGMwrR]		-> [^9].
  		[LFENCE]				-> [^3].
  		[MFENCE]				-> [^3].
  		[SFENCE]				-> [^3].
  		[LOCK]					-> [^1].
  		"[XCHGAwR]				-> [^6].
  		[XCHGMwrR]			-> [^7]."
  		[XCHGRR]				-> [^((self concreteRegister: (operands at: 0)) = RAX
  									   or: [(self concreteRegister: (operands at: 1)) = RAX])
  											ifTrue: [2]
  											ifFalse: [3]].
  		"Control"
  		[CallFull]					-> [^12].
  		[Call]						-> [^5].
  		[JumpR]						-> [^2].
  		[JumpFull]					-> [self resolveJumpTarget. ^12].
  		[JumpLong]					-> [self resolveJumpTarget. ^5].
  		[Jump]						-> [self resolveJumpTarget. ^5].
  		[JumpZero]					-> [self resolveJumpTarget. ^6].
  		[JumpNonZero]				-> [self resolveJumpTarget. ^6].
  		[JumpNegative]				-> [self resolveJumpTarget. ^6].
  		[JumpNonNegative]			-> [self resolveJumpTarget. ^6].
  		[JumpOverflow]				-> [self resolveJumpTarget. ^6].
  		[JumpNoOverflow]			-> [self resolveJumpTarget. ^6].
  		[JumpCarry]				-> [self resolveJumpTarget. ^6].
  		[JumpNoCarry]				-> [self resolveJumpTarget. ^6].
  		[JumpLess]					-> [self resolveJumpTarget. ^6].
  		[JumpGreaterOrEqual]		-> [self resolveJumpTarget. ^6].
  		[JumpGreater]				-> [self resolveJumpTarget. ^6].
  		[JumpLessOrEqual]			-> [self resolveJumpTarget. ^6].
  		[JumpBelow]				-> [self resolveJumpTarget. ^6].
  		[JumpAboveOrEqual]		-> [self resolveJumpTarget. ^6].
  		[JumpAbove]				-> [self resolveJumpTarget. ^6].
  		[JumpBelowOrEqual]		-> [self resolveJumpTarget. ^6].
  		[JumpLongZero]			-> [self resolveJumpTarget. ^6].
  		[JumpLongNonZero]		-> [self resolveJumpTarget. ^6].
  		[JumpFPEqual]				-> [self resolveJumpTarget. ^6].
  		[JumpFPNotEqual]			-> [self resolveJumpTarget. ^6].
  		[JumpFPLess]				-> [self resolveJumpTarget. ^6].
  		[JumpFPGreaterOrEqual]	-> [self resolveJumpTarget. ^6].
  		[JumpFPGreater]			-> [self resolveJumpTarget. ^6].
  		[JumpFPLessOrEqual]		-> [self resolveJumpTarget. ^6].
  		[JumpFPOrdered]			-> [self resolveJumpTarget. ^6].
  		[JumpFPUnordered]			-> [self resolveJumpTarget. ^6].
  		[RetN]						-> [^(operands at: 0) = 0 ifTrue: [1] ifFalse: [3]].
  		[Stop]						-> [^1].
  
  		"Arithmetic"
  		[AddCqR]		-> [^self computeSizeOfArithCqR].
  		[AndCqR]		-> [^self computeSizeOfArithCqR].
  		[CmpCqR]		-> [^self computeSizeOfArithCqR].
  		[OrCqR]			-> [^self computeSizeOfArithCqR].
  		[SubCqR]		-> [^self computeSizeOfArithCqR].
  		[TstCqR]		-> [^self computeSizeOfArithCqR].
  		[AddCwR]		-> [^self computeSizeOfArithCwR].
  		[AndCwR]		-> [^self computeSizeOfArithCwR].
  		[CmpCwR]		-> [^self computeSizeOfArithCwR].
  		[OrCwR]		-> [^self computeSizeOfArithCwR].
  		[SubCwR]		-> [^self computeSizeOfArithCwR].
  		[XorCwR]		-> [^self computeSizeOfArithCwR].
  		[AddRR]			-> [^3].
  		[AndRR]			-> [^3].
  		[CmpRR]		-> [^3].
  		[OrRR]			-> [^3].
  		[XorRR]			-> [^3].
  		[SubRR]			-> [^3].
  		[NegateR]		-> [^3].
  		[LoadEffectiveAddressMwrR]
  						-> [^((self isQuick: (operands at: 0))
  									ifTrue: [4]
  									ifFalse: [7])
  								+ (((self concreteRegister: (operands at: 1)) bitAnd: 7) = RSP
  									ifTrue: [1]
  									ifFalse: [0])].
  		[LogicalShiftLeftCqR]		-> [^self computeShiftCqRegSize].
  		[LogicalShiftRightCqR]		-> [^self computeShiftCqRegSize].
  		[ArithmeticShiftRightCqR]	-> [^self computeShiftCqRegSize].
  		[LogicalShiftLeftRR]			-> [^self computeShiftRRSize].
  		[LogicalShiftRightRR]		-> [^self computeShiftRRSize].
  		[ArithmeticShiftRightRR]		-> [^self computeShiftRRSize].
  		[AddRdRd]					-> [^4].
  		[CmpRdRd]					-> [^4].
  		[SubRdRd]					-> [^4].
  		[MulRdRd]					-> [^4].
  		[DivRdRd]					-> [^4].
  		[SqrtRd]					-> [^4].
  		"Data Movement"
  		[MoveCqR]		-> [^(operands at: 0) = 0
  								ifTrue: [3]
  								ifFalse:
  									[(self is32BitSignedImmediate: (operands at: 0))
  										ifTrue: [7]
  										ifFalse: [self moveCwRByteSize]]].
  		[MoveCwR]		-> [^(self inCurrentCompilation: (operands at: 0))
  								ifTrue: [7]
  								ifFalse: [self moveCwRByteSize]].
  		[MoveC32R]	-> [^7]. "N.B. Always inlined."
  		[MoveRR]		-> [^3].
  		[MoveRdRd]		-> [^4].
  		[MoveAwR]		-> [^(self isAddressRelativeToVarBase: (operands at: 0))
  								ifTrue: [7]
  								ifFalse: [(self concreteRegister: (operands at: 1)) = RAX ifTrue: [10] ifFalse: [14]]].
  		[MoveRAw]		-> [^(self isAddressRelativeToVarBase: (operands at: 1))
  								ifTrue: [7]
  								ifFalse: [(self concreteRegister: (operands at: 0)) = RAX ifTrue: [10] ifFalse: [14]]].
  		[MoveAbR]		-> [^(self isAddressRelativeToVarBase: (operands at: 0))
  								ifTrue: [7]
  								ifFalse: [(self concreteRegister: (operands at: 1)) = RAX ifTrue: [10] ifFalse: [14]]].
  		[MoveRAb]		-> [^(self isAddressRelativeToVarBase: (operands at: 1))
  								ifTrue: [7]
  								ifFalse: [(self concreteRegister: (operands at: 0)) = RAX ifTrue: [10] ifFalse: [14]]].
  		[MoveRMwr]	-> [self assert: (self is32BitSignedImmediate: (operands at: 1)).
  							^((self isQuick: (operands at: 1))
  									ifTrue: [((operands at: 1) = 0
  											and: [((self concreteRegister: (operands at: 2)) bitAnd: 7) ~= RBP])
  												ifTrue: [3]
  												ifFalse: [4]]
  									ifFalse: [7])
  								+ (((self concreteRegister: (operands at: 2)) bitAnd: 7) = RSP
  									ifTrue: [1]
  									ifFalse: [0])].
  		"[MoveRdM64r]	-> [^((self isQuick: (operands at: 1))
  											ifTrue: [5]
  											ifFalse: [8])
  										+ ((self concreteRegister: (operands at: 2)) = ESP
  											ifTrue: [1]
  											ifFalse: [0])]."
  		[MoveMbrR]		-> [self assert: (self is32BitSignedImmediate: (operands at: 0)).
  							^((self isQuick: (operands at: 0))
  									ifTrue: [((operands at: 0) = 0
  											and: [((self concreteRegister: (operands at: 1)) bitAnd: 7) ~= RBP])
  												ifTrue: [3]
  												ifFalse: [4]]
  									ifFalse: [7])
  								+ (((self concreteRegister: (operands at: 1)) bitAnd: 7) = RSP
  									ifTrue: [1]
  									ifFalse: [0])].
  		[MoveRMbr]		-> [self assert: (self is32BitSignedImmediate: (operands at: 1)).
  							^((self isQuick: (operands at: 1))
  									ifTrue: [((operands at: 1) = 0
  											and: [((self concreteRegister: (operands at: 0)) bitAnd: 7) ~= RBP])
  												ifTrue: [3]
  												ifFalse: [4]]
  									ifFalse: [7])
  								+ (((self concreteRegister: (operands at: 2)) bitAnd: 7) = RSP
  									ifTrue: [1]
  									ifFalse: [0])].
  		[MoveM16rR]	-> [^((self isQuick: (operands at: 0))
  									ifTrue: [((operands at: 0) = 0
  											and: [((self concreteRegister: (operands at: 1)) bitAnd: 7) ~= RBP])
  												ifTrue: [4]
  												ifFalse: [5]]
  									ifFalse: [8])
  								+ (((self concreteRegister: (operands at: 1)) bitAnd: 7) = RSP
  									ifTrue: [1]
  									ifFalse: [0])].
  		"[MoveM64rRd]	-> [^((self isQuick: (operands at: 0))
  											ifTrue: [5]
  											ifFalse: [8])
  										+ ((self concreteRegister: (operands at: 1)) = ESP
  											ifTrue: [1]
  											ifFalse: [0])]."
  		[MoveMwrR]		-> [self assert: (self is32BitSignedImmediate: (operands at: 0)).
  								^((self isQuick: (operands at: 0))
  									ifTrue: [((operands at: 0) = 0
  											and: [((self concreteRegister: (operands at: 1)) bitAnd: 7) ~= RBP])
  												ifTrue: [3]
  												ifFalse: [4]]
  									ifFalse: [7])
  								+ (((self concreteRegister: (operands at: 1)) bitAnd: 7) = RSP
  									ifTrue: [1]
  									ifFalse: [0])].
  		[MoveXbrRR]	-> [self assert: (self concreteRegister: (operands at: 0)) ~= RSP.
  							^((self concreteRegister: (operands at: 1)) bitAnd: 7) = RBP
  											ifTrue: [5]
  											ifFalse: [4]].
  		[MoveRXbrR]	->	[self assert: (self concreteRegister: (operands at: 1)) ~= RSP.
  							^(((self concreteRegister: (operands at: 0)) < 8
  							   and: [(self concreteRegister: (operands at: 1)) < 8
  							   and: [(self concreteRegister: (operands at: 2)) < 8]])
  								ifTrue: [3]
  								ifFalse: [4])
  							+ (((self concreteRegister: (operands at: 2)) bitAnd: 7) = RBP
  											ifTrue: [1]
  											ifFalse: [0])].
  		[MoveXwrRR]	-> [self assert: (self concreteRegister: (operands at: 0)) ~= RSP.
  							^((self concreteRegister: (operands at: 1)) = RBP
  							   or: [(self concreteRegister: (operands at: 1)) = R13])
  											ifTrue: [5]
  											ifFalse: [4]].
  		[MoveRXwrR]	-> [self assert: (self concreteRegister: (operands at: 1)) ~= RSP.
  							^((self concreteRegister: (operands at: 2)) = RBP
  							   or: [(self concreteRegister: (operands at: 2)) = R13])
  											ifTrue: [5]
  											ifFalse: [4]].
+ 		[MoveX32rRR]	-> [self assert: (self concreteRegister: (operands at: 0)) ~= RSP.
+ 							^(((self concreteRegister: (operands at: 1)) = RBP
+ 							   or: [(self concreteRegister: (operands at: 1)) = R13])
+ 										ifTrue: [7]
+ 										ifFalse: [6])
+ 							 + (((self concreteRegister: (operands at: 0)) > 7
+ 							     or: [(self concreteRegister: (operands at: 1)) > 7
+ 							     or: [(self concreteRegister: (operands at: 2)) > 7]])
+ 										ifTrue: [1]
+ 										ifFalse: [0])].
  		[PopR]			-> [^(self concreteRegister: (operands at: 0)) < 8 ifTrue: [1] ifFalse: [2]].
  		[PushR]			-> [^(self concreteRegister: (operands at: 0)) < 8 ifTrue: [1] ifFalse: [2]].
  		[PushCq]		-> [^(self isQuick: (operands at: 0)) ifTrue: [2] ifFalse: [5]].
  		[PushCw]		-> [^(self inCurrentCompilation: (operands at: 0))
  								ifTrue: [9]
  								ifFalse: [self pushCwByteSize]].
  		[PrefetchAw]	-> [^(self isAddressRelativeToVarBase: (operands at: 0)) ifTrue: [7] ifFalse: [0]].
  		"Conversion"
  		"[ConvertRRd]	-> [^4]" }.
  	^0 "to keep C compiler quiet"!

Item was changed:
  ----- Method: CogX64Compiler>>concretizeIDIVR (in category 'generate machine code') -----
  concretizeIDIVR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| regDivisor |
  	regDivisor := self concreteRegister: (operands at: 0).
  	machineCode
+ 		at: 0 put: (self rexR: 0 x: 0 b: regDivisor);
- 		at: 0 put: (self rexR: regDivisor x: 0 b: 0);
  		at: 1 put: 16rF7;
  		at: 2 put: (self mod: ModReg RM: regDivisor RO: 7).
  	^machineCodeSize := 3!

Item was added:
+ ----- Method: CogX64Compiler>>concretizeMoveX32rRR (in category 'generate machine code') -----
+ concretizeMoveX32rRR
+ 	"MoveX32rRR is expected to zero-extend, so explicitly zero the destination."
+ 	| index base dest offset |
+ 	index := self concreteRegister: (operands at: 0).
+ 	base := self concreteRegister: (operands at: 1).
+ 	dest := self concreteRegister: (operands at: 2).
+ 	machineCode
+ 		at: 0 put: (self rexR: dest x: 0 b: dest);
+ 		at: 1 put: 16r31;
+ 		at: 2 put: (self mod: ModReg RM: dest RO: dest).
+ 	(index > 7 or: [base > 7 or: [dest > 7]])
+ 		ifTrue:
+ 			[machineCode at: 3 put: (self rexw: false r: dest x: index b: base).
+ 			 offset := 1]
+ 		ifFalse:
+ 			[offset := 0].
+ 	(base bitAnd: 7) ~= RBP ifTrue:
+ 		[machineCode
+ 			at: offset + 3 put: 16r8B;
+ 			at: offset + 4 put: (self mod: ModRegInd RM: 4 RO: dest);
+ 			at: offset + 5 put: (self s: SIB4 i: index b: base).
+ 		 ^machineCodeSize := offset + 6].
+ 	machineCode
+ 		at: offset + 3 put: 16r8B;
+ 		at: offset + 4 put: (self mod: ModRegRegDisp8 RM: 4 RO: dest);
+ 		at: offset + 5 put: (self s: SIB4 i: index b: base);
+ 		at: offset + 6 put: 0.
+ 	 ^machineCodeSize := offset + 7!

Item was changed:
  ----- Method: CogX64Compiler>>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>
  	opcode caseOf: {
  		"Noops & Pseudo Ops"
  		[Label]				-> [^self concretizeLabel].
  		[AlignmentNops]	-> [^self concretizeAlignmentNops].
  		[Fill16]				-> [^self concretizeFill16].
  		[Fill32]				-> [^self concretizeFill32].
  		[FillFromWord]		-> [^self concretizeFillFromWord].
  		[Nop]				-> [^self concretizeNop].
  		"Specific Control/Data Movement"
  		[CDQ]					-> [^self concretizeCDQ].
  		[IDIVR]					-> [^self concretizeIDIVR].
  		[IMULRR]				-> [^self concretizeMulRR].
  		[CPUID]					-> [^self concretizeCPUID].
  		[CMPXCHGAwR]			-> [^self concretizeCMPXCHGAwR].
  		[CMPXCHGMwrR]		-> [^self concretizeCMPXCHGMwrR].
  		[LFENCE]				-> [^self concretizeFENCE: 5].
  		[MFENCE]				-> [^self concretizeFENCE: 6].
  		[SFENCE]				-> [^self concretizeFENCE: 7].
  		[LOCK]					-> [^self concretizeLOCK].
  		[XCHGAwR]				-> [^self concretizeXCHGAwR].
  		[XCHGMwrR]			-> [^self concretizeXCHGMwrR].
  		[XCHGRR]				-> [^self concretizeXCHGRR].
  		"Control"
  		[Call]					-> [^self concretizeCall].
  		[CallFull]				-> [^self concretizeCallFull].
  		[JumpR]					-> [^self concretizeJumpR].
  		[JumpFull]				-> [^self concretizeJumpFull].
  		[JumpLong]				-> [^self concretizeJumpLong].
  		[JumpLongZero]		-> [^self concretizeConditionalJump: 16r4].
  		[JumpLongNonZero]	-> [^self concretizeConditionalJump: 16r5].
  		[Jump]					-> [^self concretizeJump].
  		"Table B-1 Intel® 64 and IA-32 Architectures Software Developer's Manual Volume 1: Basic Architecture"
  		[JumpZero]				-> [^self concretizeConditionalJump: 16r4].
  		[JumpNonZero]			-> [^self concretizeConditionalJump: 16r5].
  		[JumpNegative]			-> [^self concretizeConditionalJump: 16r8].
  		[JumpNonNegative]		-> [^self concretizeConditionalJump: 16r9].
  		[JumpOverflow]			-> [^self concretizeConditionalJump: 16r0].
  		[JumpNoOverflow]		-> [^self concretizeConditionalJump: 16r1].
  		[JumpCarry]			-> [^self concretizeConditionalJump: 16r2].
  		[JumpNoCarry]			-> [^self concretizeConditionalJump: 16r3].
  		[JumpLess]				-> [^self concretizeConditionalJump: 16rC].
  		[JumpGreaterOrEqual]	-> [^self concretizeConditionalJump: 16rD].
  		[JumpGreater]			-> [^self concretizeConditionalJump: 16rF].
  		[JumpLessOrEqual]		-> [^self concretizeConditionalJump: 16rE].
  		[JumpBelow]			-> [^self concretizeConditionalJump: 16r2].
  		[JumpAboveOrEqual]	-> [^self concretizeConditionalJump: 16r3].
  		[JumpAbove]			-> [^self concretizeConditionalJump: 16r7].
  		[JumpBelowOrEqual]	-> [^self concretizeConditionalJump: 16r6].
  		[JumpFPEqual]				-> [^self concretizeConditionalJump: 16r4].
  		[JumpFPNotEqual]			-> [^self concretizeConditionalJump: 16r5].
  		[JumpFPLess]				-> [^self concretizeConditionalJump: 16r2].
  		[JumpFPGreaterOrEqual]	-> [^self concretizeConditionalJump: 16r3].
  		[JumpFPGreater]			-> [^self concretizeConditionalJump: 16r7].
  		[JumpFPLessOrEqual]		-> [^self concretizeConditionalJump: 16r6].
  		[JumpFPOrdered]			-> [^self concretizeConditionalJump: 16rB].
  		[JumpFPUnordered]			-> [^self concretizeConditionalJump: 16rA].
  		[RetN]						-> [^self concretizeRetN].
  		[Stop]						-> [^self concretizeStop].
  		"Arithmetic"
  		[AddCqR]					-> [^self concretizeArithCqRWithRO: 0 raxOpcode: 15r05].
  		[AddCwR]					-> [^self concretizeArithCwR: 16r03].
  		[AddRR]						-> [^self concretizeAddRR].
  		[AddRdRd]					-> [^self concretizeSEE2OpRdRd: 16r58].
  		[AndCqR]					-> [^self concretizeArithCqRWithRO: 4 raxOpcode: 16r25].
  		[AndCwR]					-> [^self concretizeArithCwR: 16r23].
  		[AndRR]						-> [^self concretizeAndRR].
  		[TstCqR]					-> [^self concretizeTstCqR].
  		[CmpCqR]					-> [^self concretizeArithCqRWithRO: 7 raxOpcode: 16r3D].
  		[CmpCwR]					-> [^self concretizeArithCwR: 16r39].
  		[CmpRR]					-> [^self concretizeCmpRR].
  		[CmpRdRd]					-> [^self concretizeCmpRdRd].
  		[DivRdRd]					-> [^self concretizeSEE2OpRdRd: 16r5E].
  		[MulRdRd]					-> [^self concretizeSEE2OpRdRd: 16r59].
  		[OrCqR]						-> [^self concretizeArithCqRWithRO: 1 raxOpcode: 16r0D].
  		[OrCwR]					-> [^self concretizeArithCwR: 16r0B].
  		[OrRR]						-> [^self concretizeOrRR].
  		[SubCqR]					-> [^self concretizeArithCqRWithRO: 5 raxOpcode: 16r2D].
  		[SubCwR]					-> [^self concretizeArithCwR: 16r2B].
  		[SubRR]						-> [^self concretizeSubRR].
  		[SubRdRd]					-> [^self concretizeSEE2OpRdRd: 16r5C].
  		[SqrtRd]					-> [^self concretizeSqrtRd].
  		[XorCwR]					-> [^self concretizeArithCwR: 16r33].
  		[XorRR]						-> [^self concretizeXorRR].
  		[NegateR]					-> [^self concretizeNegateR].
  		[LoadEffectiveAddressMwrR]	-> [^self concretizeLoadEffectiveAddressMwrR].
  		[ArithmeticShiftRightCqR]		-> [^self concretizeShiftCqRegOpcode: 7].
  		[LogicalShiftRightCqR]			-> [^self concretizeShiftCqRegOpcode: 5].
  		[LogicalShiftLeftCqR]			-> [^self concretizeShiftCqRegOpcode: 4].
  		[ArithmeticShiftRightRR]			-> [^self concretizeShiftRegRegOpcode: 7].
  		[LogicalShiftLeftRR]				-> [^self concretizeShiftRegRegOpcode: 4].
  		"Data Movement"
  		[MoveCqR]			-> [^self concretizeMoveCqR].
  		[MoveCwR]			-> [^self concretizeMoveCwR].
  		[MoveC32R]		-> [^self concretizeMoveC32R].
  		[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].
+ 		[MoveX32rRR]		-> [^self concretizeMoveX32rRR].
  		[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: CogX64CompilerForTests class>>doubleWordRegistersWithNamesDo: (in category 'test support') -----
+ doubleWordRegistersWithNamesDo: aBinaryBlock
+ 	self registers
+ 		with: #('%eax' '%ecx' '%edx' '%ebx' '%esp' '%ebp' '%esi' '%edi' '%r8d' '%r9d' '%r10d' '%r11d' '%r12d' '%r13d' '%r14d' '%r15d')
+ 		do: aBinaryBlock!

Item was changed:
  ----- Method: CogX64CompilerTests>>testDivQuoRem (in category 'tests') -----
  testDivQuoRem
  	"| failures ops |
  	 failures := Set new.
  	 [ops := (CogX64CompilerTests new testDivQuoRem)]
  		on: TestResult failure
  		do: [:ex| | c |
  			c := ex signalerContext.
  			[c tempNames includes: 'op'] whileFalse:
  				[c := c sender].
  			failures add: (c namedTempAt: (c tempNames indexOf: 'op')).
  			ex resume].
  	 { ops size. failures size. ops asSortedCollection asArray. failures asSortedCollection asArray}"
  	| map compiler memory ops |
  	map := Dictionary new.
  	compiler := self gen: nil.
  	memory := ByteArray new: 4096 * 2.
  	ops := Set new.
  	self concreteCompilerClass dataRegistersWithAccessorsExcept: #(rbp rsp) do:
  		[:sreg :srget :srset|
  		self concreteCompilerClass dataRegistersWithAccessorsExcept: { #rbp. #rsp. srget } do:
  			[:dreg :drget :drset|
  			 | instructions op |
  			self concreteCompilerClass dataRegistersWithAccessorsExcept: #(rbp rsp) do:
  				[:qreg :qrget :qrset| 
  				self concreteCompilerClass dataRegistersWithAccessorsExcept: { #rbp. #rsp. qrget } do:
  					[:rreg :rrget :rrset|
  					self resetGen.
  					op := qrget, ' := ', drget, ' quo: ', srget, '. ', rrget, ' := ', drget, ' rem: ', srget.
  					ops add: op.
  					compiler genDivR: sreg R: dreg Quo: qreg Rem: rreg.
  					instructions := self generateInstructions.
  					memory atAllPut: 0; replaceFrom: 1 to: instructions size with: instructions startingAt: 1; at: instructions size + 1 put: self processor nopOpcode.
  					#(-768 -456 -123 123 456 789)
  						with: #(987 654 321 -321 -654 -987)
  						do: [:dd :dv| "| calc mask |
  							mask := 16rFFFFFFFFFFFFFFFF.
  							calc := ((dd quo: dv) bitAnd: mask) hex, ' := ', (dd bitAnd: mask) hex, ' quo: ', (dv bitAnd: mask) hex, '. ', ((dd rem: dv) bitAnd: mask) hex, ' := ', (dd bitAnd: mask) hex, ' rem: ', (dv bitAnd: mask) hex.
  							calc := calc."
  							"Transcript cr; cr; nextPutAll: op; cr; nextPutAll: calc; cr.
  							 self processor
  								disassembleFrom: 0 to: instructions size in: memory on: Transcript;
  								printIntegerRegistersOn: Transcript."
  							map
  								at: #rax put: (self processor rax: 16rA5A5A5A5);
  								at: #rbx put: (self processor rbx: 16rB5B5B5B5);
  								at: #rcx put: (self processor rcx: 16rC5C5C5C5);
  								at: #rdx put: (self processor rdx: 16rD5D5D5D5);
  								at: #rsi put: (self processor rsi: 16r51515151);
  								at: #rdi put: (self processor rdi: 16rD1D1D1D1);
  								at: srget put: (self processor perform: srset with: (self processor convertIntegerToInternal: dv));
  								at: drget put: (self processor perform: drset with: (self processor convertIntegerToInternal: dd)).
  							self processor rsp: memory size; rip: 0.
  							self shouldnt:
  								[[self processor pc < instructions size] whileTrue:
  									[self processor singleStepIn: memory readExecuteOnlyBelow: memory size / 2]]
  								raise: Error.
  							map
  								at: qrget put: (self processor convertIntegerToInternal: (dd quo: dv));
  								at: rrget put: (self processor convertIntegerToInternal: (dd rem: dv)).
  							map keysAndValuesDo:
  								[:accessor :value|
+ 								self assert: value equals: (self processor perform: accessor)]]]]]].
- 								self assert: value = (self processor perform: accessor)]]]]]].
  	^ops!

Item was added:
+ ----- Method: CogX64CompilerTests>>testMoveX32rRR (in category 'tests') -----
+ testMoveX32rRR
+ 	"self new testMoveX32rRR"
+ 	self concreteCompilerClass registersWithNamesDo:
+ 		[:idxreg :irname|
+ 			irname ~= '%rsp' ifTrue:
+ 				[self concreteCompilerClass registersWithNamesDo:
+ 					[:basereg :brname|
+ 					self concreteCompilerClass doubleWordRegistersWithNamesDo:
+ 						[:dreg :drname|
+ 						((1 to: 19 by: 3) collect: [:po2| 2 raisedToInteger: po2]) do:
+ 							[:offset| | inst len |
+ 							inst := self gen: MoveX32rRR operand: idxreg operand: basereg operand: dreg.
+ 							len := inst concretizeAt: 0.
+ 							self processor
+ 								disassembleInstructionAt: 3
+ 								In: inst machineCode object
+ 								into: [:str :sz| | plainJane herIntended |
+ 									"Convert e.g. '00000000: movl %eax, 0x2(%eax) : 89 40 02' to  'movl %eax, 0x2(%eax)'"
+ 									plainJane := self strip: str.
+ 									herIntended := 'movl (', brname, ',', irname, ',4), ',drname.
+ 									self assert: (plainJane match: herIntended).
+ 									self assert: len - 3 = sz]]]]]]!

Item was added:
+ ----- Method: Cogit>>MoveX32r:R:R: (in category 'abstract instructions') -----
+ MoveX32r: indexReg R: baseReg R: destReg
+ 	<inline: true>
+ 	<returnTypeC: #'AbstractInstruction *'>
+ 	^self gen: MoveX32rRR operand: indexReg operand: baseReg operand: destReg!



More information about the Vm-dev mailing list