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

commits at source.squeak.org commits at source.squeak.org
Fri Jun 26 18:26:50 UTC 2015


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

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

Name: VMMaker.oscog-tpr.1386
Author: tpr
Time: 26 June 2015, 11:25:06.76 am
UUID: 440eb32a-a8d2-43de-931f-9915aba55157
Ancestors: VMMaker.oscog-tfel.1385

Add hardware FP support for ARM.
Runs all SUnit tests and assorted benchmarks ok, makes nbody 3X faster.
Probably some cleaning up to do, possibly more careful NaN handling etc.

=============== Diff against VMMaker.oscog-tfel.1385 ===============

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

Item was changed:
  ----- Method: CogARMCompiler class>>initialize (in category 'class initialization') -----
  initialize
  	
  	"Initialize various ARM instruction-related constants."
  	"CogARMCompiler initialize"
  	
  	| specificOpcodes refs |
  	super initialize.
  	self ~~ CogARMCompiler ifTrue: [^self].
  	
+ 	"ARM general registers"
  	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.
+ 	"ARM VFP Double precision floating point registers"
+ 	D0 := 0.
+ 	D1 := 1.
+ 	D2 := 2.
+ 	D3 := 3.
+ 	D4 := 4.
+ 	D5 := 5.
+ 	D6 := 6.
+ 	D7 := 7.
  	
+ 	
  	CArg0Reg := 0.
  	CArg1Reg := 1.
  	CArg2Reg := 2.
  	CArg3Reg := 3.
  
  	ConcreteVarBaseReg := 10.
  	ConcreteIPReg := 12. "IP, The Intra-Procedure-call scratch register."
  	ConcretePCReg := 15.
  	
  	"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.
  
  	"Table A3-2 in sec A3.4 Data-processing instructions of the AARM."
  	AddOpcode := 	4.
  	AndOpcode := 0.
  	BicOpcode := 14.
  	CmpOpcode := 10.
  	CmpNotOpcode := 11.
  	MoveOpcode := 13.
  	MoveNotOpcode := 15.
  	OrOpcode := 12.
  	RsbOpcode := 3.
  	SMLALOpcode := 7.
  	SubOpcode := 2.
  	TstOpcode := 8.
  	XorOpcode := 1.
  
  	CPSRReg := 16.
  	OverflowFlag := 1 << 28.
  
  	"Specific instructions"
  	LastRTLCode isNil ifTrue:
  		[CogRTLOpcodes initialize].
  	specificOpcodes := #(SMULL MSR MRS LDMFD STMFD CMPSMULL).
  	refs := (thisContext method literals select: [:l| l isVariableBinding and: [classPool includesKey: l key]]) collect:
  				[:ea| ea key].
  	(classPool keys reject: [:k| (specificOpcodes includes: k) or: [refs includes: k]]) do:
  		[:k|
  		Undeclared declare: k from: classPool].
  	specificOpcodes withIndexDo:
  		[:classVarName :value|
  		self classPool
  			declare: classVarName from: Undeclared;
  			at: classVarName put: value + LastRTLCode - 1]!

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

Item was added:
+ ----- Method: CogARMCompiler>>concreteDPFPRegister: (in category 'encoding') -----
+ concreteDPFPRegister: registerIndex
+ 	 "Map a possibly abstract double-precision floating-point register into a concrete one.
+ 	  Abstract registers (defined in CogAbstractOpcodes) are all negative.  If registerIndex
+ 	  is negative assume it is an abstract register."
+ 
+ 	^registerIndex
+ 		caseOf: {
+ 			[DPFPReg0]	-> [D0].
+ 			[DPFPReg1]	-> [D1].
+ 			[DPFPReg2]	-> [D2].
+ 			[DPFPReg3]	-> [D3].
+ 			[DPFPReg4]	-> [D4].
+ 			[DPFPReg5]	-> [D5].
+ 			[DPFPReg6]	-> [D6].
+ 			[DPFPReg7]	-> [D7] }
+ 		otherwise:
+ 			[self assert: (registerIndex between: D0 and: D7).
+ 			 registerIndex]!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeAddRdRd (in category 'generate machine code - concretize') -----
  concretizeAddRdRd
