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

commits at source.squeak.org commits at source.squeak.org
Thu Oct 3 21:43:23 UTC 2013


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

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

Name: VMMaker.oscog-eem.432
Author: eem
Time: 3 October 2013, 2:39:02.322 pm
UUID: db07559d-7249-42dd-b3ea-046593a6b23a
Ancestors: VMMaker.oscog-eem.431

Get the allocation generator names right.

Refactor common code into compileFallbackToInterpreterPrimitive

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

Item was changed:
  ----- Method: SimpleStackBasedCogit class>>initializePrimitiveTableForSqueakV3 (in category 'class initialization') -----
  initializePrimitiveTableForSqueakV3
  	"Initialize the table of primitive generators.  This does not include normal primitives implemened in the coInterpreter."
  	"SimpleStackBasedCogit initializePrimitiveTableForSqueakV3"
  	MaxCompiledPrimitiveIndex := 222.
  	primitiveTable := CArrayAccessor on: (Array new: MaxCompiledPrimitiveIndex + 1).
  	self table: primitiveTable from: 
  	#(	"Integer Primitives (0-19)"
  		(1 genPrimitiveAdd				1)
  		(2 genPrimitiveSubtract			1)
+ 		(3 genPrimitiveLessThan		1)
- 		(3 genPrimitiveLessThan			1)
  		(4 genPrimitiveGreaterThan		1)
  		(5 genPrimitiveLessOrEqual		1)
  		(6 genPrimitiveGreaterOrEqual	1)
+ 		(7 genPrimitiveEqual			1)
+ 		(8 genPrimitiveNotEqual		1)
- 		(7 genPrimitiveEqual				1)
- 		(8 genPrimitiveNotEqual			1)
  		(9 genPrimitiveMultiply			1	processorHasMultiply:)
  		(10 genPrimitiveDivide			1	processorHasDivQuoRem:)
+ 		(11 genPrimitiveMod			1	processorHasDivQuoRem:)
- 		(11 genPrimitiveMod				1	processorHasDivQuoRem:)
  		(12 genPrimitiveDiv				1	processorHasDivQuoRem:)
+ 		(13 genPrimitiveQuo			1	processorHasDivQuoRem:)
- 		(13 genPrimitiveQuo				1	processorHasDivQuoRem:)
  		(14 genPrimitiveBitAnd			1)
  		(15 genPrimitiveBitOr			1)
  		(16 genPrimitiveBitXor			1)
  		(17 genPrimitiveBitShift			1)
  		"(18 primitiveMakePoint)"
  		"(19 primitiveFail)"					"Guard primitive for simulation -- *must* fail"
  
  		"LargeInteger Primitives (20-39)"
  		"(20 primitiveFail)"
  		"(21 primitiveAddLargeIntegers)"
  		"(22 primitiveSubtractLargeIntegers)"
  		"(23 primitiveLessThanLargeIntegers)"
  		"(24 primitiveGreaterThanLargeIntegers)"
  		"(25 primitiveLessOrEqualLargeIntegers)"
  		"(26 primitiveGreaterOrEqualLargeIntegers)"
  		"(27 primitiveEqualLargeIntegers)"
  		"(28 primitiveNotEqualLargeIntegers)"
  		"(29 primitiveMultiplyLargeIntegers)"
  		"(30 primitiveDivideLargeIntegers)"
  		"(31 primitiveModLargeIntegers)"
  		"(32 primitiveDivLargeIntegers)"
  		"(33 primitiveQuoLargeIntegers)"
  		"(34 primitiveBitAndLargeIntegers)"
  		"(35 primitiveBitOrLargeIntegers)"
  		"(36 primitiveBitXorLargeIntegers)"
  		"(37 primitiveBitShiftLargeIntegers)"
  
  		"Float Primitives (38-59)"
  		"(38 primitiveFloatAt)"
  		"(39 primitiveFloatAtPut)"
  		(40 genPrimitiveAsFloat					0	processorHasDoublePrecisionFloatingPointSupport:)
  		(41 genPrimitiveFloatAdd				1	processorHasDoublePrecisionFloatingPointSupport:)
  		(42 genPrimitiveFloatSubtract			1	processorHasDoublePrecisionFloatingPointSupport:)
  		(43 genPrimitiveFloatLessThan			1	processorHasDoublePrecisionFloatingPointSupport:)
  		(44 genPrimitiveFloatGreaterThan		1	processorHasDoublePrecisionFloatingPointSupport:)
  		(45 genPrimitiveFloatLessOrEqual		1	processorHasDoublePrecisionFloatingPointSupport:)
  		(46 genPrimitiveFloatGreaterOrEqual	1	processorHasDoublePrecisionFloatingPointSupport:)
  		(47 genPrimitiveFloatEqual				1	processorHasDoublePrecisionFloatingPointSupport:)
  		(48 genPrimitiveFloatNotEqual			1	processorHasDoublePrecisionFloatingPointSupport:)
  		(49 genPrimitiveFloatMultiply			1	processorHasDoublePrecisionFloatingPointSupport:)
  		(50 genPrimitiveFloatDivide				1	processorHasDoublePrecisionFloatingPointSupport:)
  		"(51 primitiveTruncated)"
  		"(52 primitiveFractionalPart)"
  		"(53 primitiveExponent)"
  		"(54 primitiveTimesTwoPower)"
  		(55 genPrimitiveFloatSquareRoot		0	processorHasDoublePrecisionFloatingPointSupport:)
  		"(56 primitiveSine)"
  		"(57 primitiveArctan)"
  		"(58 primitiveLogN)"
  		"(59 primitiveExp)"
  
  		"Subscript and Stream Primitives (60-67)"
  		(60 genPrimitiveAt			1)
  		"(61 primitiveAtPut)"
  		(62 genPrimitiveSize		0)
  		(63 genPrimitiveStringAt	1)
  		"(64 primitiveStringAtPut)"
  		"The stream primitives no longer pay their way; normal Smalltalk code is faster."
  		"(65 primitiveFail)""was primitiveNext"
  		"(66 primitiveFail)" "was primitiveNextPut"
  		"(67 primitiveFail)" "was primitiveAtEnd"
  
  		"StorageManagement Primitives (68-79)"
  		"(68 primitiveObjectAt)"
  		"(69 primitiveObjectAtPut)"
