[Vm-dev] VM Maker: VMMaker.oscog-rmacnak.1375.mcz

Eliot Miranda eliot.miranda at gmail.com
Wed Jun 24 16:51:06 UTC 2015


Hi Ryan,

    with the optimzation I just did to block activation, which is only to
unforward the receiver in block activation if the method refers to inst
vars, there's the potential that an implicit receiver send in a block could
hit a forwarded receiver.  So this is a reminder that perhaps the block
scanning needs to trigger unforwarding if there's an implicit receiver
send.  But we should have tests before I hack a fix.
Also inlineLookupInNSMethodCacheSel:... isn't in the package (1375).

On Mon, Jun 22, 2015 at 10:08 PM, <commits at source.squeak.org> wrote:

>
> Ryan Macnak uploaded a new version of VMMaker to project VM Maker:
> http://source.squeak.org/VMMaker/VMMaker.oscog-rmacnak.1375.mcz
>
> ==================== Summary ====================
>
> Name: VMMaker.oscog-rmacnak.1375
> Author: rmacnak
> Time: 22 June 2015, 10:07:47.302 pm
> UUID: 2834a848-0c6d-4c29-bd1e-a43ad70450d9
> Ancestors: VMMaker.oscog-cb.1374
>
> Do proper lookups for implicit receiver and outer send misses from cogged
> code.
>
> =============== Diff against VMMaker.oscog-cb.1374 ===============
>
> Item was changed:
>   ----- Method: CoInterpreter>>ceImplicitReceiverSend:receiver: (in
> category 'trampolines') -----
>   ceImplicitReceiverSend: cacheAddress receiver: methodReceiver
>         "An implicit receiver send cache missed."
> +       | nsSendCache methodReceiverClassTag cogMethod errSelIdx |
> -       | nsSendCache methodMixin numArgs selector implicitReceiver
> cogMethod irClassTag mrClassTag errSelIdx |
>         <api>
>         <option: #NewspeakVM>
>         <inline: false>
>         <var: #nsSendCache type: #'NSSendCache *'>
>         <var: #cogMethod type: #'CogMethod *'>
>
>         cogit assertCStackWellAligned.
>         self assert: (objectMemory addressCouldBeOop: methodReceiver).
> +       self deny: (objectMemory isOopForwarded: methodReceiver).
>
>         nsSendCache := self cCoerceSimple: cacheAddress to: #'NSSendCache
> *'.
> +       messageSelector := nsSendCache selector.
> +       argumentCount := nsSendCache numArgs.
> +       method := (self mframeHomeMethod: framePointer) methodObject.
> -       selector := nsSendCache selector.
> -       numArgs := nsSendCache numArgs.
> -       methodMixin := self mMethodClass.
>
> +       self assert: (self stackValue: argumentCount + 1 "ret addr") =
> methodReceiver.
> -       implicitReceiver := self
> -               implicitReceiverFor: methodReceiver
> -               mixin: methodMixin
> -               implementing: selector.
>
> +       methodReceiverClassTag := objectMemory fetchClassTagOf:
> methodReceiver.
> -       self assert: (self stackValue: numArgs + 1 "ret val") =
> methodReceiver.
> -       self stackValue: numArgs + 1 "ret val " put: implicitReceiver.
> -       "Replace the methodReceiver on the stack with the
> implicitReceiver. When the cache has
> -       a hit, we don't care that the value on the stack is wrong because
> the compiled callee will
> -       use the value in ReceiverResultReg to build its frame. But the
> interpreter will use
> -       stack(numArgs)."
>
> +       (self
> +               inlineLookupInNSMethodCacheSel: messageSelector
> +               classTag: methodReceiverClassTag
> +               method: method
> +               lookupRule: LookupRuleImplicit)
> +                       ifTrue:
> +                               [localAbsentReceiverOrZero = 0
> +                                       ifTrue: [localAbsentReceiver :=
> methodReceiver]
> +                                       ifFalse: [localAbsentReceiver :=
> localAbsentReceiverOrZero].
> +                               "check for coggability because method is
> in the cache"
> +                               self ifAppropriateCompileToNativeCode:
> newMethod selector: messageSelector]
> +                       ifFalse:
> +                               [self deny: (objectMemory isOopForwarded:
> messageSelector).
> +                               self deny: (objectMemory
> isForwardedClassTag: methodReceiverClassTag).
> +                               lkupClassTag := methodReceiverClassTag.
> +                               errSelIdx := self
> lookupImplicitReceiverSendNoMNU: methodReceiver.
> +                               errSelIdx ~= 0 ifTrue:
> +                                       [self assert: errSelIdx ==
> SelectorDoesNotUnderstand.
> +                                       self handleMNU: errSelIdx
> +                                               InMachineCodeTo:
> methodReceiver
> +                                               classForMessage:
> (objectMemory classForClassTag: methodReceiverClassTag).
> +                                       self unreachable].
> +                               self addNewMethodToNSCache:
> LookupRuleImplicit].
> -       mrClassTag := objectMemory fetchClassTagOf: methodReceiver.
> -       irClassTag := objectMemory fetchClassTagOf: implicitReceiver.
> -       argumentCount := numArgs.
>
> +       "Fix stacked receiver."
> +       self stackValue: argumentCount + 1 "ret addr" put:
> localAbsentReceiver.
> -       (self lookupInMethodCacheSel: selector classTag: irClassTag)
> -               ifTrue: ["check for coggability because method is in the
> cache"
> -                       self ifAppropriateCompileToNativeCode: newMethod
> selector: selector]
> -               ifFalse: [
> -                       (objectMemory isOopForwarded: selector) ifTrue:
> -                               [self error: 'Selector should have fixed
> by mapObjectReferencesInMachineCodeForBecome'].
> -                       (objectMemory isForwardedClassTag: irClassTag)
> ifTrue:
> -                               [self error: 'Implicit receiver lookup
> should have followed fowarded objects'].
> -                       messageSelector := selector.
> -                       (errSelIdx := self lookupMethodNoMNUEtcInClass:
> (objectMemory classForClassTag: irClassTag)) ~= 0
> -                               ifTrue: [[self handleMNU: errSelIdx
> InMachineCodeTo: implicitReceiver classForMessage: (objectMemory
> classForClassTag: irClassTag).
> -                                               self error:
> 'UNREACHABLE3']]].
>
>         (self maybeMethodHasCogMethod: newMethod)
>                 ifTrue: [
>                         cogMethod := self cogMethodOf: newMethod.
>                         cogMethod selector = objectMemory nilObject
> +                               ifTrue: [cogit setSelectorOf: cogMethod
> to: messageSelector]
> -                               ifTrue: [cogit setSelectorOf: cogMethod
> to: selector]
>                                 ifFalse: ["Deal with anonymous accessors,
> e.g. in Newspeak.
>                                         The cogMethod may not have the
>                                         correct selector. If not, try and
> compile a new method
>                                         with the correct selector."
> +                                       cogMethod selector ~=
> messageSelector ifTrue: [
> +                                                       (cogit cog:
> newMethod selector: messageSelector)
> -                                       cogMethod selector ~= selector
> ifTrue: [
> -                                                       (cogit cog:
> newMethod selector: selector)
>                                                                 ifNotNil:
> [:newCogMethod | cogMethod := newCogMethod]]].
> +                       cogMethod selector = messageSelector
> -                       cogMethod selector = selector
>                                 ifTrue:
>                                         [cogit
>                                                 linkNSSendCache:
> nsSendCache
> +                                               classTag:
> methodReceiverClassTag
> +                                               enclosingObject:
> localAbsentReceiverOrZero
> -                                               classTag: mrClassTag
> -                                               enclosingObject:
> (implicitReceiver = methodReceiver
> -                                                       ifTrue: [0]
> ifFalse: [implicitReceiver])
>                                                 target: cogMethod
>                                                 caller: self
> mframeHomeMethodExport]
>                                 ifFalse: ["Out of code memory. Fall
> through to interpret."].
>                         instructionPointer := self popStack.
>                         self executeNewMethod.
> +                       self unreachable].
> -                       self error: 'UNREACHABLE 1'].
>         instructionPointer := self popStack.
>         self interpretMethodFromMachineCode.
> +       self unreachable.!
> -       self error: 'UNREACHABLE 2'.
> -       ^nil!
>
> Item was changed:
>   ----- Method: CoInterpreter>>ceOuterSend:receiver: (in category
> 'trampolines') -----
>   ceOuterSend: cacheAddress receiver: methodReceiver
>         "An outer send cache missed."
> +       | nsSendCache depth methodReceiverClassTag cogMethod errSelIdx |
> -       | nsSendCache methodMixin numArgs selector depth enclosingObject
> cogMethod eoClassTag mrClassTag errSelIdx |
>         <api>
>         <option: #NewspeakVM>
>         <inline: false>
>         <var: #nsSendCache type: #'NSSendCache *'>
>         <var: #cogMethod type: #'CogMethod *'>
>
>         cogit assertCStackWellAligned.
>         self assert: (objectMemory addressCouldBeOop: methodReceiver).
> +       self deny: (objectMemory isOopForwarded: methodReceiver).
>
>         nsSendCache := self cCoerceSimple: cacheAddress to: #'NSSendCache
> *'.
> +       messageSelector := nsSendCache selector.
> +       argumentCount := nsSendCache numArgs.
> -       selector := nsSendCache selector.
> -       numArgs := nsSendCache numArgs.
>         depth := nsSendCache depth.
> +       method := (self mframeHomeMethod: framePointer) methodObject.
> -       methodMixin := self mMethodClass.
>
> +       self assert: (self stackValue: argumentCount + 1 "ret addr") =
> methodReceiver.
> -       enclosingObject := self
> -               enclosingObjectAt: depth
> -               withObject: methodReceiver
> -               withMixin: methodMixin.
>
> +       methodReceiverClassTag := objectMemory fetchClassTagOf:
> methodReceiver.
> -       self assert: (self stackValue: numArgs + 1 "ret val") =
> methodReceiver.
> -       self stackValue: numArgs + 1 "ret val " put: enclosingObject.
> -       "Replace the methodReceiver on the stack with the enclosingObject.
> When the cache has
> -       a hit, we don't care that the value on the stack is wrong because
> the compiled callee will
> -       use the value in ReceiverResultReg to build its frame. But the
> interpreter will use
> -       stack(numArgs)."
>
> +       (self
> +               inlineLookupInNSMethodCacheSel: messageSelector
> +               classTag: methodReceiverClassTag
> +               method: method
> +               lookupRule: depth)
> +                       ifTrue:
> +                               [localAbsentReceiverOrZero = 0
> +                                       ifTrue: [localAbsentReceiver :=
> methodReceiver]
> +                                       ifFalse: [localAbsentReceiver :=
> localAbsentReceiverOrZero].
> +                               "check for coggability because method is
> in the cache"
> +                               self ifAppropriateCompileToNativeCode:
> newMethod selector: messageSelector]
> +                       ifFalse:
> +                               [self deny: (objectMemory isOopForwarded:
> messageSelector).
> +                               self deny: (objectMemory
> isForwardedClassTag: methodReceiverClassTag).
> +                               lkupClassTag := methodReceiverClassTag.
> +                               errSelIdx := self lookupOuterSendNoMNU:
> methodReceiver depth: depth.
> +                               errSelIdx ~= 0 ifTrue:
> +                                       [self assert: errSelIdx ==
> SelectorDoesNotUnderstand.
> +                                       self handleMNU: errSelIdx
> +                                               InMachineCodeTo:
> methodReceiver
> +                                               classForMessage:
> (objectMemory classForClassTag: methodReceiverClassTag).
> +                                       self unreachable].
> +                               self addNewMethodToNSCache: depth].
> -       mrClassTag := objectMemory fetchClassTagOf: methodReceiver.
> -       eoClassTag := objectMemory fetchClassTagOf: enclosingObject.
> -       argumentCount := numArgs.
>
> +       "Fix stacked receiver."
> +       self stackValue: argumentCount + 1 "ret addr" put:
> localAbsentReceiver.
> -       (self lookupInMethodCacheSel: selector classTag: eoClassTag)
> -               ifTrue: ["check for coggability because method is in the
> cache"
> -                       self ifAppropriateCompileToNativeCode: newMethod
> selector: selector]
> -               ifFalse: [
> -                       (objectMemory isOopForwarded: selector) ifTrue:
> -                               [self error: 'Selector should have fixed
> by mapObjectReferencesInMachineCodeForBecome'].
> -                       (objectMemory isForwardedClassTag: eoClassTag)
> ifTrue:
> -                               [self error: 'Implicit receiver lookup
> should have followed fowarded objects'].
> -                       messageSelector := selector.
> -                       (errSelIdx := self lookupMethodNoMNUEtcInClass:
> (objectMemory classForClassTag: eoClassTag)) ~= 0
> -                               ifTrue: [[self handleMNU: errSelIdx
> InMachineCodeTo: enclosingObject classForMessage: (objectMemory
> classForClassTag: eoClassTag).
> -                                               self error:
> 'UNREACHABLE3']]].
>
>         (self maybeMethodHasCogMethod: newMethod)
>                 ifTrue: [
>                         cogMethod := self cogMethodOf: newMethod.
>                         cogMethod selector = objectMemory nilObject
> +                               ifTrue: [cogit setSelectorOf: cogMethod
> to: messageSelector]
> -                               ifTrue: [cogit setSelectorOf: cogMethod
> to: selector]
>                                 ifFalse: ["Deal with anonymous accessors,
> e.g. in Newspeak.
>                                         The cogMethod may not have the
>                                         correct selector. If not, try and
> compile a new method
>                                         with the correct selector."
> +                                       cogMethod selector ~=
> messageSelector ifTrue: [
> +                                                       (cogit cog:
> newMethod selector: messageSelector)
> -                                       cogMethod selector ~= selector
> ifTrue: [
> -                                                       (cogit cog:
> newMethod selector: selector)
>                                                                 ifNotNil:
> [:newCogMethod | cogMethod := newCogMethod]]].
> +                       cogMethod selector = messageSelector
> -                       cogMethod selector = selector
>                                 ifTrue:
>                                         [cogit
>                                                 linkNSSendCache:
> nsSendCache
> +                                               classTag:
> methodReceiverClassTag
> +                                               enclosingObject:
> localAbsentReceiverOrZero
> -                                               classTag: mrClassTag
> -                                               enclosingObject:
> enclosingObject
>                                                 target: cogMethod
>                                                 caller: self
> mframeHomeMethodExport]
>                                 ifFalse: ["Out of code memory. Fall
> through to interpret."].
>                         instructionPointer := self popStack.
>                         self executeNewMethod.
> +                       self unreachable].
> -                       self error: 'UNREACHABLE 1'].
>         instructionPointer := self popStack.
>         self interpretMethodFromMachineCode.
> +       self unreachable.!
> -       self error: 'UNREACHABLE 2'.
> -       ^nil!
>
> Item was removed:
> - ----- Method: CoInterpreter>>implicitReceiverFor:mixin:implementing: (in
> category 'newspeak bytecode support') -----
> - implicitReceiverFor: methodReceiver mixin: methodMixin implementing:
> selector
> -       "This is used to implement implicit receiver sends in Newspeak.
> Find the nearest
> -        lexically-enclosing implementation of selector by searching up
> the static chain of the
> -        method's receiver, starting at mixin's application. This
> implementation is derived from
> -
> -       <ContextPart> implicitReceiverFor: methodReceiver <Object>
> -                                       in: methodMixin <Mixin>
> -                                       implementing: selector <Symbol>
> ^<Object>"
> -
> -       <api>
> -       <option: #NewspeakVM>
> -       cogit breakOnImplicitReceiver ifTrue:
> -               [self sendBreakpoint: selector receiver: nil].
> -       ^super implicitReceiverFor: methodReceiver mixin: methodMixin
> implementing: selector!
>
> Item was added:
> + ----- Method: CoInterpreter>>lookupImplicitReceiverSendNoMNU: (in
> category 'message sending') -----
> + lookupImplicitReceiverSendNoMNU: methodReceiver
> +       "Do the full lookup for an implicit receiver send.
> +       IN: messageSelector
> +       IN: argumentCount
> +       OUT: localAbsentReceiver
> +       OUT: localAbsentReceiverOrZero
> +       OUT: newMethod
> +       OUT: primitiveIndex
> +       RESULT: 0 or SelectorDoesNotUnderstand"
> +
> +       | candidateReceiver candidateMixin candidateMixinApplication
> dictionary found |
> +       messageSelector := objectMemory followMaybeForwarded:
> messageSelector.
> +       candidateReceiver := methodReceiver.
> +       self deny: (objectMemory isForwarded: method).
> +       candidateMixin := self methodClassOf: method.
> +       localAbsentReceiverOrZero := 0.
> +       [self deny: (objectMemory isForwarded: candidateMixin).
> +       self deny: (objectMemory isForwarded: candidateReceiver).
> +       candidateMixinApplication := self
> +               findApplicationOfTargetMixin: candidateMixin
> +               startingAtBehavior: (objectMemory fetchClassOf:
> candidateReceiver).
> +       self deny: (candidateMixinApplication = 0).
> +       self deny: (candidateMixinApplication = objectMemory nilObject).
> +       self deny: (objectMemory isForwarded: candidateMixinApplication).
> +       self assert: (self addressCouldBeClassObj:
> candidateMixinApplication).
> +       dictionary := objectMemory followObjField: MethodDictionaryIndex
> ofObject: candidateMixinApplication.
> +       found := self lookupMethodInDictionary: dictionary.
> +       found ifTrue:
> +               [localAbsentReceiver := candidateReceiver.
> +               ^self lookupLexicalNoMNU: messageSelector from:
> candidateMixin rule: LookupRuleImplicit].
> +       candidateMixin := objectMemory followObjField: EnclosingMixinIndex
> ofObject: candidateMixin.
> +       self deny: (objectMemory isForwarded: candidateMixin).
> +       candidateMixin = objectMemory nilObject]
> +               whileFalse:
> +                       [localAbsentReceiverOrZero := candidateReceiver :=
> objectMemory followObjField: EnclosingObjectIndex ofObject:
> candidateMixinApplication].
> +       "There is no lexically visible method, so the implicit receiver is
> the method receiver."
> +       localAbsentReceiverOrZero := 0.
> +       localAbsentReceiver := methodReceiver.
> +       lkupClass := objectMemory fetchClassOf: methodReceiver. "For use
> by MNU"
> +       ^self lookupProtectedNoMNU: messageSelector startingAt: lkupClass
> rule: LookupRuleImplicit.!
>
> Item was added:
> + ----- Method: CoInterpreter>>lookupLexicalNoMNU:from:rule: (in category
> 'message sending') -----
> + lookupLexicalNoMNU: selector from: mixin rule: rule
> +       "A shared part of the lookup for implicit receiver sends that
> found a lexically visible
> +       method, and self and outer sends."
> +       | receiverClass mixinApplication dictionary found |
> +       receiverClass := objectMemory fetchClassOf: localAbsentReceiver.
> +       mixinApplication := self findApplicationOfTargetMixin: mixin
> startingAtBehavior: receiverClass.
> +       dictionary := objectMemory followObjField: MethodDictionaryIndex
> ofObject: mixinApplication.
> +       found := self lookupMethodInDictionary: dictionary.
> +       (found and: [(self accessModifierOfMethod: newMethod) =
> AccessModifierPrivate])
> +               ifTrue: [^0].
> +       ^self lookupProtectedNoMNU: selector startingAt: receiverClass
> rule: rule
> + !
>
> Item was added:
> + ----- Method: CoInterpreter>>lookupOuterSendNoMNU:depth: (in category
> 'message sending') -----
> + lookupOuterSendNoMNU: methodReceiver depth: depth
> +       "Do the full lookup for a self or outer send.
> +       IN: messageSelector
> +       IN: argumentCount
> +       OUT: localAbsentReceiver
> +       OUT: localAbsentReceiverOrZero
> +       OUT: newMethod
> +       OUT: primitiveIndex
> +       RESULT: 0 or SelectorDoesNotUnderstand"
> +
> +       | targetMixin count mixinApplication |
> +       localAbsentReceiver := methodReceiver.
> +       localAbsentReceiverOrZero := 0.
> +       targetMixin := self methodClassOf: method.
> +       count := 0.
> +       [count < depth] whileTrue:
> +               [count := count + 1.
> +               mixinApplication := self
> +                       findApplicationOfTargetMixin: targetMixin
> +                       startingAtBehavior: (objectMemory fetchClassOf:
> localAbsentReceiver).
> +               localAbsentReceiverOrZero := localAbsentReceiver :=
> objectMemory followObjField: EnclosingObjectIndex ofObject:
> mixinApplication.
> +               targetMixin := objectMemory followObjField:
> EnclosingMixinIndex ofObject: targetMixin].
> +       ^self lookupLexicalNoMNU: messageSelector from: targetMixin rule:
> depth!
>
> Item was added:
> + ----- Method: CoInterpreter>>lookupProtectedNoMNU:startingAt:rule: (in
> category 'message sending') -----
> + lookupProtectedNoMNU: selector startingAt: mixinApplication rule: rule
> +       "A shared part of the lookup for self, outer or implicit receiver
> sends that did not find a
> +       private lexically visible method, and (Newspeak) super sends."
> +       | lookupClass dictionary found |
> +       lookupClass := mixinApplication.
> +       [lookupClass = objectMemory nilObject] whileFalse:
> +               [dictionary := objectMemory followObjField:
> MethodDictionaryIndex ofObject: lookupClass.
> +               found := self lookupMethodInDictionary: dictionary.
> +               (found and: [(self accessModifierOfMethod: newMethod) ~=
> AccessModifierPrivate])
> +                       ifTrue: [^0].
> +               lookupClass := self superclassOf: lookupClass].
> +       ^SelectorDoesNotUnderstand!
>
> Item was added:
> + ----- Method: CoInterpreter>>unreachable (in category 'cog jit support')
> -----
> + unreachable
> +       self error: 'UNREACHABLE'.!
>
> Item was removed:
> - ----- Method: StackInterpreter>>implicitReceiverFor:mixin:implementing:
> (in category 'newspeak bytecode support') -----
> - implicitReceiverFor: methodReceiver mixin: methodMixin implementing:
> selector
> -       "This is used to implement implicit receiver sends in Newspeak.
> Find the nearest
> -        lexically-enclosing implementation of selector by searching up
> the static chain of the
> -        method's receiver, starting at mixin's application. This
> implementation is derived from
> -
> -       <ContextPart> implicitReceiverFor: methodReceiver <Object>
> -                                       in: methodMixin <Mixin>
> -                                       implementing: selector <Symbol>
> ^<Object>"
> -       <api>
> -       <option: #NewspeakVM>
> -       | candidateReceiver candidateMixin candidateMixinApplication
> dictionary found |
> -       self deny: (objectMemory isOopForwarded: methodReceiver).
> -       self deny: (objectMemory isForwarded: methodMixin).
> -       "messageSelector is an implicit parameter of
> lookupMethodInDictionary:"
> -       messageSelector := objectMemory followMaybeForwarded: selector.
> -       candidateReceiver := methodReceiver.
> -       candidateMixin := methodMixin.
> -       [candidateMixinApplication := self
> -               findApplicationOfTargetMixin: candidateMixin
> -               startingAtBehavior: (objectMemory fetchClassOf:
> candidateReceiver).
> -        self deny: (candidateMixinApplication = objectMemory nilObject).
> -        dictionary := objectMemory followObjField: MethodDictionaryIndex
> ofObject: candidateMixinApplication.
> -        found := self lookupMethodInDictionary: dictionary.
> -        found ifTrue: [^candidateReceiver].
> -        candidateMixin := objectMemory followObjField:
> EnclosingMixinIndex ofObject: candidateMixin.
> -        candidateMixin = objectMemory nilObject]
> -               whileFalse:
> -                       [candidateReceiver := objectMemory followObjField:
> EnclosingObjectIndex ofObject: candidateMixinApplication].
> -       ^methodReceiver!
>
>


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


More information about the Vm-dev mailing list