VM Maker: VMMaker.oscog-nice.2539.mcz

 
Nicolas Cellier uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-nice.2539.mcz

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

Name: VMMaker.oscog-nice.2539
Author: nice
Time: 21 August 2019, 2:13:31.309695 pm
UUID: f8f4ac4f-6be3-1d45-80ef-27546303cc02
Ancestors: VMMaker.oscog-nice.2538

Partial fix - Part 2 - for bug https://github.com/OpenSmalltalk/opensmalltalk-vm/issues/417

Fix jitted (SmallInteger compareOp: BoxedFloat64)
Also let jitted code handle SmallFloat64 arg as it should.

Revise the declarations of instructions (most could be removed), and use better names for jump and better comment for the case (Float compareOp: ...), notably speak in term of comparison ambiguity as explained in the bug report.

TODO:
We should also improve the non jitted primitives with same trick, and generate this kind of comparison:

if ( (double) si == sf ) return si <= (int64) sf;
else return (double) si <= sf;

=============== Diff against VMMaker.oscog-nice.2538 ===============

Item was changed:
  ----- Method: CogObjectRepresentationFor64BitSpur>>genFloatComparison:orIntegerComparison:invert:boxed: (in category 'primitive generators') -----
+ genFloatComparison: jumpFPOpcodeGenerator orIntegerComparison: jumpOpcode invert: invertComparison boxed: rcvrBoxed
+ <var: #jumpFPOpcodeGenerator declareC: 'AbstractInstruction *(*jumpFPOpcodeGenerator)(void *)'>
- genFloatComparison: jumpOpcodeGenerator orIntegerComparison: jumpOpcode invert: invertComparison boxed: rcvrBoxed
- <var: #jumpOpcodeGenerator declareC: 'AbstractInstruction *(*jumpOpcodeGenerator)(void *)'>
  <inline: false>
+ | jumpImmediate jumpNotSmallFloat jumpNotSmallInteger jumpNotBoxedFloat jumpCond compareFloat jumpAmbiguous jumpTrue returnTrue |
- | jumpImmediate jumpNotSmallFloat jumpNotSmallInteger jumpNotBoxedFloat jumpCond compareFloat jumpEqual jumpTrue returnTrue |
  <var: #jumpNotSmallInteger type: #'AbstractInstruction *'>
  <var: #jumpNotBoxedFloat type: #'AbstractInstruction *'>
  <var: #jumpNotSmallFloat type: #'AbstractInstruction *'>
  <var: #jumpImmediate type: #'AbstractInstruction *'>
+ <var: #jumpAmbiguous type: #'AbstractInstruction *'>
  <var: #jumpCond type: #'AbstractInstruction *'>
+ <var: #jumpTrue type: #'AbstractInstruction *'>
+ <var: #returnTrue type: #'AbstractInstruction *'>
+ <var: #compareFloat type: #'AbstractInstruction *'>
  cogit genLoadArgAtDepth: 0 into: Arg0Reg.
  rcvrBoxed
  ifTrue: [self genGetDoubleValueOf: ReceiverResultReg into: DPFPReg0]
  ifFalse: [self genGetSmallFloatValueOf: ReceiverResultReg scratch: TempReg into: DPFPReg0].
  jumpNotSmallFloat := self genJumpNotSmallFloat: Arg0Reg.
  self genGetSmallFloatValueOf: Arg0Reg scratch: TempReg into: DPFPReg1.
  compareFloat := invertComparison "May need to invert for NaNs"
  ifTrue: [cogit CmpRd: DPFPReg0 Rd: DPFPReg1]
  ifFalse: [cogit CmpRd: DPFPReg1 Rd: DPFPReg0].
+ jumpCond := cogit perform: jumpFPOpcodeGenerator with: 0. "FP jumps are a little weird"
- jumpCond := cogit perform: jumpOpcodeGenerator with: 0. "FP jumps are a little weird"
  cogit genMoveFalseR: ReceiverResultReg.
  cogit genPrimReturn.
  jumpCond jmpTarget: (returnTrue := cogit genMoveTrueR: ReceiverResultReg).
  cogit genPrimReturn.
 
  jumpNotSmallFloat jmpTarget: cogit Label.
  jumpNotSmallInteger := self genJumpNotSmallInteger: Arg0Reg.
+ "Test for ambiguity, that is when floatRcvr == (double) intArg"
  self genConvertSmallIntegerToIntegerInReg: Arg0Reg.
  cogit ConvertR: Arg0Reg Rd: DPFPReg1.
  cogit CmpRd: DPFPReg0 Rd: DPFPReg1.
  "If floatRcvr == (double) intArg then use compareInt(intArg,(int64) floatRcvr)"
  "else use compareFloat(floatRcvr,(double) intArg)"
+ jumpAmbiguous := cogit perform: #JumpFPEqual: with: 0.
+ "Case of non ambiguity, use compareFloat(floatRcvr,(double) intArg)"
- jumpEqual := cogit perform: #JumpFPEqual: with: 0.
  cogit Jump: compareFloat.
+ "Case of ambiguity, use compareInt((int64) floatRcvr, intArg)"
+ jumpAmbiguous jmpTarget: (cogit ConvertRd: DPFPReg0 R: ReceiverResultReg).
- jumpEqual jmpTarget: (cogit ConvertRd: DPFPReg0 R: ReceiverResultReg).
  cogit CmpR: Arg0Reg R: ReceiverResultReg. "N.B. FLAGS := RRReg - Arg0Reg"
  jumpTrue := cogit genConditionalBranch: jumpOpcode operand: 0.
  cogit genMoveFalseR: ReceiverResultReg.
  cogit genPrimReturn.
  jumpTrue jmpTarget: returnTrue.
 
