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

Ryan Macnak rmacnak at gmail.com
Wed Nov 18 06:23:15 UTC 2015


This commit also broke the stack VMs, so something's probably amiss with
the Slang changes.

On Tue, Nov 17, 2015 at 5:13 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.1522.mcz
>
> ==================== Summary ====================
>
> Name: VMMaker.oscog-eem.1522
> Author: eem
> Time: 17 November 2015, 5:12:50.33 pm
> UUID: 62cb521e-b3cc-4104-999e-095ad37474a5
> Ancestors: VMMaker.oscog-eem.1521
>
> Cogit:
> Implement the long conditional branch/long unconditional branch split
> necessitated by the MIPS processor in all of the closed PIC methods.
>
> Update Slang to collapse an ifTrue:ifFalse: if bioth arms are the same, to
> avoid the code duplication this introduces on the rest of the processors
> where conditional and unconditional branch offsets can be accessed in the
> same way.
>
> Caution:  Tim's new CPICs are broken w.r.t. accessing class tags in PICs.
> In fact, he's left the breaks in classRefInClosedPICAt: &
> storeClassRef:inClosedPICAt: to show his unease.  I'll fix this asap.
> First I need to add code to disassemble the closed PIC prototype so I can
> see the wood for the trees.
>
> =============== Diff against VMMaker.oscog-eem.1521 ===============
>
> Item was changed:
>   ----- Method: CCodeGenerator>>generateIfFalseIfTrue:on:indent: (in
> category 'C translation') -----
>   generateIfFalseIfTrue: msgNode on: aStream indent: level
>         "Generate the C code for this message onto the given stream."
>
>         (self nilOrBooleanConstantReceiverOf: msgNode receiver)
>                 ifNil:
> +                       [(self tryToCollapseBothArmsOfConditional: msgNode
> on: aStream indent: level) ifFalse:
> +                               [aStream nextPutAll: 'if ('.
> +                                msgNode receiver emitCCodeAsExpressionOn:
> aStream level: level generator: self.
> +                                aStream nextPutAll: ') {'; cr.
> +                                msgNode args last emitCCodeOn: aStream
> level: level + 1 generator: self.
> +                                aStream tab: level; nextPut: $}; crtab:
> level; nextPutAll: 'else {'; cr.
> +                                msgNode args first emitCCodeOn: aStream
> level: level + 1 generator: self.
> +                                aStream tab: level; nextPut: $}]]
> -                       [aStream nextPutAll: 'if ('.
> -                       msgNode receiver emitCCodeAsExpressionOn: aStream
> level: level generator: self.
> -                       aStream nextPutAll: ') {'; cr.
> -                       msgNode args last emitCCodeOn: aStream level:
> level + 1 generator: self.
> -                       aStream tab: level; nextPut: $}; crtab: level;
> nextPutAll: 'else {'; cr.
> -                       msgNode args first emitCCodeOn: aStream level:
> level + 1 generator: self.
> -                       aStream tab: level; nextPut: $}]
>                 ifNotNil:
>                         [:const |
>                          (const ifTrue: [msgNode args last] ifFalse:
> [msgNode args first])
>                                 emitCCodeOn: aStream level: level
> generator: self]!
>
> Item was changed:
>   ----- Method: CCodeGenerator>>generateIfFalseIfTrueAsArgument:on:indent:
> (in category 'C translation') -----
>   generateIfFalseIfTrueAsArgument: msgNode on: aStream indent: level
>         "Generate the C code for this message onto the given stream."
>
>         (self nilOrBooleanConstantReceiverOf: msgNode receiver)
>                 ifNil:
> +                       [(self
> tryToCollapseBothArmsOfConditionalExpression: msgNode on: aStream indent:
> level) ifFalse:
> +                               [aStream nextPut: $(.
> +                                msgNode receiver emitCCodeAsArgumentOn:
> aStream level: level generator: self.
> +                                aStream crtab: level + 1; nextPut: $?;
> space.
> +                                msgNode args last emitCCodeAsArgumentOn:
> aStream level: level + 2 generator: self.
> +                                aStream crtab: level + 1; nextPut: $:;
> space.
> +                                msgNode args first emitCCodeAsArgumentOn:
> aStream level: level + 2 generator: self.
> +                                aStream nextPut: $)]]
> -                       [aStream nextPut: $(.
> -                       msgNode receiver emitCCodeAsArgumentOn: aStream
> level: level generator: self.
> -                       aStream crtab: level + 1; nextPut: $?; space.
> -                       msgNode args last emitCCodeAsArgumentOn: aStream
> level: level + 2 generator: self.
> -                       aStream crtab: level + 1; nextPut: $:; space.
> -                       msgNode args first emitCCodeAsArgumentOn: aStream
> level: level + 2 generator: self.
> -                       aStream nextPut: $)]
>                 ifNotNil:
>                         [:const|
>                         (const
>                                 ifTrue: [msgNode args last]
>                                 ifFalse: [msgNode args first])
>                                         emitCCodeAsArgumentOn: aStream
> level: level generator: self]!
>
> Item was changed:
>   ----- Method: CCodeGenerator>>generateIfTrueIfFalse:on:indent: (in
> category 'C translation') -----
>   generateIfTrueIfFalse: msgNode on: aStream indent: level
>         "Generate the C code for this message onto the given stream."
>
>         (self nilOrBooleanConstantReceiverOf: msgNode receiver)
>                 ifNil:
> +                       [(self tryToCollapseBothArmsOfConditional: msgNode
> on: aStream indent: level) ifFalse:
> +                               [aStream nextPutAll: 'if ('.
> +                                msgNode receiver emitCCodeAsExpressionOn:
> aStream level: level generator: self.
> +                                aStream nextPutAll: ') {'; cr.
> +                                msgNode args first emitCCodeOn: aStream
> level: level + 1 generator: self.
> +                                aStream tab: level; nextPut: $}; crtab:
> level; nextPutAll: 'else {'; cr.
> +                                msgNode args last emitCCodeOn: aStream
> level: level + 1 generator: self.
> +                                aStream tab: level; nextPut: $}]]
> -                       [aStream nextPutAll: 'if ('.
> -                       msgNode receiver emitCCodeAsExpressionOn: aStream
> level: level generator: self.
> -                       aStream nextPutAll: ') {'; cr.
> -                       msgNode args first emitCCodeOn: aStream level:
> level + 1 generator: self.
> -                       aStream tab: level; nextPut: $}; crtab: level;
> nextPutAll: 'else {'; cr.
> -                       msgNode args last emitCCodeOn: aStream level:
> level + 1 generator: self.
> -                       aStream tab: level; nextPut: $}]
>                 ifNotNil:
>                         [:const |
>                         (const ifTrue: [msgNode args first] ifFalse:
> [msgNode args last])
>                                 emitCCodeOn: aStream level: level
> generator: self]!
>
> Item was changed:
>   ----- Method: CCodeGenerator>>generateIfTrueIfFalseAsArgument:on:indent:
> (in category 'C translation') -----
>   generateIfTrueIfFalseAsArgument: msgNode on: aStream indent: level
>         "Generate the C code for this message onto the given stream."
>
>         (self nilOrBooleanConstantReceiverOf: msgNode receiver)
>                 ifNil:
> +                       [(self
> tryToCollapseBothArmsOfConditionalExpression: msgNode on: aStream indent:
> level) ifFalse:
> +                               [aStream nextPut: $(.
> +                                msgNode receiver emitCCodeAsExpressionOn:
> aStream level: level generator: self.
> +                                aStream crtab: level + 1; nextPut: $?;
> space.
> +                                msgNode args first emitCCodeAsArgumentOn:
> aStream level: level + 2 generator: self.
> +                                aStream crtab: level + 1; nextPut: $:;
> space.
> +                                msgNode args last emitCCodeAsArgumentOn:
> aStream level: level + 2 generator: self.
> +                                aStream nextPut: $)]]
> -                       [aStream nextPut: $(.
> -                       msgNode receiver emitCCodeAsExpressionOn: aStream
> level: level generator: self.
> -                       aStream crtab: level + 1; nextPut: $?; space.
> -                       msgNode args first emitCCodeAsArgumentOn: aStream
> level: level + 2 generator: self.
> -                       aStream crtab: level + 1; nextPut: $:; space.
> -                       msgNode args last emitCCodeAsArgumentOn: aStream
> level: level + 2 generator: self.
> -                       aStream nextPut: $)]
>                 ifNotNil:
>                         [:const|
>                         (const ifTrue: [msgNode args first] ifFalse:
> [msgNode args last])
>                                 emitCCodeAsArgumentOn: aStream level:
> level generator: self]!
>
> Item was added:
> + ----- Method:
> CCodeGenerator>>tryToCollapseBothArmsOfConditional:on:indent: (in category
> 'C translation support') -----
> + tryToCollapseBothArmsOfConditional: msgNode on: aStream indent: level
> +       "Attempt to generate the code for an ifTrue:ifFalse: if both arms
> are found to be the same, in which case
> +        answer true.  Otherwise output nothing and answer false."
> +       (msgNode args first isSameAs: msgNode args second) ifFalse:
> +               [^false].
> +       msgNode receiver hasSideEffect ifTrue:
> +               [msgNode receiver emitCCodeAsExpressionOn: aStream level:
> level generator: self.
> +                aStream nextPut: $; ; crtab: level].
> +       msgNode args first emitCCodeOn: aStream level: level generator:
> self.
> +       ^true!
>
> Item was added:
> + ----- Method:
> CCodeGenerator>>tryToCollapseBothArmsOfConditionalExpression:on:indent: (in
> category 'C translation support') -----
> + tryToCollapseBothArmsOfConditionalExpression: msgNode on: aStream
> indent: level
> +       "Attempt to generate the code for an ifTrue:ifFalse: if both arms
> are found to be the same, in which case
> +        answer true.  Otherwise output nothing and answer false."
> +       (msgNode args first isSameAs: msgNode args second) ifFalse:
> +               [^false].
> +       aStream nextPut: $(.
> +       msgNode receiver hasSideEffect ifTrue:
> +               [msgNode receiver emitCCodeAsExpressionOn: aStream level:
> level generator: self.
> +                aStream nextPut: $, ; crtab: level]..
> +       msgNode args first emitCCodeAsArgumentOn: aStream level: level
> generator: self.
> +       aStream nextPut: $).
> +       ^true!
>
> Item was removed:
> - ----- Method:
> CogARMCompiler>>jumpLongConditionalTargetBeforeFollowingAddress: (in
> category 'inline cacheing') -----
> - jumpLongConditionalTargetBeforeFollowingAddress: mcpc
> -       ^self jumpLongTargetBeforeFollowingAddress: mcpc!
>
> Item was added:
> + ----- Method:
> CogAbstractInstruction>>jumpLongConditionalTargetBeforeFollowingAddress:
> (in category 'inline cacheing') -----
> + jumpLongConditionalTargetBeforeFollowingAddress: mcpc
> +       "Extract the target from a long conditional jump.  On many ISAs
> this si the same as
> +        extracting the target from a long unconditional jump, so we
> provide the default here.
> +        Processors such as MIPS override as appropriate."
> +       <inline: true>
> +       ^self jumpLongTargetBeforeFollowingAddress: mcpc!
>
> Item was removed:
> - ----- Method:
> CogIA32Compiler>>jumpLongConditionalTargetBeforeFollowingAddress: (in
> category 'inline cacheing') -----
> - jumpLongConditionalTargetBeforeFollowingAddress: mcpc
> -       ^self jumpLongTargetBeforeFollowingAddress: mcpc !
>
> Item was changed:
>   ----- Method: Cogit>>cPIC:HasTarget: (in category 'in-line cacheing')
> -----
>   cPIC: cPIC HasTarget: targetMethod
>         "Are any of the jumps from this CPIC to targetMethod?"
>         <var: #cPIC type: #'CogMethod *'>
>         <var: #targetMethod type: #'CogMethod *'>
>         | pc target |
>         target := targetMethod asUnsignedInteger + cmNoCheckEntryOffset.
>         pc := cPIC asInteger + firstCPICCaseOffset.
>         "Since this is a fast test doing simple compares we don't need to
> care that some
> +       cases have nonsense addresses in there. Just zip on through."
> +       "First jump is unconditional; subsequent ones are conditional"
> +       target = (backEnd jumpLongTargetBeforeFollowingAddress: pc) ifTrue:
> +               [^true].
> +       2 to: maxCPICCases do:
> -       cases have nonsense addresses in there. Just zip on through"
> -       1 to: maxCPICCases do:
>                 [:i|
> +               pc := pc + cPICCaseSize.
> +               target = (backEnd
> jumpLongConditionalTargetBeforeFollowingAddress: pc) ifTrue:
> +                       [^true]].
> -               target = (backEnd jumpLongTargetBeforeFollowingAddress:
> pc) ifTrue:
> -                       [^true].
> -               pc := pc + cPICCaseSize].
>         ^false!
>
> Item was changed:
>   ----- Method: Cogit>>cPICHasFreedTargets: (in category 'in-line
> cacheing') -----
>   cPICHasFreedTargets: cPIC
>         "scan the CPIC for target methods that have been freed. "
>         <var: #cPIC type: #'CogMethod *'>
>         | pc entryPoint targetMethod |
>         <var: #targetMethod type: #'CogMethod *'>
>
>         1 to: cPIC cPICNumCases do:
>                 [:i|
>                 pc := self addressOfEndOfCase: i inCPIC: cPIC.
> +               entryPoint := i = 1
> +                                               ifTrue: [backEnd
> jumpLongTargetBeforeFollowingAddress: pc]
> +                                               ifFalse: [backEnd
> jumpLongConditionalTargetBeforeFollowingAddress: pc].
> -               entryPoint := backEnd
> jumpLongTargetBeforeFollowingAddress: pc.
>                 "Find target from jump.  Ignore jumps to the interpret and
> MNU calls within this PIC"
>                 (cPIC containsAddress: entryPoint) ifFalse:
>                         [targetMethod := self cCoerceSimple: entryPoint -
> cmNoCheckEntryOffset to: #'CogMethod *'.
>                          self assert: (targetMethod cmType = CMMethod or:
> [targetMethod cmType = CMFree]).
>                          targetMethod cmType = CMFree ifTrue:
>                                 [^true]]].
>         ^false!
>
> Item was changed:
>   ----- Method: Cogit>>closedPICRefersToUnmarkedObject: (in category
> 'garbage collection') -----
>   closedPICRefersToUnmarkedObject: cPIC
>         "Answer if the ClosedPIC refers to any unmarked objects or
> freed/freeable target methods,
>          applying markAndTraceOrFreeCogMethod:firstVisit: to those targets
> to determine if freed/freeable."
>         <var: #cPIC type: #'CogMethod *'>
>         | pc offsetToLiteral object entryPoint targetMethod |
>         <var: #targetMethod type: #'CogMethod *'>
>         (objectMemory isImmediate: cPIC selector) ifFalse:
>                 [(objectMemory isMarked: cPIC selector) ifFalse:
>                         [^true]].
> +       "First jump is unconditional; subsequent ones are conditional."
> -       "First jump is unconditional; subsequent ones are conditional"
>         offsetToLiteral := backEnd jumpLongByteSize.
>         1 to: cPIC cPICNumCases do:
>                 [:i|
>                 pc := self addressOfEndOfCase: i inCPIC: cPIC.
>                 (objectRepresentation inlineCacheTagsMayBeObjects and:
> [i>1] ) "inline cache tags for the 0th case are at the send site" ifTrue:
>                         [object := literalsManager classRefInClosedPICAt:
> pc - offsetToLiteral.
>                          ((objectRepresentation couldBeObject: object)
>                           and: [(objectMemory isMarked: object) not])
> ifTrue:
>                                 [^true]].
>                 object := literalsManager objRefInClosedPICAt: pc -
> offsetToLiteral.
>                 ((objectRepresentation couldBeObject: object)
>                  and: [(objectMemory isMarked: object) not]) ifTrue:
>                         [^true].
>                 offsetToLiteral := backEnd jumpLongConditionalByteSize.
> +               entryPoint := i = 1
> +                                               ifTrue: [backEnd
> jumpLongTargetBeforeFollowingAddress: pc]
> +                                               ifFalse: [backEnd
> jumpLongConditionalTargetBeforeFollowingAddress: pc].
> -               entryPoint := backEnd
> jumpLongTargetBeforeFollowingAddress: pc.
>                 "Find target from jump.  Ignore jumps to the interpret and
> MNU calls within this PIC"
>                 self assert: (entryPoint > methodZoneBase and: [entryPoint
> < methodZone freeStart]).
>                 (cPIC containsAddress: entryPoint) ifFalse:
>                         [targetMethod := self cCoerceSimple: entryPoint -
> cmNoCheckEntryOffset to: #'CogMethod *'.
>                          self assert: (targetMethod cmType = CMMethod
>                                                 or: [targetMethod cmType =
> CMFree]).
>                          (self markAndTraceOrFreeCogMethod: targetMethod
>                                   firstVisit: targetMethod
> asUnsignedInteger > pc asUnsignedInteger) ifTrue:
> +                               [^true]]].
> -                               [^true]].
> -               ].
>         ^false!
>
> Item was changed:
>   ----- Method: Cogit>>compileClosedPICPrototype (in category 'in-line
> cacheing') -----
>   compileClosedPICPrototype
> +       "Compile the abstract instructions for a full closed PIC, used to
> generate the chunk of code
> +        which is copied to form each closed PIC.  A Closed Polymorphic
> Inline Cache is a small jump
> +        table used to optimize sends with a limited degree of
> polymorphism (currently up to 6 cases).
> +        We call it closed because it deals only with a finite number of
> cases, as opposed to an Open PIC.
> +        When a monomorphic linked send (a send with a single case,
> linking direct to the checked entry
> +        point of a CogMethod) fails a class check, the Cogit attempts to
> create a two-entry PIC that will
> +        handle jumping to the original target for the original class and
> the relevant target for the new
> +        class.  This jump table will be extended on subsequent failures
> up to a limit (6).
> +
> +        We avoid extending CPICs to Open PICs by linking the send site to
> an Open PIC if one already
> +        exists with the send's selector, a good policy since measurements
> show that sends of mega-
> +        morphic selectors usually become megamorphic at all send sites.
> Hence the Open PIC list.
> +
> +        A CPIC also optimizes MNUs and interpret-only methods.  Each case
> can load SendNumArgs with
> +        the oop of a method, or will load SendNumArgs with 0 if not.
> MNUs are optimized by jumping to
> +        the mnuAbort in the CPIC, which calls code that creates the
> Message, thereby avoiding looking up
> +        the original message which will not be found, and either looks up
> doesNotUnderstand: or directly
> +        activates the method loaded into SendNumArgs, hence avoiding
> looking up doesNotUnderstand:.
> +        Interpret-only methods are handled by jumping to the
> picInterpretAbort, which enters the
> +        interpreter activating the method loaded in SendNumArgs.
> +
> +        CPICs look like the following, where rClass is set at the
> original send site for the 1st case, and #Foo
> +        is some constant, either an oop, a class tag or an instruction
> address.
> +
> +               rTemp := (rRecever bitAnd: TagMask) = 0 ifTrue: [rReceiver
> class] ifFalse: [rRecever bitAnd: TagMask].
> +               rTemp = rClass ifFalse:
> +                       [self goto: #Label].
> +               rSendNumArgs := #MethodForCase1Or0.
> +               self goto: #TargetForCase1.
> +        #Label
> +               rTemp = #ClassTagForCase6 ifTrue:
> +                       [rSendNumArgs := #MethodForCase6Or0.
> +                        self goto: #TargetForCase6].
> +               ...cases 5, 4 & 3
> +               rTemp = #ClassTagForCase2 ifTrue:
> +                       [rSendNumArgs := #MethodForCase2Or0.
> +                        self goto: #TargetForCase2].
> +               self goto: #CPICMissTrampoline
> +               literals (if out-of-line literals)
> +
> +        where we short-cut as many cases as needed by making the self
> goto: #Label skip as many cases
> +        as needed."
> -       "Compile the abstract instructions for a full closed PIC used to
> initialize closedPICSize.
> -        The loads into SendNumArgsReg are those for optional method
> objects which may be
> -        used in MNU cases."
>         <inline: true>
>         | numArgs jumpNext |
>         <var: #jumpNext type: #'AbstractInstruction *'>
> +       self compilePICAbort: (numArgs := 0). "Will get rewritten to
> appropriate arity when configuring."
> +       jumpNext := self compileCPICEntry.
> +       "At the end of the entry code we need to jump to the first case
> code, which is actually the last chunk.
> +        On each entension we must update this jump to move back one case."
> +       "16r5EAF00D is the method oop, or 0, for the 1st case."
> -       numArgs := 0.
> -       self compilePICAbort: numArgs.
> -       jumpNext := self compileCPICEntry. "at the end of the entry code
> we need to jump to the first case code, which is actually the last chunk -
> for each entension we must update this jump to move back one case"
>         self MoveUniqueCw: 16r5EAF00D R: SendNumArgsReg.
>         self JumpLong: self cPICPrototypeCaseOffset + 16rCA5E10.
>         endCPICCase0 := self Label.
>         1 to: maxCPICCases - 1 do:
>                 [:h|
> +               h = (maxCPICCases - 1) ifTrue:
> +                       [jumpNext jmpTarget: self Label]. "this is where
> we jump to for the first case"
> +               "16rBABE1F15+h is the class tag for the Nth case"
> -               h = (maxCPICCases - 1)
> -                               ifTrue: [jumpNext jmpTarget: self Label].
> "this is where we jump to for the first case"
>                 self CmpCw: 16rBABE1F15+h R: TempReg.
> +               "16rBADA550+h is the method oop, or 0, for the Nth case."
>                 self MoveUniqueCw: 16rBADA550 + h R: SendNumArgsReg.
>                 self JumpLongZero: self cPICPrototypeCaseOffset +
> 16rCA5E10 + (h * 16).
> +               h = 1 ifTrue:
> -               h =  1 ifTrue:
>                         [endCPICCase1 := self Label]].
>         self MoveCw: methodLabel address R: ClassReg.
> +       self JumpLong: (self cPICMissTrampolineFor: numArgs).   "Will get
> rewritten to appropriate arity when configuring."
> -       self JumpLong: (self cPICMissTrampolineFor: numArgs).
>         cPICEndOfCodeLabel := self Label.
>         literalsManager dumpLiterals: false.
>         ^0!
>
> Item was changed:
>   ----- Method: Cogit>>noTargetsFreeInClosedPIC: (in category
> 'compaction') -----
>   noTargetsFreeInClosedPIC: cPIC
>         "Answer if all targets in the PIC are in-use methods."
> +       ^(self cPICHasFreedTargets: cPIC) not!
> -       <var: #cPIC type: #'CogMethod *'>
> -       | pc entryPoint targetMethod |
> -       <var: #targetMethod type: #'CogMethod *'>
> -
> -       1 to: cPIC cPICNumCases do:
> -               [:i|
> -               pc := self addressOfEndOfCase: i inCPIC: cPIC.
> -               entryPoint := backEnd
> jumpLongTargetBeforeFollowingAddress: pc.
> -               "Find target from jump.  Ignore jumps to the interpret and
> MNU calls within this PIC"
> -               (cPIC containsAddress: entryPoint) ifFalse:
> -                       [targetMethod := self cCoerceSimple: entryPoint -
> cmNoCheckEntryOffset to: #'CogMethod *'.
> -                        targetMethod cmType ~= CMMethod ifTrue:
> -                               [^false]]].
> -       ^true!
>
> Item was changed:
>   ----- Method: Cogit>>relocateCallsInClosedPIC: (in category
> 'compaction') -----
>   relocateCallsInClosedPIC: cPIC
>         <var: #cPIC type: #'CogMethod *'>
>         | delta pc entryPoint targetMethod |
>         <var: #targetMethod type: #'CogMethod *'>
>         delta := cPIC objectHeader.
>         self assert: (backEnd callTargetFromReturnAddress: cPIC asInteger
> + missOffset)
>                                         = (self picAbortTrampolineFor:
> cPIC cmNumArgs).
>         backEnd relocateCallBeforeReturnPC: cPIC asInteger + missOffset
> by: delta negated.
>
>         pc := cPIC asInteger + firstCPICCaseOffset.
>         1 to: cPIC cPICNumCases do:
>                 [:i|
>                 pc := self addressOfEndOfCase: i inCPIC: cPIC.
> +               entryPoint := i = 1
> +                                               ifTrue: [backEnd
> jumpLongTargetBeforeFollowingAddress: pc]
> +                                               ifFalse: [backEnd
> jumpLongConditionalTargetBeforeFollowingAddress: pc].
> -               entryPoint := backEnd
> jumpLongTargetBeforeFollowingAddress: pc.
>                 "Find target from jump.  Ignore jumps to the interpret and
> MNU calls within this PIC"
>                 (cPIC containsAddress: entryPoint) ifFalse:
>                         [targetMethod := self cCoerceSimple: entryPoint -
> cmNoCheckEntryOffset to: #'CogMethod *'.
>                          self assert: targetMethod cmType = CMMethod.
>                          backEnd
>                                 relocateJumpLongBeforeFollowingAddress: pc
>                                 by: (delta - targetMethod objectHeader)
> negated]].
>         self assert: cPIC cPICNumCases > 0.
>
>         "Finally relocate the load of the PIC and the jump to the overflow
> routine ceCPICMiss:receiver:"
>         backEnd relocateMethodReferenceBeforeAddress: (self
> addressOfEndOfCase: 2 inCPIC: cPIC)+ backEnd loadPICLiteralByteSize by:
> delta.
>         backEnd relocateJumpLongBeforeFollowingAddress: cPIC asInteger +
> cPICEndOfCodeOffset by: delta negated!
>
> Item was changed:
>   ----- Method:
> SistaStackToRegisterMappingCogit>>populate:withPICInfoFor:firstCacheTag:
> (in category 'method introspection') -----
>   populate: tuple withPICInfoFor: cPIC firstCacheTag: firstCacheTag
>         "Populate tuple (which must be large enough) with the ClosedPIC's
> target method class pairs.
>          The first entry in tuple contains the bytecode pc for the send,
> so skip the tuple's first field."
>         <var: #cPIC type: #'CogMethod *'>
>         | pc cacheTag classOop entryPoint targetMethod value |
>         <var: #targetMethod type: #'CogMethod *'>
>
>         1 to: cPIC cPICNumCases do:
>                 [:i|
>                 pc := self addressOfEndOfCase: i inCPIC: cPIC.
>                 cacheTag := i = 1
>                                                 ifTrue: [firstCacheTag]
>                                                 ifFalse: [backEnd
> literalBeforeFollowingAddress: pc
>
>                                                                       -
> backEnd jumpLongConditionalByteSize
>
>                                                                       -
> backEnd loadLiteralByteSize].
>                 classOop := objectRepresentation classForInlineCacheTag:
> cacheTag.
>                 objectMemory storePointer: i * 2 - 1 ofObject: tuple
> withValue: classOop.
> +               entryPoint := i = 1
> +                                               ifTrue: [backEnd
> jumpLongTargetBeforeFollowingAddress: pc]
> +                                               ifFalse: [backEnd
> jumpLongConditionalTargetBeforeFollowingAddress: pc].
> -               entryPoint := backEnd
> jumpLongTargetBeforeFollowingAddress: pc.
>                 "Find target from jump.  A jump to the MNU entry-point
> should collect #doesNotUnderstand:"
>                 (cPIC containsAddress: entryPoint)
>                         ifTrue:
>                                 [value := objectMemory splObj:
> SelectorDoesNotUnderstand]
>                         ifFalse:
>                                 [targetMethod := self cCoerceSimple:
> entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
>                                  self assert: targetMethod cmType =
> CMMethod.
>                                  value := targetMethod methodObject].
> +               objectMemory storePointer: i * 2 ofObject: tuple
> withValue: value]!
> -               objectMemory storePointer: i * 2 ofObject: tuple
> withValue: value ]!
>
> Item was added:
> + ----- Method: TAssignmentNode>>isSameAs: (in category 'testing') -----
> + isSameAs: aTParseNode
> +       ^aTParseNode isAssignment
> +        and: [(variable isSameAs: aTParseNode variable)
> +        and: [expression isSameAs: aTParseNode expression]]!
>
> Item was added:
> + ----- Method: TConstantNode>>hasSideEffect (in category 'testing') -----
> + hasSideEffect
> +       "Answer if the parse tree rooted at this node has a side-effect or
> not."
> +       ^false!
>
> Item was added:
> + ----- Method: TParseNode>>hasSideEffect (in category 'testing') -----
> + hasSideEffect
> +       "Answer if the parse tree rooted at this node has a side-effect or
> not.  By default assume it has.  Nodes that don't override."
> +       ^true!
>
> Item was changed:
>   ----- Method: TParseNode>>isSameAs: (in category 'comparing') -----
>   isSameAs: aTParseNode
> +       "Answer if the ParseTree rooted at this node is the same as
> aTParseNode.
> +        By default answer false and have subclasses override as
> appropriate."
> +       ^false!
> -       ^self subclassResponsibility!
>
> Item was added:
> + ----- Method: TSendNode>>hasSideEffect (in category 'as yet
> unclassified') -----
> + hasSideEffect
> +       "Answer if the parse tree rooted at this node has a side-effect or
> not."
> +       ^(#(#+ #- #* #/ #// #\\ #= #== #~= #~~) includes: selector) not!
>
> Item was added:
> + ----- Method: TStmtListNode>>isSameAs: (in category 'testing') -----
> + isSameAs: aTParseNode
> +       (aTParseNode isStmtList
> +        and: [statements size = aTParseNode statements size]) ifFalse:
> +               [^false].
> +       statements with: aTParseNode statements do:
> +               [:mine :theirs|
> +                (mine isSameAs: theirs) ifFalse:
> +                       [^false]].
> +       ^true!
>
> Item was changed:
>   ----- Method: TSwitchStmtNode>>createCasesFromBraceNode: (in category
> 'instance initialization') -----
>   createCasesFromBraceNode: aTBraceNode
> +       "Answer a sequence of tuples of { labels. case } for a TBraceNode,
> making
> +        sure to collect equivalent cases together under a signle sequence
> of labels."
>         | casesToStrings stringsToLabels newCases |
>         casesToStrings := Dictionary new.
>         stringsToLabels := Dictionary new.
>         newCases := OrderedCollection new: aTBraceNode caseLabels size.
>         aTBraceNode caseLabels with: aTBraceNode cases do:
>                 [:label :case| | printString |
>                 printString := casesToStrings at: case put: case
> printString.
>                 (stringsToLabels at: printString ifAbsentPut:
> [OrderedCollection new]) addLast: label].
>
>         aTBraceNode caseLabels with: aTBraceNode cases do:
>                 [:label :case| | printString labels |
>                 printString := casesToStrings at: case.
>                 label = (labels := (stringsToLabels at: printString)
> asArray) first ifTrue:
>                         [newCases addLast: { labels collect: [:ea| ea
> statements first]. case}]].
>
>         ^newCases!
>
> Item was added:
> + ----- Method: TVariableNode>>hasSideEffect (in category 'as yet
> unclassified') -----
> + hasSideEffect
> +       "Answer if the parse tree rooted at this node has a side-effect or
> not."
> +       ^false!
>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://lists.squeakfoundation.org/pipermail/vm-dev/attachments/20151117/e4e7a7f1/attachment-0001.htm


More information about the Vm-dev mailing list