<div dir="ltr">Well, the crash seems to be unrelated to primitiveStringReplace...<div><br></div><div>2088 was working just fine.</div><div>2099 is not. Something wrong has happened in between.<br><div class="gmail_extra"><br><div class="gmail_quote">On Wed, Jan 18, 2017 at 10:17 AM, Clément Bera <span dir="ltr"><<a href="mailto:bera.clement@gmail.com" target="_blank">bera.clement@gmail.com</a>></span> wrote:<br><blockquote class="gmail_quote" style="margin:0px 0px 0px 0.8ex;border-left:1px solid rgb(204,204,204);padding-left:1ex"><div dir="ltr">Hi,<div><br></div><div>When I compile from this version I have a start-up crash in Pharo.</div><div><br></div><div>I suspect changes in primitiveStringReplace ...</div><div><br></div><div><div>Segmentation fault Wed Jan 18 10:10:24 2017</div><div><font face="monospace, monospace"><br></font></div><div><font face="monospace, monospace">[...]</font></div><div><font face="monospace, monospace">Smalltalk stack dump:</font></div><div><font face="monospace, monospace">0xbff11834 M Array(SequenceableCollection)><wbr>mergeFirst:middle:last:into:<wbr>by: 0x47c0138: a(n) Array</font></div><div><font face="monospace, monospace">0xbff11864 M Array(SequenceableCollection)><wbr>mergeSortFrom:to:src:dst:by: 0x47c0068: a(n) Array</font></div><div><font face="monospace, monospace">0xbff11894 M Array(SequenceableCollection)><wbr>mergeSortFrom:to:src:dst:by: 0x47c0068: a(n) Array</font></div><div><font face="monospace, monospace">0xbff118cc I Array(SequenceableCollection)><wbr>mergeSortFrom:to:src:dst:by: 0x47c0068: a(n) Array</font></div><div><font face="monospace, monospace">0xbff11900 I Array(SequenceableCollection)><wbr>mergeSortFrom:to:by: 0x47c0068: a(n) Array</font></div><div><font face="monospace, monospace">[...]</font></div><div><font face="monospace, monospace"> 0x5356da0 s WorldMorph>doOneCycle</font></div><div><font face="monospace, monospace"> 0x5356d40 s WorldMorph class>doOneCycle</font></div><div><font face="monospace, monospace"> 0x876f890 s [] in MorphicUIManager><wbr>spawnNewProcess</font></div><div><font face="monospace, monospace"> 0x876fa20 s [] in FullBlockClosure>newProcess</font></div><div><font face="monospace, monospace"><br></font></div><div><font face="monospace, monospace">Most recent primitives</font></div><div><font face="monospace, monospace">new:</font></div><div><font face="monospace, monospace">basicNew</font></div><div><font face="monospace, monospace">value:</font></div><div><font face="monospace, monospace">at:</font></div><div><font face="monospace, monospace">at:</font></div><div><font face="monospace, monospace">[...]</font></div><div><font face="monospace, monospace">replaceFrom:to:with:<wbr>startingAt:</font></div><div><font face="monospace, monospace">replaceFrom:to:with:<wbr>startingAt:</font></div><div><font face="monospace, monospace">replaceFrom:to:with:<wbr>startingAt:</font></div><div><font face="monospace, monospace">replaceFrom:to:with:<wbr>startingAt:</font></div><div><font face="monospace, monospace"><br></font></div><div><font face="monospace, monospace">stack page bytes 4096 available headroom 2788 minimum unused headroom 68</font></div><div><font face="monospace, monospace"><br></font></div><div><font face="monospace, monospace"><span class="gmail-m_-3555673930144104041gmail-Apple-tab-span" style="white-space:pre-wrap">  </span>(Segmentation fault)</font></div><div><font face="monospace, monospace">Abort trap: 6</font></div></div></div><div class="gmail-HOEnZb"><div class="gmail-h5"><div class="gmail_extra"><br><div class="gmail_quote">On Tue, Jan 17, 2017 at 7:04 PM,  <span dir="ltr"><<a href="mailto:commits@source.squeak.org" target="_blank">commits@source.squeak.org</a>></span> wrote:<br><blockquote class="gmail_quote" style="margin:0px 0px 0px 0.8ex;border-left:1px solid rgb(204,204,204);padding-left:1ex"><br>
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:<br>
<a href="http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2099.mcz" rel="noreferrer" target="_blank">http://source.squeak.org/VMMak<wbr>er/VMMaker.oscog-eem.2099.mcz</a><br>
<br>
==================== Summary ====================<br>
<br>
Name: VMMaker.oscog-eem.2099<br>
Author: eem<br>
Time: 17 January 2017, 10:03:25.012123 am<br>
UUID: 08323ffb-7df4-498c-a5b0-8a4e6d<wbr>295352<br>
Ancestors: VMMaker.oscog-eem.2098<br>
<br>
StackToRegisterMappingCogits:<br>
Clean-up after the branch following changes:<br>
Make extractMaybeBranchDescriptorIn<wbr>to: fulfil its contract when it doesn't find a following branch (directly or indirectly).<br>
Simplify the various gen*InlinedIdenticalOrNotIf: to eliminate the duplication using #== to compare orNot with the branch.<br>
<br>
=============== Diff against VMMaker.oscog-eem.2098 ===============<br>
<br>
Item was changed:<br>
  ----- Method: RegisterAllocatingCogit>>genFo<wbr>rwardersInlinedIdenticalOrNotI<wbr>f: (in category 'bytecode generators') -----<br>
  genForwardersInlinedIdenticalO<wbr>rNotIf: orNot<br>
        | nextPC branchDescriptor unforwardRcvr argReg targetBytecodePC<br>
        unforwardArg  rcvrReg postBranchPC label fixup |<br>
        <var: #branchDescriptor type: #'BytecodeDescriptor *'><br>
        <var: #label type: #'AbstractInstruction *'><br>