+ 		(70 genPrimitiveNew			0			objectRepresentationImplementsNew:)
+ 		(71 genPrimitiveNewWithArg	1			objectRepresentationImplementsNewWithArg:)
+ 		"(72 primitiveArrayBecomeOneWay)"		"Blue Book: primitiveBecome"
- 		(70 primitiveNew				0			objectRepresentationImplementsNew:)
- 		(71 primitiveNewWithArg		1			objectRepresentationImplementsNewWithArg:)
- 		"(72 primitiveArrayBecomeOneWay)"	"Blue Book: primitiveBecome"
  		"(73 primitiveInstVarAt)"
  		"(74 primitiveInstVarAtPut)"
  		(75 genPrimitiveIdentityHash	0)
  		"(76 primitiveStoreStackp)"					"Blue Book: primitiveAsObject"
  		"(77 primitiveSomeInstance)"
  		"(78 primitiveNextInstance)"
+ 		(79 genPrimitiveNewMethod	2			objectRepresentationImplementsNewMethod:)
- 		(79 primitiveNewMethod		2			objectRepresentationImplementsNewMethod:)
  
  		"Control Primitives (80-89)"
+ 		"(80 primitiveFail)"							"Blue Book: primitiveBlockCopy"
+ 		"(81 primitiveFail)"							"Blue Book: primitiveValue"
+ 		"(82 primitiveFail)"							"Blue Book: primitiveValueWithArgs"
- 		"(80 primitiveFail)"					"Blue Book: primitiveBlockCopy"
- 		"(81 primitiveFail)"					"Blue Book: primitiveValue"
- 		"(82 primitiveFail)"					"Blue Book: primitiveValueWithArgs"
  		"(83 primitivePerform)"
  		"(84 primitivePerformWithArgs)"
  		"(85 primitiveSignal)"
  		"(86 primitiveWait)"
  		"(87 primitiveResume)"
  		"(88 primitiveSuspend)"
  		"(89 primitiveFlushCache)"
  
  		"Input/Output Primitives (90-109); We won't compile any of these"
  
  		"System Primitives (110-119)"
  		(110 genPrimitiveIdentical 1)
  		(111 genPrimitiveClass)
  		"(112 primitiveBytesLeft)"
  		"(113 primitiveQuit)"
  		"(114 primitiveExitToDebugger)"
  		"(115 primitiveChangeClass)"					"Blue Book: primitiveOopsLeft"
  		"(116 primitiveFlushCacheByMethod)"
  		"(117 primitiveExternalCall)"
  		"(118 primitiveDoPrimitiveWithArgs)"
  		"(119 primitiveFlushCacheSelective)"
  			"Squeak 2.2 and earlier use 119.  Squeak 2.3 and later use 116.
  			Both are supported for backward compatibility."
  
  		"Miscellaneous Primitives (120-127); We won't compile any of these"
  
  		"Squeak Primitives Start Here"
  
  		"Squeak Miscellaneous Primitives (128-149); We won't compile any of these"
  
  		"File Primitives (150-169) - NO LONGER INDEXED; We won't compile any of these"
  		(169 genPrimitiveNotIdentical 1)
  
  		"Sound Primitives (170-199) - NO LONGER INDEXED; We won't compile any of these"
  
  		"Old closure primitives"
  		"(186 primitiveFail)" "was primitiveClosureValue"
  		"(187 primitiveFail)" "was primitiveClosureValueWithArgs"
  
  		"Perform method directly"
  		"(188 primitiveExecuteMethodArgsArray)"
  		"(189 primitiveExecuteMethod)"
  
  		"Sound Primitives (continued) - NO LONGER INDEXED; We won't compile any of these"
  		"(190 194 primitiveFail)"
  
  		"Unwind primitives"
  		"(195 primitiveFindNextUnwindContext)"
  		"(196 primitiveTerminateTo)"
  		"(197 primitiveFindHandlerContext)"
  		(198 genFastPrimFail "primitiveMarkUnwindMethod")
  		(199 genFastPrimFail "primitiveMarkHandlerMethod")
  
  		"new closure primitives (were Networking primitives)"
  		"(200 primitiveClosureCopyWithCopiedValues)"
  		(201 genPrimitiveClosureValue	0) "value"
  		(202 genPrimitiveClosureValue	1) "value:"
  		(203 genPrimitiveClosureValue	2) "value:value:"
  		(204 genPrimitiveClosureValue	3) "value:value:value:"
  		(205 genPrimitiveClosureValue	4) "value:value:value:value:"
  		"(206 genPrimitiveClosureValueWithArgs)" "valueWithArguments:"
  
  		"(207 209 primitiveFail)"	"reserved for Cog primitives"
  
  		"(210 primitiveContextAt)"
  		"(211 primitiveContextAtPut)"
  		"(212 primitiveContextSize)"
  		"(213 217 primitiveFail)"	"reserved for Cog primitives"
  		"(218 primitiveDoNamedPrimitiveWithArgs)"
  		"(219 primitiveFail)"	"reserved for Cog primitives"
  
  		"(220 primitiveFail)"		"reserved for Cog primitives"
  
  		(221 genPrimitiveClosureValue	0) "valueNoContextSwitch"
  		(222 genPrimitiveClosureValue	1) "valueNoContextSwitch:"
  
  		"(223 229 primitiveFail)"	"reserved for Cog primitives"
  	)!

