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

Eliot Miranda eliot.miranda at gmail.com
Wed Nov 18 17:58:09 UTC 2015


On Tue, Nov 17, 2015 at 10:23 PM, Ryan Macnak <rmacnak at gmail.com> wrote:

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

Doh:

                                /* begin internalPush: */
-                               object = (0 /* currentBytecode bitAnd: 15
*/ < ((frameNumArgs = byteAt((localFP + FoxFrameFlags) + 1)))
-                                       ? longAt((localFP +
FoxCallerSavedIP) + ((frameNumArgs) * BytesPerWord))
-                                       : longAt(((localFP + FoxReceiver) -
BytesPerWord) + ((frameNumArgs) * BytesPerWord)));
+                               object = (0 /* currentBytecode bitAnd: 15
*/ < ((frameNumArgs = byteAt((localFP + FoxFrameFlags) + 1))),
+                               longAt((localFP + FoxCallerSavedIP) +
((frameNumArgs) * BytesPerWord)));
                                longAtPointerput((localSP -= BytesPerOop),
object);
                        }
                        BREAK;

So yes.  I'll fix this pronto.

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!
>>
>>
>
>


-- 
_,,,^..^,,,_
best, Eliot
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://lists.squeakfoundation.org/pipermail/vm-dev/attachments/20151118/f27f0dbe/attachment-0001.htm


More information about the Vm-dev mailing list