<br>
        self extractMaybeBranchDescriptorIn<wbr>to: [ :descr :next :postBranch :target |<br>
                branchDescriptor := descr. nextPC := next. postBranchPC := postBranch. targetBytecodePC := target ].<br>
<br>
        "If an operand is an annotable constant, it may be forwarded, so we need to store it into a<br>
        register so the forwarder check can jump back to the comparison after unforwarding the constant.<br>
        However, if one of the operand is an unnanotable constant, does not allocate a register for it<br>
        (machine code will use operations on constants) and does not generate forwarder checks."<br>
        unforwardRcvr := (objectRepresentation isUnannotatableConstant: (self ssValue: 1)) not.<br>
        unforwardArg := (objectRepresentation isUnannotatableConstant: self ssTop) not.<br>
<br>
        self<br>
                allocateEqualsEqualsRegistersA<wbr>rgNeedsReg: unforwardArg<br>
                rcvrNeedsReg: unforwardRcvr<br>
                into: [ :rcvr :arg | rcvrReg:= rcvr. argReg := arg ].<br>
<br>
        "If not followed by a branch, resolve to true or false."<br>
        (branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse]) ifFalse:<br>
                [^ self<br>
                        genIdenticalNoBranchArgIsConst<wbr>ant: unforwardArg not<br>
                        rcvrIsConstant: unforwardRcvr not<br>
                        argReg: argReg<br>
                        rcvrReg: rcvrReg<br>
                        orNotIf: orNot].<br>
<br>
        label := self Label.<br>
        self genCmpArgIsConstant: unforwardArg not rcvrIsConstant: unforwardRcvr not argReg: argReg rcvrReg: rcvrReg.<br>
        self ssPop: 2.<br>
<br>
        "Further since there is a following conditional jump bytecode, define<br>
         non-merge fixups and leave the cond bytecode to set the mergeness."<br>
        (self fixupAt: nextPC - initialPC) notAFixup<br>
                ifTrue: "The next instruction is dead.  we can skip it."<br>
                        [deadCode := true.<br>
                         self ensureFixupAt: targetBytecodePC - initialPC.<br>
                         self ensureFixupAt: postBranchPC - initialPC]<br>
                ifFalse:<br>
                        [self deny: deadCode]. "push dummy value below"<br>
<br>
        self assert: (unforwardArg or: [unforwardRcvr]).<br>