Item was added:
+ ----- Method: SimpleStackBasedCogit>>compileFallbackToInterpreterPrimitive (in category 'primitive generators') -----
+ compileFallbackToInterpreterPrimitive
+ 	<inline: false>
+ 	^self compileInterpreterPrimitive: (coInterpreter
+ 											functionPointerForCompiledMethod: methodObj
+ 											primitiveIndex: primitiveIndex)!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genDoubleArithmetic:preOpCheck: (in category 'primitive generators') -----
  genDoubleArithmetic: arithmeticOperator preOpCheck: preOpCheckOrNil
  	"Stack looks like
  		receiver (also in ResultReceiverReg)
  		arg
  		return address"
  	<var: #preOpCheckOrNil declareC: 'AbstractInstruction *(*preOpCheckOrNil)(int rcvrReg, int argReg)'>
  	| jumpFailClass jumpFailAlloc jumpFailCheck jumpImmediate jumpNonInt doOp fail |
  	<var: #jumpFailClass type: #'AbstractInstruction *'>
  	<var: #jumpFailAlloc type: #'AbstractInstruction *'>
  	<var: #jumpNonInt type: #'AbstractInstruction *'>
  	<var: #jumpImmediate type: #'AbstractInstruction *'>
  	<var: #jumpFailCheck type: #'AbstractInstruction *'>
  	<var: #doOp type: #'AbstractInstruction *'>
  	<var: #fail type: #'AbstractInstruction *'>
  	self MoveMw: BytesPerWord r: SPReg R: TempReg.
  	objectRepresentation genGetDoubleValueOf: ReceiverResultReg into: DPFPReg0.
  	self MoveR: TempReg R: ClassReg.
  	jumpImmediate := objectRepresentation genJumpImmediateInScratchReg: TempReg.
  	objectRepresentation genGetCompactClassIndexNonImmOf: ClassReg into: SendNumArgsReg.
  	self CmpCq: objectMemory classFloatCompactIndex R: SendNumArgsReg.
  	jumpFailClass := self JumpNonZero: 0.
  	objectRepresentation genGetDoubleValueOf: ClassReg into: DPFPReg1.
  	doOp := self Label.
  	preOpCheckOrNil ifNotNil:
  		[jumpFailCheck := self perform: preOpCheckOrNil with: DPFPReg0 with: DPFPReg1].
  	self gen: arithmeticOperator operand: DPFPReg1 operand: DPFPReg0.
  	jumpFailAlloc := objectRepresentation
  					genAllocFloatValue: DPFPReg0
  					into: SendNumArgsReg
  					scratchReg: ClassReg
  					scratchReg: TempReg.
  	self MoveR: SendNumArgsReg R: ReceiverResultReg.
  	self flag: 'currently caller pushes result'.
  	self RetN: BytesPerWord * 2.
  	jumpImmediate jmpTarget: self Label.
  	objectRepresentation smallIntegerIsOnlyImmediateType ifFalse:
  		[jumpNonInt := objectRepresentation genJumpNotSmallIntegerInScratchReg: TempReg].
  	objectRepresentation genConvertSmallIntegerToIntegerInScratchReg: ClassReg.
  	self ConvertR: ClassReg Rd: DPFPReg1.
  	self Jump: doOp.
  	jumpFailAlloc jmpTarget: self Label.