+ 	"Will get inlined into concretizeAt: switch."
+ 	<inline: true>
+ 	"Add FP regRHS to FP regLHS and stick result in FP regLHS"
+ 	| regLHS regRHS |
+ 	regRHS := self concreteDPFPRegister: (operands at: 0).
+ 	regLHS := self concreteDPFPRegister: (operands at: 1).
+ 	machineCode at: 0 put:(self faddd: regLHS with: regRHS).
+ 	^machineCodeSize := 4
+ 	!
- 	self assert: false.
- 	self notYetImplemented
- !

Item was changed:
  ----- Method: CogARMCompiler>>concretizeCmpRdRd (in category 'generate machine code - concretize') -----
  concretizeCmpRdRd
+ 	"Will get inlined into concretizeAt: switch."
+ 	<inline: true>
+ 	"Compare FP regB with FP regA and leave the FP status reg ready to be transferred back to ARM with next instruction"
+ 	| regB regA |
+ 	regA := self concreteDPFPRegister: (operands at:0).
+ 	regB := self concreteDPFPRegister: (operands at: 1).
+ 	machineCode at: 0 put:(self fcmpFrom: regB to: regA).
+ 	^machineCodeSize := 4
+ 		
- 	self assert: false.
- 	self notYetImplemented
  !

Item was changed:
  ----- Method: CogARMCompiler>>concretizeConvertRRd (in category 'generate machine code - concretize') -----
  concretizeConvertRRd
+ 	"Will get inlined into concretizeAt: switch."
+ 	<inline: true>
+ 	| srcReg destReg |
+ 	srcReg := self concreteRegister: (operands at:0).
+ 	destReg := self concreteDPFPRegister: (operands at: 1).
+ 	machineCode at: 0 put:(self fmsrFrom: srcReg to: 9).
+ 	machineCode at: 1 put: (self fsitodFrom: 9 to: destReg). "probably not quite right"
+ 	^machineCodeSize := 8
+ 		
- 	self assert: false.
- 	self notYetImplemented
  !

Item was changed:
  ----- Method: CogARMCompiler>>concretizeDivRdRd (in category 'generate machine code - concretize') -----
  concretizeDivRdRd
+ 	"Will get inlined into concretizeAt: switch."
+ 	<inline: true>
+ 	"FP divide regLHS by regRHS and stick result in regLHS"
+ 	| regLHS regRHS |
+ 	regRHS := self concreteDPFPRegister: (operands at: 0).
+ 	regLHS := self concreteDPFPRegister: (operands at: 1).
+ 	machineCode at: 0 put:(self fdivd: regLHS by: regRHS).
+ 	^machineCodeSize := 4
+ 	!
- 	self assert: false.
- 	self notYetImplemented
- !

Item was changed:
  ----- Method: CogARMCompiler>>concretizeFPConditionalJump: (in category 'generate machine code - concretize') -----
  concretizeFPConditionalJump: conditionCode
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| offset |
+ 	"transfer the FP status to ARM cpsr and then jump accordingly"
+ 	offset := self computeJumpTargetOffsetPlus: 8+4 "pc is always 2 instr ahead plus add another to refer to the actual branch".
+  	self assert: (self isInImmediateJumpRange: offset).
- 	self assert: (operands at: 0) ~= 0.
- 	offset := ((operands at: 0) - (address + 8)) signedIntFromLong "signed-conversion for range assertion".
- 	self assert: offset <= 33554428 & (offset >= -33554432).
  	self machineCodeAt: 0 put: self fmstat. "FMSTAT: copy the FPSCR to CPSR"
  	self machineCodeAt: 4 put: (self cond: conditionCode br: 0 offset: offset). "B offset"
  	^machineCodeSize := 8!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeMoveM64rRd (in category 'generate machine code - concretize') -----
  concretizeMoveM64rRd