+ "not a Small Float, nor Small Integer, check for Boxed Float argument"
  jumpNotSmallInteger jmpTarget: cogit Label.
  jumpImmediate := self genJumpImmediate: Arg0Reg.
  self genGetCompactClassIndexNonImmOf: Arg0Reg into: SendNumArgsReg.
  self genCmpClassFloatCompactIndexR: SendNumArgsReg.
  jumpNotBoxedFloat := cogit JumpNonZero: 0.
  self genGetDoubleValueOf: Arg0Reg into: DPFPReg1.
  cogit Jump: compareFloat.
+
  jumpImmediate jmpTarget:
  (jumpNotBoxedFloat jmpTarget: cogit Label).
  ^CompletePrimitive!

Item was added:
+ ----- Method: CogObjectRepresentationFor64BitSpur>>genSmallIntegerComparison:orDoubleComparison:invert: (in category 'primitive generators') -----
+ genSmallIntegerComparison: jumpOpcode orDoubleComparison: jumpFPOpcodeGenerator invert: invertComparison
+ "Stack looks like
+ return address"
+ | jumpCond r compareIntFloat jumpAmbiguous jumpNotBoxedFloat jumpNotFloatAtAll jumpNotSmallFloat jumpTrue returnTrue |
+ <var: #jumpFPOpcodeGenerator declareC: 'AbstractInstruction * NoDbgRegParms (*jumpFPOpcodeGenerator)(void *)'>
+ <var: #jumpNonInt type: #'AbstractInstruction *'>
+ <var: #jumpCond type: #'AbstractInstruction *'>
+ <var: #jumpTrue type: #'AbstractInstruction *'>
+ <var: #returnTrue type: #'AbstractInstruction *'>
+ <var: #jumpAmbiguous type: #'AbstractInstruction *'>
+ <var: #jumpNotBoxedFloat type: #'AbstractInstruction *'>
+ <var: #jumpNotSmallFloat type: #'AbstractInstruction *'>
+ <var: #jumpNotFloatAtAll type: #'AbstractInstruction *'>
+ <var: #compareIntFloat type: #'AbstractInstruction *'>
+ r := self genSmallIntegerComparison: jumpOpcode.
+ r < 0 ifTrue:
+ [^r].
+ self cppIf: #DPFPReg0 defined ifTrue:
+ "Fall through on non-SmallInteger argument.  Argument may be a Float : let us check or fail"
+ [
+ "check for Small Float argument"
+ jumpNotSmallFloat := self genJumpNotSmallFloat: Arg0Reg.
+ self genGetSmallFloatValueOf: Arg0Reg scratch: TempReg into: DPFPReg1.
+
+ "Case of (int compare: float). Test for ambiguity, that is when (double) intRcvr == floatArg"
+ compareIntFloat := cogit Label.
+ self genConvertSmallIntegerToIntegerInReg: ReceiverResultReg.
+ cogit ConvertR: ReceiverResultReg Rd: DPFPReg0.
+ cogit CmpRd: DPFPReg0 Rd: DPFPReg1.
+ jumpAmbiguous := cogit perform: #JumpFPEqual: with: 0.
+ "Case of non ambiguity, use compareFloat((double) intRcvr,floatArg)"
+ invertComparison "May need to invert for NaNs"
+ ifTrue: [cogit CmpRd: DPFPReg0 Rd: DPFPReg1]
+ ifFalse: [cogit CmpRd: DPFPReg1 Rd: DPFPReg0].
+ jumpCond := cogit perform: jumpFPOpcodeGenerator with: 0. "FP jumps are a little weird"
+ cogit genMoveFalseR: ReceiverResultReg.
+ cogit genPrimReturn.
+ jumpCond jmpTarget: (returnTrue := cogit genMoveTrueR: ReceiverResultReg).
+ cogit genPrimReturn.
+ "Case of ambiguity, use compareInt(intRcvr , (int64) floatArg)"
+ jumpAmbiguous jmpTarget: (cogit ConvertRd: DPFPReg1 R: Arg0Reg).
+ cogit CmpR: Arg0Reg R: ReceiverResultReg. "N.B. FLAGS := RRReg - Arg0Reg"
+ jumpTrue := cogit genConditionalBranch: jumpOpcode operand: 0.
+ cogit genMoveFalseR: ReceiverResultReg.
+ cogit genPrimReturn.
+ jumpTrue jmpTarget: returnTrue.
+
+ "not a Small Float, check for Boxed Float argument"
+ jumpNotSmallFloat jmpTarget: (jumpNotFloatAtAll := self genJumpImmediate: Arg0Reg).
+ self genGetCompactClassIndexNonImmOf: Arg0Reg into: SendNumArgsReg.
+ self genCmpClassFloatCompactIndexR: SendNumArgsReg.
+ jumpNotBoxedFloat := cogit JumpNonZero: 0.
+ "It was a Boxed Float, so convert the receiver to double and perform the (int compare: float) operation"
+ self genGetDoubleValueOf: Arg0Reg into: DPFPReg1.
+ cogit Jump: compareIntFloat.
+
+ "not a Float, just let the primitive fall thru failure"
+ jumpNotBoxedFloat jmpTarget: (jumpNotFloatAtAll jmpTarget: cogit Label)].
+ ^CompletePrimitive!