+ 	self compileFallbackToInterpreterPrimitive.
- 	self compileInterpreterPrimitive: (coInterpreter
- 										functionPointerForCompiledMethod: methodObj
- 										primitiveIndex: primitiveIndex).
  	fail := self Label.
  	jumpFailClass jmpTarget: fail.
  	preOpCheckOrNil ifNotNil:
  		[jumpFailCheck jmpTarget: fail].
  	objectRepresentation smallIntegerIsOnlyImmediateType ifFalse:
  		[jumpNonInt jmpTarget: fail].
  	^0!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genPrimitiveAsFloat (in category 'primitive generators') -----
  genPrimitiveAsFloat
  	"Stack looks like
  		receiver (also in ResultReceiverReg)
  		return address"
  	| jumpFailAlloc |
  	<var: #jumpFailAlloc type: #'AbstractInstruction *'>
  	self MoveR: ReceiverResultReg R: ClassReg.
  	objectRepresentation genConvertSmallIntegerToIntegerInScratchReg: ClassReg.
  	self ConvertR: ClassReg Rd: DPFPReg0.
  	jumpFailAlloc := objectRepresentation
  					genAllocFloatValue: DPFPReg0
  					into: SendNumArgsReg
  					scratchReg: ClassReg
  					scratchReg: TempReg.
  	self MoveR: SendNumArgsReg R: ReceiverResultReg.
  	self flag: 'currently caller pushes result'.
  	self RetN: BytesPerWord.
  	jumpFailAlloc jmpTarget: self Label.
+ 	^self compileFallbackToInterpreterPrimitive!
- 	self compileInterpreterPrimitive: (coInterpreter
- 										functionPointerForCompiledMethod: methodObj
- 										primitiveIndex: primitiveIndex).
- 	^0!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genPrimitiveAt (in category 'primitive generators') -----
  genPrimitiveAt
  	| r |
  	self MoveMw: BytesPerWord r: SPReg R: Arg0Reg.
  	(r := objectRepresentation genInnerPrimitiveAt: BytesPerWord * 2) < 0 ifTrue:
  		[^r].