+ 	"Will get inlined into concretizeAt: switch."	
+ 	<inline: true>
+ 	"Load a float from srcReg+offset into FP destReg"
+ 	| srcReg offset destReg u|
+ 	offset := operands at: 0.
+ 	u := offset >0 ifTrue:[1] ifFalse:[0].
+ 	srcReg := self concreteRegister: (operands at: 1).
+ 	destReg := self concreteDPFPRegister: (operands at: 2).
+ 	machineCode at: 0 put: (self fldd: destReg rn: srcReg plus: u imm: offset>>2).
+ 	^machineCodeSize := 4
- 	self assert: false.
- 	self notYetImplemented
  !

Item was changed:
  ----- Method: CogARMCompiler>>concretizeMoveRdM64r (in category 'generate machine code - concretize') -----
  concretizeMoveRdM64r
+ 	"Will get inlined into concretizeAt: switch."	
+ 	<inline: true>
+ 	"Store FP fpReg to dstReg+offset"
+ 	| dstReg offset fpReg u|
+ 	offset := operands at: 1.
+ 	u := offset >0 ifTrue:[1] ifFalse:[0].
+ 	dstReg := self concreteRegister: (operands at: 2).
+ 	fpReg := self concreteDPFPRegister: (operands at: 0).
+ 	machineCode at: 0 put: (self fstd: fpReg rn: dstReg plus: u imm: offset>>2).
+ 	^machineCodeSize := 4
+ !
- 	self assert: false.
- 	self notYetImplemented!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeMulRdRd (in category 'generate machine code - concretize') -----
  concretizeMulRdRd
+ 	"Will get inlined into concretizeAt: switch."
+ 	<inline: true>
+ 	"FP multiply regLHS by regRHS and stick result in regLHS"
+ 	| regLHS regRHS |
+ 	regRHS := self concreteDPFPRegister: (operands at: 0).
+ 	regLHS := self concreteDPFPRegister: (operands at: 1).
+ 	machineCode at: 0 put:(self fmuld: regLHS with: regRHS).
+ 	^machineCodeSize := 4
+ 	!
- 	self assert: false.
- 	self notYetImplemented
- !

Item was changed:
  ----- Method: CogARMCompiler>>concretizeSqrtRd (in category 'generate machine code - concretize') -----
  concretizeSqrtRd
+ 	"Will get inlined into concretizeAt: switch."
+ 	<inline: true>
+ 	"Square root of FP regLHS into regLHS"
+ 	| regLHS  |
+ 	regLHS := self concreteDPFPRegister: (operands at: 1).
+ 	machineCode at: 0 put:(self fsqrtd: regLHS).
+ 	^machineCodeSize := 4
+ 	!
- 	self assert: false.
- 	self notYetImplemented
- !

Item was changed:
  ----- Method: CogARMCompiler>>concretizeSubRdRd (in category 'generate machine code - concretize') -----
  concretizeSubRdRd
+ 	"Will get inlined into concretizeAt: switch."
+ 	<inline: true>
+ 	| regLHS regRHS |
+ 	"Subtract FP regRHS from FP regLHS and leave the result in FP regLHS"
+ 	regRHS := self concreteDPFPRegister: (operands at: 0).
+ 	regLHS := self concreteDPFPRegister: (operands at: 1).
+ 	machineCode at: 0 put:(self fsubd: regLHS with: regRHS).
+ 	^machineCodeSize := 4
+ 	!
- 	self assert: false.
- 	self notYetImplemented
- !

Item was added:
+ ----- Method: CogARMCompiler>>faddd:with: (in category 'ARM convenience instructions') -----
+ faddd: destReg with: srcReg
+ "FADDD or VADD instruction to add double srcReg to double destReg and stick result in double destReg
+ ARM_ARM v5 DDI 01001.pdf pp. C4-6"
+ 	<inline: true>
+ 	^((2r11101110001100000000101100000000 bitOr: destReg<<16 ) bitOr: destReg<<12) bitOr: srcReg!

