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

Clément Bera bera.clement at gmail.com
Wed Jan 18 09:47:45 UTC 2017


Well, the crash seems to be unrelated to primitiveStringReplace...

2088 was working just fine.
2099 is not. Something wrong has happened in between.

On Wed, Jan 18, 2017 at 10:17 AM, Clément Bera <bera.clement at gmail.com>
wrote:

> Hi,
>
> When I compile from this version I have a start-up crash in Pharo.
>
> I suspect changes in primitiveStringReplace ...
>
> Segmentation fault Wed Jan 18 10:10:24 2017
>
> [...]
> Smalltalk stack dump:
> 0xbff11834 M Array(SequenceableCollection)>mergeFirst:middle:last:into:by:
> 0x47c0138: a(n) Array
> 0xbff11864 M Array(SequenceableCollection)>mergeSortFrom:to:src:dst:by:
> 0x47c0068: a(n) Array
> 0xbff11894 M Array(SequenceableCollection)>mergeSortFrom:to:src:dst:by:
> 0x47c0068: a(n) Array
> 0xbff118cc I Array(SequenceableCollection)>mergeSortFrom:to:src:dst:by:
> 0x47c0068: a(n) Array
> 0xbff11900 I Array(SequenceableCollection)>mergeSortFrom:to:by:
> 0x47c0068: a(n) Array
> [...]
>  0x5356da0 s WorldMorph>doOneCycle
>  0x5356d40 s WorldMorph class>doOneCycle
>  0x876f890 s [] in MorphicUIManager>spawnNewProcess
>  0x876fa20 s [] in FullBlockClosure>newProcess
>
> Most recent primitives
> new:
> basicNew
> value:
> at:
> at:
> [...]
> replaceFrom:to:with:startingAt:
> replaceFrom:to:with:startingAt:
> replaceFrom:to:with:startingAt:
> replaceFrom:to:with:startingAt:
>
> stack page bytes 4096 available headroom 2788 minimum unused headroom 68
>
> (Segmentation fault)
> Abort trap: 6
>
> On Tue, Jan 17, 2017 at 7:04 PM, <commits at source.squeak.org> wrote:
>
>>
>> Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
>> http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2099.mcz
>>
>> ==================== Summary ====================
>>
>> Name: VMMaker.oscog-eem.2099
>> Author: eem
>> Time: 17 January 2017, 10:03:25.012123 am
>> UUID: 08323ffb-7df4-498c-a5b0-8a4e6d295352
>> Ancestors: VMMaker.oscog-eem.2098
>>
>> StackToRegisterMappingCogits:
>> Clean-up after the branch following changes:
>> Make extractMaybeBranchDescriptorInto: fulfil its contract when it
>> doesn't find a following branch (directly or indirectly).
>> Simplify the various gen*InlinedIdenticalOrNotIf: to eliminate the
>> duplication using #== to compare orNot with the branch.
>>
>> =============== Diff against VMMaker.oscog-eem.2098 ===============
>>
>> Item was changed:
>>   ----- Method: RegisterAllocatingCogit>>genFo
>> rwardersInlinedIdenticalOrNotIf: (in category 'bytecode generators')
>> -----
>>   genForwardersInlinedIdenticalOrNotIf: orNot
>>         | nextPC branchDescriptor unforwardRcvr argReg targetBytecodePC
>>         unforwardArg  rcvrReg postBranchPC label fixup |
>>         <var: #branchDescriptor type: #'BytecodeDescriptor *'>
>>         <var: #label type: #'AbstractInstruction *'>
>>
>>         self extractMaybeBranchDescriptorInto: [ :descr :next
>> :postBranch :target |
>>                 branchDescriptor := descr. nextPC := next. postBranchPC
>> := postBranch. targetBytecodePC := target ].
>>
>>         "If an operand is an annotable constant, it may be forwarded, so
>> we need to store it into a
>>         register so the forwarder check can jump back to the comparison
>> after unforwarding the constant.
>>         However, if one of the operand is an unnanotable constant, does
>> not allocate a register for it
>>         (machine code will use operations on constants) and does not
>> generate forwarder checks."
>>         unforwardRcvr := (objectRepresentation isUnannotatableConstant:
>> (self ssValue: 1)) not.
>>         unforwardArg := (objectRepresentation isUnannotatableConstant:
>> self ssTop) not.
>>
>>         self
>>                 allocateEqualsEqualsRegistersArgNeedsReg: unforwardArg
>>                 rcvrNeedsReg: unforwardRcvr
>>                 into: [ :rcvr :arg | rcvrReg:= rcvr. argReg := arg ].
>>
>>         "If not followed by a branch, resolve to true or false."
>>         (branchDescriptor isBranchTrue or: [branchDescriptor
>> isBranchFalse]) ifFalse:
>>                 [^ self
>>                         genIdenticalNoBranchArgIsConstant: unforwardArg
>> not
>>                         rcvrIsConstant: unforwardRcvr not
>>                         argReg: argReg
>>                         rcvrReg: rcvrReg
>>                         orNotIf: orNot].
>>
>>         label := self Label.
>>         self genCmpArgIsConstant: unforwardArg not rcvrIsConstant:
>> unforwardRcvr not argReg: argReg rcvrReg: rcvrReg.
>>         self ssPop: 2.
>>
>>         "Further since there is a following conditional jump bytecode,
>> define
>>          non-merge fixups and leave the cond bytecode to set the
>> mergeness."
>>         (self fixupAt: nextPC - initialPC) notAFixup
>>                 ifTrue: "The next instruction is dead.  we can skip it."
>>                         [deadCode := true.
>>                          self ensureFixupAt: targetBytecodePC - initialPC.
>>                          self ensureFixupAt: postBranchPC - initialPC]
>>                 ifFalse:
>>                         [self deny: deadCode]. "push dummy value below"
>>
>>         self assert: (unforwardArg or: [unforwardRcvr]).
>> +       orNot == branchDescriptor isBranchTrue "orNot is true for ~~"
>> +               ifFalse: "branchDescriptor is branchFalse"
>> +                       [ fixup := (self ensureNonMergeFixupAt:
>> postBranchPC - initialPC) asUnsignedInteger.
>> +                       self JumpZero:  (self ensureNonMergeFixupAt:
>> targetBytecodePC - initialPC) asUnsignedInteger ]
>> +               ifTrue:
>> +                       [ fixup := (self ensureNonMergeFixupAt:
>> targetBytecodePC - initialPC) asUnsignedInteger.
>> +                       self JumpZero: (self ensureNonMergeFixupAt:
>> postBranchPC - initialPC) asUnsignedInteger ].
>> -       "We could use (branchDescriptor isBranchTrue xor: orNot) to
>> simplify this."
>> -       orNot
>> -               ifFalse: [branchDescriptor isBranchTrue
>> -                                       ifTrue:
>> -                                               [ fixup := (self
>> ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger.
>> -                                               self JumpZero:  (self
>> ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger ]
>> -                                       ifFalse: "branchDescriptor is
>> branchFalse"
>> -                                               [ fixup := (self
>> ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger.
>> -                                               self JumpZero: (self
>> ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger ]]
>> -               ifTrue: [branchDescriptor isBranchTrue
>> -                                       ifFalse: "branchDescriptor is
>> branchFalse"
>> -                                               [ fixup := (self
>> ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger.
>> -                                               self JumpZero:  (self
>> ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger ]
>> -                                       ifTrue:
>> -                                               [ fixup := (self
>> ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger.
>> -                                               self JumpZero: (self
>> ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger ]].
>>
>>         deadCode ifFalse:
>>                 [self ssPushConstant: objectMemory trueObject]. "dummy
>> value"
>>         "The forwarders checks need to jump back to the comparison
>> (label) if a forwarder is found, else
>>         jump forward either to the next forwarder check or to the
>> postBranch or branch target (fixup)."
>>         unforwardArg ifTrue:
>>                 [ unforwardRcvr
>>                         ifTrue: [ objectRepresentation
>> genEnsureOopInRegNotForwarded: argReg scratchReg: TempReg jumpBackTo: label
>> ]
>>                         ifFalse: [ objectRepresentation
>>                                 genEnsureOopInRegNotForwarded: argReg
>>                                 scratchReg: TempReg
>>                                 ifForwarder: label
>>                                 ifNotForwarder: fixup ] ].
>>         unforwardRcvr ifTrue:
>>                 [ objectRepresentation
>>                         genEnsureOopInRegNotForwarded: rcvrReg
>>                         scratchReg: TempReg
>>                         ifForwarder: label
>>                         ifNotForwarder: fixup ].
>>
>>         "Not reached, execution flow have jumped to fixup"
>>
>>         ^0!
>>
>> Item was changed:
>>   ----- Method: RegisterAllocatingCogit>>genVanillaInlinedIdenticalOrNotIf:
>> (in category 'bytecode generators') -----
>>   genVanillaInlinedIdenticalOrNotIf: orNot
>>         | nextPC postBranchPC targetBytecodePC branchDescriptor
>>           rcvrReg argReg argIsConstant rcvrIsConstant  |
>>         <var: #branchDescriptor type: #'BytecodeDescriptor *'>
>>
>>         self extractMaybeBranchDescriptorInto: [ :descr :next
>> :postBranch :target |
>>                 branchDescriptor := descr. nextPC := next. postBranchPC
>> := postBranch. targetBytecodePC := target ].
>>
>>         argIsConstant := self ssTop type = SSConstant.
>>         "They can't be both constants to use correct machine opcodes.
>>          However annotable constants can't be resolved statically, hence
>> we need to careful."
>>         rcvrIsConstant := argIsConstant not and: [(self ssValue: 1) type
>> = SSConstant].
>>
>>         self
>>                 allocateEqualsEqualsRegistersArgNeedsReg: argIsConstant
>> not
>>                 rcvrNeedsReg: rcvrIsConstant not
>>                 into: [ :rcvr :arg | rcvrReg:= rcvr. argReg := arg ].
>>
>>         "If not followed by a branch, resolve to true or false."
>>         (branchDescriptor isBranchTrue or: [branchDescriptor
>> isBranchFalse]) ifFalse:
>>                 [^ self
>>                         genIdenticalNoBranchArgIsConstant: argIsConstant
>>                         rcvrIsConstant: rcvrIsConstant
>>                         argReg: argReg
>>                         rcvrReg: rcvrReg
>>                         orNotIf: orNot].
>>
>>         self genCmpArgIsConstant: argIsConstant rcvrIsConstant:
>> rcvrIsConstant argReg: argReg rcvrReg: rcvrReg.
>>         self ssPop: 2.
>>
>>         "Further since there is a following conditional jump bytecode,
>> define
>>          non-merge fixups and leave the cond bytecode to set the
>> mergeness."
>>         (self fixupAt: nextPC - initialPC) notAFixup
>>                 ifTrue: "The next instruction is dead.  we can skip it."
>>                         [deadCode := true.
>>                          self ensureFixupAt: targetBytecodePC - initialPC.
>>                          self ensureFixupAt: postBranchPC - initialPC]
>>                 ifFalse:
>>                         [self deny: deadCode]. "push dummy value below"
>>
>> +       self genConditionalBranch: (orNot == branchDescriptor
>> isBranchTrue ifTrue: [JumpNonZero] ifFalse: [JumpZero])
>> -       "We could simplify this with a xor:"
>> -       self genConditionalBranch: (orNot
>> -                                               ifFalse:
>> [branchDescriptor isBranchTrue ifTrue: [JumpZero] ifFalse: [JumpNonZero]]
>> -                                               ifTrue: [branchDescriptor
>> isBranchTrue ifTrue: [JumpNonZero] ifFalse: [JumpZero]])
>>                 operand: (self ensureNonMergeFixupAt: targetBytecodePC -
>> initialPC) asUnsignedInteger.
>>
>>         "If the branch is dead, then we can just fall through
>> postBranchPC (only a nop in-between), else
>>         we need to jump over the code of the branch"
>>         deadCode ifFalse:
>>                 [self Jump: (self ensureNonMergeFixupAt: postBranchPC -
>> initialPC).
>>                  self ssPushConstant: objectMemory trueObject]. "dummy
>> value"
>>         ^0!
>>
>> Item was changed:
>>   ----- Method: SistaCogit>>genForwardersInlinedIdenticalOrNotIf: (in
>> category 'bytecode generators') -----
>>   genForwardersInlinedIdenticalOrNotIf: orNot
>>         "Override to count inlined branches if followed by a conditional
>> branch.
>>          We borrow the following conditional branch's counter and when
>> about to
>>          inline the comparison we decrement the counter (without writing
>> it back)
>>          and if it trips simply abort the inlining, falling back to the
>> normal send which
>>          will then continue to the conditional branch which will trip and
>> enter the abort."
>>         | nextPC postBranchPC targetBytecodePC branchDescriptor
>> counterReg fixup jumpEqual jumpNotEqual
>>           counterAddress countTripped unforwardArg unforwardRcvr argReg
>> rcvrReg regMask |
>>         <var: #fixup type: #'BytecodeFixup *'>
>>         <var: #countTripped type: #'AbstractInstruction *'>
>>         <var: #label type: #'AbstractInstruction *'>
>>         <var: #branchDescriptor type: #'BytecodeDescriptor *'>
>>         <var: #jumpEqual type: #'AbstractInstruction *'>
>>         <var: #jumpNotEqual type: #'AbstractInstruction *'>
>>
>>         ((coInterpreter isOptimizedMethod: methodObj) or: [needsFrame
>> not]) ifTrue:
>>                 [^super genForwardersInlinedIdenticalOrNotIf: orNot].
>>
>>         regMask := 0.
>>
>>         self extractMaybeBranchDescriptorInto: [ :descr :next
>> :postBranch :target |
>>                 branchDescriptor := descr. nextPC := next. postBranchPC
>> := postBranch. targetBytecodePC := target ].
>>
>>         unforwardRcvr := (objectRepresentation isUnannotatableConstant:
>> (self ssValue: 1)) not.
>>         unforwardArg := (objectRepresentation isUnannotatableConstant:
>> self ssTop) not.
>>
>>         "If an operand is an annotable constant, it may be forwarded, so
>> we need to store it into a
>>         register so the forwarder check can jump back to the comparison
>> after unforwarding the constant.
>>         However, if one of the operand is an unnanotable constant, does
>> not allocate a register for it
>>         (machine code will use operations on constants)."
>>         rcvrReg:= argReg := NoReg.
>>         self
>>                 allocateEqualsEqualsRegistersArgNeedsReg: unforwardArg
>>                 rcvrNeedsReg: unforwardRcvr
>>                 into: [ :rcvr :arg | rcvrReg:= rcvr. argReg := arg ].
>>
>>         argReg ~= NoReg ifTrue: [ regMask := self registerMaskFor: argReg
>> ].
>>         rcvrReg ~= NoReg ifTrue: [ regMask := regMask bitOr: (self
>> registerMaskFor: rcvrReg) ].
>>
>>         "Only interested in inlining if followed by a conditional branch."
>>         (branchDescriptor isBranchTrue or: [branchDescriptor
>> isBranchFalse]) ifFalse:
>>                 [^ self
>>                         genIdenticalNoBranchArgIsConstant: unforwardArg
>> not
>>                         rcvrIsConstant: unforwardRcvr not
>>                         argReg: argReg
>>                         rcvrReg: rcvrReg
>>                         orNotIf: orNot].
>>
>>         "If branching the stack must be flushed for the merge"
>>         self ssFlushTo: simStackPtr - 2.
>>
>>         unforwardArg ifTrue: [ objectRepresentation
>> genEnsureOopInRegNotForwarded: argReg scratchReg: TempReg ].
>>         unforwardRcvr ifTrue: [ objectRepresentation
>> genEnsureOopInRegNotForwarded: rcvrReg scratchReg: TempReg ].
>>
>>         counterReg := self allocateRegNotConflictingWith: regMask.
>>         self
>>                 genExecutionCountLogicInto: [ :cAddress :countTripBranch |
>>                         counterAddress := cAddress.
>>                         countTripped := countTripBranch ]
>>                 counterReg: counterReg.
>>
>>         self assert: (unforwardArg or: [ unforwardRcvr ]).
>>         self genCmpArgIsConstant: unforwardArg not rcvrIsConstant:
>> unforwardRcvr not argReg: argReg rcvrReg: rcvrReg.
>>         self ssPop: 2.
>>
>> +       orNot == branchDescriptor isBranchTrue "orNot is true for ~~"
>> +               ifFalse:
>> +                       [ fixup := (self ensureNonMergeFixupAt:
>> postBranchPC - initialPC) asUnsignedInteger.
>> +                       self JumpZero:  (self ensureNonMergeFixupAt:
>> targetBytecodePC - initialPC) asUnsignedInteger ]
>> +               ifTrue:
>> +                       [ fixup := (self ensureNonMergeFixupAt:
>> targetBytecodePC - initialPC) asUnsignedInteger.
>> +                       self JumpZero: (self ensureNonMergeFixupAt:
>> postBranchPC - initialPC) asUnsignedInteger ].
>> -       "We could use (branchDescriptor isBranchTrue xor: orNot) to
>> simplify this."
>> -       orNot
>> -               ifFalse: [branchDescriptor isBranchTrue
>> -                                       ifTrue:
>> -                                               [ fixup := (self
>> ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger.
>> -                                               self JumpZero:  (self
>> ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger ]
>> -                                       ifFalse: "branchDescriptor is
>> branchFalse"
>> -                                               [ fixup := (self
>> ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger.
>> -                                               self JumpZero: (self
>> ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger ]]
>> -               ifTrue: [branchDescriptor isBranchTrue
>> -                                       ifFalse: "branchDescriptor is
>> branchFalse"
>> -                                               [ fixup := (self
>> ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger.
>> -                                               self JumpZero:  (self
>> ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger ]
>> -                                       ifTrue:
>> -                                               [ fixup := (self
>> ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger.
>> -                                               self JumpZero: (self
>> ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger ]].
>>
>>         self genFallsThroughCountLogicCounterReg: counterReg
>> counterAddress: counterAddress.
>>         self Jump: fixup.
>>
>>         countTripped jmpTarget: self Label.
>>
>>         "inlined version of #== ignoring the branchDescriptor if the
>> counter trips to have normal state for the optimizer"
>>         self ssPop: -2.
>>         self genCmpArgIsConstant: unforwardArg not rcvrIsConstant:
>> unforwardRcvr not argReg: argReg rcvrReg: rcvrReg.
>>         self ssPop: 2.
>>
>>         "This code necessarily directly falls through the jumpIf: code
>> which pops the top of the stack into TempReg.
>>         We therefore directly assign the result to TempReg to save one
>> move instruction"
>>         jumpEqual := orNot ifFalse: [self JumpZero: 0] ifTrue: [self
>> JumpNonZero: 0].
>>         self genMoveFalseR: TempReg.
>>         jumpNotEqual := self Jump: 0.
>>         jumpEqual jmpTarget: (self genMoveTrueR: TempReg).
>>         jumpNotEqual jmpTarget: self Label.
>>         self ssPushRegister: TempReg.
>>
>>         (self fixupAt: nextPC - initialPC) notAFixup ifTrue: [
>> branchReachedOnlyForCounterTrip := true ].
>>
>>         ^ 0!
>>
>> Item was changed:
>>   ----- Method: SistaRegisterAllocatingCogit>>
>> genForwardersInlinedIdenticalOrNotIf: (in category 'bytecode
>> generators') -----
>>   genForwardersInlinedIdenticalOrNotIf: orNot
>>         "Override to count inlined branches if followed by a conditional
>> branch.
>>          We borrow the following conditional branch's counter and when
>> about to
>>          inline the comparison we decrement the counter (without writing
>> it back)
>>          and if it trips simply abort the inlining, falling back to the
>> normal send which
>>          will then continue to the conditional branch which will trip and
>> enter the abort."
>>         | nextPC postBranchPC targetBytecodePC branchDescriptor
>> counterReg fixup jumpEqual jumpNotEqual
>>           counterAddress countTripped unforwardArg unforwardRcvr argReg
>> rcvrReg regMask |
>>         <var: #fixup type: #'BytecodeFixup *'>
>>         <var: #countTripped type: #'AbstractInstruction *'>
>>         <var: #label type: #'AbstractInstruction *'>
>>         <var: #branchDescriptor type: #'BytecodeDescriptor *'>
>>         <var: #jumpEqual type: #'AbstractInstruction *'>
>>         <var: #jumpNotEqual type: #'AbstractInstruction *'>
>>
>>         ((coInterpreter isOptimizedMethod: methodObj) or: [needsFrame
>> not]) ifTrue:
>>                 [^super genForwardersInlinedIdenticalOrNotIf: orNot].
>>
>>         regMask := 0.
>>
>>         self extractMaybeBranchDescriptorInto: [ :descr :next
>> :postBranch :target |
>>                 branchDescriptor := descr. nextPC := next. postBranchPC
>> := postBranch. targetBytecodePC := target ].
>>
>>         unforwardRcvr := (objectRepresentation isUnannotatableConstant:
>> (self ssValue: 1)) not.
>>         unforwardArg := (objectRepresentation isUnannotatableConstant:
>> self ssTop) not.
>>
>>         "If an operand is an annotable constant, it may be forwarded, so
>> we need to store it into a
>>         register so the forwarder check can jump back to the comparison
>> after unforwarding the constant.
>>         However, if one of the operand is an unnanotable constant, does
>> not allocate a register for it
>>         (machine code will use operations on constants)."
>>         rcvrReg:= argReg := NoReg.
>>         self
>>                 allocateEqualsEqualsRegistersArgNeedsReg: unforwardArg
>>                 rcvrNeedsReg: unforwardRcvr
>>                 into: [ :rcvr :arg | rcvrReg:= rcvr. argReg := arg ].
>>
>>         argReg ~= NoReg ifTrue: [ regMask := self registerMaskFor: argReg
>> ].
>>         rcvrReg ~= NoReg ifTrue: [ regMask := regMask bitOr: (self
>> registerMaskFor: rcvrReg) ].
>>
>>         "Only interested in inlining if followed by a conditional branch."
>>         (branchDescriptor isBranchTrue or: [branchDescriptor
>> isBranchFalse]) ifFalse:
>>                 [^ self
>>                         genIdenticalNoBranchArgIsConstant: unforwardArg
>> not
>>                         rcvrIsConstant: unforwardRcvr not
>>                         argReg: argReg
>>                         rcvrReg: rcvrReg
>>                         orNotIf: orNot].
>>
>>         unforwardArg ifTrue: [ objectRepresentation
>> genEnsureOopInRegNotForwarded: argReg scratchReg: TempReg ].
>>         unforwardRcvr ifTrue: [ objectRepresentation
>> genEnsureOopInRegNotForwarded: rcvrReg scratchReg: TempReg ].
>>
>>         counterReg := self allocateRegNotConflictingWith: regMask.
>>         self
>>                 genExecutionCountLogicInto: [ :cAddress :countTripBranch |
>>                         counterAddress := cAddress.
>>                         countTripped := countTripBranch ]
>>                 counterReg: counterReg.
>>
>>         self assert: (unforwardArg or: [ unforwardRcvr ]).
>>         self genCmpArgIsConstant: unforwardArg not rcvrIsConstant:
>> unforwardRcvr not argReg: argReg rcvrReg: rcvrReg.
>>         self ssPop: 2.
>>
>> +       orNot == branchDescriptor isBranchTrue "orNot is true for ~~"
>> +               ifFalse:
>> +                       [ fixup := (self ensureNonMergeFixupAt:
>> postBranchPC - initialPC) asUnsignedInteger.
>> +                       self JumpZero:  (self ensureNonMergeFixupAt:
>> targetBytecodePC - initialPC) asUnsignedInteger ]
>> +               ifTrue:
>> +                       [ fixup := (self ensureNonMergeFixupAt:
>> targetBytecodePC - initialPC) asUnsignedInteger.
>> +                       self JumpZero: (self ensureNonMergeFixupAt:
>> postBranchPC - initialPC) asUnsignedInteger ].
>> -       "We could use (branchDescriptor isBranchTrue xor: orNot) to
>> simplify this."
>> -       orNot
>> -               ifFalse: [branchDescriptor isBranchTrue
>> -                                       ifTrue:
>> -                                               [ fixup := (self
>> ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger.
>> -                                               self JumpZero:  (self
>> ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger ]
>> -                                       ifFalse: "branchDescriptor is
>> branchFalse"
>> -                                               [ fixup := (self
>> ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger.
>> -                                               self JumpZero: (self
>> ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger ]]
>> -               ifTrue: [branchDescriptor isBranchTrue
>> -                                       ifFalse: "branchDescriptor is
>> branchFalse"
>> -                                               [ fixup := (self
>> ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger.
>> -                                               self JumpZero:  (self
>> ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger ]
>> -                                       ifTrue:
>> -                                               [ fixup := (self
>> ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger.
>> -                                               self JumpZero: (self
>> ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger ]].
>>
>>         self genFallsThroughCountLogicCounterReg: counterReg
>> counterAddress: counterAddress.
>>         self Jump: fixup.
>>
>>         countTripped jmpTarget: self Label.
>>
>>         "inlined version of #== ignoring the branchDescriptor if the
>> counter trips to have normal state for the optimizer"
>>         self ssPop: -2.
>>         self genCmpArgIsConstant: unforwardArg not rcvrIsConstant:
>> unforwardRcvr not argReg: argReg rcvrReg: rcvrReg.
>>         self ssPop: 2.
>>
>>         "This code necessarily directly falls through the jumpIf: code
>> which pops the top of the stack into TempReg.
>>         We therefore directly assign the result to TempReg to save one
>> move instruction"
>>         jumpEqual := orNot ifFalse: [self JumpZero: 0] ifTrue: [self
>> JumpNonZero: 0].
>>         self genMoveFalseR: TempReg.
>>         jumpNotEqual := self Jump: 0.
>>         jumpEqual jmpTarget: (self genMoveTrueR: TempReg).
>>         jumpNotEqual jmpTarget: self Label.
>>         self ssPushRegister: TempReg.
>>
>>         (self fixupAt: nextPC - initialPC) notAFixup ifTrue: [
>> branchReachedOnlyForCounterTrip := true ].
>>
>>         ^ 0!
>>
>> Item was changed:
>>   ----- Method: StackToRegisterMappingCogit>>e
>> xtractMaybeBranchDescriptorInto: (in category 'bytecode generator
>> support') -----
>>   extractMaybeBranchDescriptorInto: fourArgBlock
>>         "Looks one instruction ahead of the current bytecodePC and
>> answers its bytecode descriptor and its pc.
>> +        If the instruction found is a branch, also answers the pc after
>> the branch and the pc targeted by the branch.
>> +        For convenience, avoiding duplication in the senders, it follows
>> those two pcs to their eventual targets."
>> -        If the instruction found is a branch, also answers the pc after
>> the branch and the pc targeted by the branch."
>>         | primDescriptor nextPC nExts branchDescriptor targetBytecodePC
>> postBranchPC |
>>         <inline: true>
>>         <var: #primDescriptor type: #'BytecodeDescriptor *'>
>>         <var: #branchDescriptor type: #'BytecodeDescriptor *'>
>>
>>         primDescriptor := self generatorAt: byte0.
>>
>>         nextPC := bytecodePC + primDescriptor numBytes.
>>         nExts := 0.
>>         [[branchDescriptor := self generatorAt: (objectMemory fetchByte:
>> nextPC ofObject: methodObj) + bytecodeSetOffset.
>>           branchDescriptor isExtension] whileTrue:
>>                 [nExts := nExts + 1.
>>                  nextPC := nextPC + branchDescriptor numBytes].
>>          branchDescriptor isUnconditionalBranch]
>>                 whileTrue:
>>                         [nextPC := self eventualTargetOf: nextPC
>>
>>               + branchDescriptor numBytes
>>
>>               + (self spanFor: branchDescriptor at: nextPC exts: nExts in:
>> methodObj)].
>>
>>         targetBytecodePC := postBranchPC := 0.
>>
>>         (branchDescriptor isBranchTrue or: [branchDescriptor
>> isBranchFalse])
>>                 ifTrue:
>>                         [targetBytecodePC := self eventualTargetOf: nextPC
>>
>>                                       + branchDescriptor numBytes
>>
>>                                       + (self spanFor: branchDescriptor at:
>> nextPC exts: nExts in: methodObj).
>>                          postBranchPC := self eventualTargetOf: nextPC +
>> branchDescriptor numBytes]
>>                 ifFalse:
>> +                       [nextPC := bytecodePC + primDescriptor numBytes].
>> -                       [branchDescriptor isReturn ifFalse:
>> -                               [postBranchPC := self eventualTargetOf:
>> nextPC + branchDescriptor numBytes.
>> -                                nextPC := self eventualTargetOf:
>> bytecodePC + primDescriptor numBytes]].
>>
>>         fourArgBlock value: branchDescriptor value: nextPC value:
>> postBranchPC value: targetBytecodePC!
>>
>> Item was changed:
>>   ----- Method: StackToRegisterMappingCogit>>g
>> enForwardersInlinedIdenticalOrNotIf: (in category 'bytecode generators')
>> -----
>>   genForwardersInlinedIdenticalOrNotIf: orNot
>>         | nextPC branchDescriptor unforwardRcvr argReg targetBytecodePC
>>         unforwardArg  rcvrReg postBranchPC label fixup |
>>         <var: #branchDescriptor type: #'BytecodeDescriptor *'>
>>         <var: #label type: #'AbstractInstruction *'>
>>
>>         self extractMaybeBranchDescriptorInto: [ :descr :next
>> :postBranch :target |
>>                 branchDescriptor := descr. nextPC := next. postBranchPC
>> := postBranch. targetBytecodePC := target ].
>>
>>         "If an operand is an annotable constant, it may be forwarded, so
>> we need to store it into a
>>         register so the forwarder check can jump back to the comparison
>> after unforwarding the constant.
>>         However, if one of the operand is an unnanotable constant, does
>> not allocate a register for it
>>         (machine code will use operations on constants) and does not
>> generate forwarder checks."
>>         unforwardRcvr := (objectRepresentation isUnannotatableConstant:
>> (self ssValue: 1)) not.
>>         unforwardArg := (objectRepresentation isUnannotatableConstant:
>> self ssTop) not.
>>
>>         self
>>                 allocateEqualsEqualsRegistersArgNeedsReg: unforwardArg
>>                 rcvrNeedsReg: unforwardRcvr
>>                 into: [ :rcvr :arg | rcvrReg:= rcvr. argReg := arg ].
>>
>>         "If not followed by a branch, resolve to true or false."
>>         (branchDescriptor isBranchTrue or: [branchDescriptor
>> isBranchFalse]) ifFalse:
>>                 [^ self
>>                         genIdenticalNoBranchArgIsConstant: unforwardArg
>> not
>>                         rcvrIsConstant: unforwardRcvr not
>>                         argReg: argReg
>>                         rcvrReg: rcvrReg
>>                         orNotIf: orNot].
>>
>>         "If branching the stack must be flushed for the merge"
>>         self ssFlushTo: simStackPtr - 2.
>>
>>         label := self Label.
>>         self genCmpArgIsConstant: unforwardArg not rcvrIsConstant:
>> unforwardRcvr not argReg: argReg rcvrReg: rcvrReg.
>>         self ssPop: 2.
>>
>>         "Further since there is a following conditional jump bytecode,
>> define
>>          non-merge fixups and leave the cond bytecode to set the
>> mergeness."
>>         (self fixupAt: nextPC - initialPC) notAFixup
>>                 ifTrue: "The next instruction is dead.  we can skip it."
>>                         [deadCode := true.
>>                          self ensureFixupAt: targetBytecodePC - initialPC.
>>                          self ensureFixupAt: postBranchPC - initialPC]
>>                 ifFalse:
>>                         [self deny: deadCode]. "push dummy value below"
>>
>>         self assert: (unforwardArg or: [unforwardRcvr]).
>> +       orNot == branchDescriptor isBranchTrue "orNot is true for ~~"
>> +               ifFalse:
>> +                       [ fixup := (self ensureNonMergeFixupAt:
>> postBranchPC - initialPC) asUnsignedInteger.
>> +                       self JumpZero:  (self ensureNonMergeFixupAt:
>> targetBytecodePC - initialPC) asUnsignedInteger ]
>> +               ifTrue:
>> +                       [ fixup := (self ensureNonMergeFixupAt:
>> targetBytecodePC - initialPC) asUnsignedInteger.
>> +                       self JumpZero: (self ensureNonMergeFixupAt:
>> postBranchPC - initialPC) asUnsignedInteger ].
>> -       "We could use (branchDescriptor isBranchTrue xor: orNot) to
>> simplify this."
>> -       orNot
>> -               ifFalse: [branchDescriptor isBranchTrue
>> -                                       ifTrue:
>> -                                               [ fixup := (self
>> ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger.
>> -                                               self JumpZero:  (self
>> ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger ]
>> -                                       ifFalse: "branchDescriptor is
>> branchFalse"
>> -                                               [ fixup := (self
>> ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger.
>> -                                               self JumpZero: (self
>> ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger ]]
>> -               ifTrue: [branchDescriptor isBranchTrue
>> -                                       ifFalse: "branchDescriptor is
>> branchFalse"
>> -                                               [ fixup := (self
>> ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger.
>> -                                               self JumpZero:  (self
>> ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger ]
>> -                                       ifTrue:
>> -                                               [ fixup := (self
>> ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger.
>> -                                               self JumpZero: (self
>> ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger ]].
>>
>>         deadCode ifFalse:
>>                 [self ssPushConstant: objectMemory trueObject]. "dummy
>> value"
>>
>>         "The forwarders checks need to jump back to the comparison
>> (label) if a forwarder is found, else
>>         jump forward either to the next forwarder check or to the
>> postBranch or branch target (fixup)."
>>         unforwardArg ifTrue:
>>                 [ unforwardRcvr
>>                         ifTrue: [ objectRepresentation
>> genEnsureOopInRegNotForwarded: argReg scratchReg: TempReg jumpBackTo: label
>> ]
>>                         ifFalse: [ objectRepresentation
>>                                 genEnsureOopInRegNotForwarded: argReg
>>                                 scratchReg: TempReg
>>                                 ifForwarder: label
>>                                 ifNotForwarder: fixup ] ].
>>         unforwardRcvr ifTrue:
>>                 [ objectRepresentation
>>                         genEnsureOopInRegNotForwarded: rcvrReg
>>                         scratchReg: TempReg
>>                         ifForwarder: label
>>                         ifNotForwarder: fixup ].
>>
>>         "Not reached, execution flow have jumped to fixup"
>>
>>         ^0!
>>
>> Item was changed:
>>   ----- Method: StackToRegisterMappingCogit>>g
>> enVanillaInlinedIdenticalOrNotIf: (in category 'bytecode generators')
>> -----
>>   genVanillaInlinedIdenticalOrNotIf: orNot
>>         | nextPC postBranchPC targetBytecodePC branchDescriptor
>>           rcvrReg argReg argIsConstant rcvrIsConstant  |
>>         <var: #branchDescriptor type: #'BytecodeDescriptor *'>
>>
>>         self extractMaybeBranchDescriptorInto: [ :descr :next
>> :postBranch :target |
>>                 branchDescriptor := descr. nextPC := next. postBranchPC
>> := postBranch. targetBytecodePC := target ].
>>
>>         argIsConstant := self ssTop type = SSConstant.
>>         "They can't be both constants to use correct machine opcodes.
>>          However annotable constants can't be resolved statically, hence
>> we need to careful."
>>         rcvrIsConstant := argIsConstant not and: [(self ssValue: 1) type
>> = SSConstant].
>>
>>         self
>>                 allocateEqualsEqualsRegistersArgNeedsReg: argIsConstant
>> not
>>                 rcvrNeedsReg: rcvrIsConstant not
>>                 into: [ :rcvr :arg | rcvrReg:= rcvr. argReg := arg ].
>>
>>         "If not followed by a branch, resolve to true or false."
>>         (branchDescriptor isBranchTrue or: [branchDescriptor
>> isBranchFalse]) ifFalse:
>>                 [^ self
>>                         genIdenticalNoBranchArgIsConstant: argIsConstant
>>                         rcvrIsConstant: rcvrIsConstant
>>                         argReg: argReg
>>                         rcvrReg: rcvrReg
>>                         orNotIf: orNot].
>>
>>         "If branching the stack must be flushed for the merge"
>>         self ssFlushTo: simStackPtr - 2.
>>
>>         self genCmpArgIsConstant: argIsConstant rcvrIsConstant:
>> rcvrIsConstant argReg: argReg rcvrReg: rcvrReg.
>>         self ssPop: 2.
>>
>>         "Further since there is a following conditional jump bytecode,
>> define
>>          non-merge fixups and leave the cond bytecode to set the
>> mergeness."
>>         (self fixupAt: nextPC - initialPC) notAFixup
>>                 ifTrue: "The next instruction is dead.  we can skip it."
>>                         [deadCode := true.
>>                          self ensureFixupAt: targetBytecodePC - initialPC.
>>                          self ensureFixupAt: postBranchPC - initialPC]
>>                 ifFalse:
>>                         [self deny: deadCode]. "push dummy value below"
>>
>> +       self genConditionalBranch: (orNot == branchDescriptor
>> isBranchTrue ifTrue: [JumpNonZero] ifFalse: [JumpZero])
>> -       "We could simplify this with a xor:"
>> -       self genConditionalBranch: (orNot
>> -                                               ifFalse:
>> [branchDescriptor isBranchTrue ifTrue: [JumpZero] ifFalse: [JumpNonZero]]
>> -                                               ifTrue: [branchDescriptor
>> isBranchTrue ifTrue: [JumpNonZero] ifFalse: [JumpZero]])
>>                 operand: (self ensureNonMergeFixupAt: targetBytecodePC -
>> initialPC) asUnsignedInteger.
>>
>>         "If the branch is dead, then we can just fall through
>> postBranchPC (only a nop in-between), else
>>         we need to jump over the code of the branch"
>>         deadCode ifFalse:
>>                 [self Jump: (self ensureNonMergeFixupAt: postBranchPC -
>> initialPC).
>>                  self ssPushConstant: objectMemory trueObject]. "dummy
>> value"
>>         ^0!
>>
>>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.squeakfoundation.org/pipermail/vm-dev/attachments/20170118/2bfe5367/attachment-0001.html>


More information about the Vm-dev mailing list