+ 	^self compileFallbackToInterpreterPrimitive!
- 	^self compileInterpreterPrimitive: (coInterpreter
- 											functionPointerForCompiledMethod: methodObj
- 											primitiveIndex: primitiveIndex)!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genPrimitiveFloatSquareRoot (in category 'primitive generators') -----
  genPrimitiveFloatSquareRoot
  	"Stack looks like
  		receiver (also in ResultReceiverReg)
  		return address"
  	| jumpFailAlloc |
  	<var: #jumpFailAlloc type: #'AbstractInstruction *'>
  	objectRepresentation genGetDoubleValueOf: ReceiverResultReg into: DPFPReg0.
  	self SqrtRd: DPFPReg0.
  	jumpFailAlloc := objectRepresentation
  					genAllocFloatValue: DPFPReg0
  					into: SendNumArgsReg
  					scratchReg: ClassReg
  					scratchReg: TempReg.
  	self MoveR: SendNumArgsReg R: ReceiverResultReg.
  	self flag: 'currently caller pushes result'.
  	self RetN: BytesPerWord.
  	jumpFailAlloc jmpTarget: self Label.
+ 	^self compileFallbackToInterpreterPrimitive!
- 	self compileInterpreterPrimitive: (coInterpreter
- 										functionPointerForCompiledMethod: methodObj
- 										primitiveIndex: primitiveIndex).
- 	^0!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genPrimitiveIdentityHash (in category 'primitive generators') -----
  genPrimitiveIdentityHash
  	| jumpSI jumpNotSet |
  	<var: #jumpSI type: #'AbstractInstruction *'>
  	<var: #jumpNotSet type: #'AbstractInstruction *'>
  	self MoveR: ReceiverResultReg R: ClassReg.
  	jumpSI := objectRepresentation genJumpSmallIntegerInScratchReg: ClassReg.
  	objectRepresentation genGetHashFieldNonImmOf: ReceiverResultReg asSmallIntegerInto: TempReg.
  	objectRepresentation isHashSetOnInstanceCreation ifFalse:
  		[self CmpCq: ConstZero R: TempReg.
  		 jumpNotSet := self JumpZero: 0].
  	self MoveR: TempReg R: ReceiverResultReg.
  	self flag: 'currently caller pushes result'.
  	self RetN: BytesPerWord.
  	objectRepresentation isHashSetOnInstanceCreation ifFalse:
  		[jumpNotSet jmpTarget: self Label.
+ 		 self compileFallbackToInterpreterPrimitive].
- 		 self compileInterpreterPrimitive: (coInterpreter
- 											functionPointerForCompiledMethod: methodObj
- 											primitiveIndex: primitiveIndex)].
  	jumpSI jmpTarget: self Label.
  	^0!

Item was added:
+ ----- Method: SimpleStackBasedCogit>>genPrimitiveNew (in category 'primitive generators') -----
+ genPrimitiveNew
+ 	| r |
+ 	(r := objectRepresentation genInnerPrimitiveNew: BytesPerWord) < 0 ifTrue:
+ 		[^r].
+ 	^self compileFallbackToInterpreterPrimitive!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genPrimitiveSize (in category 'primitive generators') -----
  genPrimitiveSize
  	| r |
  	(r := objectRepresentation genInnerPrimitiveSize: BytesPerWord) < 0 ifTrue:
  		[^r].
+ 	^self compileFallbackToInterpreterPrimitive!
- 	^self compileInterpreterPrimitive: (coInterpreter
- 											functionPointerForCompiledMethod: methodObj
- 											primitiveIndex: primitiveIndex)!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genPrimitiveStringAt (in category 'primitive generators') -----
  genPrimitiveStringAt
  	| r |
  	self MoveMw: BytesPerWord r: SPReg R: Arg0Reg.
  	(r := objectRepresentation genInnerPrimitiveStringAt: BytesPerWord * 2) < 0 ifTrue:
  		[^r].