+       orNot == branchDescriptor isBranchTrue "orNot is true for ~~"<br>
+               ifFalse: "branchDescriptor is branchFalse"<br>
+                       [ fixup := (self ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger.<br>
+                       self JumpZero:  (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger ]<br>
+               ifTrue:<br>
+                       [ fixup := (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger.<br>
+                       self JumpZero: (self ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger ].<br>
-       "We could use (branchDescriptor isBranchTrue xor: orNot) to simplify this."<br>
-       orNot<br>
-               ifFalse: [branchDescriptor isBranchTrue<br>
-                                       ifTrue:<br>
-                                               [ fixup := (self ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger.<br>
-                                               self JumpZero:  (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger ]<br>
-                                       ifFalse: "branchDescriptor is branchFalse"<br>
-                                               [ fixup := (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger.<br>
-                                               self JumpZero: (self ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger ]]<br>
-               ifTrue: [branchDescriptor isBranchTrue<br>
-                                       ifFalse: "branchDescriptor is branchFalse"<br>
-                                               [ fixup := (self ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger.<br>
-                                               self JumpZero:  (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger ]<br>
-                                       ifTrue:<br>
-                                               [ fixup := (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger.<br>
-                                               self JumpZero: (self ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger ]].<br>
<br>
        deadCode ifFalse:<br>
                [self ssPushConstant: objectMemory trueObject]. "dummy value"<br>
        "The forwarders checks need to jump back to the comparison (label) if a forwarder is found, else<br>
        jump forward either to the next forwarder check or to the postBranch or branch target (fixup)."<br>
        unforwardArg ifTrue:<br>
                [ unforwardRcvr<br>
                        ifTrue: [ objectRepresentation genEnsureOopInRegNotForwarded: argReg scratchReg: TempReg jumpBackTo: label ]<br>
                        ifFalse: [ objectRepresentation<br>
                                genEnsureOopInRegNotForwarded: argReg<br>
                                scratchReg: TempReg<br>
                                ifForwarder: label<br>
                                ifNotForwarder: fixup ] ].<br>
        unforwardRcvr ifTrue:<br>
                [ objectRepresentation<br>
                        genEnsureOopInRegNotForwarded: rcvrReg<br>
                        scratchReg: TempReg<br>
                        ifForwarder: label<br>
                        ifNotForwarder: fixup ].<br>
<br>
        "Not reached, execution flow have jumped to fixup"<br>
<br>
        ^0!<br>
<br>
Item was changed:<br>
  ----- Method: RegisterAllocatingCogit>>genVa<wbr>nillaInlinedIdenticalOrNotIf: (in category 'bytecode generators') -----<br>
  genVanillaInlinedIdenticalOrNo<wbr>tIf: orNot<br>
        | nextPC postBranchPC targetBytecodePC branchDescriptor<br>
          rcvrReg argReg argIsConstant rcvrIsConstant  |<br>
        <var: #branchDescriptor type: #'BytecodeDescriptor *'><br>
<br>
        self extractMaybeBranchDescriptorIn<wbr>to: [ :descr :next :postBranch :target |<br>
                branchDescriptor := descr. nextPC := next. postBranchPC := postBranch. targetBytecodePC := target ].<br>
<br>
        argIsConstant := self ssTop type = SSConstant.<br>
        "They can't be both constants to use correct machine opcodes.<br>
         However annotable constants can't be resolved statically, hence we need to careful."<br>
        rcvrIsConstant := argIsConstant not and: [(self ssValue: 1) type = SSConstant].<br>
<br>
        self<br>
                allocateEqualsEqualsRegistersA<wbr>rgNeedsReg: argIsConstant not<br>
                rcvrNeedsReg: rcvrIsConstant not<br>
                into: [ :rcvr :arg | rcvrReg:= rcvr. argReg := arg ].<br>
<br>
        "If not followed by a branch, resolve to true or false."<br>
        (branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse]) ifFalse:<br>
                [^ self<br>
                        genIdenticalNoBranchArgIsConst<wbr>ant: argIsConstant<br>
                        rcvrIsConstant: rcvrIsConstant<br>
                        argReg: argReg<br>
                        rcvrReg: rcvrReg<br>
                        orNotIf: orNot].<br>
<br>
        self genCmpArgIsConstant: argIsConstant rcvrIsConstant: rcvrIsConstant argReg: argReg rcvrReg: rcvrReg.<br>
        self ssPop: 2.<br>
<br>
        "Further since there is a following conditional jump bytecode, define<br>
         non-merge fixups and leave the cond bytecode to set the mergeness."<br>
        (self fixupAt: nextPC - initialPC) notAFixup<br>
                ifTrue: "The next instruction is dead.  we can skip it."<br>
                        [deadCode := true.<br>
                         self ensureFixupAt: targetBytecodePC - initialPC.<br>
                         self ensureFixupAt: postBranchPC - initialPC]<br>
                ifFalse:<br>
                        [self deny: deadCode]. "push dummy value below"<br>
<br>
+       self genConditionalBranch: (orNot == branchDescriptor isBranchTrue ifTrue: [JumpNonZero] ifFalse: [JumpZero])<br>
-       "We could simplify this with a xor:"<br>
-       self genConditionalBranch: (orNot<br>
-                                               ifFalse: [branchDescriptor isBranchTrue ifTrue: [JumpZero] ifFalse: [JumpNonZero]]<br>
-                                               ifTrue: [branchDescriptor isBranchTrue ifTrue: [JumpNonZero] ifFalse: [JumpZero]])<br>
                operand: (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger.<br>
<br>
        "If the branch is dead, then we can just fall through postBranchPC (only a nop in-between), else<br>
        we need to jump over the code of the branch"<br>
        deadCode ifFalse:<br>
                [self Jump: (self ensureNonMergeFixupAt: postBranchPC - initialPC).<br>
                 self ssPushConstant: objectMemory trueObject]. "dummy value"<br>
        ^0!<br>
<br>
Item was changed:<br>
  ----- Method: SistaCogit>>genForwardersInlin<wbr>edIdenticalOrNotIf: (in category 'bytecode generators') -----<br>
  genForwardersInlinedIdenticalO<wbr>rNotIf: orNot<br>
        "Override to count inlined branches if followed by a conditional branch.<br>
         We borrow the following conditional branch's counter and when about to<br>
         inline the comparison we decrement the counter (without writing it back)<br>
         and if it trips simply abort the inlining, falling back to the normal send which<br>
         will then continue to the conditional branch which will trip and enter the abort."<br>
        | nextPC postBranchPC targetBytecodePC branchDescriptor counterReg fixup jumpEqual jumpNotEqual<br>
          counterAddress countTripped unforwardArg unforwardRcvr argReg rcvrReg regMask |<br>
        <var: #fixup type: #'BytecodeFixup *'><br>
        <var: #countTripped type: #'AbstractInstruction *'><br>
        <var: #label type: #'AbstractInstruction *'><br>
        <var: #branchDescriptor type: #'BytecodeDescriptor *'><br>
        <var: #jumpEqual type: #'AbstractInstruction *'><br>
        <var: #jumpNotEqual type: #'AbstractInstruction *'><br>
<br>
        ((coInterpreter isOptimizedMethod: methodObj) or: [needsFrame not]) ifTrue:<br>
                [^super genForwardersInlinedIdenticalO<wbr>rNotIf: orNot].<br>
<br>
        regMask := 0.<br>
<br>
        self extractMaybeBranchDescriptorIn<wbr>to: [ :descr :next :postBranch :target |<br>
                branchDescriptor := descr. nextPC := next. postBranchPC := postBranch. targetBytecodePC := target ].<br>
<br>
        unforwardRcvr := (objectRepresentation isUnannotatableConstant: (self ssValue: 1)) not.<br>
        unforwardArg := (objectRepresentation isUnannotatableConstant: self ssTop) not.<br>
<br>
        "If an operand is an annotable constant, it may be forwarded, so we need to store it into a<br>
        register so the forwarder check can jump back to the comparison after unforwarding the constant.<br>
        However, if one of the operand is an unnanotable constant, does not allocate a register for it<br>
        (machine code will use operations on constants)."<br>
        rcvrReg:= argReg := NoReg.<br>
        self<br>
                allocateEqualsEqualsRegistersA<wbr>rgNeedsReg: unforwardArg<br>
                rcvrNeedsReg: unforwardRcvr<br>
                into: [ :rcvr :arg | rcvrReg:= rcvr. argReg := arg ].<br>
<br>
        argReg ~= NoReg ifTrue: [ regMask := self registerMaskFor: argReg ].<br>
        rcvrReg ~= NoReg ifTrue: [ regMask := regMask bitOr: (self registerMaskFor: rcvrReg) ].<br>
<br>
        "Only interested in inlining if followed by a conditional branch."<br>
        (branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse]) ifFalse:<br>
                [^ self<br>
                        genIdenticalNoBranchArgIsConst<wbr>ant: unforwardArg not<br>
                        rcvrIsConstant: unforwardRcvr not<br>
                        argReg: argReg<br>
                        rcvrReg: rcvrReg<br>
                        orNotIf: orNot].<br>
<br>
        "If branching the stack must be flushed for the merge"<br>
        self ssFlushTo: simStackPtr - 2.<br>
<br>
        unforwardArg ifTrue: [ objectRepresentation genEnsureOopInRegNotForwarded: argReg scratchReg: TempReg ].<br>
        unforwardRcvr ifTrue: [ objectRepresentation genEnsureOopInRegNotForwarded: rcvrReg scratchReg: TempReg ].<br>
<br>
        counterReg := self allocateRegNotConflictingWith: regMask.<br>
        self<br>
                genExecutionCountLogicInto: [ :cAddress :countTripBranch |<br>
                        counterAddress := cAddress.<br>
                        countTripped := countTripBranch ]<br>
                counterReg: counterReg.<br>
<br>
        self assert: (unforwardArg or: [ unforwardRcvr ]).<br>
        self genCmpArgIsConstant: unforwardArg not rcvrIsConstant: unforwardRcvr not argReg: argReg rcvrReg: rcvrReg.<br>
        self ssPop: 2.<br>
<br>
+       orNot == branchDescriptor isBranchTrue "orNot is true for ~~"<br>
+               ifFalse:<br>
+                       [ fixup := (self ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger.<br>
+                       self JumpZero:  (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger ]<br>
+               ifTrue:<br>
+                       [ fixup := (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger.<br>
+                       self JumpZero: (self ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger ].<br>
-       "We could use (branchDescriptor isBranchTrue xor: orNot) to simplify this."<br>
-       orNot<br>
-               ifFalse: [branchDescriptor isBranchTrue<br>
-                                       ifTrue:<br>
-                                               [ fixup := (self ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger.<br>
-                                               self JumpZero:  (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger ]<br>
-                                       ifFalse: "branchDescriptor is branchFalse"<br>
-                                               [ fixup := (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger.<br>
-                                               self JumpZero: (self ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger ]]<br>
-               ifTrue: [branchDescriptor isBranchTrue<br>
-                                       ifFalse: "branchDescriptor is branchFalse"<br>
-                                               [ fixup := (self ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger.<br>
-                                               self JumpZero:  (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger ]<br>
-                                       ifTrue:<br>
-                                               [ fixup := (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger.<br>
-                                               self JumpZero: (self ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger ]].<br>
<br>
        self genFallsThroughCountLogicCount<wbr>erReg: counterReg counterAddress: counterAddress.<br>
        self Jump: fixup.<br>
<br>
        countTripped jmpTarget: self Label.<br>
<br>
        "inlined version of #== ignoring the branchDescriptor if the counter trips to have normal state for the optimizer"<br>
        self ssPop: -2.<br>
        self genCmpArgIsConstant: unforwardArg not rcvrIsConstant: unforwardRcvr not argReg: argReg rcvrReg: rcvrReg.<br>
        self ssPop: 2.<br>
<br>
        "This code necessarily directly falls through the jumpIf: code which pops the top of the stack into TempReg.<br>
        We therefore directly assign the result to TempReg to save one move instruction"<br>
        jumpEqual := orNot ifFalse: [self JumpZero: 0] ifTrue: [self JumpNonZero: 0].<br>
        self genMoveFalseR: TempReg.<br>
        jumpNotEqual := self Jump: 0.<br>
        jumpEqual jmpTarget: (self genMoveTrueR: TempReg).<br>
        jumpNotEqual jmpTarget: self Label.<br>
        self ssPushRegister: TempReg.<br>
<br>
        (self fixupAt: nextPC - initialPC) notAFixup ifTrue: [ branchReachedOnlyForCounterTri<wbr>p := true ].<br>
<br>
        ^ 0!<br>
<br>
Item was changed:<br>
  ----- Method: SistaRegisterAllocatingCogit>><wbr>genForwardersInlinedIdenticalO<wbr>rNotIf: (in category 'bytecode generators') -----<br>
  genForwardersInlinedIdenticalO<wbr>rNotIf: orNot<br>
        "Override to count inlined branches if followed by a conditional branch.<br>
         We borrow the following conditional branch's counter and when about to<br>
         inline the comparison we decrement the counter (without writing it back)<br>
         and if it trips simply abort the inlining, falling back to the normal send which<br>
         will then continue to the conditional branch which will trip and enter the abort."<br>
        | nextPC postBranchPC targetBytecodePC branchDescriptor counterReg fixup jumpEqual jumpNotEqual<br>
          counterAddress countTripped unforwardArg unforwardRcvr argReg rcvrReg regMask |<br>
        <var: #fixup type: #'BytecodeFixup *'><br>
        <var: #countTripped type: #'AbstractInstruction *'><br>
        <var: #label type: #'AbstractInstruction *'><br>
        <var: #branchDescriptor type: #'BytecodeDescriptor *'><br>
        <var: #jumpEqual type: #'AbstractInstruction *'><br>
        <var: #jumpNotEqual type: #'AbstractInstruction *'><br>
<br>
        ((coInterpreter isOptimizedMethod: methodObj) or: [needsFrame not]) ifTrue:<br>
                [^super genForwardersInlinedIdenticalO<wbr>rNotIf: orNot].<br>
<br>
        regMask := 0.<br>
<br>
        self extractMaybeBranchDescriptorIn<wbr>to: [ :descr :next :postBranch :target |<br>
                branchDescriptor := descr. nextPC := next. postBranchPC := postBranch. targetBytecodePC := target ].<br>
<br>
        unforwardRcvr := (objectRepresentation isUnannotatableConstant: (self ssValue: 1)) not.<br>
        unforwardArg := (objectRepresentation isUnannotatableConstant: self ssTop) not.<br>
<br>
        "If an operand is an annotable constant, it may be forwarded, so we need to store it into a<br>
        register so the forwarder check can jump back to the comparison after unforwarding the constant.<br>
        However, if one of the operand is an unnanotable constant, does not allocate a register for it<br>
        (machine code will use operations on constants)."<br>
        rcvrReg:= argReg := NoReg.<br>
        self<br>
                allocateEqualsEqualsRegistersA<wbr>rgNeedsReg: unforwardArg<br>
                rcvrNeedsReg: unforwardRcvr<br>
                into: [ :rcvr :arg | rcvrReg:= rcvr. argReg := arg ].<br>
<br>
        argReg ~= NoReg ifTrue: [ regMask := self registerMaskFor: argReg ].<br>
        rcvrReg ~= NoReg ifTrue: [ regMask := regMask bitOr: (self registerMaskFor: rcvrReg) ].<br>
<br>
        "Only interested in inlining if followed by a conditional branch."<br>
        (branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse]) ifFalse:<br>
                [^ self<br>
                        genIdenticalNoBranchArgIsConst<wbr>ant: unforwardArg not<br>
                        rcvrIsConstant: unforwardRcvr not<br>
                        argReg: argReg<br>
                        rcvrReg: rcvrReg<br>
                        orNotIf: orNot].<br>
<br>
        unforwardArg ifTrue: [ objectRepresentation genEnsureOopInRegNotForwarded: argReg scratchReg: TempReg ].<br>
        unforwardRcvr ifTrue: [ objectRepresentation genEnsureOopInRegNotForwarded: rcvrReg scratchReg: TempReg ].<br>
<br>
        counterReg := self allocateRegNotConflictingWith: regMask.<br>
        self<br>
                genExecutionCountLogicInto: [ :cAddress :countTripBranch |<br>
                        counterAddress := cAddress.<br>
                        countTripped := countTripBranch ]<br>
                counterReg: counterReg.<br>
<br>
        self assert: (unforwardArg or: [ unforwardRcvr ]).<br>
        self genCmpArgIsConstant: unforwardArg not rcvrIsConstant: unforwardRcvr not argReg: argReg rcvrReg: rcvrReg.<br>
        self ssPop: 2.<br>
<br>
+       orNot == branchDescriptor isBranchTrue "orNot is true for ~~"<br>
+               ifFalse:<br>
+                       [ fixup := (self ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger.<br>
+                       self JumpZero:  (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger ]<br>
+               ifTrue:<br>
+                       [ fixup := (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger.<br>
+                       self JumpZero: (self ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger ].<br>
-       "We could use (branchDescriptor isBranchTrue xor: orNot) to simplify this."<br>
-       orNot<br>
-               ifFalse: [branchDescriptor isBranchTrue<br>
-                                       ifTrue:<br>
-                                               [ fixup := (self ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger.<br>
-                                               self JumpZero:  (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger ]<br>
-                                       ifFalse: "branchDescriptor is branchFalse"<br>
-                                               [ fixup := (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger.<br>
-                                               self JumpZero: (self ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger ]]<br>
-               ifTrue: [branchDescriptor isBranchTrue<br>
-                                       ifFalse: "branchDescriptor is branchFalse"<br>
-                                               [ fixup := (self ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger.<br>
-                                               self JumpZero:  (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger ]<br>
-                                       ifTrue:<br>
-                                               [ fixup := (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger.<br>
-                                               self JumpZero: (self ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger ]].<br>
<br>
        self genFallsThroughCountLogicCount<wbr>erReg: counterReg counterAddress: counterAddress.<br>
        self Jump: fixup.<br>
<br>
        countTripped jmpTarget: self Label.<br>
<br>
        "inlined version of #== ignoring the branchDescriptor if the counter trips to have normal state for the optimizer"<br>
        self ssPop: -2.<br>
        self genCmpArgIsConstant: unforwardArg not rcvrIsConstant: unforwardRcvr not argReg: argReg rcvrReg: rcvrReg.<br>
        self ssPop: 2.<br>
<br>
        "This code necessarily directly falls through the jumpIf: code which pops the top of the stack into TempReg.<br>
        We therefore directly assign the result to TempReg to save one move instruction"<br>
        jumpEqual := orNot ifFalse: [self JumpZero: 0] ifTrue: [self JumpNonZero: 0].<br>
        self genMoveFalseR: TempReg.<br>
        jumpNotEqual := self Jump: 0.<br>
        jumpEqual jmpTarget: (self genMoveTrueR: TempReg).<br>
        jumpNotEqual jmpTarget: self Label.<br>
        self ssPushRegister: TempReg.<br>
<br>
        (self fixupAt: nextPC - initialPC) notAFixup ifTrue: [ branchReachedOnlyForCounterTri<wbr>p := true ].<br>
<br>
        ^ 0!<br>
<br>
Item was changed:<br>
  ----- Method: StackToRegisterMappingCogit>>e<wbr>xtractMaybeBranchDescriptorInt<wbr>o: (in category 'bytecode generator support') -----<br>
  extractMaybeBranchDescriptorIn<wbr>to: fourArgBlock<br>
        "Looks one instruction ahead of the current bytecodePC and answers its bytecode descriptor and its pc.<br>
+        If the instruction found is a branch, also answers the pc after the branch and the pc targeted by the branch.<br>
+        For convenience, avoiding duplication in the senders, it follows those two pcs to their eventual targets."<br>
-        If the instruction found is a branch, also answers the pc after the branch and the pc targeted by the branch."<br>
        | primDescriptor nextPC nExts branchDescriptor targetBytecodePC postBranchPC |<br>
        <inline: true><br>
        <var: #primDescriptor type: #'BytecodeDescriptor *'><br>
        <var: #branchDescriptor type: #'BytecodeDescriptor *'><br>
<br>
        primDescriptor := self generatorAt: byte0.<br>
<br>
        nextPC := bytecodePC + primDescriptor numBytes.<br>
        nExts := 0.<br>
        [[branchDescriptor := self generatorAt: (objectMemory fetchByte: nextPC ofObject: methodObj) + bytecodeSetOffset.<br>
          branchDescriptor isExtension] whileTrue:<br>
                [nExts := nExts + 1.<br>
                 nextPC := nextPC + branchDescriptor numBytes].<br>
         branchDescriptor isUnconditionalBranch]<br>
                whileTrue:<br>
                        [nextPC := self eventualTargetOf: nextPC<br>
                                                                                        + branchDescriptor numBytes<br>
                                                                                        + (self spanFor: branchDescriptor at: nextPC exts: nExts in: methodObj)].<br>
<br>
        targetBytecodePC := postBranchPC := 0.<br>
<br>
        (branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse])<br>
                ifTrue:<br>
                        [targetBytecodePC := self eventualTargetOf: nextPC<br>
                                                                                                                + branchDescriptor numBytes<br>
                                                                                                                + (self spanFor: branchDescriptor at: nextPC exts: nExts in: methodObj).<br>
                         postBranchPC := self eventualTargetOf: nextPC + branchDescriptor numBytes]<br>
                ifFalse:<br>
+                       [nextPC := bytecodePC + primDescriptor numBytes].<br>
-                       [branchDescriptor isReturn ifFalse:<br>
-                               [postBranchPC := self eventualTargetOf: nextPC + branchDescriptor numBytes.<br>
-                                nextPC := self eventualTargetOf: bytecodePC + primDescriptor numBytes]].<br>
<br>
        fourArgBlock value: branchDescriptor value: nextPC value: postBranchPC value: targetBytecodePC!<br>
<br>
Item was changed:<br>
  ----- Method: StackToRegisterMappingCogit>>g<wbr>enForwardersInlinedIdenticalOr<wbr>NotIf: (in category 'bytecode generators') -----<br>
  genForwardersInlinedIdenticalO<wbr>rNotIf: orNot<br>
        | nextPC branchDescriptor unforwardRcvr argReg targetBytecodePC<br>
        unforwardArg  rcvrReg postBranchPC label fixup |<br>
        <var: #branchDescriptor type: #'BytecodeDescriptor *'><br>
        <var: #label type: #'AbstractInstruction *'><br>
<br>
        self extractMaybeBranchDescriptorIn<wbr>to: [ :descr :next :postBranch :target |<br>
                branchDescriptor := descr. nextPC := next. postBranchPC := postBranch. targetBytecodePC := target ].<br>
<br>
        "If an operand is an annotable constant, it may be forwarded, so we need to store it into a<br>
        register so the forwarder check can jump back to the comparison after unforwarding the constant.<br>
        However, if one of the operand is an unnanotable constant, does not allocate a register for it<br>
        (machine code will use operations on constants) and does not generate forwarder checks."<br>
        unforwardRcvr := (objectRepresentation isUnannotatableConstant: (self ssValue: 1)) not.<br>
        unforwardArg := (objectRepresentation isUnannotatableConstant: self ssTop) not.<br>
<br>
        self<br>
                allocateEqualsEqualsRegistersA<wbr>rgNeedsReg: unforwardArg<br>
                rcvrNeedsReg: unforwardRcvr<br>
                into: [ :rcvr :arg | rcvrReg:= rcvr. argReg := arg ].<br>
<br>
        "If not followed by a branch, resolve to true or false."<br>
        (branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse]) ifFalse:<br>
                [^ self<br>
                        genIdenticalNoBranchArgIsConst<wbr>ant: unforwardArg not<br>
                        rcvrIsConstant: unforwardRcvr not<br>
                        argReg: argReg<br>
                        rcvrReg: rcvrReg<br>
                        orNotIf: orNot].<br>
<br>
        "If branching the stack must be flushed for the merge"<br>
        self ssFlushTo: simStackPtr - 2.<br>
<br>
        label := self Label.<br>
        self genCmpArgIsConstant: unforwardArg not rcvrIsConstant: unforwardRcvr not argReg: argReg rcvrReg: rcvrReg.<br>
        self ssPop: 2.<br>
<br>
        "Further since there is a following conditional jump bytecode, define<br>
         non-merge fixups and leave the cond bytecode to set the mergeness."<br>
        (self fixupAt: nextPC - initialPC) notAFixup<br>
                ifTrue: "The next instruction is dead.  we can skip it."<br>
                        [deadCode := true.<br>
                         self ensureFixupAt: targetBytecodePC - initialPC.<br>
                         self ensureFixupAt: postBranchPC - initialPC]<br>
                ifFalse:<br>
                        [self deny: deadCode]. "push dummy value below"<br>
<br>
        self assert: (unforwardArg or: [unforwardRcvr]).<br>
+       orNot == branchDescriptor isBranchTrue "orNot is true for ~~"<br>
+               ifFalse:<br>
+                       [ fixup := (self ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger.<br>
+                       self JumpZero:  (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger ]<br>
+               ifTrue:<br>
+                       [ fixup := (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger.<br>
+                       self JumpZero: (self ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger ].<br>
-       "We could use (branchDescriptor isBranchTrue xor: orNot) to simplify this."<br>
-       orNot<br>
-               ifFalse: [branchDescriptor isBranchTrue<br>
-                                       ifTrue:<br>
-                                               [ fixup := (self ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger.<br>
-                                               self JumpZero:  (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger ]<br>
-                                       ifFalse: "branchDescriptor is branchFalse"<br>
-                                               [ fixup := (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger.<br>
-                                               self JumpZero: (self ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger ]]<br>
-               ifTrue: [branchDescriptor isBranchTrue<br>
-                                       ifFalse: "branchDescriptor is branchFalse"<br>
-                                               [ fixup := (self ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger.<br>
-                                               self JumpZero:  (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger ]<br>
-                                       ifTrue:<br>
-                                               [ fixup := (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger.<br>
-                                               self JumpZero: (self ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger ]].<br>
<br>
        deadCode ifFalse:<br>
                [self ssPushConstant: objectMemory trueObject]. "dummy value"<br>
<br>
        "The forwarders checks need to jump back to the comparison (label) if a forwarder is found, else<br>
        jump forward either to the next forwarder check or to the postBranch or branch target (fixup)."<br>
        unforwardArg ifTrue:<br>
                [ unforwardRcvr<br>
                        ifTrue: [ objectRepresentation genEnsureOopInRegNotForwarded: argReg scratchReg: TempReg jumpBackTo: label ]<br>
                        ifFalse: [ objectRepresentation<br>
                                genEnsureOopInRegNotForwarded: argReg<br>
                                scratchReg: TempReg<br>
                                ifForwarder: label<br>
                                ifNotForwarder: fixup ] ].<br>
        unforwardRcvr ifTrue:<br>
                [ objectRepresentation<br>
                        genEnsureOopInRegNotForwarded: rcvrReg<br>
                        scratchReg: TempReg<br>
                        ifForwarder: label<br>
                        ifNotForwarder: fixup ].<br>
<br>
        "Not reached, execution flow have jumped to fixup"<br>
<br>
        ^0!<br>
<br>
Item was changed:<br>
  ----- Method: StackToRegisterMappingCogit>>g<wbr>enVanillaInlinedIdenticalOrNot<wbr>If: (in category 'bytecode generators') -----<br>
  genVanillaInlinedIdenticalOrNo<wbr>tIf: orNot<br>
        | nextPC postBranchPC targetBytecodePC branchDescriptor<br>
          rcvrReg argReg argIsConstant rcvrIsConstant  |<br>
        <var: #branchDescriptor type: #'BytecodeDescriptor *'><br>
<br>
        self extractMaybeBranchDescriptorIn<wbr>to: [ :descr :next :postBranch :target |<br>
                branchDescriptor := descr. nextPC := next. postBranchPC := postBranch. targetBytecodePC := target ].<br>
<br>
        argIsConstant := self ssTop type = SSConstant.<br>
        "They can't be both constants to use correct machine opcodes.<br>
         However annotable constants can't be resolved statically, hence we need to careful."<br>
        rcvrIsConstant := argIsConstant not and: [(self ssValue: 1) type = SSConstant].<br>
<br>
        self<br>
                allocateEqualsEqualsRegistersA<wbr>rgNeedsReg: argIsConstant not<br>
                rcvrNeedsReg: rcvrIsConstant not<br>
                into: [ :rcvr :arg | rcvrReg:= rcvr. argReg := arg ].<br>
<br>
        "If not followed by a branch, resolve to true or false."<br>
        (branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse]) ifFalse:<br>
                [^ self<br>
                        genIdenticalNoBranchArgIsConst<wbr>ant: argIsConstant<br>
                        rcvrIsConstant: rcvrIsConstant<br>
                        argReg: argReg<br>
                        rcvrReg: rcvrReg<br>
                        orNotIf: orNot].<br>
<br>
        "If branching the stack must be flushed for the merge"<br>
        self ssFlushTo: simStackPtr - 2.<br>
<br>
        self genCmpArgIsConstant: argIsConstant rcvrIsConstant: rcvrIsConstant argReg: argReg rcvrReg: rcvrReg.<br>
        self ssPop: 2.<br>
<br>
        "Further since there is a following conditional jump bytecode, define<br>
         non-merge fixups and leave the cond bytecode to set the mergeness."<br>
        (self fixupAt: nextPC - initialPC) notAFixup<br>
                ifTrue: "The next instruction is dead.  we can skip it."<br>
                        [deadCode := true.<br>
                         self ensureFixupAt: targetBytecodePC - initialPC.<br>
                         self ensureFixupAt: postBranchPC - initialPC]<br>
                ifFalse:<br>
                        [self deny: deadCode]. "push dummy value below"<br>
<br>
+       self genConditionalBranch: (orNot == branchDescriptor isBranchTrue ifTrue: [JumpNonZero] ifFalse: [JumpZero])<br>
-       "We could simplify this with a xor:"<br>
-       self genConditionalBranch: (orNot<br>
-                                               ifFalse: [branchDescriptor isBranchTrue ifTrue: [JumpZero] ifFalse: [JumpNonZero]]<br>
-                                               ifTrue: [branchDescriptor isBranchTrue ifTrue: [JumpNonZero] ifFalse: [JumpZero]])<br>
                operand: (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger.<br>
<br>
        "If the branch is dead, then we can just fall through postBranchPC (only a nop in-between), else<br>
        we need to jump over the code of the branch"<br>
        deadCode ifFalse:<br>
                [self Jump: (self ensureNonMergeFixupAt: postBranchPC - initialPC).<br>
                 self ssPushConstant: objectMemory trueObject]. "dummy value"<br>
        ^0!<br>
<br>
</blockquote></div><br></div>
</div></div></blockquote></div><br></div></div></div>