Item was added:
+ ----- Method: CogARMCompiler>>fcmpFrom:to: (in category 'ARM convenience instructions') -----
+ fcmpFrom: regA to: regB
+ "FCMP or VCMP instruction to compare two fpu double registers.
+ ARM_ARM v5 DDI 01001.pdf pp. C4-10"
+ 	<inline: true>
+ 	^(2r11101110101101000000101101000000 bitOr:(regA <<12)) bitOr: regB!

Item was added:
+ ----- Method: CogARMCompiler>>fdivd:by: (in category 'ARM convenience instructions') -----
+ fdivd: dividend by: divisor
+ "FDIVD or VDIV instruction to divide double dividend by double divisor and stick result in double dividend
+ ARM_ARM v5 DDI 01001.pdf pp. C4-32"
+ 	<inline: true>
+ 	^((2r11101110100000000000101100000000 bitOr: dividend<<16 ) bitOr: dividend<<12) bitOr: divisor!

Item was added:
+ ----- Method: CogARMCompiler>>fldd:rn:plus:imm: (in category 'ARM convenience instructions') -----
+ fldd: destReg rn: srcReg plus: u imm: immediate8bitValue
+ "FLDD or VLDR instruction to move a value from address in an ARM srcReg +/- offset<<2 to an fpu double destReg
+ ARM_ARM v5 DDI 01001.pdf pp. C4-36"
+ 	<inline: true>
+ 	"Note that
+ 		offset is <<2 to make byte address 
+ 		u =1 -> srcReg + offset<<2
+ 		u=0 -> srgREg - offset<<2"
+ 	^(((2r11101101000100000000101100000000 bitOr:(srcReg <<16)) bitOr: destReg<<12) bitOr: u<<23) bitOr: immediate8bitValue!

Item was added:
+ ----- Method: CogARMCompiler>>fmsrFrom:to: (in category 'ARM convenience instructions') -----
+ fmsrFrom: regA to: regB
+ "FMSR or VMSR instruction to move a value from an ARM reg to an fpu double register ready for conversion
+ ARM_ARM v5 DDI 01001.pdf pp. C4-68"
+ 	<inline: true>
+ 	|destReg|
+ 	"the dest reg bits are spread out a little"
+ 	destReg := (regB >>1) <<16 bitOr:(regB bitAnd: 1) << 7.
+ 	^(2r11101110000000000000101000010000 bitOr:(regA <<12)) bitOr: destReg!

Item was changed:
  ----- Method: CogARMCompiler>>fmstat (in category 'ARM convenience instructions') -----
  fmstat
+ 	"FMSTAT or VMRS unconditional transfer FP status to cpsr to choose jumps etc.
+ 	ARM_ARM v5 DDI 01001.pdf pp. C4-72"
- 	"unconditional transfer FP status to cpsr to choose jumps etc. Manually fudged for now"
  	<inline: true>
+ 	^2r11101110111100011111101000010000!
- 	^16rEF1FA10!

Item was added:
+ ----- Method: CogARMCompiler>>fmuld:with: (in category 'ARM convenience instructions') -----
+ fmuld: destReg with: srcReg
+ "FMULD or VMUL instruction to multiply double srcReg by double destReg and stick result in double destReg
+ ARM_ARM v5 DDI 01001.pdf pp. C4-73"
+ 	<inline: true>
+ 	^((2r11101110001000000000101100000000 bitOr: destReg<<16 ) bitOr: destReg<<12) bitOr: srcReg!

Item was added:
+ ----- Method: CogARMCompiler>>fsitodFrom:to: (in category 'ARM convenience instructions') -----
+ fsitodFrom: regA to: regB
+ "FSITOD or VCVT instruction to move convert an integer value to an fpu double
+ ARM_ARM v5 DDI 01001.pdf pp. C4-95"
+ 	<inline: true>
+ 	|srcReg|
+ 	"the src reg bits are spread out a little"
+ 	srcReg := (regA >>1) bitOr:(regA bitAnd: 1) << 5.
+ 	^(2r11101110101110000000101111000000 bitOr: srcReg ) bitOr: regB<<12!