+ 	^self compileFallbackToInterpreterPrimitive!
- 	^self compileInterpreterPrimitive: (coInterpreter
- 											functionPointerForCompiledMethod: methodObj
- 											primitiveIndex: primitiveIndex)!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genDoubleArithmetic:preOpCheck: (in category 'primitive generators') -----
  genDoubleArithmetic: arithmeticOperator preOpCheck: preOpCheckOrNil
  	"Receiver and arg in registers.
  	 Stack looks like
  		return address"
  	<var: #preOpCheckOrNil declareC: 'AbstractInstruction *(*preOpCheckOrNil)(int rcvrReg, int argReg)'>
  	| jumpFailClass jumpFailAlloc jumpFailCheck jumpImmediate jumpNonInt doOp |
  	<var: #jumpFailClass type: #'AbstractInstruction *'>
  	<var: #jumpFailAlloc type: #'AbstractInstruction *'>
  	<var: #jumpImmediate type: #'AbstractInstruction *'>
  	<var: #jumpNonInt type: #'AbstractInstruction *'>
  	<var: #jumpFailCheck type: #'AbstractInstruction *'>
  	<var: #doOp type: #'AbstractInstruction *'>
  	self MoveR: Arg0Reg R: TempReg.
  	objectRepresentation genGetDoubleValueOf: ReceiverResultReg into: DPFPReg0.
  	self MoveR: Arg0Reg R: ClassReg.
  	jumpImmediate := objectRepresentation genJumpImmediateInScratchReg: TempReg.
  	objectRepresentation genGetCompactClassIndexNonImmOf: Arg0Reg into: SendNumArgsReg.
  	self CmpCq: objectMemory classFloatCompactIndex R: SendNumArgsReg.
  	jumpFailClass := self JumpNonZero: 0.
  	objectRepresentation genGetDoubleValueOf: Arg0Reg into: DPFPReg1.
  	doOp := self Label.
  	preOpCheckOrNil ifNotNil:
  		[jumpFailCheck := self perform: preOpCheckOrNil with: DPFPReg0 with: DPFPReg1].
  	self gen: arithmeticOperator operand: DPFPReg1 operand: DPFPReg0.
  	jumpFailAlloc := objectRepresentation
  						genAllocFloatValue: DPFPReg0
  						into: SendNumArgsReg
  						scratchReg: ClassReg
  						scratchReg: TempReg.
  	self MoveR: SendNumArgsReg R: ReceiverResultReg.
  	self RetN: 0.
  	"We need to push the register args on two paths; this one and the interpreter primitive path.
  	But the interpreter primitive path won't unless regArgsHaveBeenPushed is false."
  	self assert: methodOrBlockNumArgs <= self numRegArgs.
  	jumpFailClass jmpTarget: self Label.
  	preOpCheckOrNil ifNotNil:
  		[jumpFailCheck jmpTarget: jumpFailClass getJmpTarget].
  	self genPushRegisterArgsForNumArgs: methodOrBlockNumArgs.
  	jumpFailClass := self Jump: 0.
  	jumpImmediate jmpTarget: self Label.
  	objectRepresentation smallIntegerIsOnlyImmediateType ifFalse:
  		[jumpNonInt := objectRepresentation genJumpNotSmallIntegerInScratchReg: TempReg].
  	objectRepresentation genConvertSmallIntegerToIntegerInScratchReg: ClassReg.
  	self ConvertR: ClassReg Rd: DPFPReg1.
  	self Jump: doOp.
  	jumpFailAlloc jmpTarget: self Label.
+ 	self compileFallbackToInterpreterPrimitive.
- 	self compileInterpreterPrimitive: (coInterpreter
- 										functionPointerForCompiledMethod: methodObj
- 										primitiveIndex: primitiveIndex).
  	jumpFailClass jmpTarget: self Label.
  	objectRepresentation smallIntegerIsOnlyImmediateType ifFalse:
  		[jumpNonInt jmpTarget: jumpFailClass getJmpTarget].
  	^0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genPrimitiveAsFloat (in category 'primitive generators') -----
  genPrimitiveAsFloat
  	| jumpFailAlloc |
  	<var: #jumpFailAlloc type: #'AbstractInstruction *'>
  	self MoveR: ReceiverResultReg R: TempReg.
  	objectRepresentation genConvertSmallIntegerToIntegerInScratchReg: TempReg.
  	self ConvertR: TempReg Rd: DPFPReg0.
  	jumpFailAlloc := objectRepresentation
  						genAllocFloatValue: DPFPReg0
  						into: SendNumArgsReg
  						scratchReg: ClassReg
  						scratchReg: TempReg.
  	self MoveR: SendNumArgsReg R: ReceiverResultReg.
  	self RetN: 0.
  	jumpFailAlloc jmpTarget: self Label.
