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

commits at source.squeak.org commits at source.squeak.org
Fri Mar 20 18:00:43 UTC 2015


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

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

Name: VMMaker.oscog-eem.1105
Author: eem
Time: 20 March 2015, 10:58:51.231 am
UUID: 57fdb1dc-a1be-40c3-a5a3-1ccc60068cfe
Ancestors: VMMaker.oscog-eem.1104

Implement genMulR:R: for ARM.  Only 4 instructions :)
Provide support for conditional instructions, even
though the multiply sequence doesn't need them.
It will be useful later on.

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

Item was changed:
  CogAbstractInstruction subclass: #CogARMCompiler
+ 	instanceVariableNames: 'cond'
+ 	classVariableNames: 'AL AddOpcode AndOpcode BICCqR BicOpcode CArg0Reg CArg1Reg CArg2Reg CArg3Reg CC CPSRReg CS CmpOpcode CondHI CondLS EQ GE GT HI LDMFD LE LR LS LT MI MRS MSR 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'
- 	instanceVariableNames: ''
- 	classVariableNames: 'AL AddOpcode AndOpcode BICCqR BicOpcode CArg0Reg CArg1Reg CArg2Reg CArg3Reg CC CS CmpOpcode EQ GE GT HI LDMFD LE LR LS LT MI MoveOpcode NE OrOpcode PC PL R0 R1 R10 R11 R12 R2 R3 R4 R5 R6 R7 R8 R9 RsbOpcode 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 added:
+ ----- Method: CogARMCompiler class>>filteredInstVarNames (in category 'translation') -----
+ filteredInstVarNames
+ 	"Edit such that cond is amongst the char size vars opcode machineCodeSize and maxSize."
+ 	^(super filteredInstVarNames copyWithout: 'cond')
+ 		copyReplaceFrom: 4 to: 3 with: #('cond')!

Item was changed:
  ----- Method: CogARMCompiler class>>initialize (in category 'class initialization') -----
  initialize
  	
  	"Initialize various ARM instruction-related constants."
  	"CogARMCompiler initialize"
  	
  	| specificOpcodes refs |
  	super initialize.
  	self ~~ CogARMCompiler ifTrue: [^self].
  	
  	R0 := 0.
  	R1 := 1.
  	R2 := 2.
  	R3 := 3.
  	R4 := 4.
  	R5 := 5.
  	R6 := 6.
  	R7 := 7.
  	R8 := 8.
  	R9 := 9.
  	R10 := 10.
  	R11 := 11.
  	R12 := 12..
  	SP := 13..
  	LR := 14.
  	PC := 15.
  	
  	CArg0Reg := 0.
  	CArg1Reg := 1.
  	CArg2Reg := 2.
  	CArg3Reg := 3.
  	
  	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.
  	OrOpcode := 12.
  	RsbOpcode := 3.
  	SubOpcode := 2.
  	XorOpcode := 1.
+ 	SMLALOpcode := 7.
+ 
+ 	CondHI := 8.
+ 	CondLS := 9.
+ 	CPSRReg := 16.
+ 	OverflowFlag := 1 << 28.
+ 
  	"Specific instructions"
  	LastRTLCode isNil ifTrue:
  		[CogRTLOpcodes initialize].
+ 	specificOpcodes := #(SMULL MSR MRS LDMFD STMFD BICCqR).
- 	specificOpcodes := #(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>>concretizeConditionalInstruction (in category 'generate machine code') -----
+ concretizeConditionalInstruction
+ 	"Concretize the current instruction, but with a condition."
+ 	<returnTypeC: #void>
+ 	| savedCond |
+ 	self assert: cond notNil.
+ 	savedCond := cond.
+ 	cond := nil.
+ 	self dispatchConcretize.
+ 	cond := savedCond.
+ 	3 to: machineCodeSize by: 4 do:
+ 		[:i| | topByte |
+ 		 topByte := machineCode at: i.
+ 		 self assert: (topByte bitClear: 15) = 0.
+ 		 machineCode at: i put: cond << 4 + topByte]!

Item was added:
+ ----- Method: CogARMCompiler>>concretizeSMULL (in category 'generate machine code - concretize') -----
+ concretizeSMULL
+ 	| srcReg destReg hiReg loReg |
+ 	srcReg := self concreteRegister: (operands at: 0).
+ 	destReg := self concreteRegister: (operands at: 1).
+ 	hiReg := self concreteRegister: RISCTempReg.
+ 	loReg := self concreteRegister: TempReg.
+ 	self machineCodeAt: 0
+ 		put: (self type: 0 op: 6 set: 0 rn: hiReg rd: loReg)
+ 			+ (srcReg << 8)
+ 			+ (9 << 4)
+ 			+ destReg.
+ 	^machineCodeSize := 4!

Item was added:
+ ----- Method: CogARMCompiler>>cond (in category 'accessing') -----
+ cond
+ 	^cond!

Item was added:
+ ----- Method: CogARMCompiler>>cond: (in category 'accessing') -----
+ cond: condCode
+ 	^cond := condCode!

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].
- 		"Specific Control/Data Movement"
- 		"[LDM]					-> [^self concretizeLDM].
- 		[STM]					-> [^self concretizeSTM]."
  		"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].
  		[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]	}!
- 		[STMFD]			-> [^self concretizeSTMFD]	}!

Item was added:
+ ----- Method: CogARMCompiler>>genMulR:R: (in category 'abstract instructions') -----
+ genMulR: regSource R: regDest
+ 	"Use SMULL to produce a 64-bit result, implicitly in TempReg,RISCTempReg.
+ 	 Test the top word for 0 or 1 and set oVerflow if not equal.  Move result in
+ 	 TempReg into regDest."
+ 	<var: #inst type: #AbstractInstruction>
+ 
+ 	cogit
+ 		gen: SMULL operand: regSource operand: regDest; "result in TempReg,RISCTempReg"
+ 		AddCq: 1 R: RISCTempReg; "turn -1,0 into 0,1"
+ 		AddCq: -1 R: RISCTempReg; "turn 0,1 into not oVerflow"
+ 		MoveR: TempReg R: regDest!



More information about the Vm-dev mailing list