Item was added:
+ ----- Method: CogARMCompiler>>fsqrtd: (in category 'ARM convenience instructions') -----
+ fsqrtd: destReg
+ "FSQRTD or VSQRT instruction to square root double dividend destReg and stick result in double destReg
+ ARM_ARM v5 DDI 01001.pdf pp. C4-97"
+ 	<inline: true>
+ 	^((2r11101110101100010000101111000000 ) bitOr: destReg<<12) bitOr: destReg!

Item was added:
+ ----- Method: CogARMCompiler>>fstd:rn:plus:imm: (in category 'ARM convenience instructions') -----
+ fstd: destReg rn: srcReg plus: u imm: immediate8bitValue
+ "FSTD or VSTR instruction to move a value to address in an ARM srcReg +/- offset<<2 from an fpu double destReg
+ ARM_ARM v5 DDI 01001.pdf pp. C4-101"
+ 	<inline: true>
+ 	"Note that
+ 		offset is <<2 to make byte address 
+ 		u =1 -> srcReg + offset<<2
+ 		u=0 -> srgREg - offset<<2"
+ 	^(((2r11101101000000000000101100000000 bitOr:(srcReg <<16)) bitOr: destReg<<12) bitOr: u<<23) bitOr: immediate8bitValue!

Item was added:
+ ----- Method: CogARMCompiler>>fsubd:with: (in category 'ARM convenience instructions') -----
+ fsubd: destReg with: srcReg
+ "FSUBD or VSUB instruction to subtract double srcReg from double destREg and stick result in double destReg
+ ARM_ARM v5 DDI 01001.pdf pp. C4-112"
+ 	<inline: true>
+ 	^((2r11101110001100000000101101000000 bitOr: destReg<<16 ) bitOr: destReg<<12) bitOr: srcReg!

Item was changed:
  ----- Method: CogARMCompiler>>hasDoublePrecisionFloatingPointSupport (in category 'testing') -----
  hasDoublePrecisionFloatingPointSupport
  	"might be true, but is for the forseeable future disabled"
  	<inline: true>
+ 	^true!
- 	^false!

Item was changed:
  ----- Method: CogARMCompiler>>loadCwInto: (in category 'generate machine code - support') -----
  loadCwInto: destReg
  	"Load the operand into the destination register, answering
  	 the size of the instructions generated to do so."
  	| operand distance |
  	operand := operands at: 0.
+ 	self cCode:[] inSmalltalk:[operand := operand bitAnd: 16rFFFFFFFF]. "Need to clamp the value to a word size since one or two usages actually generate double sized values and rely upon the C code to narrow it within the running VM"
  	(self isAnInstruction: (cogit cCoerceSimple: operand to: #'AbstractInstruction *')) ifTrue:
  		[operand := (cogit cCoerceSimple: operand to: #'AbstractInstruction *') address].
  	"First try and encode as a pc-relative reference..."
  	(cogit addressIsInCurrentCompilation: operand) ifTrue:
  		[distance := operand - (address + 8).
  		 self rotateable8bitSignedImmediate: distance
  		 	ifTrue:
  				[:rot :immediate :negate|
  		 		 self machineCodeAt: 0 put: (negate
  												ifTrue: [self sub: destReg rn: PC imm: immediate ror: rot]
  												ifFalse: [self add: destReg rn: PC imm: immediate ror: rot]).
  		 		^4]
  		 	ifFalse:
  		 		[self deny: (self isAnInstruction: (cogit cCoerceSimple: (operands at: 0) to: #'AbstractInstruction *'))]].
  	"If this fails, use the conventional literal load sequence."
  	^self moveCw: operand intoR: destReg!

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



More information about the Vm-dev mailing list