+ 	^self compileFallbackToInterpreterPrimitive!
- 	self compileInterpreterPrimitive: (coInterpreter
- 										functionPointerForCompiledMethod: methodObj
- 										primitiveIndex: primitiveIndex).
- 	^0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genPrimitiveAt (in category 'primitive generators') -----
  genPrimitiveAt
  	| r |
  	self assert: self numRegArgs >= 1.
  	(r := objectRepresentation genInnerPrimitiveAt: 0) < 0 ifTrue:
  		[^r].
+ 	^self compileFallbackToInterpreterPrimitive!
- 	^self compileInterpreterPrimitive: (coInterpreter
- 											functionPointerForCompiledMethod: methodObj
- 											primitiveIndex: primitiveIndex)!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genPrimitiveFloatSquareRoot (in category 'primitive generators') -----
  genPrimitiveFloatSquareRoot
  	| jumpFailAlloc |
  	<var: #jumpFailAlloc type: #'AbstractInstruction *'>
  	objectRepresentation genGetDoubleValueOf: ReceiverResultReg into: DPFPReg0.
  	self SqrtRd: DPFPReg0.
  	jumpFailAlloc := objectRepresentation
  						genAllocFloatValue: DPFPReg0
  						into: SendNumArgsReg
  						scratchReg: ClassReg
  						scratchReg: TempReg.
  	self MoveR: SendNumArgsReg R: ReceiverResultReg.
  	self RetN: 0.
  	jumpFailAlloc jmpTarget: self Label.
+ 	^self compileFallbackToInterpreterPrimitive!
- 	self compileInterpreterPrimitive: (coInterpreter
- 										functionPointerForCompiledMethod: methodObj
- 										primitiveIndex: primitiveIndex).
- 	^0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genPrimitiveIdentityHash (in category 'primitive generators') -----
  genPrimitiveIdentityHash
  	| jumpSI jumpNotSet |
  	<var: #jumpSI type: #'AbstractInstruction *'>
  	<var: #jumpNotSet type: #'AbstractInstruction *'>
  	self MoveR: ReceiverResultReg R: ClassReg.
  	jumpSI := objectRepresentation genJumpSmallIntegerInScratchReg: ClassReg.
  	objectRepresentation genGetHashFieldNonImmOf: ReceiverResultReg asSmallIntegerInto: TempReg.
  	objectRepresentation isHashSetOnInstanceCreation ifFalse:
  		[self CmpCq: ConstZero R: TempReg.
  		 jumpNotSet := self JumpZero: 0].
  	self MoveR: TempReg R: ReceiverResultReg.
  	self RetN: 0.
  	objectRepresentation isHashSetOnInstanceCreation ifFalse:
  		[jumpNotSet jmpTarget: self Label.
+ 		 self compileFallbackToInterpreterPrimitive].
- 		 self compileInterpreterPrimitive: (coInterpreter
- 											functionPointerForCompiledMethod: methodObj
- 											primitiveIndex: primitiveIndex)].
  	jumpSI jmpTarget: self Label.
  	^0!

Item was added:
+ ----- Method: StackToRegisterMappingCogit>>genPrimitiveNew (in category 'primitive generators') -----
+ genPrimitiveNew
+ 	| r |
+ 	(r := objectRepresentation genInnerPrimitiveNew: 0) < 0 ifTrue:
+ 		[^r].
+ 	^self compileFallbackToInterpreterPrimitive!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genPrimitiveSize (in category 'primitive generators') -----
  genPrimitiveSize
  	| r |
  	(r := objectRepresentation genInnerPrimitiveSize: 0) < 0 ifTrue:
  		[^r].
+ 	^self compileFallbackToInterpreterPrimitive!
- 	^self compileInterpreterPrimitive: (coInterpreter
- 											functionPointerForCompiledMethod: methodObj
- 											primitiveIndex: primitiveIndex)!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genPrimitiveStringAt (in category 'primitive generators') -----
  genPrimitiveStringAt
  	| r |
  	self assert: self numRegArgs >= 1.
  	(r := objectRepresentation genInnerPrimitiveStringAt: 0) < 0 ifTrue:
  		[^r].
+ 	^self compileFallbackToInterpreterPrimitive!
- 	^self compileInterpreterPrimitive: (coInterpreter
- 											functionPointerForCompiledMethod: methodObj
- 											primitiveIndex: primitiveIndex)!



More information about the Vm-dev mailing list