From f012dde278db8cf0f1e2e769a4aa358833b38ba2 Mon Sep 17 00:00:00 2001 From: Guille Polito Date: Wed, 6 Sep 2023 15:21:47 +0200 Subject: [PATCH 01/12] Change implementation by trap bytecode methods with patched literals --- .../MpMethodProxyTest.class.st | 259 +++--- .../MpTestConcurrentSharedObject.class.st | 5 +- src/MethodProxies/BlockClosure.extension.st | 19 - src/MethodProxies/MpMethodProxy.class.st | 333 ++----- .../MpMethodProxyPrototypeFactory.class.st | 828 ++++++++++++++++++ 5 files changed, 1023 insertions(+), 421 deletions(-) delete mode 100644 src/MethodProxies/BlockClosure.extension.st create mode 100644 src/MethodProxies/MpMethodProxyPrototypeFactory.class.st diff --git a/src/MethodProxies-Tests/MpMethodProxyTest.class.st b/src/MethodProxies-Tests/MpMethodProxyTest.class.st index 05869bc..a4151dd 100644 --- a/src/MethodProxies-Tests/MpMethodProxyTest.class.st +++ b/src/MethodProxies-Tests/MpMethodProxyTest.class.st @@ -41,44 +41,65 @@ MpMethodProxyTest >> installMethodProxy: aMethodProxy [ ] { #category : #initialization } -MpMethodProxyTest >> setUp [ +MpMethodProxyTest >> setUp [ super setUp. - trackedWrappers := OrderedCollection new. - MpClassA methods do: [ :each | each uninstall ] - + trackedWrappers := OrderedCollection new ] { #category : #initialization } MpMethodProxyTest >> tearDown [ - trackedWrappers do: [ :e | e uninstall ]. + trackedWrappers do: [ :each | + [ each uninstall ] + on: Error + do: [ :e | "continue" ] ]. super tearDown ] { #category : #'tests - safety' } MpMethodProxyTest >> testCanRunConcurrently [ "This tests the ability of method proxies to not influence each other between threads." - | mp1 mp2 mpTrigger1 mpTrigger2 handlerTrigger1 handlerTrigger2 sharedObject testSemaphore | - + + | mp1 mp2 mpTrigger1 mpTrigger2 handlerTrigger1 handlerTrigger2 sharedObject testSemaphore p1 p2 | sharedObject := MpTestConcurrentSharedObject new. testSemaphore := Semaphore new. - - mp1 := MpMethodProxy onMethod: (MpTestConcurrentSharedObject lookupSelector: #methodProcess1) handler: (MpWaitBeforeHandler new). - mp2 := MpMethodProxy onMethod: (MpTestConcurrentSharedObject lookupSelector: #methodProcess2) handler: (MpWaitAndTriggerBeforeHandler new). - mpTrigger1 := MpMethodProxy onMethod: (MpTestConcurrentSharedObject lookupSelector: #trigger1) handler: (handlerTrigger1 := MpAfterCounterHandler new). - mpTrigger2 := MpMethodProxy onMethod: (MpTestConcurrentSharedObject lookupSelector: #trigger2) handler: (handlerTrigger2 := MpAfterCounterHandler new). - + + mp1 := MpMethodProxy + onMethod: + (MpTestConcurrentSharedObject lookupSelector: #methodProcess1) + handler: MpWaitBeforeHandler new. + mp2 := MpMethodProxy + onMethod: + (MpTestConcurrentSharedObject lookupSelector: #methodProcess2) + handler: MpWaitAndTriggerBeforeHandler new. + mpTrigger1 := MpMethodProxy + onMethod: + (MpTestConcurrentSharedObject lookupSelector: + #trigger1) + handler: + (handlerTrigger1 := MpAfterCounterHandler new). + mpTrigger2 := MpMethodProxy + onMethod: + (MpTestConcurrentSharedObject lookupSelector: + #trigger2) + handler: + (handlerTrigger2 := MpAfterCounterHandler new). + self installMethodProxy: mp1. self installMethodProxy: mp2. self installMethodProxy: mpTrigger1. self installMethodProxy: mpTrigger2. - + "Here the first process will run an instrumented trigger (trigger1) while the second process is not instrumenting, then the second process will run a non-instrumented trigger while the first process is still instrumenting." - [ sharedObject methodProcess1. testSemaphore signal ] fork. - [ sharedObject methodProcess2. testSemaphore signal ] fork. + p1 := [ + sharedObject methodProcess1. + testSemaphore signal ] fork. + p2 := [ + sharedObject methodProcess2. + testSemaphore signal ] fork. testSemaphore wait. - + "Here the first trigger should have been captured, but not the second. If not concurrency is not correctly managed." self assert: handlerTrigger1 count equals: 1. self assert: handlerTrigger2 count equals: 0 @@ -152,6 +173,7 @@ MpMethodProxyTest >> testCanWrapEnsureWithException [ { #category : #'tests - safety' } MpMethodProxyTest >> testCanWrapValue [ + | mp handler | mp := MpMethodProxy onMethod: (FullBlockClosure lookupSelector: #value) handler: (handler := MpCountingHandler new). @@ -165,68 +187,19 @@ MpMethodProxyTest >> testCanWrapValue [ { #category : #'tests - safety' } MpMethodProxyTest >> testCanWrapValueWithException [ + | mp handler | - mp := MpMethodProxy onMethod: (FullBlockClosure lookupSelector: #value) handler: (handler := MpCountingHandler new). - - self installMethodProxy: mp. - - [[[ 1 error ] value] value] on: Error do: #yourself "to avoid an extra block". - - self assert: handler count equals: 2 "value" + 1 "on:do:" -] - -{ #category : #'tests - installation' } -MpMethodProxyTest >> testCannotProxyUnexistentMethod [ - - | mp | - mp := MpMethodProxy on: #methodOne inClass: Object handler: self handlerClass new. - - self assertCannotInstall: mp -] - -{ #category : #'tests - safety' } -MpMethodProxyTest >> testCannotWrapCriticalProxyMethods [ - - | mp handler | - mp := MpMethodProxy onMethod: MpMethodProxy >> #valueWithReceiver:arguments: handler: (handler := MpCountingHandler new). - - self assertCannotInstall: mp -] - -{ #category : #'tests - safety' } -MpMethodProxyTest >> testCannotWrapCriticalProxyMethods2 [ - - | mp handler | - mp := MpMethodProxy onMethod: MpMethodProxy >> #receiver:withArgs:executeMethod: handler: (handler := MpCountingHandler new). - - self assertCannotInstall: mp -] - -{ #category : #'tests - safety' } -MpMethodProxyTest >> testCannotWrapCriticalProxyMethods3 [ - - | mp handler | - mp := MpMethodProxy onMethod: MpMethodProxy >> #run:with:in: handler: (handler := MpCountingHandler new). - - self assertCannotInstall: mp -] - -{ #category : #'tests - safety' } -MpMethodProxyTest >> testCannotWrapCriticalProxyMethods4 [ - - | mp handler | - mp := MpMethodProxy onMethod: BlockClosure >> #methodProxyEnsure: handler: (handler := MpCountingHandler new). - - self assertCannotInstall: mp -] + mp := MpMethodProxy + onMethod: (FullBlockClosure lookupSelector: #value) + handler: (handler := MpCountingHandler new). -{ #category : #'tests - safety' } -MpMethodProxyTest >> testCannotWrapCriticalProxyMethods5 [ + self installMethodProxy: mp. + [ [ [ 1 error ] value ] value ] + on: Error + do: #yourself. "to avoid an extra block" - | mp handler | - mp := MpMethodProxy onMethod: MpInstrumentationUnwinder >> #value handler: (handler := MpCountingHandler new). - - self assertCannotInstall: mp + "#on:do: does send value too but it's optimised by default and there is no message send" + self assert: handler count equals: 2 ] { #category : #'tests - safety' } @@ -241,13 +214,14 @@ MpMethodProxyTest >> testCannotWrapCriticalProxyMethods6 [ { #category : #'tests - dead representation' } MpMethodProxyTest >> testCreatingAnInstanceDoesNotInstallIt [ - | mp method | - method := MpClassA >> #methodOne. - mp := MpMethodProxy on: #methodOne inClass: MpClassA handler: self handlerClass new. + | mp | + mp := MpMethodProxy + onMethod: MpClassA >> #methodOne + handler: self handlerClass new. self assert: mp selector equals: #methodOne. self assert: mp methodClass equals: MpClassA. - self assert: mp wrappedMethod equals: nil + self deny: mp isInstalled ] { #category : #'tests - safety' } @@ -307,7 +281,7 @@ MpMethodProxyTest >> testInstallSetCompiledMethod [ | mw method | [ method := MpClassA >> #methodOne. - mw := MpMethodProxy on: #methodOne inClass: MpClassA handler: self handlerClass new. + mw := MpMethodProxy onMethod: method handler: self handlerClass new. mw install. self assert: mw selector equals: #methodOne. self assert: mw methodClass equals: MpClassA. @@ -321,7 +295,7 @@ MpMethodProxyTest >> testIsInstalled [ | mw method | [ method := MpClassA >> #methodOne. - mw := MpMethodProxy on: #methodOne inClass: MpClassA handler: self handlerClass new. + mw := MpMethodProxy onMethod: method handler: self handlerClass new. self deny: mw isInstalled. mw install. self assert: mw isInstalled ] ensure: [ mw uninstall ] @@ -330,19 +304,25 @@ MpMethodProxyTest >> testIsInstalled [ { #category : #'tests - installation' } MpMethodProxyTest >> testIsInstalledNestedMWAreNotInstalled [ - | mp method mp2 | - method := MpClassA >> #methodOne. - mp := MpMethodProxy on: #methodOne inClass: MpClassA handler: self handlerClass new. - mp2 := MpMethodProxy on: #methodOne inClass: MpClassA handler: MpMockMethodProxyHandler new. + | mp mp2 | + mp := MpMethodProxy + onMethod: MpClassA >> #methodOne + handler: self handlerClass new. + mp2 := MpMethodProxy + onMethod: MpClassA >> #methodOne + handler: MpMockMethodProxyHandler new. + + [ + [ mp install. mp2 install. self deny: mp isInstalled. - self assert: mp2 isInstalled. - mp2 uninstall. - self deny: mp2 isInstalled. - self assert: mp isInstalled. - mp uninstall. - self deny: mp isInstalled + self assert: mp2 isInstalled ] ensure: [ + mp2 uninstall. + self deny: mp2 isInstalled. + self assert: mp isInstalled ] ] ensure: [ + mp uninstall. + self deny: mp isInstalled ] ] { #category : #'tests - safety' } @@ -350,7 +330,7 @@ MpMethodProxyTest >> testRecursiveMethodWrapperDoesNotRecurse [ | mw method | method := MpMockObject >> #recursiveMethod. - mw := MpMethodProxy onMethod: method handler: MpMockMethodProxyHandler new. + mw := MpMethodProxy onMethod: method handler: MpMockMethodProxyHandler new. self installMethodProxy: mw. self assert: MpMockObject new recursiveMethod equals: 'trapped [original]'. @@ -360,14 +340,16 @@ MpMethodProxyTest >> testRecursiveMethodWrapperDoesNotRecurse [ MpMethodProxyTest >> testUninstall [ | mp method | + [ method := MpClassA >> #methodOne. - mp := MpMethodProxy on: #methodOne inClass: MpClassA handler: self handlerClass new. + mp := MpMethodProxy onMethod: method handler: self handlerClass new. mp install. - self assert: (MpClassA compiledMethodAt: #methodOne) isMethodProxy. - self assert: (MpClassA compiledMethodAt: #methodOne) == mp. - mp uninstall. - self assert: (MpClassA compiledMethodAt: #methodOne) == method. - self assert: mp wrappedMethod isNil + self assert: + (MpClassA compiledMethodAt: #methodOne) selector = #methodOne. + self assert: (MpClassA compiledMethodAt: #methodOne) == mp trap ] + ensure: [ + mp uninstall. + self assert: (MpClassA compiledMethodAt: #methodOne) == method ] ] { #category : #'tests - installation' } @@ -375,15 +357,24 @@ MpMethodProxyTest >> testUninstallNestedInRightOrderIsOk [ | mp mp2 method | method := MpClassA >> #methodOne. - mp := MpMethodProxy on: #methodOne inClass: MpClassA handler: self handlerClass new. - mp2 := MpMethodProxy on: #methodOne inClass: MpClassA handler: MpMockMethodProxyHandler new. - mp install. - mp2 install. - self assert: (MpClassA compiledMethodAt: #methodOne) isMethodProxy. - self assert: (MpClassA compiledMethodAt: #methodOne) identicalTo: mp2. - mp2 uninstall. - self assert: (MpClassA compiledMethodAt: #methodOne) identicalTo: mp. - mp uninstall. + mp := MpMethodProxy + onMethod: MpClassA >> #methodOne + handler: self handlerClass new. + mp2 := MpMethodProxy + onMethod: MpClassA >> #methodOne + handler: MpMockMethodProxyHandler new. + self installMethodProxy: mp. + self installMethodProxy: mp2. + + [ + [ + self + assert: (MpClassA compiledMethodAt: #methodOne) + identicalTo: mp2 trap ] ensure: [ + mp2 uninstall. + self + assert: (MpClassA compiledMethodAt: #methodOne) + identicalTo: mp trap ] ] ensure: [ mp uninstall ]. self assert: (MpClassA compiledMethodAt: #methodOne) identicalTo: method @@ -393,29 +384,29 @@ MpMethodProxyTest >> testUninstallNestedInRightOrderIsOk [ MpMethodProxyTest >> testUnwrappedMethodAtOneLevelIsTheWrappedMethod [ | mp method | - [ method := MpClassA >> #methodOne. - mp := MpMethodProxy on: #methodOne inClass: MpClassA handler: self handlerClass new. - mp install. - self assert: mp unproxifiedMethod equals: method ] ensure: [ - mp uninstall ] + mp := MpMethodProxy onMethod: method handler: self handlerClass new. + self installMethodProxy: mp. + + self assert: mp wrappedMethod equals: method ] { #category : #tests } MpMethodProxyTest >> testUnwrappedMethodOfNestedMethodWrapperInTheCompiledMethod [ | mp method mp2 | - [ method := MpClassA >> #methodOne. - mp := MpMethodProxy on: #methodOne inClass: MpClassA handler: self handlerClass new. - mp install. - mp2 := MpMethodProxy on: #methodOne inClass: MpClassA handler: MpMockMethodProxyHandler new. - mp2 install. + mp := MpMethodProxy + onMethod: MpClassA >> #methodOne + handler: self handlerClass new. + self installMethodProxy: mp. - self assert: mp2 wrappedMethod equals: mp. - self assert: mp2 unproxifiedMethod equals: method ] ensure: [ - mp2 uninstall. - mp uninstall ] + mp2 := MpMethodProxy + onMethod: MpClassA >> #methodOne + handler: MpMockMethodProxyHandler new. + self installMethodProxy: mp2. + + self assert: mp2 wrappedMethod equals: mp trap. ] { #category : #'tests - safety' } @@ -474,13 +465,17 @@ MpMethodProxyTest >> testWrapNonLocalReturns [ MpMethodProxyTest >> testWrappingTwiceIsPossible [ | mp1 method mp2 | - [ + [ method := MpClassA >> #methodOne. - mp1 := MpMethodProxy on: #methodOne inClass: MpClassA handler: self handlerClass new. - mp1 install. + mp1 := MpMethodProxy + onMethod: MpClassA >> #methodOne + handler: self handlerClass new. + self installMethodProxy: mp1. - mp2 := MpMethodProxy on: #methodOne inClass: MpClassA handler: MpMockMethodProxyHandler new. - mp2 install. + mp2 := MpMethodProxy + onMethod: MpClassA >> #methodOne + handler: MpMockMethodProxyHandler new. + self installMethodProxy: mp2. self assert: mp1 selector equals: #methodOne. self assert: mp1 methodClass equals: MpClassA. @@ -488,9 +483,11 @@ MpMethodProxyTest >> testWrappingTwiceIsPossible [ self assert: mp2 selector equals: #methodOne. self assert: mp2 methodClass equals: MpClassA. - self assert: mp2 wrappedMethod equals: mp1 ] ensure: [ + self assert: mp2 wrappedMethod equals: mp1 trap ] ensure: [ + [ mp2 uninstall. - self assert: (MpClassA methodDict at: #methodOne) equals: mp1. - mp1 uninstall. - self assert: (MpClassA methodDict at: #methodOne) equals: method ] + self assert: (MpClassA methodDict at: #methodOne) equals: mp1 trap ] + ensure: [ + mp1 uninstall. + self assert: (MpClassA methodDict at: #methodOne) equals: method ] ] ] diff --git a/src/MethodProxies-Tests/MpTestConcurrentSharedObject.class.st b/src/MethodProxies-Tests/MpTestConcurrentSharedObject.class.st index 73d228d..c578fc1 100644 --- a/src/MethodProxies-Tests/MpTestConcurrentSharedObject.class.st +++ b/src/MethodProxies-Tests/MpTestConcurrentSharedObject.class.st @@ -20,8 +20,9 @@ MpTestConcurrentSharedObject >> concurrencySemaphore: anObject [ ] { #category : #initialization } -MpTestConcurrentSharedObject >> initialize [ - self concurrencySemaphore: (Semaphore new). +MpTestConcurrentSharedObject >> initialize [ + + self concurrencySemaphore: Semaphore new ] { #category : #debugging } diff --git a/src/MethodProxies/BlockClosure.extension.st b/src/MethodProxies/BlockClosure.extension.st deleted file mode 100644 index 64ec036..0000000 --- a/src/MethodProxies/BlockClosure.extension.st +++ /dev/null @@ -1,19 +0,0 @@ -Extension { #name : #BlockClosure } - -{ #category : #'*MethodProxies' } -BlockClosure >> methodProxyEnsure: aBlock [ - "Evaluate a termination block after evaluating the receiver, regardless of - whether the receiver's evaluation completes. N.B. This method is *not* - implemented as a primitive. Primitive 198 always fails. The VM uses prim - 198 in a context's method as the mark for an ensure:/ifCurtailed: activation." - - | complete returnValue | - - - returnValue := self valueNoContextSwitch. - complete ifNil:[ - complete := true. - aBlock value. - ]. - ^ returnValue -] diff --git a/src/MethodProxies/MpMethodProxy.class.st b/src/MethodProxies/MpMethodProxy.class.st index b97d790..c150bc9 100644 --- a/src/MethodProxies/MpMethodProxy.class.st +++ b/src/MethodProxies/MpMethodProxy.class.st @@ -1,338 +1,133 @@ -" -I'm a modern implementation of Python's method decorators or MethodWrappers for Pharo based on `valueWithReceiver:arguments:` VM hook. -Method proxies are objects that wrap methods stored in the method dictionary of the class. -Some support before and after action the execution of the original method. -Method proxies control their installation and propagation. -In particular, they can be applied to any Pharo method. The implementation ensures that the method proxy installation cannot touch any part of the system that could be used to installation. -Method proxies delegate to method handler. This delegation ensures that end user cannot blow up their environment by overridding undesired methods. -## Usage -Here is a typical usage. Check the tests to know more. -``` -testCounts - | proxy instance handler | - [ proxy := MpMethodProxy - on: #methodOne - inClass: MpClassA - handler: (handler := MwCountingHandler new). - proxy install. - instance := MpClassA new. - self assert: handler count equals: 0. - instance methodOne. - self assert: handler count equals: 1. - instance methodOne. - self assert: handler count equals: 2 ] ensure: [ proxy uninstall ] -``` -This package is developed and maintained by S. Ducasse, G. Polito and P. Tesone, but feel free to give a hand. -" Class { #name : #MpMethodProxy, #superclass : #Object, #instVars : [ - 'selector', - 'methodClass', - 'isDisabled', + 'proxyMethod', 'handler', - 'proxifiedMethod' + 'hiddenSelector', + 'trapMethod', + 'wrappedMethod' ], #category : #MethodProxies } -{ #category : #'reflective operations' } -MpMethodProxy class >> doesNotUnderstand: aMessage [ - - ^ CompiledMethod - perform: aMessage selector - withArguments: aMessage arguments -] - -{ #category : #'instance creation' } -MpMethodProxy class >> on: selector inClass: aClass handler: aHandler [ - - | proxy | - proxy := self new. - proxy class: aClass selector: selector. - proxy handler: aHandler. - ^ proxy -] - { #category : #'instance creation' } MpMethodProxy class >> onMethod: aMethod handler: aHandler [ - ^ self on: aMethod selector inClass: aMethod methodClass handler: aHandler -] - -{ #category : #private } -MpMethodProxy class >> uninstallAllWrappers [ - "self uninstallAllWrappers" - - self allSubInstancesDo: [ :inst | inst uninstall ] -] - -{ #category : #comparing } -MpMethodProxy >> = anObject [ - "Answer whether the receiver and the argument represent the same - object. If = is redefined in any subclass, consider also redefining the - message hash." - - ^ self == anObject + ^ self new + proxyMethod: aMethod; + handler: aHandler; + yourself ] { #category : #accessing } -MpMethodProxy >> calypsoEnvironmentType [ - ^ proxifiedMethod - ifNotNil: [ proxifiedMethod calypsoEnvironmentType ] - ifNil: [ super calypsoEnvironmentType ] - -] - -{ #category : #initialization } -MpMethodProxy >> class: aClass selector: aSymbol [ - - self - methodClass: aClass; - selector: aSymbol -] - -{ #category : #accessing } -MpMethodProxy >> disable [ +MpMethodProxy >> handler [ - isDisabled := true + ^ handler ] { #category : #accessing } -MpMethodProxy >> doesNotUnderstand: aMessage [ - ^ proxifiedMethod - ifNotNil: [ proxifiedMethod - perform: aMessage selector - withArguments: aMessage arguments ] - ifNil: [ super doesNotUnderstand: aMessage ] - -] +MpMethodProxy >> handler: anObject [ -{ #category : #accessing } -MpMethodProxy >> fetchMethod [ - - "Fetches the method to be instrumented" - ^ methodClass >> selector + handler := anObject ] { #category : #installation } -MpMethodProxy >> handler [ - - ^ handler -] +MpMethodProxy >> install [ -{ #category : #accessing } -MpMethodProxy >> handler: aHandler [ + | deactivator newTrap index trapSelector | + thisProcess runInMetaLevel: [ + (proxyMethod hasPragmaNamed: #noInstrumentation) ifTrue: [ + ^ MpCannotInstall signalWith: self ]. - handler := aHandler -] + deactivator := ProxyInstrumentationDeactivator new. + deactivator handler: handler. -{ #category : #installation } -MpMethodProxy >> initialize [ + newTrap := self trapMethodPrototype copy. + trapSelector := newTrap selector. + newTrap selector: proxyMethod selector. + newTrap methodClass: proxyMethod methodClass. - super initialize. - isDisabled := true -] + hiddenSelector := Object new. -{ #category : #installation } -MpMethodProxy >> install [ - "We have a method proxy with a method = class * selector of the method it will proxy." - - | method | - method := methodClass compiledMethodAt: selector ifAbsent: [ - MpCannotInstall signalWith: self ]. - - (self shouldWrap: method) ifFalse: [ - MpCannotInstall signalWith: self ]. - - self unproxifiedMethod: method. - methodClass methodDict at: selector put: self. - - "Activate it now" - isDisabled := false. - ^ self -] + index := newTrap literals indexOf: trapSelector. + newTrap literalAt: index put: hiddenSelector. -{ #category : #accessing } -MpMethodProxy >> isEnabled [ + index := newTrap literals indexOf: #handler. + newTrap literalAt: index put: handler. - ^ isDisabled not -] + index := newTrap literals indexOf: #deactivator. + newTrap literalAt: index put: deactivator. -{ #category : #accessing } -MpMethodProxy >> isEnabled: anObject [ + "It could happen that a proxy wraps a proxy. + Remember the object that was installed at this moment. + This is the object to restore during uninstall" + wrappedMethod := proxyMethod methodClass methodDict + at: proxyMethod selector. - isDisabled := anObject not + proxyMethod methodClass methodDict + at: hiddenSelector + put: proxyMethod. + proxyMethod methodClass methodDict + at: proxyMethod selector + put: newTrap. + + trapMethod := newTrap ] ] { #category : #testing } MpMethodProxy >> isInstalled [ - "Return whether the receiver is effectively installed in a method dictionary. - Note that in the case of nesting of method proxies the inner ones are not considered as installed." - - methodClass ifNotNil: [ - selector ifNotNil: [ - ^ self == (methodClass methodDict at: selector ifAbsent: [])]]. - ^ false -] -{ #category : #testing } -MpMethodProxy >> isMethodProxy [ + trapMethod ifNil: [ ^ false ]. - ^ true + ^ proxyMethod methodClass >> proxyMethod selector == trapMethod ] { #category : #accessing } MpMethodProxy >> methodClass [ - ^ methodClass -] - -{ #category : #accessing } -MpMethodProxy >> methodClass: aClass [ - - methodClass := aClass -] -{ #category : #evaluating } -MpMethodProxy >> name [ - - ^ self printString -] - -{ #category : #printing } -MpMethodProxy >> printOn: aStream [ - - aStream - nextPutAll: self class name; - nextPutAll: '['; - nextPutAll: methodClass name; - nextPutAll: '>>#'; - nextPutAll: selector; - nextPutAll: ']' + ^ proxyMethod methodClass ] -{ #category : #evaluating } -MpMethodProxy >> receiver: aReceiver withArgs: argArray executeMethod: compiledMethod [ - "Execute compiledMethod against the receiver and args in argArray" - - - - self primitiveFailed -] +{ #category : #accessing } +MpMethodProxy >> proxyMethod: anObject [ -{ #category : #evaluating } -MpMethodProxy >> run: aSelector with: anArrayOfObjects in: aReceiver [ - "Do not intercept" - - - (isDisabled or: [ thisProcess isMeta ]) ifTrue: [ - ^ self - receiver: aReceiver - withArgs: anArrayOfObjects - executeMethod: proxifiedMethod ]. - - "Purposely do not use a non-local return. - Otherwise the non-local return logic would be instrumented once the ensure block is executed. - However, since a lot of code executes between the ensure block and the real method return, this could end in infinite loops" - ^ self valueWithReceiver: aReceiver arguments: anArrayOfObjects + proxyMethod := anObject ] { #category : #accessing } MpMethodProxy >> selector [ - - ^ selector + + ^ proxyMethod selector ] -{ #category : #accessing } -MpMethodProxy >> selector: aSymbol [ - - selector := aSymbol +{ #category : #'instruction decoding' } +MpMethodProxy >> trap [ + + ^ trapMethod ] { #category : #installation } -MpMethodProxy >> shouldWrap: aMethod [ - - (aMethod isCompiledMethod not and: [ - aMethod handler class ~~ self handler class ]) ifTrue: [ ^ true ]. - - aMethod isCompiledMethod ifFalse: [ ^ false ]. +MpMethodProxy >> trapMethodPrototype [ - ^ aMethod pragmas noneSatisfy: [ :pragma | - pragma selector = #methodProxyCannotWrap or: [ - pragma selector = #noInstrumentation ] ] + ^ MpMethodProxyPrototypeFactory class methods detect: [ :m | + m numArgs = proxyMethod numArgs and: [ m selector beginsWith: 'trap' ] ] ] { #category : #installation } MpMethodProxy >> uninstall [ - | installedMethod | - thisProcess runInMetaLevel: [ - installedMethod := methodClass - compiledMethodAt: selector - ifAbsent: [ ^ self ]. - installedMethod == self ifTrue: [ - methodClass methodDict - at: selector - put: installedMethod wrappedMethod ]. - self unproxifiedMethod: nil ] -] - -{ #category : #accessing } -MpMethodProxy >> unproxifiedMethod [ - "The unproxifedMethod returns the proxified method even in case we have multiple proxified nesting." - - ^ proxifiedMethod ifNotNil: [ proxifiedMethod unproxifiedMethod ] -] - -{ #category : #'when installed' } -MpMethodProxy >> unproxifiedMethod: aCompiledMethod [ - - proxifiedMethod := aCompiledMethod -] - -{ #category : #evaluating } -MpMethodProxy >> valueWithReceiver: receiver arguments: arguments [ + self isInstalled ifFalse: [ ^ self ]. - - | result | - "Hooking into user methods to define before actions. - Before actions are not instrumented." thisProcess runInMetaLevel: [ - handler beforeExecutionWithReceiver: receiver arguments: arguments ]. - - "Purposely do not use a non-local return. - Otherwise the non-local return logic would be instrumented and this could end in infinite loops" - [ - result := self - receiver: receiver - withArgs: arguments - executeMethod: proxifiedMethod ] methodProxyEnsure: - (MpInstrumentationUnwinder - newWithHandler: handler - receiver: receiver - arguments: arguments). - - thisProcess runInMetaLevel: [^ handler - afterExecutionWithReceiver: receiver - arguments: arguments - returnValue: result] -] - -{ #category : #accessing } -MpMethodProxy >> wrappedClass [ - - ^ methodClass -] - -{ #category : #accessing } -MpMethodProxy >> wrappedClass: aClass [ - - methodClass := aClass + proxyMethod methodClass methodDict + at: proxyMethod selector + put: wrappedMethod. + proxyMethod methodClass methodDict removeKey: hiddenSelector ] ] { #category : #'when installed' } MpMethodProxy >> wrappedMethod [ - ^ proxifiedMethod + ^ proxyMethod ] diff --git a/src/MethodProxies/MpMethodProxyPrototypeFactory.class.st b/src/MethodProxies/MpMethodProxyPrototypeFactory.class.st new file mode 100644 index 0000000..cf53d82 --- /dev/null +++ b/src/MethodProxies/MpMethodProxyPrototypeFactory.class.st @@ -0,0 +1,828 @@ +Class { + #name : #MpMethodProxyPrototypeFactory, + #superclass : #Object, + #category : #MethodProxies +} + +{ #category : #evaluating } +MpMethodProxyPrototypeFactory class >> buildPrototypesUpToArguments: maxNumberOfArguments [ + + "self buildPrototypesUpToArguments: 15" + + | forwarders | + 0 to: maxNumberOfArguments do: [ :numberOfArguments | + | originalAst trapSelector trapArguments | + originalAst := (MpMethodProxyPrototypeFactory class >> #protoPrototype) + parseTree. + + trapSelector := #trap. + 1 to: numberOfArguments do: [ :i | + trapSelector := trapSelector , #with: ]. + trapArguments := ((1 to: numberOfArguments) collect: [ :i | + RBVariableNode named: 'arg' , i asString ]). + + originalAst selector: trapSelector. + originalAst arguments: trapArguments. + + forwarders := originalAst sendNodes select: [ :e | e selector = #originalMessage ]. + forwarders do: [ :e | + e replaceWith: (RBMessageNode + receiver: RBVariableNode selfNode + selector: trapSelector + arguments: trapArguments) ]. + self class compile: originalAst formattedCode + ] +] + +{ #category : #evaluating } +MpMethodProxyPrototypeFactory class >> protoPrototype [ + + + | deactivator result process complete wasMeta | + process := Processor activeProcess. + process isMeta ifTrue: [ ^ self originalMessage ]. + + deactivator := #deactivator. + process shiftLevelUp. + wasMeta := true. + #handler beforeExecutionWithReceiver: self arguments: #( ). + process shiftLevelDown. + wasMeta := false. + + result := self originalMessage. + + process shiftLevelUp. + wasMeta := true. + #handler aboutToReturnWithReceiver: self arguments: #( ). + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + process shiftLevelDown. + wasMeta := false. + + complete := true. + + ^ result +] + +{ #category : #'as yet unclassified' } +MpMethodProxyPrototypeFactory class >> proxyMethod: method handler: aHandler [ + + ^ MpMethodProxy new + proxyMethod: method; + handler: aHandler; + yourself +] + +{ #category : #'as yet unclassified' } +MpMethodProxyPrototypeFactory class >> trap [ + + + | deactivator result process complete wasMeta | + process := Processor activeProcess. + process isMeta ifTrue: [ ^ self trap ]. + + deactivator := #deactivator. + process shiftLevelUp. + wasMeta := true. + #handler beforeExecutionWithReceiver: self arguments: #( ). + process shiftLevelDown. + wasMeta := false. + + result := self trap. + + process shiftLevelUp. + wasMeta := true. + #handler aboutToReturnWithReceiver: self arguments: #( ). + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + process shiftLevelDown. + wasMeta := false. + + complete := true. + + ^ result +] + +{ #category : #'as yet unclassified' } +MpMethodProxyPrototypeFactory class >> trapwith: arg1 [ + + + | deactivator result process complete wasMeta | + process := Processor activeProcess. + process isMeta ifTrue: [ ^ self trapwith: arg1 ]. + + deactivator := #deactivator. + process shiftLevelUp. + wasMeta := true. + #handler beforeExecutionWithReceiver: self arguments: #( ). + process shiftLevelDown. + wasMeta := false. + + result := self trapwith: arg1. + + process shiftLevelUp. + wasMeta := true. + #handler aboutToReturnWithReceiver: self arguments: #( ). + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + process shiftLevelDown. + wasMeta := false. + + complete := true. + + ^ result +] + +{ #category : #'as yet unclassified' } +MpMethodProxyPrototypeFactory class >> trapwith: arg1 with: arg2 [ + + + | deactivator result process complete wasMeta | + process := Processor activeProcess. + process isMeta ifTrue: [ ^ self trapwith: arg1 with: arg2 ]. + + deactivator := #deactivator. + process shiftLevelUp. + wasMeta := true. + #handler beforeExecutionWithReceiver: self arguments: #( ). + process shiftLevelDown. + wasMeta := false. + + result := self trapwith: arg1 with: arg2. + + process shiftLevelUp. + wasMeta := true. + #handler aboutToReturnWithReceiver: self arguments: #( ). + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + process shiftLevelDown. + wasMeta := false. + + complete := true. + + ^ result +] + +{ #category : #'as yet unclassified' } +MpMethodProxyPrototypeFactory class >> trapwith: arg1 with: arg2 with: arg3 [ + + + | deactivator result process complete wasMeta | + process := Processor activeProcess. + process isMeta ifTrue: [ ^ self trapwith: arg1 with: arg2 with: arg3 ]. + + deactivator := #deactivator. + process shiftLevelUp. + wasMeta := true. + #handler beforeExecutionWithReceiver: self arguments: #( ). + process shiftLevelDown. + wasMeta := false. + + result := self trapwith: arg1 with: arg2 with: arg3. + + process shiftLevelUp. + wasMeta := true. + #handler aboutToReturnWithReceiver: self arguments: #( ). + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + process shiftLevelDown. + wasMeta := false. + + complete := true. + + ^ result +] + +{ #category : #'as yet unclassified' } +MpMethodProxyPrototypeFactory class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 [ + + + | deactivator result process complete wasMeta | + process := Processor activeProcess. + process isMeta ifTrue: [ + ^ self + trapwith: arg1 + with: arg2 + with: arg3 + with: arg4 ]. + + deactivator := #deactivator. + process shiftLevelUp. + wasMeta := true. + #handler beforeExecutionWithReceiver: self arguments: #( ). + process shiftLevelDown. + wasMeta := false. + + result := self + trapwith: arg1 + with: arg2 + with: arg3 + with: arg4. + + process shiftLevelUp. + wasMeta := true. + #handler aboutToReturnWithReceiver: self arguments: #( ). + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + process shiftLevelDown. + wasMeta := false. + + complete := true. + + ^ result +] + +{ #category : #'as yet unclassified' } +MpMethodProxyPrototypeFactory class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg5 [ + + + | deactivator result process complete wasMeta | + process := Processor activeProcess. + process isMeta ifTrue: [ + ^ self + trapwith: arg1 + with: arg2 + with: arg3 + with: arg4 + with: arg5 ]. + + deactivator := #deactivator. + process shiftLevelUp. + wasMeta := true. + #handler beforeExecutionWithReceiver: self arguments: #( ). + process shiftLevelDown. + wasMeta := false. + + result := self + trapwith: arg1 + with: arg2 + with: arg3 + with: arg4 + with: arg5. + + process shiftLevelUp. + wasMeta := true. + #handler aboutToReturnWithReceiver: self arguments: #( ). + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + process shiftLevelDown. + wasMeta := false. + + complete := true. + + ^ result +] + +{ #category : #'as yet unclassified' } +MpMethodProxyPrototypeFactory class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 [ + + + | deactivator result process complete wasMeta | + process := Processor activeProcess. + process isMeta ifTrue: [ + ^ self + trapwith: arg1 + with: arg2 + with: arg3 + with: arg4 + with: arg5 + with: arg6 ]. + + deactivator := #deactivator. + process shiftLevelUp. + wasMeta := true. + #handler beforeExecutionWithReceiver: self arguments: #( ). + process shiftLevelDown. + wasMeta := false. + + result := self + trapwith: arg1 + with: arg2 + with: arg3 + with: arg4 + with: arg5 + with: arg6. + + process shiftLevelUp. + wasMeta := true. + #handler aboutToReturnWithReceiver: self arguments: #( ). + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + process shiftLevelDown. + wasMeta := false. + + complete := true. + + ^ result +] + +{ #category : #'as yet unclassified' } +MpMethodProxyPrototypeFactory class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7 [ + + + | deactivator result process complete wasMeta | + process := Processor activeProcess. + process isMeta ifTrue: [ + ^ self + trapwith: arg1 + with: arg2 + with: arg3 + with: arg4 + with: arg5 + with: arg6 + with: arg7 ]. + + deactivator := #deactivator. + process shiftLevelUp. + wasMeta := true. + #handler beforeExecutionWithReceiver: self arguments: #( ). + process shiftLevelDown. + wasMeta := false. + + result := self + trapwith: arg1 + with: arg2 + with: arg3 + with: arg4 + with: arg5 + with: arg6 + with: arg7. + + process shiftLevelUp. + wasMeta := true. + #handler aboutToReturnWithReceiver: self arguments: #( ). + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + process shiftLevelDown. + wasMeta := false. + + complete := true. + + ^ result +] + +{ #category : #'as yet unclassified' } +MpMethodProxyPrototypeFactory class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7 with: arg8 [ + + + | deactivator result process complete wasMeta | + process := Processor activeProcess. + process isMeta ifTrue: [ + ^ self + trapwith: arg1 + with: arg2 + with: arg3 + with: arg4 + with: arg5 + with: arg6 + with: arg7 + with: arg8 ]. + + deactivator := #deactivator. + process shiftLevelUp. + wasMeta := true. + #handler beforeExecutionWithReceiver: self arguments: #( ). + process shiftLevelDown. + wasMeta := false. + + result := self + trapwith: arg1 + with: arg2 + with: arg3 + with: arg4 + with: arg5 + with: arg6 + with: arg7 + with: arg8. + + process shiftLevelUp. + wasMeta := true. + #handler aboutToReturnWithReceiver: self arguments: #( ). + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + process shiftLevelDown. + wasMeta := false. + + complete := true. + + ^ result +] + +{ #category : #'as yet unclassified' } +MpMethodProxyPrototypeFactory class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7 with: arg8 with: arg9 [ + + + | deactivator result process complete wasMeta | + process := Processor activeProcess. + process isMeta ifTrue: [ + ^ self + trapwith: arg1 + with: arg2 + with: arg3 + with: arg4 + with: arg5 + with: arg6 + with: arg7 + with: arg8 + with: arg9 ]. + + deactivator := #deactivator. + process shiftLevelUp. + wasMeta := true. + #handler beforeExecutionWithReceiver: self arguments: #( ). + process shiftLevelDown. + wasMeta := false. + + result := self + trapwith: arg1 + with: arg2 + with: arg3 + with: arg4 + with: arg5 + with: arg6 + with: arg7 + with: arg8 + with: arg9. + + process shiftLevelUp. + wasMeta := true. + #handler aboutToReturnWithReceiver: self arguments: #( ). + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + process shiftLevelDown. + wasMeta := false. + + complete := true. + + ^ result +] + +{ #category : #'as yet unclassified' } +MpMethodProxyPrototypeFactory class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7 with: arg8 with: arg9 with: arg10 [ + + + | deactivator result process complete wasMeta | + process := Processor activeProcess. + process isMeta ifTrue: [ + ^ self + trapwith: arg1 + with: arg2 + with: arg3 + with: arg4 + with: arg5 + with: arg6 + with: arg7 + with: arg8 + with: arg9 + with: arg10 ]. + + deactivator := #deactivator. + process shiftLevelUp. + wasMeta := true. + #handler beforeExecutionWithReceiver: self arguments: #( ). + process shiftLevelDown. + wasMeta := false. + + result := self + trapwith: arg1 + with: arg2 + with: arg3 + with: arg4 + with: arg5 + with: arg6 + with: arg7 + with: arg8 + with: arg9 + with: arg10. + + process shiftLevelUp. + wasMeta := true. + #handler aboutToReturnWithReceiver: self arguments: #( ). + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + process shiftLevelDown. + wasMeta := false. + + complete := true. + + ^ result +] + +{ #category : #'as yet unclassified' } +MpMethodProxyPrototypeFactory class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7 with: arg8 with: arg9 with: arg10 with: arg11 [ + + + | deactivator result process complete wasMeta | + process := Processor activeProcess. + process isMeta ifTrue: [ + ^ self + trapwith: arg1 + with: arg2 + with: arg3 + with: arg4 + with: arg5 + with: arg6 + with: arg7 + with: arg8 + with: arg9 + with: arg10 + with: arg11 ]. + + deactivator := #deactivator. + process shiftLevelUp. + wasMeta := true. + #handler beforeExecutionWithReceiver: self arguments: #( ). + process shiftLevelDown. + wasMeta := false. + + result := self + trapwith: arg1 + with: arg2 + with: arg3 + with: arg4 + with: arg5 + with: arg6 + with: arg7 + with: arg8 + with: arg9 + with: arg10 + with: arg11. + + process shiftLevelUp. + wasMeta := true. + #handler aboutToReturnWithReceiver: self arguments: #( ). + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + process shiftLevelDown. + wasMeta := false. + + complete := true. + + ^ result +] + +{ #category : #'as yet unclassified' } +MpMethodProxyPrototypeFactory class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7 with: arg8 with: arg9 with: arg10 with: arg11 with: arg12 [ + + + | deactivator result process complete wasMeta | + process := Processor activeProcess. + process isMeta ifTrue: [ + ^ self + trapwith: arg1 + with: arg2 + with: arg3 + with: arg4 + with: arg5 + with: arg6 + with: arg7 + with: arg8 + with: arg9 + with: arg10 + with: arg11 + with: arg12 ]. + + deactivator := #deactivator. + process shiftLevelUp. + wasMeta := true. + #handler beforeExecutionWithReceiver: self arguments: #( ). + process shiftLevelDown. + wasMeta := false. + + result := self + trapwith: arg1 + with: arg2 + with: arg3 + with: arg4 + with: arg5 + with: arg6 + with: arg7 + with: arg8 + with: arg9 + with: arg10 + with: arg11 + with: arg12. + + process shiftLevelUp. + wasMeta := true. + #handler aboutToReturnWithReceiver: self arguments: #( ). + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + process shiftLevelDown. + wasMeta := false. + + complete := true. + + ^ result +] + +{ #category : #'as yet unclassified' } +MpMethodProxyPrototypeFactory class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7 with: arg8 with: arg9 with: arg10 with: arg11 with: arg12 with: arg13 [ + + + | deactivator result process complete wasMeta | + process := Processor activeProcess. + process isMeta ifTrue: [ + ^ self + trapwith: arg1 + with: arg2 + with: arg3 + with: arg4 + with: arg5 + with: arg6 + with: arg7 + with: arg8 + with: arg9 + with: arg10 + with: arg11 + with: arg12 + with: arg13 ]. + + deactivator := #deactivator. + process shiftLevelUp. + wasMeta := true. + #handler beforeExecutionWithReceiver: self arguments: #( ). + process shiftLevelDown. + wasMeta := false. + + result := self + trapwith: arg1 + with: arg2 + with: arg3 + with: arg4 + with: arg5 + with: arg6 + with: arg7 + with: arg8 + with: arg9 + with: arg10 + with: arg11 + with: arg12 + with: arg13. + + process shiftLevelUp. + wasMeta := true. + #handler aboutToReturnWithReceiver: self arguments: #( ). + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + process shiftLevelDown. + wasMeta := false. + + complete := true. + + ^ result +] + +{ #category : #'as yet unclassified' } +MpMethodProxyPrototypeFactory class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7 with: arg8 with: arg9 with: arg10 with: arg11 with: arg12 with: arg13 with: arg14 [ + + + | deactivator result process complete wasMeta | + process := Processor activeProcess. + process isMeta ifTrue: [ + ^ self + trapwith: arg1 + with: arg2 + with: arg3 + with: arg4 + with: arg5 + with: arg6 + with: arg7 + with: arg8 + with: arg9 + with: arg10 + with: arg11 + with: arg12 + with: arg13 + with: arg14 ]. + + deactivator := #deactivator. + process shiftLevelUp. + wasMeta := true. + #handler beforeExecutionWithReceiver: self arguments: #( ). + process shiftLevelDown. + wasMeta := false. + + result := self + trapwith: arg1 + with: arg2 + with: arg3 + with: arg4 + with: arg5 + with: arg6 + with: arg7 + with: arg8 + with: arg9 + with: arg10 + with: arg11 + with: arg12 + with: arg13 + with: arg14. + + process shiftLevelUp. + wasMeta := true. + #handler aboutToReturnWithReceiver: self arguments: #( ). + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + process shiftLevelDown. + wasMeta := false. + + complete := true. + + ^ result +] + +{ #category : #'as yet unclassified' } +MpMethodProxyPrototypeFactory class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7 with: arg8 with: arg9 with: arg10 with: arg11 with: arg12 with: arg13 with: arg14 with: arg15 [ + + + | deactivator result process complete wasMeta | + process := Processor activeProcess. + process isMeta ifTrue: [ + ^ self + trapwith: arg1 + with: arg2 + with: arg3 + with: arg4 + with: arg5 + with: arg6 + with: arg7 + with: arg8 + with: arg9 + with: arg10 + with: arg11 + with: arg12 + with: arg13 + with: arg14 + with: arg15 ]. + + deactivator := #deactivator. + process shiftLevelUp. + wasMeta := true. + #handler beforeExecutionWithReceiver: self arguments: #( ). + process shiftLevelDown. + wasMeta := false. + + result := self + trapwith: arg1 + with: arg2 + with: arg3 + with: arg4 + with: arg5 + with: arg6 + with: arg7 + with: arg8 + with: arg9 + with: arg10 + with: arg11 + with: arg12 + with: arg13 + with: arg14 + with: arg15. + + process shiftLevelUp. + wasMeta := true. + #handler aboutToReturnWithReceiver: self arguments: #( ). + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + process shiftLevelDown. + wasMeta := false. + + complete := true. + + ^ result +] From bb20d6e671cbcdf8587da15d568b0de4b186bad2 Mon Sep 17 00:00:00 2001 From: Guille Polito Date: Wed, 6 Sep 2023 15:34:47 +0200 Subject: [PATCH 02/12] Adding ProxyInstrumentationDeactivator --- .../ProxyInstrumentationDeactivator.class.st | 20 +++++++++++++++++++ 1 file changed, 20 insertions(+) create mode 100644 src/MethodProxies/ProxyInstrumentationDeactivator.class.st diff --git a/src/MethodProxies/ProxyInstrumentationDeactivator.class.st b/src/MethodProxies/ProxyInstrumentationDeactivator.class.st new file mode 100644 index 0000000..fdef867 --- /dev/null +++ b/src/MethodProxies/ProxyInstrumentationDeactivator.class.st @@ -0,0 +1,20 @@ +Class { + #name : #ProxyInstrumentationDeactivator, + #superclass : #InstrumentationEnsurer, + #instVars : [ + 'handler' + ], + #category : #MethodProxies +} + +{ #category : #accessing } +ProxyInstrumentationDeactivator >> handler [ + + ^ handler +] + +{ #category : #accessing } +ProxyInstrumentationDeactivator >> handler: anObject [ + + handler := anObject +] From 69cec7c2b8a1abce984dd0755dac95a525d43b30 Mon Sep 17 00:00:00 2001 From: Guille Polito Date: Wed, 6 Sep 2023 15:35:13 +0200 Subject: [PATCH 03/12] Moving method --- .../ProxyInstrumentationDeactivator.class.st | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/src/MethodProxies/ProxyInstrumentationDeactivator.class.st b/src/MethodProxies/ProxyInstrumentationDeactivator.class.st index fdef867..89dcfd5 100644 --- a/src/MethodProxies/ProxyInstrumentationDeactivator.class.st +++ b/src/MethodProxies/ProxyInstrumentationDeactivator.class.st @@ -18,3 +18,19 @@ ProxyInstrumentationDeactivator >> handler: anObject [ handler := anObject ] + +{ #category : #evaluating } +ProxyInstrumentationDeactivator >> value [ + + + "Slow path, an exception or a non local return happened" + | wasMeta me | + thisProcess shiftLevelUp. + + me := thisContext findContextSuchThat: [ :ctx | ctx isUnwindContext ]. + wasMeta := me tempNamed: 'wasMeta'. + handler aboutToReturnWithReceiver: me receiver arguments: me arguments. + thisProcess shiftLevelDown. + wasMeta ifTrue: [ thisProcess shiftLevelDown ]. + +] From de62b89ef666353a750e5a05c6450dea83c98072 Mon Sep 17 00:00:00 2001 From: Guille Polito Date: Thu, 7 Sep 2023 15:14:02 +0200 Subject: [PATCH 04/12] Use a separate class for hidden selectors --- src/MethodProxies/MpHiddenSelector.class.st | 12 ++++++++++++ src/MethodProxies/MpMethodProxy.class.st | 2 +- 2 files changed, 13 insertions(+), 1 deletion(-) create mode 100644 src/MethodProxies/MpHiddenSelector.class.st diff --git a/src/MethodProxies/MpHiddenSelector.class.st b/src/MethodProxies/MpHiddenSelector.class.st new file mode 100644 index 0000000..2f32e51 --- /dev/null +++ b/src/MethodProxies/MpHiddenSelector.class.st @@ -0,0 +1,12 @@ +Class { + #name : #MpHiddenSelector, + #superclass : #Object, + #category : #MethodProxies +} + +{ #category : #private } +MpHiddenSelector >> flushCache [ + "Tell the virtual machine to remove all entries with this symbol as a selector from its method lookup caches, if it has any. This must be done whenever a method is added, redefined or removed, so that message lookups reflect the revised organization. c.f. Behavior>>flushCache & CompiledMethod>>flushCache. Essential. See MethodDictionary class comment." + + +] diff --git a/src/MethodProxies/MpMethodProxy.class.st b/src/MethodProxies/MpMethodProxy.class.st index c150bc9..09eafa9 100644 --- a/src/MethodProxies/MpMethodProxy.class.st +++ b/src/MethodProxies/MpMethodProxy.class.st @@ -48,7 +48,7 @@ MpMethodProxy >> install [ newTrap selector: proxyMethod selector. newTrap methodClass: proxyMethod methodClass. - hiddenSelector := Object new. + hiddenSelector := MpHiddenSelector new. index := newTrap literals indexOf: trapSelector. newTrap literalAt: index put: hiddenSelector. From 1d00ef9d48b49ba7fb2c4c000dc3482bce3c7942 Mon Sep 17 00:00:00 2001 From: Guille Polito Date: Thu, 7 Sep 2023 16:49:10 +0200 Subject: [PATCH 05/12] Cleanups, comments, refactorings and renames --- src/MethodProxies-Tests/MpClassA.class.st | 2 +- .../MpMethodProxyTest.class.st | 2 + src/MethodProxies/MpHandler.class.st | 32 +- .../MpInstrumentationUnwinder.class.st | 64 - src/MethodProxies/MpMethodProxy.class.st | 1128 ++++++++++++++++- .../MpMethodProxyPrototypeFactory.class.st | 828 ------------ ...pProxyInstrumentationDeactivator.class.st} | 8 +- .../MpAllocationProfilerHandler.class.st | 25 +- 8 files changed, 1158 insertions(+), 931 deletions(-) delete mode 100644 src/MethodProxies/MpInstrumentationUnwinder.class.st delete mode 100644 src/MethodProxies/MpMethodProxyPrototypeFactory.class.st rename src/MethodProxies/{ProxyInstrumentationDeactivator.class.st => MpProxyInstrumentationDeactivator.class.st} (76%) diff --git a/src/MethodProxies-Tests/MpClassA.class.st b/src/MethodProxies-Tests/MpClassA.class.st index 7440e2a..974af58 100644 --- a/src/MethodProxies-Tests/MpClassA.class.st +++ b/src/MethodProxies-Tests/MpClassA.class.st @@ -32,8 +32,8 @@ MpClassA >> methodLastingOneSecond [ { #category : #debugging } MpClassA >> methodOne [ + ^ 101 - ] { #category : #debugging } diff --git a/src/MethodProxies-Tests/MpMethodProxyTest.class.st b/src/MethodProxies-Tests/MpMethodProxyTest.class.st index a4151dd..4043030 100644 --- a/src/MethodProxies-Tests/MpMethodProxyTest.class.st +++ b/src/MethodProxies-Tests/MpMethodProxyTest.class.st @@ -54,6 +54,8 @@ MpMethodProxyTest >> tearDown [ [ each uninstall ] on: Error do: [ :e | "continue" ] ]. + (MpMethodProxy allInstances anySatisfy: [ :e | e isInstalled ]) + ifTrue: [ self error: 'Proxies still installed after test: ', testSelector asString ]. super tearDown ] diff --git a/src/MethodProxies/MpHandler.class.st b/src/MethodProxies/MpHandler.class.st index 29e4590..f906d8a 100644 --- a/src/MethodProxies/MpHandler.class.st +++ b/src/MethodProxies/MpHandler.class.st @@ -1,8 +1,16 @@ " -I'm the root of hierarchy of objects that can perform computation in place of method such as counting execution... -The main API is composed of two methods: -- `afterExecutionWithReceiver: anObject arguments: anArrayOfObjects returnValue: aReturnValue` -- `beforeExecutionWithReceiver: anObject arguments: anArrayOfObjects` +I'm the responsible of executing some instrumentation for a method proxy. +I implement the main hooks that are called when a method is executed or returns. +By default, I do nothing. Override my hooks to perform some action before/after. + +The main API is composed of three methods: +- `beforeExecutionWithReceiver: anObject arguments: anArrayOfObjects`: called before the wrapped method gets invoked. It receives as argument the actual receiver and arguments of the trapped message send. +- `aboutToReturnWithReceiver: anObject arguments: arguments`: called before the wrapped method exits because of a stack unwind that *passes through* this method. This happens in the case of non-local returns and exceptions. +- `afterExecutionWithReceiver: anObject arguments: anArrayOfObjects returnValue: aReturnValue`: called before the wraped method exists on a normal return with a return value. This hook allows doing something after normal execution happened, act on the return value, and change the return values of methods. The return value of the trapped call is sent as argument. The proxy will return the value returned by this method. + +Moreover, for cases when this is not required, two higher-level hooks are proposed in and defined in terms of the ones above. +- `beforeMethod`: called before the method gets invoked. Just a simpler version of `beforeExecutionWithReceiver: anObject arguments: anArrayOfObjects`. +- `afterMethod`: called before the method returns, either by normal or abnormal execution. It does not allow any action on the return value. " Class { #name : #MpHandler, @@ -19,6 +27,7 @@ MpHandler >> aboutToReturnWithReceiver: receiver arguments: arguments [ { #category : #evaluating } MpHandler >> afterExecutionWithReceiver: anObject arguments: anArrayOfObjects returnValue: aReturnValue [ + self afterMethod. ^ aReturnValue ] @@ -36,18 +45,3 @@ MpHandler >> beforeExecutionWithReceiver: anObject arguments: anArrayOfObjects [ { #category : #evaluating } MpHandler >> beforeMethod [ ] - -{ #category : #evaluating } -MpHandler >> captureCallingContext [ - - | runWithInContext | - - "Find the context of #run:with:in:" - runWithInContext := thisContext sender. - [ runWithInContext isNil - or: [ runWithInContext method isCompiledMethod and: [runWithInContext method selector = #run:with:in:] ] ] - whileFalse: [ runWithInContext := runWithInContext sender ]. - - "Find the real sender" - ^ runWithInContext ifNotNil: [ runWithInContext sender ] -] diff --git a/src/MethodProxies/MpInstrumentationUnwinder.class.st b/src/MethodProxies/MpInstrumentationUnwinder.class.st deleted file mode 100644 index 032fcb0..0000000 --- a/src/MethodProxies/MpInstrumentationUnwinder.class.st +++ /dev/null @@ -1,64 +0,0 @@ -Class { - #name : #MpInstrumentationUnwinder, - #superclass : #InstrumentationEnsurer, - #instVars : [ - 'receiver', - 'arguments', - 'handler' - ], - #category : #MethodProxies -} - -{ #category : #'instance creation' } -MpInstrumentationUnwinder class >> newWithHandler: aHandler receiver: receiver arguments: arguments [ - - ^ self new - handler: aHandler; - receiver: receiver; - arguments: arguments; - yourself -] - -{ #category : #accessing } -MpInstrumentationUnwinder >> arguments [ - - ^ arguments -] - -{ #category : #accessing } -MpInstrumentationUnwinder >> arguments: anObject [ - - arguments := anObject -] - -{ #category : #accessing } -MpInstrumentationUnwinder >> handler [ - - ^ handler -] - -{ #category : #accessing } -MpInstrumentationUnwinder >> handler: anObject [ - - handler := anObject -] - -{ #category : #accessing } -MpInstrumentationUnwinder >> receiver [ - - ^ receiver -] - -{ #category : #accessing } -MpInstrumentationUnwinder >> receiver: anObject [ - - receiver := anObject -] - -{ #category : #evaluating } -MpInstrumentationUnwinder >> value [ - - - thisProcess runInMetaLevel: [ - ^ handler aboutToReturnWithReceiver: receiver arguments: arguments ] -] diff --git a/src/MethodProxies/MpMethodProxy.class.st b/src/MethodProxies/MpMethodProxy.class.st index 09eafa9..c633213 100644 --- a/src/MethodProxies/MpMethodProxy.class.st +++ b/src/MethodProxies/MpMethodProxy.class.st @@ -1,3 +1,56 @@ +" +I implement a method proxy that can wrap a method and do something before/after it. +I'm implemented as a stratified proxy: the specific instrumentation and the implementation of the instrumentation are separate concerns. +I am responsible of the instrumentation implementation, and I delegate to a handler object the corresponding instrumentation. +This allows users to define their own concerns without caring about specifics of the implementation. + +## Basic Usage + +A proxy is created by giving the method to wrap and a handler. +The proxy is not installed by default in the system. +Send it the message `install` to make it available. + +```smalltalk + mp := MpMethodProxy onMethod: Context >> #aboutToReturn:through: handler: (handler := MpCountingHandler new). + mp install. +``` + +After installation the proxy will trap calls to the wrapped method and transfer them to the handler. +To uninstall a proxy, send it the message `#uninstall` + +```smalltalk + mp uninstall. +``` + +Check the implementation of `MpHandler` to understand how to define new handlers. + +## Implementation notes + +To instrument method executions, I use normal methods and literal patching which plays very well with the JIT and inline caches. +The general strategy is the following. + +The original method is installed in the method dictionary with another selector (an object instance of `MpHiddenSelector`). +A trap method accepting the same number of arguments than the original method is copied, then it is patched so it forwards the message to the previously crafted selector. +Since the instrumented method is installed with a selector that has only one sender, this will become a monomorphic linked callsite after the first call. + +Moreover, trap methods have been optimized to avoid allocating ensure blocks, stack reifications and other subtleties required for stack unwind (correct management of exceptions and non-local returns) which makes it very slow. Trap methods are thus written as: + +```smalltalk +MpMethodProxy class >> trapWith: arg1 with: arg2 + | handler | + handler := ""some object that understands value"". + ... +``` + +This allows + +- unwind without extra blocks and less contexts +- having a very fast execution path without unwind in the middle. + +On top of this, the handler of traps is set as a literal that is patched. + +That literal is a normal object (`MpProxyInstrumentationDeactivator`) that on value inspects the stack (we are in the slow case anyways, who cares! :D) and performs what is required to do. +" Class { #name : #MpMethodProxy, #superclass : #Object, @@ -11,6 +64,38 @@ Class { #category : #MethodProxies } +{ #category : #evaluating } +MpMethodProxy class >> buildPrototypesUpToArguments: maxNumberOfArguments [ + "This method builds/compiles the prototype traps for arguments up to the argument. + The trap prototypes are installed in this class' class side. + They can later be copied and patched by MpMethodProxy" + + "self buildPrototypesUpToArguments: 15" + + | forwarders | + 0 to: maxNumberOfArguments do: [ :numberOfArguments | + | originalAst trapSelector trapArguments | + originalAst := (self class >> #prototypeTrap) parseTree. + + trapSelector := #trap. + 1 to: numberOfArguments do: [ :i | + trapSelector := trapSelector , #with: ]. + trapArguments := (1 to: numberOfArguments) collect: [ :i | + RBVariableNode named: 'arg' , i asString ]. + + originalAst selector: trapSelector. + originalAst arguments: trapArguments. + + forwarders := originalAst sendNodes select: [ :e | + e selector = #originalMessage ]. + forwarders do: [ :e | + e replaceWith: (RBMessageNode + receiver: RBVariableNode selfNode + selector: trapSelector + arguments: trapArguments) ]. + self class compile: originalAst formattedCode ] +] + { #category : #'instance creation' } MpMethodProxy class >> onMethod: aMethod handler: aHandler [ @@ -20,6 +105,1038 @@ MpMethodProxy class >> onMethod: aMethod handler: aHandler [ yourself ] +{ #category : #evaluating } +MpMethodProxy class >> prototypeTrap [ + + + "The unwind handler should be the first temp, the complete flag should be the second temp. + Then this method is free to use as many extra temporaries and arguments as is wants" + | deactivator complete result process wasMeta | + + "Quick check, if we are in a meta-level do not instrument" + process := thisProcess. + process isMeta ifTrue: [ ^ self originalMessage ]. + + "Set the deactivator literal that will be later patched as exception handler" + deactivator := #deactivator. + + "Move to the meta level and call the before hook" + process shiftLevelUp. + wasMeta := true. + #handler beforeExecutionWithReceiver: self arguments: #( ). + process shiftLevelDown. + wasMeta := false. + + "Back in the base-level forward the original message. + This is a message to self that will be monomorphically linked by the VM. + The core idea is that + - the original method is installed in the same method dictionary using a unique symbol + - this call is patched to use that symbol for the send" + result := self originalMessage. + + "Move to the meta level and call the after hooks. + Two after hooks are required. + One indicates the method is returning either because a normal return, or a stack unwind due to exceptions or non-local returns + The other indicates we are returning normally with a value." + process shiftLevelUp. + wasMeta := true. + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + process shiftLevelDown. + wasMeta := false. + + "Mark the execution as complete to avoid double execution of the unwind handler" + complete := true. + ^ result +] + +{ #category : #'as yet unclassified' } +MpMethodProxy class >> proxyMethod: method handler: aHandler [ + + ^ MpMethodProxy new + proxyMethod: method; + handler: aHandler; + yourself +] + +{ #category : #'as yet unclassified' } +MpMethodProxy class >> trap [ + "The unwind handler should be the first temp, the complete flag should be the second temp. + Then this method is free to use as many extra temporaries and arguments as is wants" + + + | deactivator complete result process wasMeta | + "Quick check, if we are in a meta-level do not instrument" + process := thisProcess. + process isMeta ifTrue: [ ^ self trap ]. + + "Set the deactivator literal that will be later patched as exception handler" + deactivator := #deactivator. + + "Move to the meta level and call the before hook" + process shiftLevelUp. + wasMeta := true. + #handler beforeExecutionWithReceiver: self arguments: #( ). + process shiftLevelDown. + wasMeta := false. + + "Back in the base-level forward the original message. + This is a message to self that will be monomorphically linked by the VM. + The core idea is that + - the original method is installed in the same method dictionary using a unique symbol + - this call is patched to use that symbol for the send" + result := self trap. + + "Move to the meta level and call the after hooks. + Two after hooks are required. + One indicates the method is returning either because a normal return, or a stack unwind due to exceptions or non-local returns + The other indicates we are returning normally with a value." + process shiftLevelUp. + wasMeta := true. + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + process shiftLevelDown. + wasMeta := false. + + "Mark the execution as complete to avoid double execution of the unwind handler" + complete := true. + ^ result +] + +{ #category : #'as yet unclassified' } +MpMethodProxy class >> trapwith: arg1 [ + "The unwind handler should be the first temp, the complete flag should be the second temp. + Then this method is free to use as many extra temporaries and arguments as is wants" + + + | deactivator complete result process wasMeta | + "Quick check, if we are in a meta-level do not instrument" + process := thisProcess. + process isMeta ifTrue: [ ^ self trapwith: arg1 ]. + + "Set the deactivator literal that will be later patched as exception handler" + deactivator := #deactivator. + + "Move to the meta level and call the before hook" + process shiftLevelUp. + wasMeta := true. + #handler beforeExecutionWithReceiver: self arguments: #( ). + process shiftLevelDown. + wasMeta := false. + + "Back in the base-level forward the original message. + This is a message to self that will be monomorphically linked by the VM. + The core idea is that + - the original method is installed in the same method dictionary using a unique symbol + - this call is patched to use that symbol for the send" + result := self trapwith: arg1. + + "Move to the meta level and call the after hooks. + Two after hooks are required. + One indicates the method is returning either because a normal return, or a stack unwind due to exceptions or non-local returns + The other indicates we are returning normally with a value." + process shiftLevelUp. + wasMeta := true. + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + process shiftLevelDown. + wasMeta := false. + + "Mark the execution as complete to avoid double execution of the unwind handler" + complete := true. + ^ result +] + +{ #category : #'as yet unclassified' } +MpMethodProxy class >> trapwith: arg1 with: arg2 [ + "The unwind handler should be the first temp, the complete flag should be the second temp. + Then this method is free to use as many extra temporaries and arguments as is wants" + + + | deactivator complete result process wasMeta | + "Quick check, if we are in a meta-level do not instrument" + process := thisProcess. + process isMeta ifTrue: [ ^ self trapwith: arg1 with: arg2 ]. + + "Set the deactivator literal that will be later patched as exception handler" + deactivator := #deactivator. + + "Move to the meta level and call the before hook" + process shiftLevelUp. + wasMeta := true. + #handler beforeExecutionWithReceiver: self arguments: #( ). + process shiftLevelDown. + wasMeta := false. + + "Back in the base-level forward the original message. + This is a message to self that will be monomorphically linked by the VM. + The core idea is that + - the original method is installed in the same method dictionary using a unique symbol + - this call is patched to use that symbol for the send" + result := self trapwith: arg1 with: arg2. + + "Move to the meta level and call the after hooks. + Two after hooks are required. + One indicates the method is returning either because a normal return, or a stack unwind due to exceptions or non-local returns + The other indicates we are returning normally with a value." + process shiftLevelUp. + wasMeta := true. + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + process shiftLevelDown. + wasMeta := false. + + "Mark the execution as complete to avoid double execution of the unwind handler" + complete := true. + ^ result +] + +{ #category : #'as yet unclassified' } +MpMethodProxy class >> trapwith: arg1 with: arg2 with: arg3 [ + "The unwind handler should be the first temp, the complete flag should be the second temp. + Then this method is free to use as many extra temporaries and arguments as is wants" + + + | deactivator complete result process wasMeta | + "Quick check, if we are in a meta-level do not instrument" + process := thisProcess. + process isMeta ifTrue: [ ^ self trapwith: arg1 with: arg2 with: arg3 ]. + + "Set the deactivator literal that will be later patched as exception handler" + deactivator := #deactivator. + + "Move to the meta level and call the before hook" + process shiftLevelUp. + wasMeta := true. + #handler beforeExecutionWithReceiver: self arguments: #( ). + process shiftLevelDown. + wasMeta := false. + + "Back in the base-level forward the original message. + This is a message to self that will be monomorphically linked by the VM. + The core idea is that + - the original method is installed in the same method dictionary using a unique symbol + - this call is patched to use that symbol for the send" + result := self trapwith: arg1 with: arg2 with: arg3. + + "Move to the meta level and call the after hooks. + Two after hooks are required. + One indicates the method is returning either because a normal return, or a stack unwind due to exceptions or non-local returns + The other indicates we are returning normally with a value." + process shiftLevelUp. + wasMeta := true. + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + process shiftLevelDown. + wasMeta := false. + + "Mark the execution as complete to avoid double execution of the unwind handler" + complete := true. + ^ result +] + +{ #category : #'as yet unclassified' } +MpMethodProxy class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 [ + "The unwind handler should be the first temp, the complete flag should be the second temp. + Then this method is free to use as many extra temporaries and arguments as is wants" + + + | deactivator complete result process wasMeta | + "Quick check, if we are in a meta-level do not instrument" + process := thisProcess. + process isMeta ifTrue: [ + ^ self + trapwith: arg1 + with: arg2 + with: arg3 + with: arg4 ]. + + "Set the deactivator literal that will be later patched as exception handler" + deactivator := #deactivator. + + "Move to the meta level and call the before hook" + process shiftLevelUp. + wasMeta := true. + #handler beforeExecutionWithReceiver: self arguments: #( ). + process shiftLevelDown. + wasMeta := false. + + "Back in the base-level forward the original message. + This is a message to self that will be monomorphically linked by the VM. + The core idea is that + - the original method is installed in the same method dictionary using a unique symbol + - this call is patched to use that symbol for the send" + result := self + trapwith: arg1 + with: arg2 + with: arg3 + with: arg4. + + "Move to the meta level and call the after hooks. + Two after hooks are required. + One indicates the method is returning either because a normal return, or a stack unwind due to exceptions or non-local returns + The other indicates we are returning normally with a value." + process shiftLevelUp. + wasMeta := true. + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + process shiftLevelDown. + wasMeta := false. + + "Mark the execution as complete to avoid double execution of the unwind handler" + complete := true. + ^ result +] + +{ #category : #'as yet unclassified' } +MpMethodProxy class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg5 [ + "The unwind handler should be the first temp, the complete flag should be the second temp. + Then this method is free to use as many extra temporaries and arguments as is wants" + + + | deactivator complete result process wasMeta | + "Quick check, if we are in a meta-level do not instrument" + process := thisProcess. + process isMeta ifTrue: [ + ^ self + trapwith: arg1 + with: arg2 + with: arg3 + with: arg4 + with: arg5 ]. + + "Set the deactivator literal that will be later patched as exception handler" + deactivator := #deactivator. + + "Move to the meta level and call the before hook" + process shiftLevelUp. + wasMeta := true. + #handler beforeExecutionWithReceiver: self arguments: #( ). + process shiftLevelDown. + wasMeta := false. + + "Back in the base-level forward the original message. + This is a message to self that will be monomorphically linked by the VM. + The core idea is that + - the original method is installed in the same method dictionary using a unique symbol + - this call is patched to use that symbol for the send" + result := self + trapwith: arg1 + with: arg2 + with: arg3 + with: arg4 + with: arg5. + + "Move to the meta level and call the after hooks. + Two after hooks are required. + One indicates the method is returning either because a normal return, or a stack unwind due to exceptions or non-local returns + The other indicates we are returning normally with a value." + process shiftLevelUp. + wasMeta := true. + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + process shiftLevelDown. + wasMeta := false. + + "Mark the execution as complete to avoid double execution of the unwind handler" + complete := true. + ^ result +] + +{ #category : #'as yet unclassified' } +MpMethodProxy class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 [ + "The unwind handler should be the first temp, the complete flag should be the second temp. + Then this method is free to use as many extra temporaries and arguments as is wants" + + + | deactivator complete result process wasMeta | + "Quick check, if we are in a meta-level do not instrument" + process := thisProcess. + process isMeta ifTrue: [ + ^ self + trapwith: arg1 + with: arg2 + with: arg3 + with: arg4 + with: arg5 + with: arg6 ]. + + "Set the deactivator literal that will be later patched as exception handler" + deactivator := #deactivator. + + "Move to the meta level and call the before hook" + process shiftLevelUp. + wasMeta := true. + #handler beforeExecutionWithReceiver: self arguments: #( ). + process shiftLevelDown. + wasMeta := false. + + "Back in the base-level forward the original message. + This is a message to self that will be monomorphically linked by the VM. + The core idea is that + - the original method is installed in the same method dictionary using a unique symbol + - this call is patched to use that symbol for the send" + result := self + trapwith: arg1 + with: arg2 + with: arg3 + with: arg4 + with: arg5 + with: arg6. + + "Move to the meta level and call the after hooks. + Two after hooks are required. + One indicates the method is returning either because a normal return, or a stack unwind due to exceptions or non-local returns + The other indicates we are returning normally with a value." + process shiftLevelUp. + wasMeta := true. + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + process shiftLevelDown. + wasMeta := false. + + "Mark the execution as complete to avoid double execution of the unwind handler" + complete := true. + ^ result +] + +{ #category : #'as yet unclassified' } +MpMethodProxy class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7 [ + "The unwind handler should be the first temp, the complete flag should be the second temp. + Then this method is free to use as many extra temporaries and arguments as is wants" + + + | deactivator complete result process wasMeta | + "Quick check, if we are in a meta-level do not instrument" + process := thisProcess. + process isMeta ifTrue: [ + ^ self + trapwith: arg1 + with: arg2 + with: arg3 + with: arg4 + with: arg5 + with: arg6 + with: arg7 ]. + + "Set the deactivator literal that will be later patched as exception handler" + deactivator := #deactivator. + + "Move to the meta level and call the before hook" + process shiftLevelUp. + wasMeta := true. + #handler beforeExecutionWithReceiver: self arguments: #( ). + process shiftLevelDown. + wasMeta := false. + + "Back in the base-level forward the original message. + This is a message to self that will be monomorphically linked by the VM. + The core idea is that + - the original method is installed in the same method dictionary using a unique symbol + - this call is patched to use that symbol for the send" + result := self + trapwith: arg1 + with: arg2 + with: arg3 + with: arg4 + with: arg5 + with: arg6 + with: arg7. + + "Move to the meta level and call the after hooks. + Two after hooks are required. + One indicates the method is returning either because a normal return, or a stack unwind due to exceptions or non-local returns + The other indicates we are returning normally with a value." + process shiftLevelUp. + wasMeta := true. + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + process shiftLevelDown. + wasMeta := false. + + "Mark the execution as complete to avoid double execution of the unwind handler" + complete := true. + ^ result +] + +{ #category : #'as yet unclassified' } +MpMethodProxy class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7 with: arg8 [ + "The unwind handler should be the first temp, the complete flag should be the second temp. + Then this method is free to use as many extra temporaries and arguments as is wants" + + + | deactivator complete result process wasMeta | + "Quick check, if we are in a meta-level do not instrument" + process := thisProcess. + process isMeta ifTrue: [ + ^ self + trapwith: arg1 + with: arg2 + with: arg3 + with: arg4 + with: arg5 + with: arg6 + with: arg7 + with: arg8 ]. + + "Set the deactivator literal that will be later patched as exception handler" + deactivator := #deactivator. + + "Move to the meta level and call the before hook" + process shiftLevelUp. + wasMeta := true. + #handler beforeExecutionWithReceiver: self arguments: #( ). + process shiftLevelDown. + wasMeta := false. + + "Back in the base-level forward the original message. + This is a message to self that will be monomorphically linked by the VM. + The core idea is that + - the original method is installed in the same method dictionary using a unique symbol + - this call is patched to use that symbol for the send" + result := self + trapwith: arg1 + with: arg2 + with: arg3 + with: arg4 + with: arg5 + with: arg6 + with: arg7 + with: arg8. + + "Move to the meta level and call the after hooks. + Two after hooks are required. + One indicates the method is returning either because a normal return, or a stack unwind due to exceptions or non-local returns + The other indicates we are returning normally with a value." + process shiftLevelUp. + wasMeta := true. + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + process shiftLevelDown. + wasMeta := false. + + "Mark the execution as complete to avoid double execution of the unwind handler" + complete := true. + ^ result +] + +{ #category : #'as yet unclassified' } +MpMethodProxy class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7 with: arg8 with: arg9 [ + "The unwind handler should be the first temp, the complete flag should be the second temp. + Then this method is free to use as many extra temporaries and arguments as is wants" + + + | deactivator complete result process wasMeta | + "Quick check, if we are in a meta-level do not instrument" + process := thisProcess. + process isMeta ifTrue: [ + ^ self + trapwith: arg1 + with: arg2 + with: arg3 + with: arg4 + with: arg5 + with: arg6 + with: arg7 + with: arg8 + with: arg9 ]. + + "Set the deactivator literal that will be later patched as exception handler" + deactivator := #deactivator. + + "Move to the meta level and call the before hook" + process shiftLevelUp. + wasMeta := true. + #handler beforeExecutionWithReceiver: self arguments: #( ). + process shiftLevelDown. + wasMeta := false. + + "Back in the base-level forward the original message. + This is a message to self that will be monomorphically linked by the VM. + The core idea is that + - the original method is installed in the same method dictionary using a unique symbol + - this call is patched to use that symbol for the send" + result := self + trapwith: arg1 + with: arg2 + with: arg3 + with: arg4 + with: arg5 + with: arg6 + with: arg7 + with: arg8 + with: arg9. + + "Move to the meta level and call the after hooks. + Two after hooks are required. + One indicates the method is returning either because a normal return, or a stack unwind due to exceptions or non-local returns + The other indicates we are returning normally with a value." + process shiftLevelUp. + wasMeta := true. + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + process shiftLevelDown. + wasMeta := false. + + "Mark the execution as complete to avoid double execution of the unwind handler" + complete := true. + ^ result +] + +{ #category : #'as yet unclassified' } +MpMethodProxy class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7 with: arg8 with: arg9 with: arg10 [ + "The unwind handler should be the first temp, the complete flag should be the second temp. + Then this method is free to use as many extra temporaries and arguments as is wants" + + + | deactivator complete result process wasMeta | + "Quick check, if we are in a meta-level do not instrument" + process := thisProcess. + process isMeta ifTrue: [ + ^ self + trapwith: arg1 + with: arg2 + with: arg3 + with: arg4 + with: arg5 + with: arg6 + with: arg7 + with: arg8 + with: arg9 + with: arg10 ]. + + "Set the deactivator literal that will be later patched as exception handler" + deactivator := #deactivator. + + "Move to the meta level and call the before hook" + process shiftLevelUp. + wasMeta := true. + #handler beforeExecutionWithReceiver: self arguments: #( ). + process shiftLevelDown. + wasMeta := false. + + "Back in the base-level forward the original message. + This is a message to self that will be monomorphically linked by the VM. + The core idea is that + - the original method is installed in the same method dictionary using a unique symbol + - this call is patched to use that symbol for the send" + result := self + trapwith: arg1 + with: arg2 + with: arg3 + with: arg4 + with: arg5 + with: arg6 + with: arg7 + with: arg8 + with: arg9 + with: arg10. + + "Move to the meta level and call the after hooks. + Two after hooks are required. + One indicates the method is returning either because a normal return, or a stack unwind due to exceptions or non-local returns + The other indicates we are returning normally with a value." + process shiftLevelUp. + wasMeta := true. + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + process shiftLevelDown. + wasMeta := false. + + "Mark the execution as complete to avoid double execution of the unwind handler" + complete := true. + ^ result +] + +{ #category : #'as yet unclassified' } +MpMethodProxy class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7 with: arg8 with: arg9 with: arg10 with: arg11 [ + "The unwind handler should be the first temp, the complete flag should be the second temp. + Then this method is free to use as many extra temporaries and arguments as is wants" + + + | deactivator complete result process wasMeta | + "Quick check, if we are in a meta-level do not instrument" + process := thisProcess. + process isMeta ifTrue: [ + ^ self + trapwith: arg1 + with: arg2 + with: arg3 + with: arg4 + with: arg5 + with: arg6 + with: arg7 + with: arg8 + with: arg9 + with: arg10 + with: arg11 ]. + + "Set the deactivator literal that will be later patched as exception handler" + deactivator := #deactivator. + + "Move to the meta level and call the before hook" + process shiftLevelUp. + wasMeta := true. + #handler beforeExecutionWithReceiver: self arguments: #( ). + process shiftLevelDown. + wasMeta := false. + + "Back in the base-level forward the original message. + This is a message to self that will be monomorphically linked by the VM. + The core idea is that + - the original method is installed in the same method dictionary using a unique symbol + - this call is patched to use that symbol for the send" + result := self + trapwith: arg1 + with: arg2 + with: arg3 + with: arg4 + with: arg5 + with: arg6 + with: arg7 + with: arg8 + with: arg9 + with: arg10 + with: arg11. + + "Move to the meta level and call the after hooks. + Two after hooks are required. + One indicates the method is returning either because a normal return, or a stack unwind due to exceptions or non-local returns + The other indicates we are returning normally with a value." + process shiftLevelUp. + wasMeta := true. + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + process shiftLevelDown. + wasMeta := false. + + "Mark the execution as complete to avoid double execution of the unwind handler" + complete := true. + ^ result +] + +{ #category : #'as yet unclassified' } +MpMethodProxy class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7 with: arg8 with: arg9 with: arg10 with: arg11 with: arg12 [ + "The unwind handler should be the first temp, the complete flag should be the second temp. + Then this method is free to use as many extra temporaries and arguments as is wants" + + + | deactivator complete result process wasMeta | + "Quick check, if we are in a meta-level do not instrument" + process := thisProcess. + process isMeta ifTrue: [ + ^ self + trapwith: arg1 + with: arg2 + with: arg3 + with: arg4 + with: arg5 + with: arg6 + with: arg7 + with: arg8 + with: arg9 + with: arg10 + with: arg11 + with: arg12 ]. + + "Set the deactivator literal that will be later patched as exception handler" + deactivator := #deactivator. + + "Move to the meta level and call the before hook" + process shiftLevelUp. + wasMeta := true. + #handler beforeExecutionWithReceiver: self arguments: #( ). + process shiftLevelDown. + wasMeta := false. + + "Back in the base-level forward the original message. + This is a message to self that will be monomorphically linked by the VM. + The core idea is that + - the original method is installed in the same method dictionary using a unique symbol + - this call is patched to use that symbol for the send" + result := self + trapwith: arg1 + with: arg2 + with: arg3 + with: arg4 + with: arg5 + with: arg6 + with: arg7 + with: arg8 + with: arg9 + with: arg10 + with: arg11 + with: arg12. + + "Move to the meta level and call the after hooks. + Two after hooks are required. + One indicates the method is returning either because a normal return, or a stack unwind due to exceptions or non-local returns + The other indicates we are returning normally with a value." + process shiftLevelUp. + wasMeta := true. + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + process shiftLevelDown. + wasMeta := false. + + "Mark the execution as complete to avoid double execution of the unwind handler" + complete := true. + ^ result +] + +{ #category : #'as yet unclassified' } +MpMethodProxy class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7 with: arg8 with: arg9 with: arg10 with: arg11 with: arg12 with: arg13 [ + "The unwind handler should be the first temp, the complete flag should be the second temp. + Then this method is free to use as many extra temporaries and arguments as is wants" + + + | deactivator complete result process wasMeta | + "Quick check, if we are in a meta-level do not instrument" + process := thisProcess. + process isMeta ifTrue: [ + ^ self + trapwith: arg1 + with: arg2 + with: arg3 + with: arg4 + with: arg5 + with: arg6 + with: arg7 + with: arg8 + with: arg9 + with: arg10 + with: arg11 + with: arg12 + with: arg13 ]. + + "Set the deactivator literal that will be later patched as exception handler" + deactivator := #deactivator. + + "Move to the meta level and call the before hook" + process shiftLevelUp. + wasMeta := true. + #handler beforeExecutionWithReceiver: self arguments: #( ). + process shiftLevelDown. + wasMeta := false. + + "Back in the base-level forward the original message. + This is a message to self that will be monomorphically linked by the VM. + The core idea is that + - the original method is installed in the same method dictionary using a unique symbol + - this call is patched to use that symbol for the send" + result := self + trapwith: arg1 + with: arg2 + with: arg3 + with: arg4 + with: arg5 + with: arg6 + with: arg7 + with: arg8 + with: arg9 + with: arg10 + with: arg11 + with: arg12 + with: arg13. + + "Move to the meta level and call the after hooks. + Two after hooks are required. + One indicates the method is returning either because a normal return, or a stack unwind due to exceptions or non-local returns + The other indicates we are returning normally with a value." + process shiftLevelUp. + wasMeta := true. + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + process shiftLevelDown. + wasMeta := false. + + "Mark the execution as complete to avoid double execution of the unwind handler" + complete := true. + ^ result +] + +{ #category : #'as yet unclassified' } +MpMethodProxy class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7 with: arg8 with: arg9 with: arg10 with: arg11 with: arg12 with: arg13 with: arg14 [ + "The unwind handler should be the first temp, the complete flag should be the second temp. + Then this method is free to use as many extra temporaries and arguments as is wants" + + + | deactivator complete result process wasMeta | + "Quick check, if we are in a meta-level do not instrument" + process := thisProcess. + process isMeta ifTrue: [ + ^ self + trapwith: arg1 + with: arg2 + with: arg3 + with: arg4 + with: arg5 + with: arg6 + with: arg7 + with: arg8 + with: arg9 + with: arg10 + with: arg11 + with: arg12 + with: arg13 + with: arg14 ]. + + "Set the deactivator literal that will be later patched as exception handler" + deactivator := #deactivator. + + "Move to the meta level and call the before hook" + process shiftLevelUp. + wasMeta := true. + #handler beforeExecutionWithReceiver: self arguments: #( ). + process shiftLevelDown. + wasMeta := false. + + "Back in the base-level forward the original message. + This is a message to self that will be monomorphically linked by the VM. + The core idea is that + - the original method is installed in the same method dictionary using a unique symbol + - this call is patched to use that symbol for the send" + result := self + trapwith: arg1 + with: arg2 + with: arg3 + with: arg4 + with: arg5 + with: arg6 + with: arg7 + with: arg8 + with: arg9 + with: arg10 + with: arg11 + with: arg12 + with: arg13 + with: arg14. + + "Move to the meta level and call the after hooks. + Two after hooks are required. + One indicates the method is returning either because a normal return, or a stack unwind due to exceptions or non-local returns + The other indicates we are returning normally with a value." + process shiftLevelUp. + wasMeta := true. + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + process shiftLevelDown. + wasMeta := false. + + "Mark the execution as complete to avoid double execution of the unwind handler" + complete := true. + ^ result +] + +{ #category : #'as yet unclassified' } +MpMethodProxy class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7 with: arg8 with: arg9 with: arg10 with: arg11 with: arg12 with: arg13 with: arg14 with: arg15 [ + "The unwind handler should be the first temp, the complete flag should be the second temp. + Then this method is free to use as many extra temporaries and arguments as is wants" + + + | deactivator complete result process wasMeta | + "Quick check, if we are in a meta-level do not instrument" + process := thisProcess. + process isMeta ifTrue: [ + ^ self + trapwith: arg1 + with: arg2 + with: arg3 + with: arg4 + with: arg5 + with: arg6 + with: arg7 + with: arg8 + with: arg9 + with: arg10 + with: arg11 + with: arg12 + with: arg13 + with: arg14 + with: arg15 ]. + + "Set the deactivator literal that will be later patched as exception handler" + deactivator := #deactivator. + + "Move to the meta level and call the before hook" + process shiftLevelUp. + wasMeta := true. + #handler beforeExecutionWithReceiver: self arguments: #( ). + process shiftLevelDown. + wasMeta := false. + + "Back in the base-level forward the original message. + This is a message to self that will be monomorphically linked by the VM. + The core idea is that + - the original method is installed in the same method dictionary using a unique symbol + - this call is patched to use that symbol for the send" + result := self + trapwith: arg1 + with: arg2 + with: arg3 + with: arg4 + with: arg5 + with: arg6 + with: arg7 + with: arg8 + with: arg9 + with: arg10 + with: arg11 + with: arg12 + with: arg13 + with: arg14 + with: arg15. + + "Move to the meta level and call the after hooks. + Two after hooks are required. + One indicates the method is returning either because a normal return, or a stack unwind due to exceptions or non-local returns + The other indicates we are returning normally with a value." + process shiftLevelUp. + wasMeta := true. + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + process shiftLevelDown. + wasMeta := false. + + "Mark the execution as complete to avoid double execution of the unwind handler" + complete := true. + ^ result +] + { #category : #accessing } MpMethodProxy >> handler [ @@ -40,7 +1157,7 @@ MpMethodProxy >> install [ (proxyMethod hasPragmaNamed: #noInstrumentation) ifTrue: [ ^ MpCannotInstall signalWith: self ]. - deactivator := ProxyInstrumentationDeactivator new. + deactivator := MpProxyInstrumentationDeactivator new. deactivator handler: handler. newTrap := self trapMethodPrototype copy. @@ -101,7 +1218,7 @@ MpMethodProxy >> selector [ ^ proxyMethod selector ] -{ #category : #'instruction decoding' } +{ #category : #accessing } MpMethodProxy >> trap [ ^ trapMethod @@ -110,8 +1227,9 @@ MpMethodProxy >> trap [ { #category : #installation } MpMethodProxy >> trapMethodPrototype [ - ^ MpMethodProxyPrototypeFactory class methods detect: [ :m | - m numArgs = proxyMethod numArgs and: [ m selector beginsWith: 'trap' ] ] + ^ self class class methods detect: [ :m | + m numArgs = proxyMethod numArgs and: [ + m selector beginsWith: 'trap' ] ] ] { #category : #installation } @@ -126,7 +1244,7 @@ MpMethodProxy >> uninstall [ proxyMethod methodClass methodDict removeKey: hiddenSelector ] ] -{ #category : #'when installed' } +{ #category : #accessing } MpMethodProxy >> wrappedMethod [ ^ proxyMethod diff --git a/src/MethodProxies/MpMethodProxyPrototypeFactory.class.st b/src/MethodProxies/MpMethodProxyPrototypeFactory.class.st deleted file mode 100644 index cf53d82..0000000 --- a/src/MethodProxies/MpMethodProxyPrototypeFactory.class.st +++ /dev/null @@ -1,828 +0,0 @@ -Class { - #name : #MpMethodProxyPrototypeFactory, - #superclass : #Object, - #category : #MethodProxies -} - -{ #category : #evaluating } -MpMethodProxyPrototypeFactory class >> buildPrototypesUpToArguments: maxNumberOfArguments [ - - "self buildPrototypesUpToArguments: 15" - - | forwarders | - 0 to: maxNumberOfArguments do: [ :numberOfArguments | - | originalAst trapSelector trapArguments | - originalAst := (MpMethodProxyPrototypeFactory class >> #protoPrototype) - parseTree. - - trapSelector := #trap. - 1 to: numberOfArguments do: [ :i | - trapSelector := trapSelector , #with: ]. - trapArguments := ((1 to: numberOfArguments) collect: [ :i | - RBVariableNode named: 'arg' , i asString ]). - - originalAst selector: trapSelector. - originalAst arguments: trapArguments. - - forwarders := originalAst sendNodes select: [ :e | e selector = #originalMessage ]. - forwarders do: [ :e | - e replaceWith: (RBMessageNode - receiver: RBVariableNode selfNode - selector: trapSelector - arguments: trapArguments) ]. - self class compile: originalAst formattedCode - ] -] - -{ #category : #evaluating } -MpMethodProxyPrototypeFactory class >> protoPrototype [ - - - | deactivator result process complete wasMeta | - process := Processor activeProcess. - process isMeta ifTrue: [ ^ self originalMessage ]. - - deactivator := #deactivator. - process shiftLevelUp. - wasMeta := true. - #handler beforeExecutionWithReceiver: self arguments: #( ). - process shiftLevelDown. - wasMeta := false. - - result := self originalMessage. - - process shiftLevelUp. - wasMeta := true. - #handler aboutToReturnWithReceiver: self arguments: #( ). - result := #handler - afterExecutionWithReceiver: self - arguments: #( ) - returnValue: result. - process shiftLevelDown. - wasMeta := false. - - complete := true. - - ^ result -] - -{ #category : #'as yet unclassified' } -MpMethodProxyPrototypeFactory class >> proxyMethod: method handler: aHandler [ - - ^ MpMethodProxy new - proxyMethod: method; - handler: aHandler; - yourself -] - -{ #category : #'as yet unclassified' } -MpMethodProxyPrototypeFactory class >> trap [ - - - | deactivator result process complete wasMeta | - process := Processor activeProcess. - process isMeta ifTrue: [ ^ self trap ]. - - deactivator := #deactivator. - process shiftLevelUp. - wasMeta := true. - #handler beforeExecutionWithReceiver: self arguments: #( ). - process shiftLevelDown. - wasMeta := false. - - result := self trap. - - process shiftLevelUp. - wasMeta := true. - #handler aboutToReturnWithReceiver: self arguments: #( ). - result := #handler - afterExecutionWithReceiver: self - arguments: #( ) - returnValue: result. - process shiftLevelDown. - wasMeta := false. - - complete := true. - - ^ result -] - -{ #category : #'as yet unclassified' } -MpMethodProxyPrototypeFactory class >> trapwith: arg1 [ - - - | deactivator result process complete wasMeta | - process := Processor activeProcess. - process isMeta ifTrue: [ ^ self trapwith: arg1 ]. - - deactivator := #deactivator. - process shiftLevelUp. - wasMeta := true. - #handler beforeExecutionWithReceiver: self arguments: #( ). - process shiftLevelDown. - wasMeta := false. - - result := self trapwith: arg1. - - process shiftLevelUp. - wasMeta := true. - #handler aboutToReturnWithReceiver: self arguments: #( ). - result := #handler - afterExecutionWithReceiver: self - arguments: #( ) - returnValue: result. - process shiftLevelDown. - wasMeta := false. - - complete := true. - - ^ result -] - -{ #category : #'as yet unclassified' } -MpMethodProxyPrototypeFactory class >> trapwith: arg1 with: arg2 [ - - - | deactivator result process complete wasMeta | - process := Processor activeProcess. - process isMeta ifTrue: [ ^ self trapwith: arg1 with: arg2 ]. - - deactivator := #deactivator. - process shiftLevelUp. - wasMeta := true. - #handler beforeExecutionWithReceiver: self arguments: #( ). - process shiftLevelDown. - wasMeta := false. - - result := self trapwith: arg1 with: arg2. - - process shiftLevelUp. - wasMeta := true. - #handler aboutToReturnWithReceiver: self arguments: #( ). - result := #handler - afterExecutionWithReceiver: self - arguments: #( ) - returnValue: result. - process shiftLevelDown. - wasMeta := false. - - complete := true. - - ^ result -] - -{ #category : #'as yet unclassified' } -MpMethodProxyPrototypeFactory class >> trapwith: arg1 with: arg2 with: arg3 [ - - - | deactivator result process complete wasMeta | - process := Processor activeProcess. - process isMeta ifTrue: [ ^ self trapwith: arg1 with: arg2 with: arg3 ]. - - deactivator := #deactivator. - process shiftLevelUp. - wasMeta := true. - #handler beforeExecutionWithReceiver: self arguments: #( ). - process shiftLevelDown. - wasMeta := false. - - result := self trapwith: arg1 with: arg2 with: arg3. - - process shiftLevelUp. - wasMeta := true. - #handler aboutToReturnWithReceiver: self arguments: #( ). - result := #handler - afterExecutionWithReceiver: self - arguments: #( ) - returnValue: result. - process shiftLevelDown. - wasMeta := false. - - complete := true. - - ^ result -] - -{ #category : #'as yet unclassified' } -MpMethodProxyPrototypeFactory class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 [ - - - | deactivator result process complete wasMeta | - process := Processor activeProcess. - process isMeta ifTrue: [ - ^ self - trapwith: arg1 - with: arg2 - with: arg3 - with: arg4 ]. - - deactivator := #deactivator. - process shiftLevelUp. - wasMeta := true. - #handler beforeExecutionWithReceiver: self arguments: #( ). - process shiftLevelDown. - wasMeta := false. - - result := self - trapwith: arg1 - with: arg2 - with: arg3 - with: arg4. - - process shiftLevelUp. - wasMeta := true. - #handler aboutToReturnWithReceiver: self arguments: #( ). - result := #handler - afterExecutionWithReceiver: self - arguments: #( ) - returnValue: result. - process shiftLevelDown. - wasMeta := false. - - complete := true. - - ^ result -] - -{ #category : #'as yet unclassified' } -MpMethodProxyPrototypeFactory class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg5 [ - - - | deactivator result process complete wasMeta | - process := Processor activeProcess. - process isMeta ifTrue: [ - ^ self - trapwith: arg1 - with: arg2 - with: arg3 - with: arg4 - with: arg5 ]. - - deactivator := #deactivator. - process shiftLevelUp. - wasMeta := true. - #handler beforeExecutionWithReceiver: self arguments: #( ). - process shiftLevelDown. - wasMeta := false. - - result := self - trapwith: arg1 - with: arg2 - with: arg3 - with: arg4 - with: arg5. - - process shiftLevelUp. - wasMeta := true. - #handler aboutToReturnWithReceiver: self arguments: #( ). - result := #handler - afterExecutionWithReceiver: self - arguments: #( ) - returnValue: result. - process shiftLevelDown. - wasMeta := false. - - complete := true. - - ^ result -] - -{ #category : #'as yet unclassified' } -MpMethodProxyPrototypeFactory class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 [ - - - | deactivator result process complete wasMeta | - process := Processor activeProcess. - process isMeta ifTrue: [ - ^ self - trapwith: arg1 - with: arg2 - with: arg3 - with: arg4 - with: arg5 - with: arg6 ]. - - deactivator := #deactivator. - process shiftLevelUp. - wasMeta := true. - #handler beforeExecutionWithReceiver: self arguments: #( ). - process shiftLevelDown. - wasMeta := false. - - result := self - trapwith: arg1 - with: arg2 - with: arg3 - with: arg4 - with: arg5 - with: arg6. - - process shiftLevelUp. - wasMeta := true. - #handler aboutToReturnWithReceiver: self arguments: #( ). - result := #handler - afterExecutionWithReceiver: self - arguments: #( ) - returnValue: result. - process shiftLevelDown. - wasMeta := false. - - complete := true. - - ^ result -] - -{ #category : #'as yet unclassified' } -MpMethodProxyPrototypeFactory class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7 [ - - - | deactivator result process complete wasMeta | - process := Processor activeProcess. - process isMeta ifTrue: [ - ^ self - trapwith: arg1 - with: arg2 - with: arg3 - with: arg4 - with: arg5 - with: arg6 - with: arg7 ]. - - deactivator := #deactivator. - process shiftLevelUp. - wasMeta := true. - #handler beforeExecutionWithReceiver: self arguments: #( ). - process shiftLevelDown. - wasMeta := false. - - result := self - trapwith: arg1 - with: arg2 - with: arg3 - with: arg4 - with: arg5 - with: arg6 - with: arg7. - - process shiftLevelUp. - wasMeta := true. - #handler aboutToReturnWithReceiver: self arguments: #( ). - result := #handler - afterExecutionWithReceiver: self - arguments: #( ) - returnValue: result. - process shiftLevelDown. - wasMeta := false. - - complete := true. - - ^ result -] - -{ #category : #'as yet unclassified' } -MpMethodProxyPrototypeFactory class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7 with: arg8 [ - - - | deactivator result process complete wasMeta | - process := Processor activeProcess. - process isMeta ifTrue: [ - ^ self - trapwith: arg1 - with: arg2 - with: arg3 - with: arg4 - with: arg5 - with: arg6 - with: arg7 - with: arg8 ]. - - deactivator := #deactivator. - process shiftLevelUp. - wasMeta := true. - #handler beforeExecutionWithReceiver: self arguments: #( ). - process shiftLevelDown. - wasMeta := false. - - result := self - trapwith: arg1 - with: arg2 - with: arg3 - with: arg4 - with: arg5 - with: arg6 - with: arg7 - with: arg8. - - process shiftLevelUp. - wasMeta := true. - #handler aboutToReturnWithReceiver: self arguments: #( ). - result := #handler - afterExecutionWithReceiver: self - arguments: #( ) - returnValue: result. - process shiftLevelDown. - wasMeta := false. - - complete := true. - - ^ result -] - -{ #category : #'as yet unclassified' } -MpMethodProxyPrototypeFactory class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7 with: arg8 with: arg9 [ - - - | deactivator result process complete wasMeta | - process := Processor activeProcess. - process isMeta ifTrue: [ - ^ self - trapwith: arg1 - with: arg2 - with: arg3 - with: arg4 - with: arg5 - with: arg6 - with: arg7 - with: arg8 - with: arg9 ]. - - deactivator := #deactivator. - process shiftLevelUp. - wasMeta := true. - #handler beforeExecutionWithReceiver: self arguments: #( ). - process shiftLevelDown. - wasMeta := false. - - result := self - trapwith: arg1 - with: arg2 - with: arg3 - with: arg4 - with: arg5 - with: arg6 - with: arg7 - with: arg8 - with: arg9. - - process shiftLevelUp. - wasMeta := true. - #handler aboutToReturnWithReceiver: self arguments: #( ). - result := #handler - afterExecutionWithReceiver: self - arguments: #( ) - returnValue: result. - process shiftLevelDown. - wasMeta := false. - - complete := true. - - ^ result -] - -{ #category : #'as yet unclassified' } -MpMethodProxyPrototypeFactory class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7 with: arg8 with: arg9 with: arg10 [ - - - | deactivator result process complete wasMeta | - process := Processor activeProcess. - process isMeta ifTrue: [ - ^ self - trapwith: arg1 - with: arg2 - with: arg3 - with: arg4 - with: arg5 - with: arg6 - with: arg7 - with: arg8 - with: arg9 - with: arg10 ]. - - deactivator := #deactivator. - process shiftLevelUp. - wasMeta := true. - #handler beforeExecutionWithReceiver: self arguments: #( ). - process shiftLevelDown. - wasMeta := false. - - result := self - trapwith: arg1 - with: arg2 - with: arg3 - with: arg4 - with: arg5 - with: arg6 - with: arg7 - with: arg8 - with: arg9 - with: arg10. - - process shiftLevelUp. - wasMeta := true. - #handler aboutToReturnWithReceiver: self arguments: #( ). - result := #handler - afterExecutionWithReceiver: self - arguments: #( ) - returnValue: result. - process shiftLevelDown. - wasMeta := false. - - complete := true. - - ^ result -] - -{ #category : #'as yet unclassified' } -MpMethodProxyPrototypeFactory class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7 with: arg8 with: arg9 with: arg10 with: arg11 [ - - - | deactivator result process complete wasMeta | - process := Processor activeProcess. - process isMeta ifTrue: [ - ^ self - trapwith: arg1 - with: arg2 - with: arg3 - with: arg4 - with: arg5 - with: arg6 - with: arg7 - with: arg8 - with: arg9 - with: arg10 - with: arg11 ]. - - deactivator := #deactivator. - process shiftLevelUp. - wasMeta := true. - #handler beforeExecutionWithReceiver: self arguments: #( ). - process shiftLevelDown. - wasMeta := false. - - result := self - trapwith: arg1 - with: arg2 - with: arg3 - with: arg4 - with: arg5 - with: arg6 - with: arg7 - with: arg8 - with: arg9 - with: arg10 - with: arg11. - - process shiftLevelUp. - wasMeta := true. - #handler aboutToReturnWithReceiver: self arguments: #( ). - result := #handler - afterExecutionWithReceiver: self - arguments: #( ) - returnValue: result. - process shiftLevelDown. - wasMeta := false. - - complete := true. - - ^ result -] - -{ #category : #'as yet unclassified' } -MpMethodProxyPrototypeFactory class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7 with: arg8 with: arg9 with: arg10 with: arg11 with: arg12 [ - - - | deactivator result process complete wasMeta | - process := Processor activeProcess. - process isMeta ifTrue: [ - ^ self - trapwith: arg1 - with: arg2 - with: arg3 - with: arg4 - with: arg5 - with: arg6 - with: arg7 - with: arg8 - with: arg9 - with: arg10 - with: arg11 - with: arg12 ]. - - deactivator := #deactivator. - process shiftLevelUp. - wasMeta := true. - #handler beforeExecutionWithReceiver: self arguments: #( ). - process shiftLevelDown. - wasMeta := false. - - result := self - trapwith: arg1 - with: arg2 - with: arg3 - with: arg4 - with: arg5 - with: arg6 - with: arg7 - with: arg8 - with: arg9 - with: arg10 - with: arg11 - with: arg12. - - process shiftLevelUp. - wasMeta := true. - #handler aboutToReturnWithReceiver: self arguments: #( ). - result := #handler - afterExecutionWithReceiver: self - arguments: #( ) - returnValue: result. - process shiftLevelDown. - wasMeta := false. - - complete := true. - - ^ result -] - -{ #category : #'as yet unclassified' } -MpMethodProxyPrototypeFactory class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7 with: arg8 with: arg9 with: arg10 with: arg11 with: arg12 with: arg13 [ - - - | deactivator result process complete wasMeta | - process := Processor activeProcess. - process isMeta ifTrue: [ - ^ self - trapwith: arg1 - with: arg2 - with: arg3 - with: arg4 - with: arg5 - with: arg6 - with: arg7 - with: arg8 - with: arg9 - with: arg10 - with: arg11 - with: arg12 - with: arg13 ]. - - deactivator := #deactivator. - process shiftLevelUp. - wasMeta := true. - #handler beforeExecutionWithReceiver: self arguments: #( ). - process shiftLevelDown. - wasMeta := false. - - result := self - trapwith: arg1 - with: arg2 - with: arg3 - with: arg4 - with: arg5 - with: arg6 - with: arg7 - with: arg8 - with: arg9 - with: arg10 - with: arg11 - with: arg12 - with: arg13. - - process shiftLevelUp. - wasMeta := true. - #handler aboutToReturnWithReceiver: self arguments: #( ). - result := #handler - afterExecutionWithReceiver: self - arguments: #( ) - returnValue: result. - process shiftLevelDown. - wasMeta := false. - - complete := true. - - ^ result -] - -{ #category : #'as yet unclassified' } -MpMethodProxyPrototypeFactory class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7 with: arg8 with: arg9 with: arg10 with: arg11 with: arg12 with: arg13 with: arg14 [ - - - | deactivator result process complete wasMeta | - process := Processor activeProcess. - process isMeta ifTrue: [ - ^ self - trapwith: arg1 - with: arg2 - with: arg3 - with: arg4 - with: arg5 - with: arg6 - with: arg7 - with: arg8 - with: arg9 - with: arg10 - with: arg11 - with: arg12 - with: arg13 - with: arg14 ]. - - deactivator := #deactivator. - process shiftLevelUp. - wasMeta := true. - #handler beforeExecutionWithReceiver: self arguments: #( ). - process shiftLevelDown. - wasMeta := false. - - result := self - trapwith: arg1 - with: arg2 - with: arg3 - with: arg4 - with: arg5 - with: arg6 - with: arg7 - with: arg8 - with: arg9 - with: arg10 - with: arg11 - with: arg12 - with: arg13 - with: arg14. - - process shiftLevelUp. - wasMeta := true. - #handler aboutToReturnWithReceiver: self arguments: #( ). - result := #handler - afterExecutionWithReceiver: self - arguments: #( ) - returnValue: result. - process shiftLevelDown. - wasMeta := false. - - complete := true. - - ^ result -] - -{ #category : #'as yet unclassified' } -MpMethodProxyPrototypeFactory class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7 with: arg8 with: arg9 with: arg10 with: arg11 with: arg12 with: arg13 with: arg14 with: arg15 [ - - - | deactivator result process complete wasMeta | - process := Processor activeProcess. - process isMeta ifTrue: [ - ^ self - trapwith: arg1 - with: arg2 - with: arg3 - with: arg4 - with: arg5 - with: arg6 - with: arg7 - with: arg8 - with: arg9 - with: arg10 - with: arg11 - with: arg12 - with: arg13 - with: arg14 - with: arg15 ]. - - deactivator := #deactivator. - process shiftLevelUp. - wasMeta := true. - #handler beforeExecutionWithReceiver: self arguments: #( ). - process shiftLevelDown. - wasMeta := false. - - result := self - trapwith: arg1 - with: arg2 - with: arg3 - with: arg4 - with: arg5 - with: arg6 - with: arg7 - with: arg8 - with: arg9 - with: arg10 - with: arg11 - with: arg12 - with: arg13 - with: arg14 - with: arg15. - - process shiftLevelUp. - wasMeta := true. - #handler aboutToReturnWithReceiver: self arguments: #( ). - result := #handler - afterExecutionWithReceiver: self - arguments: #( ) - returnValue: result. - process shiftLevelDown. - wasMeta := false. - - complete := true. - - ^ result -] diff --git a/src/MethodProxies/ProxyInstrumentationDeactivator.class.st b/src/MethodProxies/MpProxyInstrumentationDeactivator.class.st similarity index 76% rename from src/MethodProxies/ProxyInstrumentationDeactivator.class.st rename to src/MethodProxies/MpProxyInstrumentationDeactivator.class.st index 89dcfd5..b9c3602 100644 --- a/src/MethodProxies/ProxyInstrumentationDeactivator.class.st +++ b/src/MethodProxies/MpProxyInstrumentationDeactivator.class.st @@ -1,5 +1,5 @@ Class { - #name : #ProxyInstrumentationDeactivator, + #name : #MpProxyInstrumentationDeactivator, #superclass : #InstrumentationEnsurer, #instVars : [ 'handler' @@ -8,19 +8,19 @@ Class { } { #category : #accessing } -ProxyInstrumentationDeactivator >> handler [ +MpProxyInstrumentationDeactivator >> handler [ ^ handler ] { #category : #accessing } -ProxyInstrumentationDeactivator >> handler: anObject [ +MpProxyInstrumentationDeactivator >> handler: anObject [ handler := anObject ] { #category : #evaluating } -ProxyInstrumentationDeactivator >> value [ +MpProxyInstrumentationDeactivator >> value [ "Slow path, an exception or a non local return happened" diff --git a/src/MethodProxiesExamples/MpAllocationProfilerHandler.class.st b/src/MethodProxiesExamples/MpAllocationProfilerHandler.class.st index 473ffb7..8e805ca 100644 --- a/src/MethodProxiesExamples/MpAllocationProfilerHandler.class.st +++ b/src/MethodProxiesExamples/MpAllocationProfilerHandler.class.st @@ -36,21 +36,26 @@ MpAllocationProfilerHandler >> afterExecutionWithReceiver: receiver arguments: a ^ returnValue ] -{ #category : #initialization } -MpAllocationProfilerHandler >> afterExecutionWithReceiver: receiver arguments: arguments returnValue: returnValue callerContext: callerContext [ - - | allocationsPerClass transformedContext | - transformedContext := self transformContext: callerContext. - allocationsPerClass := allocations at: receiver ifAbsentPut: [ OrderedCollection new ]. - allocationsPerClass add: {returnValue. transformedContext}. - ^ returnValue -] - { #category : #accessing } MpAllocationProfilerHandler >> allocations [ ^ allocations ] +{ #category : #evaluating } +MpAllocationProfilerHandler >> captureCallingContext [ + + | runWithInContext | + + "Find the context of #run:with:in:" + runWithInContext := thisContext sender. + [ runWithInContext isNil + or: [ runWithInContext method isCompiledMethod and: [runWithInContext method selector = #run:with:in:] ] ] + whileFalse: [ runWithInContext := runWithInContext sender ]. + + "Find the real sender" + ^ runWithInContext ifNotNil: [ runWithInContext sender ] +] + { #category : #accessing } MpAllocationProfilerHandler >> contextTransformationBlock: aBlock [ From 3d5c5ca68ab7d24aacde4278a025b1d71a1b859e Mon Sep 17 00:00:00 2001 From: Guille Polito Date: Thu, 7 Sep 2023 16:55:52 +0200 Subject: [PATCH 06/12] Ensure a system cleanup during tear down --- .../MpMethodProxyTest.class.st | 24 +++++++++++++++---- 1 file changed, 19 insertions(+), 5 deletions(-) diff --git a/src/MethodProxies-Tests/MpMethodProxyTest.class.st b/src/MethodProxies-Tests/MpMethodProxyTest.class.st index 4043030..56e7fa1 100644 --- a/src/MethodProxies-Tests/MpMethodProxyTest.class.st +++ b/src/MethodProxies-Tests/MpMethodProxyTest.class.st @@ -50,12 +50,26 @@ MpMethodProxyTest >> setUp [ { #category : #initialization } MpMethodProxyTest >> tearDown [ - trackedWrappers do: [ :each | - [ each uninstall ] - on: Error - do: [ :e | "continue" ] ]. + | stillInstalled | + + "Uninstall proxies using a fixed point approach. + This is to cover a problem of proxies wrapping proxies for now" + [ + stillInstalled := trackedWrappers select: [ :e | e isInstalled ]. + stillInstalled isEmpty ] whileFalse: [ + stillInstalled do: [ :each | + [ + each uninstall. + trackedWrappers remove: each ] + on: Error + do: [ :e | "continue" ] ] ]. + + "Give me the guarantee that we did not leave proxies installed in the system" (MpMethodProxy allInstances anySatisfy: [ :e | e isInstalled ]) - ifTrue: [ self error: 'Proxies still installed after test: ', testSelector asString ]. + ifTrue: [ + self error: + 'Proxies still installed after test: ' , testSelector asString ]. + super tearDown ] From e1ec3bcdd229686f6213cbbbbbb8abd26ddcf033 Mon Sep 17 00:00:00 2001 From: Guille Polito Date: Thu, 7 Sep 2023 17:06:40 +0200 Subject: [PATCH 07/12] More simplifications. Now that exception handlers are outside of the fast path, we can just use a block. --- src/MethodProxies/MpCannotInstall.class.st | 4 +++ src/MethodProxies/MpHiddenSelector.class.st | 7 ++++ src/MethodProxies/MpMethodProxy.class.st | 18 ++++++++-- ...MpProxyInstrumentationDeactivator.class.st | 36 ------------------- 4 files changed, 27 insertions(+), 38 deletions(-) delete mode 100644 src/MethodProxies/MpProxyInstrumentationDeactivator.class.st diff --git a/src/MethodProxies/MpCannotInstall.class.st b/src/MethodProxies/MpCannotInstall.class.st index 9f065d4..5b25ec0 100644 --- a/src/MethodProxies/MpCannotInstall.class.st +++ b/src/MethodProxies/MpCannotInstall.class.st @@ -1,3 +1,7 @@ +" +I'm an exception raised when a proxy cannot be installed. +This usually happens when the wrapped method is a very special method whose instrumentation could break the system. +" Class { #name : #MpCannotInstall, #superclass : #Error, diff --git a/src/MethodProxies/MpHiddenSelector.class.st b/src/MethodProxies/MpHiddenSelector.class.st index 2f32e51..cc01a9e 100644 --- a/src/MethodProxies/MpHiddenSelector.class.st +++ b/src/MethodProxies/MpHiddenSelector.class.st @@ -1,3 +1,10 @@ +" +I represent a selector that is hidden for the user, used to install hidden methods in method dictionaries. +I'm not a string, so I cannot be typed, avoiding potential conflicts. + +I'm used as key of the original method wrapped by proxies, to ensure this wrapped method can be called using myself as selector. +Check my usages during proxy installation. +" Class { #name : #MpHiddenSelector, #superclass : #Object, diff --git a/src/MethodProxies/MpMethodProxy.class.st b/src/MethodProxies/MpMethodProxy.class.st index c633213..699393c 100644 --- a/src/MethodProxies/MpMethodProxy.class.st +++ b/src/MethodProxies/MpMethodProxy.class.st @@ -1157,8 +1157,22 @@ MpMethodProxy >> install [ (proxyMethod hasPragmaNamed: #noInstrumentation) ifTrue: [ ^ MpCannotInstall signalWith: self ]. - deactivator := MpProxyInstrumentationDeactivator new. - deactivator handler: handler. + deactivator := [ "Execution handler for the slow path. An exception or a non local return happened during proxy execution" + | wasMeta trapContext | + + "Jump to the meta level (to avoid meta-recursions) to observe if the handler was in a meta level, marked by the wasMeta flag. + During the meta-jump call the handler to tell there was an unwind. + " + thisProcess shiftLevelUp. + trapContext := thisContext findContextSuchThat: [ :ctx | ctx isUnwindContext ]. + wasMeta := trapContext tempNamed: 'wasMeta'. + handler aboutToReturnWithReceiver: trapContext receiver arguments: trapContext arguments. + thisProcess shiftLevelDown. + + "If the handler was in a meta-state (i.e., the exception or non-local return happened in the handler), shift it back to the base level before returning. + Otherwise, we were already in the base level and we need to do nothing!" + wasMeta ifTrue: [ thisProcess shiftLevelDown ]. + ]. newTrap := self trapMethodPrototype copy. trapSelector := newTrap selector. diff --git a/src/MethodProxies/MpProxyInstrumentationDeactivator.class.st b/src/MethodProxies/MpProxyInstrumentationDeactivator.class.st deleted file mode 100644 index b9c3602..0000000 --- a/src/MethodProxies/MpProxyInstrumentationDeactivator.class.st +++ /dev/null @@ -1,36 +0,0 @@ -Class { - #name : #MpProxyInstrumentationDeactivator, - #superclass : #InstrumentationEnsurer, - #instVars : [ - 'handler' - ], - #category : #MethodProxies -} - -{ #category : #accessing } -MpProxyInstrumentationDeactivator >> handler [ - - ^ handler -] - -{ #category : #accessing } -MpProxyInstrumentationDeactivator >> handler: anObject [ - - handler := anObject -] - -{ #category : #evaluating } -MpProxyInstrumentationDeactivator >> value [ - - - "Slow path, an exception or a non local return happened" - | wasMeta me | - thisProcess shiftLevelUp. - - me := thisContext findContextSuchThat: [ :ctx | ctx isUnwindContext ]. - wasMeta := me tempNamed: 'wasMeta'. - handler aboutToReturnWithReceiver: me receiver arguments: me arguments. - thisProcess shiftLevelDown. - wasMeta ifTrue: [ thisProcess shiftLevelDown ]. - -] From 4fff7b9a71cdc4fcb71a456373a6b4748c6a5d62 Mon Sep 17 00:00:00 2001 From: Guille Polito Date: Thu, 7 Sep 2023 17:08:12 +0200 Subject: [PATCH 08/12] Renames, cleanups and comments --- .../MpMethodProxyTest.class.st | 18 ++--- src/MethodProxies/MpMethodProxy.class.st | 76 +++++++++---------- .../MpProfilingHandler.class.st | 2 +- 3 files changed, 48 insertions(+), 48 deletions(-) diff --git a/src/MethodProxies-Tests/MpMethodProxyTest.class.st b/src/MethodProxies-Tests/MpMethodProxyTest.class.st index 56e7fa1..2c14d80 100644 --- a/src/MethodProxies-Tests/MpMethodProxyTest.class.st +++ b/src/MethodProxies-Tests/MpMethodProxyTest.class.st @@ -301,7 +301,7 @@ MpMethodProxyTest >> testInstallSetCompiledMethod [ mw install. self assert: mw selector equals: #methodOne. self assert: mw methodClass equals: MpClassA. - self assert: mw wrappedMethod equals: method ] ensure: [ + self assert: mw proxifiedMethod equals: method ] ensure: [ mw uninstall ] ] @@ -362,7 +362,7 @@ MpMethodProxyTest >> testUninstall [ mp install. self assert: (MpClassA compiledMethodAt: #methodOne) selector = #methodOne. - self assert: (MpClassA compiledMethodAt: #methodOne) == mp trap ] + self assert: (MpClassA compiledMethodAt: #methodOne) == mp trapMethod ] ensure: [ mp uninstall. self assert: (MpClassA compiledMethodAt: #methodOne) == method ] @@ -386,11 +386,11 @@ MpMethodProxyTest >> testUninstallNestedInRightOrderIsOk [ [ self assert: (MpClassA compiledMethodAt: #methodOne) - identicalTo: mp2 trap ] ensure: [ + identicalTo: mp2 trapMethod ] ensure: [ mp2 uninstall. self assert: (MpClassA compiledMethodAt: #methodOne) - identicalTo: mp trap ] ] ensure: [ mp uninstall ]. + identicalTo: mp trapMethod ] ] ensure: [ mp uninstall ]. self assert: (MpClassA compiledMethodAt: #methodOne) identicalTo: method @@ -404,7 +404,7 @@ MpMethodProxyTest >> testUnwrappedMethodAtOneLevelIsTheWrappedMethod [ mp := MpMethodProxy onMethod: method handler: self handlerClass new. self installMethodProxy: mp. - self assert: mp wrappedMethod equals: method + self assert: mp proxifiedMethod equals: method ] { #category : #tests } @@ -422,7 +422,7 @@ MpMethodProxyTest >> testUnwrappedMethodOfNestedMethodWrapperInTheCompiledMethod handler: MpMockMethodProxyHandler new. self installMethodProxy: mp2. - self assert: mp2 wrappedMethod equals: mp trap. + self assert: mp2 proxifiedMethod equals: mp trapMethod. ] { #category : #'tests - safety' } @@ -495,14 +495,14 @@ MpMethodProxyTest >> testWrappingTwiceIsPossible [ self assert: mp1 selector equals: #methodOne. self assert: mp1 methodClass equals: MpClassA. - self assert: mp1 wrappedMethod equals: method. + self assert: mp1 proxifiedMethod equals: method. self assert: mp2 selector equals: #methodOne. self assert: mp2 methodClass equals: MpClassA. - self assert: mp2 wrappedMethod equals: mp1 trap ] ensure: [ + self assert: mp2 proxifiedMethod equals: mp1 trapMethod ] ensure: [ [ mp2 uninstall. - self assert: (MpClassA methodDict at: #methodOne) equals: mp1 trap ] + self assert: (MpClassA methodDict at: #methodOne) equals: mp1 trapMethod ] ensure: [ mp1 uninstall. self assert: (MpClassA methodDict at: #methodOne) equals: method ] ] diff --git a/src/MethodProxies/MpMethodProxy.class.st b/src/MethodProxies/MpMethodProxy.class.st index 699393c..8b9d872 100644 --- a/src/MethodProxies/MpMethodProxy.class.st +++ b/src/MethodProxies/MpMethodProxy.class.st @@ -55,11 +55,11 @@ Class { #name : #MpMethodProxy, #superclass : #Object, #instVars : [ - 'proxyMethod', 'handler', 'hiddenSelector', 'trapMethod', - 'wrappedMethod' + 'wrappedMethod', + 'proxifiedMethod' ], #category : #MethodProxies } @@ -77,7 +77,7 @@ MpMethodProxy class >> buildPrototypesUpToArguments: maxNumberOfArguments [ | originalAst trapSelector trapArguments | originalAst := (self class >> #prototypeTrap) parseTree. - trapSelector := #trap. + trapSelector := #trapMethod. 1 to: numberOfArguments do: [ :i | trapSelector := trapSelector , #with: ]. trapArguments := (1 to: numberOfArguments) collect: [ :i | @@ -162,7 +162,7 @@ MpMethodProxy class >> proxyMethod: method handler: aHandler [ ] { #category : #'as yet unclassified' } -MpMethodProxy class >> trap [ +MpMethodProxy class >> trapMethod [ "The unwind handler should be the first temp, the complete flag should be the second temp. Then this method is free to use as many extra temporaries and arguments as is wants" @@ -170,7 +170,7 @@ MpMethodProxy class >> trap [ | deactivator complete result process wasMeta | "Quick check, if we are in a meta-level do not instrument" process := thisProcess. - process isMeta ifTrue: [ ^ self trap ]. + process isMeta ifTrue: [ ^ self trapMethod ]. "Set the deactivator literal that will be later patched as exception handler" deactivator := #deactivator. @@ -187,7 +187,7 @@ MpMethodProxy class >> trap [ The core idea is that - the original method is installed in the same method dictionary using a unique symbol - this call is patched to use that symbol for the send" - result := self trap. + result := self trapMethod. "Move to the meta level and call the after hooks. Two after hooks are required. @@ -1154,7 +1154,7 @@ MpMethodProxy >> install [ | deactivator newTrap index trapSelector | thisProcess runInMetaLevel: [ - (proxyMethod hasPragmaNamed: #noInstrumentation) ifTrue: [ + (proxifiedMethod hasPragmaNamed: #noInstrumentation) ifTrue: [ ^ MpCannotInstall signalWith: self ]. deactivator := [ "Execution handler for the slow path. An exception or a non local return happened during proxy execution" @@ -1174,10 +1174,10 @@ MpMethodProxy >> install [ wasMeta ifTrue: [ thisProcess shiftLevelDown ]. ]. - newTrap := self trapMethodPrototype copy. + newTrap := self prototypeTrapMethod copy. trapSelector := newTrap selector. - newTrap selector: proxyMethod selector. - newTrap methodClass: proxyMethod methodClass. + newTrap selector: proxifiedMethod selector. + newTrap methodClass: proxifiedMethod methodClass. hiddenSelector := MpHiddenSelector new. @@ -1193,14 +1193,14 @@ MpMethodProxy >> install [ "It could happen that a proxy wraps a proxy. Remember the object that was installed at this moment. This is the object to restore during uninstall" - wrappedMethod := proxyMethod methodClass methodDict - at: proxyMethod selector. + wrappedMethod := proxifiedMethod methodClass methodDict + at: proxifiedMethod selector. - proxyMethod methodClass methodDict + proxifiedMethod methodClass methodDict at: hiddenSelector - put: proxyMethod. - proxyMethod methodClass methodDict - at: proxyMethod selector + put: proxifiedMethod. + proxifiedMethod methodClass methodDict + at: proxifiedMethod selector put: newTrap. trapMethod := newTrap ] @@ -1211,55 +1211,55 @@ MpMethodProxy >> isInstalled [ trapMethod ifNil: [ ^ false ]. - ^ proxyMethod methodClass >> proxyMethod selector == trapMethod + ^ proxifiedMethod methodClass >> proxifiedMethod selector == trapMethod ] { #category : #accessing } MpMethodProxy >> methodClass [ - ^ proxyMethod methodClass + ^ proxifiedMethod methodClass +] + +{ #category : #installation } +MpMethodProxy >> prototypeTrapMethod [ + + ^ self class class methods detect: [ :m | + m numArgs = proxifiedMethod numArgs and: [ + m selector beginsWith: 'trap' ] ] +] + +{ #category : #accessing } +MpMethodProxy >> proxifiedMethod [ + + ^ proxifiedMethod ] { #category : #accessing } MpMethodProxy >> proxyMethod: anObject [ - proxyMethod := anObject + proxifiedMethod := anObject ] { #category : #accessing } MpMethodProxy >> selector [ - ^ proxyMethod selector + ^ proxifiedMethod selector ] { #category : #accessing } -MpMethodProxy >> trap [ +MpMethodProxy >> trapMethod [ ^ trapMethod ] -{ #category : #installation } -MpMethodProxy >> trapMethodPrototype [ - - ^ self class class methods detect: [ :m | - m numArgs = proxyMethod numArgs and: [ - m selector beginsWith: 'trap' ] ] -] - { #category : #installation } MpMethodProxy >> uninstall [ self isInstalled ifFalse: [ ^ self ]. thisProcess runInMetaLevel: [ - proxyMethod methodClass methodDict - at: proxyMethod selector + proxifiedMethod methodClass methodDict + at: proxifiedMethod selector put: wrappedMethod. - proxyMethod methodClass methodDict removeKey: hiddenSelector ] -] - -{ #category : #accessing } -MpMethodProxy >> wrappedMethod [ - - ^ proxyMethod + proxifiedMethod methodClass methodDict removeKey: hiddenSelector ] ] diff --git a/src/MethodProxiesExamples/MpProfilingHandler.class.st b/src/MethodProxiesExamples/MpProfilingHandler.class.st index cea4355..d554e1b 100644 --- a/src/MethodProxiesExamples/MpProfilingHandler.class.st +++ b/src/MethodProxiesExamples/MpProfilingHandler.class.st @@ -75,7 +75,7 @@ MpProfilingHandler >> instrumentImplementorsOf: potentialSelector [ ] { #category : #accessing } -MpProfilingHandler >> wrappedMethod [ +MpProfilingHandler >> proxifiedMethod [ ^ wrappedMethod ] From 4b1754af38dc274f9c78f59de9fcf2a74b69fe1b Mon Sep 17 00:00:00 2001 From: Guille Polito Date: Thu, 7 Sep 2023 17:25:47 +0200 Subject: [PATCH 09/12] Cleaning tests and comments --- .../MpAbstractMethodProxyTest.class.st | 55 ++++++++++++++++++ .../MpMethodProxyTest.class.st | 46 +-------------- .../MpAllocationProfilerHandlerTest.class.st | 2 +- .../MpCalledMethodProxyTest.class.st | 5 -- .../MpCountingMethodProxyTest.class.st | 58 +++++++++++++++---- .../MpAllocationProfilerHandler.class.st | 14 ++--- .../MpCalledHandler.class.st | 2 +- .../MpCountingHandler.class.st | 2 +- .../MpFailingHandlerMock.class.st | 3 +- .../MpProfilingHandler.class.st | 3 +- 10 files changed, 118 insertions(+), 72 deletions(-) create mode 100644 src/MethodProxies-Tests/MpAbstractMethodProxyTest.class.st delete mode 100644 src/MethodProxiesExamples-Tests/MpCalledMethodProxyTest.class.st diff --git a/src/MethodProxies-Tests/MpAbstractMethodProxyTest.class.st b/src/MethodProxies-Tests/MpAbstractMethodProxyTest.class.st new file mode 100644 index 0000000..10b0769 --- /dev/null +++ b/src/MethodProxies-Tests/MpAbstractMethodProxyTest.class.st @@ -0,0 +1,55 @@ +Class { + #name : #MpAbstractMethodProxyTest, + #superclass : #TestCase, + #instVars : [ + 'trackedWrappers' + ], + #category : #'MethodProxies-Tests' +} + +{ #category : #testing } +MpAbstractMethodProxyTest class >> isAbstract [ + + ^ self == MpAbstractMethodProxyTest +] + +{ #category : #'tests - dead representation' } +MpAbstractMethodProxyTest >> installMethodProxy: aMethodProxy [ + + trackedWrappers add: aMethodProxy. + aMethodProxy install. + +] + +{ #category : #initialization } +MpAbstractMethodProxyTest >> setUp [ + + super setUp. + trackedWrappers := OrderedCollection new +] + +{ #category : #initialization } +MpAbstractMethodProxyTest >> tearDown [ + + | stillInstalled | + + "Uninstall proxies using a fixed point approach. + This is to cover a problem of proxies wrapping proxies for now" + [ + stillInstalled := trackedWrappers select: [ :e | e isInstalled ]. + stillInstalled isEmpty ] whileFalse: [ + stillInstalled do: [ :each | + [ + each uninstall. + trackedWrappers remove: each ] + on: Error + do: [ :e | "continue" ] ] ]. + + "Give me the guarantee that we did not leave proxies installed in the system" + (MpMethodProxy allInstances anySatisfy: [ :e | e isInstalled ]) + ifTrue: [ + self error: + 'Proxies still installed after test: ' , testSelector asString ]. + + super tearDown +] diff --git a/src/MethodProxies-Tests/MpMethodProxyTest.class.st b/src/MethodProxies-Tests/MpMethodProxyTest.class.st index 2c14d80..71c4e05 100644 --- a/src/MethodProxies-Tests/MpMethodProxyTest.class.st +++ b/src/MethodProxies-Tests/MpMethodProxyTest.class.st @@ -1,9 +1,6 @@ Class { #name : #MpMethodProxyTest, - #superclass : #TestCase, - #instVars : [ - 'trackedWrappers' - ], + #superclass : #MpAbstractMethodProxyTest, #category : #'MethodProxies-Tests' } @@ -32,47 +29,6 @@ MpMethodProxyTest >> handlerClass [ ^ MpHandler ] -{ #category : #'tests - dead representation' } -MpMethodProxyTest >> installMethodProxy: aMethodProxy [ - - trackedWrappers add: aMethodProxy. - aMethodProxy install. - -] - -{ #category : #initialization } -MpMethodProxyTest >> setUp [ - - super setUp. - trackedWrappers := OrderedCollection new -] - -{ #category : #initialization } -MpMethodProxyTest >> tearDown [ - - | stillInstalled | - - "Uninstall proxies using a fixed point approach. - This is to cover a problem of proxies wrapping proxies for now" - [ - stillInstalled := trackedWrappers select: [ :e | e isInstalled ]. - stillInstalled isEmpty ] whileFalse: [ - stillInstalled do: [ :each | - [ - each uninstall. - trackedWrappers remove: each ] - on: Error - do: [ :e | "continue" ] ] ]. - - "Give me the guarantee that we did not leave proxies installed in the system" - (MpMethodProxy allInstances anySatisfy: [ :e | e isInstalled ]) - ifTrue: [ - self error: - 'Proxies still installed after test: ' , testSelector asString ]. - - super tearDown -] - { #category : #'tests - safety' } MpMethodProxyTest >> testCanRunConcurrently [ "This tests the ability of method proxies to not influence each other between threads." diff --git a/src/MethodProxiesExamples-Tests/MpAllocationProfilerHandlerTest.class.st b/src/MethodProxiesExamples-Tests/MpAllocationProfilerHandlerTest.class.st index 8741f13..9f3736d 100644 --- a/src/MethodProxiesExamples-Tests/MpAllocationProfilerHandlerTest.class.st +++ b/src/MethodProxiesExamples-Tests/MpAllocationProfilerHandlerTest.class.st @@ -1,6 +1,6 @@ Class { #name : #MpAllocationProfilerHandlerTest, - #superclass : #MpMethodProxyTest, + #superclass : #MpAbstractMethodProxyTest, #category : #'MethodProxiesExamples-Tests' } diff --git a/src/MethodProxiesExamples-Tests/MpCalledMethodProxyTest.class.st b/src/MethodProxiesExamples-Tests/MpCalledMethodProxyTest.class.st deleted file mode 100644 index 9e83b27..0000000 --- a/src/MethodProxiesExamples-Tests/MpCalledMethodProxyTest.class.st +++ /dev/null @@ -1,5 +0,0 @@ -Class { - #name : #MpCalledMethodProxyTest, - #superclass : #MpMethodProxyTest, - #category : #'MethodProxiesExamples-Tests' -} diff --git a/src/MethodProxiesExamples-Tests/MpCountingMethodProxyTest.class.st b/src/MethodProxiesExamples-Tests/MpCountingMethodProxyTest.class.st index a7b769e..8689824 100644 --- a/src/MethodProxiesExamples-Tests/MpCountingMethodProxyTest.class.st +++ b/src/MethodProxiesExamples-Tests/MpCountingMethodProxyTest.class.st @@ -1,6 +1,6 @@ Class { #name : #MpCountingMethodProxyTest, - #superclass : #MpMethodProxyTest, + #superclass : #MpAbstractMethodProxyTest, #category : #'MethodProxiesExamples-Tests' } @@ -11,18 +11,56 @@ MpCountingMethodProxyTest >> handlerClass [ ] { #category : #tests } -MpCountingMethodProxyTest >> testCounts [ +MpCountingMethodProxyTest >> testInstalledButNotCalledCounts0 [ | proxy instance handler | - [ proxy := MpMethodProxy - on: #methodOne - inClass: MpClassA - handler: (handler := self handlerClass new). - proxy install. + proxy := MpMethodProxy + onMethod: MpClassA >> #methodOne + handler: (handler := self handlerClass new). + self installMethodProxy: proxy. + + instance := MpClassA new. + self assert: handler count equals: 0 +] + +{ #category : #tests } +MpCountingMethodProxyTest >> testInstalledCalledOnceCounts1 [ + + | proxy instance handler | + proxy := MpMethodProxy + onMethod: MpClassA >> #methodOne + handler: (handler := self handlerClass new). + self installMethodProxy: proxy. + instance := MpClassA new. - self assert: handler count equals: 0. instance methodOne. - self assert: handler count equals: 1. + self assert: handler count equals: 1 +] + +{ #category : #tests } +MpCountingMethodProxyTest >> testInstalledCalledTwiceCounts2 [ + + | proxy instance handler instance2 | + proxy := MpMethodProxy + onMethod: MpClassA >> #methodOne + handler: (handler := self handlerClass new). + self installMethodProxy: proxy. + + instance := MpClassA new. instance methodOne. - self assert: handler count equals: 2 ] ensure: [ proxy uninstall ] + + instance2 := MpClassA new. + instance2 methodOne. + + self assert: handler count equals: 2 +] + +{ #category : #tests } +MpCountingMethodProxyTest >> testNonInstalledCounts0 [ + + | proxy handler | + proxy := MpMethodProxy + onMethod: MpClassA >> #methodOne + handler: (handler := self handlerClass new). + self assert: handler count equals: 0 ] diff --git a/src/MethodProxiesExamples/MpAllocationProfilerHandler.class.st b/src/MethodProxiesExamples/MpAllocationProfilerHandler.class.st index 8e805ca..afe5318 100644 --- a/src/MethodProxiesExamples/MpAllocationProfilerHandler.class.st +++ b/src/MethodProxiesExamples/MpAllocationProfilerHandler.class.st @@ -1,5 +1,6 @@ " -I'm a simple little profiler that can store all the objects returned by the spyied method. +I'm an example handler for profiling purposes that stores all the objects returned by the spyied method + ``` h := MpAllocationProfilerHandler new. p1 := MpMethodProxy @@ -45,14 +46,13 @@ MpAllocationProfilerHandler >> allocations [ MpAllocationProfilerHandler >> captureCallingContext [ | runWithInContext | - - "Find the context of #run:with:in:" + "Find the context of #run:with:in:" runWithInContext := thisContext sender. - [ runWithInContext isNil - or: [ runWithInContext method isCompiledMethod and: [runWithInContext method selector = #run:with:in:] ] ] + [ + runWithInContext isNil or: [ runWithInContext method primitive = 198 ] ] whileFalse: [ runWithInContext := runWithInContext sender ]. - - "Find the real sender" + + "Find the real sender" ^ runWithInContext ifNotNil: [ runWithInContext sender ] ] diff --git a/src/MethodProxiesExamples/MpCalledHandler.class.st b/src/MethodProxiesExamples/MpCalledHandler.class.st index 51f24ff..2f1ebc5 100644 --- a/src/MethodProxiesExamples/MpCalledHandler.class.st +++ b/src/MethodProxiesExamples/MpCalledHandler.class.st @@ -1,5 +1,5 @@ " -I'm a little example that reports if the spyied method has been executed. +I'm an example handler that reports if the spyied method has been executed " Class { #name : #MpCalledHandler, diff --git a/src/MethodProxiesExamples/MpCountingHandler.class.st b/src/MethodProxiesExamples/MpCountingHandler.class.st index 8bfc61b..a4d75fa 100644 --- a/src/MethodProxiesExamples/MpCountingHandler.class.st +++ b/src/MethodProxiesExamples/MpCountingHandler.class.st @@ -1,5 +1,5 @@ " -I'm counting the number of times I'm executed. +I'm an example handler that counts all the times a method has been invoked " Class { #name : #MpCountingHandler, diff --git a/src/MethodProxiesExamples/MpFailingHandlerMock.class.st b/src/MethodProxiesExamples/MpFailingHandlerMock.class.st index 74b8f80..05c5d1b 100644 --- a/src/MethodProxiesExamples/MpFailingHandlerMock.class.st +++ b/src/MethodProxiesExamples/MpFailingHandlerMock.class.st @@ -1,5 +1,6 @@ " -I'm a mock for tests that checks that the infrastructure does not collapse when a handler is failing. +I'm an example handler for testing purposes that fails on before. +I'm used to check that the infrastructure does not collapse when a handler fails " Class { #name : #MpFailingHandlerMock, diff --git a/src/MethodProxiesExamples/MpProfilingHandler.class.st b/src/MethodProxiesExamples/MpProfilingHandler.class.st index d554e1b..ec2e738 100644 --- a/src/MethodProxiesExamples/MpProfilingHandler.class.st +++ b/src/MethodProxiesExamples/MpProfilingHandler.class.st @@ -1,6 +1,7 @@ " I'm a more advanced proxy that propagates itself during execution. -When a proxy is executed, before letting the execution runs, it installs itself on all the implementators of the methods used in the method. +When a proxy is executed, before letting the execution runs, it installs itself on all the implementors of the messages sent in the method. + ``` proxy := nil. proxies := nil. From 8e1a5a2f9320f1d948894ac88a61235fdf8d26e7 Mon Sep 17 00:00:00 2001 From: Guille Polito Date: Thu, 7 Sep 2023 17:48:53 +0200 Subject: [PATCH 10/12] Cleaning dependencies --- .../BaselineOfMethodProxies.class.st | 8 +++++--- src/MethodProxies-Tests/MpMethodProxyTest.class.st | 2 +- ...ndlerMock.class.st => MpFailingBeforeHandler.class.st} | 4 ++-- .../MpMockMethodProxyHandler.class.st | 2 +- 4 files changed, 9 insertions(+), 7 deletions(-) rename src/MethodProxiesExamples/{MpFailingHandlerMock.class.st => MpFailingBeforeHandler.class.st} (80%) rename src/{MethodProxies-Tests => MethodProxiesExamples}/MpMockMethodProxyHandler.class.st (87%) diff --git a/src/BaselineOfMethodProxies/BaselineOfMethodProxies.class.st b/src/BaselineOfMethodProxies/BaselineOfMethodProxies.class.st index 0b8f1d5..fd74c57 100644 --- a/src/BaselineOfMethodProxies/BaselineOfMethodProxies.class.st +++ b/src/BaselineOfMethodProxies/BaselineOfMethodProxies.class.st @@ -9,13 +9,15 @@ BaselineOfMethodProxies >> baseline: spec [ spec for: #common do: [ - spec package: #MethodProxies; + spec + package: #MethodProxies; package: #'MethodProxies-Tests' - with: [ spec requires: #( #MethodProxies ) ]; + with: [ spec requires: #( #MethodProxies #MethodProxiesExamples ) ]; package: #MethodProxiesExamples with: [ spec requires: #( #MethodProxies ) ]; package: #'MethodProxiesExamples-Tests' - with: [ spec requires: #( #MethodProxiesExamples ) ]. + with: [ + spec requires: #( #'MethodProxies-Tests' ) ]. spec group: 'Core' with: #( #MethodProxies ); diff --git a/src/MethodProxies-Tests/MpMethodProxyTest.class.st b/src/MethodProxies-Tests/MpMethodProxyTest.class.st index 71c4e05..96e2897 100644 --- a/src/MethodProxies-Tests/MpMethodProxyTest.class.st +++ b/src/MethodProxies-Tests/MpMethodProxyTest.class.st @@ -234,7 +234,7 @@ MpMethodProxyTest >> testExceptionsAfterInstrumentationFlow [ MpMethodProxyTest >> testExceptionsDuringInstrumentationDoNotBreakInstrumentation [ "Managing exceptions in the wrapper" | w | - w := MpMethodProxy onMethod: MpClassB >> #methodTwo handler: MpFailingHandlerMock new. + w := MpMethodProxy onMethod: MpClassB >> #methodTwo handler: MpFailingBeforeHandler new. self installMethodProxy: w. diff --git a/src/MethodProxiesExamples/MpFailingHandlerMock.class.st b/src/MethodProxiesExamples/MpFailingBeforeHandler.class.st similarity index 80% rename from src/MethodProxiesExamples/MpFailingHandlerMock.class.st rename to src/MethodProxiesExamples/MpFailingBeforeHandler.class.st index 05c5d1b..f972610 100644 --- a/src/MethodProxiesExamples/MpFailingHandlerMock.class.st +++ b/src/MethodProxiesExamples/MpFailingBeforeHandler.class.st @@ -3,13 +3,13 @@ I'm an example handler for testing purposes that fails on before. I'm used to check that the infrastructure does not collapse when a handler fails " Class { - #name : #MpFailingHandlerMock, + #name : #MpFailingBeforeHandler, #superclass : #MpHandler, #category : #MethodProxiesExamples } { #category : #evaluating } -MpFailingHandlerMock >> beforeMethod [ +MpFailingBeforeHandler >> beforeMethod [ self error: 'error during instrumentation' ] diff --git a/src/MethodProxies-Tests/MpMockMethodProxyHandler.class.st b/src/MethodProxiesExamples/MpMockMethodProxyHandler.class.st similarity index 87% rename from src/MethodProxies-Tests/MpMockMethodProxyHandler.class.st rename to src/MethodProxiesExamples/MpMockMethodProxyHandler.class.st index a1ff073..cfe7cbd 100644 --- a/src/MethodProxies-Tests/MpMockMethodProxyHandler.class.st +++ b/src/MethodProxiesExamples/MpMockMethodProxyHandler.class.st @@ -1,7 +1,7 @@ Class { #name : #MpMockMethodProxyHandler, #superclass : #MpHandler, - #category : #'MethodProxies-Tests' + #category : #MethodProxiesExamples } { #category : #evaluating } From 95ef9eca2f371a351523b13c7da9bb9c3f318955 Mon Sep 17 00:00:00 2001 From: Guille Polito Date: Tue, 12 Sep 2023 09:23:08 +0200 Subject: [PATCH 11/12] Split even more fast and slow paths Rename trap methods Make tests green --- .../MpAfterResultHandler.class.st | 26 + .../MpMethodProxyTest.class.st | 11 +- src/MethodProxies/MpMethodProxy.class.st | 1395 ++++++++++++++--- 3 files changed, 1227 insertions(+), 205 deletions(-) create mode 100644 src/MethodProxies-Tests/MpAfterResultHandler.class.st diff --git a/src/MethodProxies-Tests/MpAfterResultHandler.class.st b/src/MethodProxies-Tests/MpAfterResultHandler.class.st new file mode 100644 index 0000000..7b23acf --- /dev/null +++ b/src/MethodProxies-Tests/MpAfterResultHandler.class.st @@ -0,0 +1,26 @@ +Class { + #name : #MpAfterResultHandler, + #superclass : #MpHandler, + #instVars : [ + 'count' + ], + #category : #'MethodProxies-Tests' +} + +{ #category : #evaluating } +MpAfterResultHandler >> afterExecutionWithReceiver: anObject arguments: anArrayOfObjects returnValue: aReturnValue [ + + ^ 'trapped [', aReturnValue asString, ']' +] + +{ #category : #accessing } +MpAfterResultHandler >> count [ + ^ count +] + +{ #category : #evaluating } +MpAfterResultHandler >> initialize [ + + super initialize. + count := 0 +] diff --git a/src/MethodProxies-Tests/MpMethodProxyTest.class.st b/src/MethodProxies-Tests/MpMethodProxyTest.class.st index 96e2897..5824ce4 100644 --- a/src/MethodProxies-Tests/MpMethodProxyTest.class.st +++ b/src/MethodProxies-Tests/MpMethodProxyTest.class.st @@ -100,6 +100,7 @@ MpMethodProxyTest >> testCanWrapBasicNew [ MpClassA new. + mp uninstall. self assert: handler count equals: 1 ] @@ -282,7 +283,7 @@ MpMethodProxyTest >> testIsInstalledNestedMWAreNotInstalled [ handler: self handlerClass new. mp2 := MpMethodProxy onMethod: MpClassA >> #methodOne - handler: MpMockMethodProxyHandler new. + handler: self handlerClass new. [ [ @@ -302,7 +303,7 @@ MpMethodProxyTest >> testRecursiveMethodWrapperDoesNotRecurse [ | mw method | method := MpMockObject >> #recursiveMethod. - mw := MpMethodProxy onMethod: method handler: MpMockMethodProxyHandler new. + mw := MpMethodProxy onMethod: method handler: MpAfterResultHandler new. self installMethodProxy: mw. self assert: MpMockObject new recursiveMethod equals: 'trapped [original]'. @@ -334,7 +335,7 @@ MpMethodProxyTest >> testUninstallNestedInRightOrderIsOk [ handler: self handlerClass new. mp2 := MpMethodProxy onMethod: MpClassA >> #methodOne - handler: MpMockMethodProxyHandler new. + handler: self handlerClass new. self installMethodProxy: mp. self installMethodProxy: mp2. @@ -375,7 +376,7 @@ MpMethodProxyTest >> testUnwrappedMethodOfNestedMethodWrapperInTheCompiledMethod mp2 := MpMethodProxy onMethod: MpClassA >> #methodOne - handler: MpMockMethodProxyHandler new. + handler: self handlerClass new. self installMethodProxy: mp2. self assert: mp2 proxifiedMethod equals: mp trapMethod. @@ -446,7 +447,7 @@ MpMethodProxyTest >> testWrappingTwiceIsPossible [ mp2 := MpMethodProxy onMethod: MpClassA >> #methodOne - handler: MpMockMethodProxyHandler new. + handler: self handlerClass new. self installMethodProxy: mp2. self assert: mp1 selector equals: #methodOne. diff --git a/src/MethodProxies/MpMethodProxy.class.st b/src/MethodProxies/MpMethodProxy.class.st index 8b9d872..865bb5d 100644 --- a/src/MethodProxies/MpMethodProxy.class.st +++ b/src/MethodProxies/MpMethodProxy.class.st @@ -61,6 +61,9 @@ Class { 'wrappedMethod', 'proxifiedMethod' ], + #classVars : [ + 'MetaOwner' + ], #category : #MethodProxies } @@ -107,18 +110,75 @@ MpMethodProxy class >> onMethod: aMethod handler: aHandler [ { #category : #evaluating } MpMethodProxy class >> prototypeTrap [ - - "The unwind handler should be the first temp, the complete flag should be the second temp. Then this method is free to use as many extra temporaries and arguments as is wants" - | deactivator complete result process wasMeta | - - "Quick check, if we are in a meta-level do not instrument" - process := thisProcess. - process isMeta ifTrue: [ ^ self originalMessage ]. - "Set the deactivator literal that will be later patched as exception handler" - deactivator := #deactivator. + + | deactivator complete result process wasMeta | + "Set the deactivator literal for the fast path. + It will be patched to an exception handler" + deactivator := #fastdeactivator. + + "Quick check, if we are not in a meta-level, we are the first one here! + Chances are there are never meta-recursions. + Mark it and go FAST" + MetaOwner ifNil: [ "Take the ownership of the meta-level to call before" + MetaOwner := Processor activeProcess. + #handler beforeExecutionWithReceiver: self arguments: #( ). + + "Release it before forwarding the call" + MetaOwner := nil. + result := self originalMessage. + + "Try to get it back and do the fast path if that's the case." + MetaOwner ifNil: [ + MetaOwner := Processor activeProcess. + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + MetaOwner := nil. + ^ result ]. + + "However, maybe another process took it. + In that case we will need to fall back to the slow case" + + "Set the deactivator literal for the slow path. + It will be patched to an exception handler" + deactivator := #slowdeactivator. + + + process := Processor activeProcess. + "Move to the meta level and call the after hooks. + Two after hooks are required. + One indicates the method is returning either because a normal return, + or a stack unwind due to exceptions or non-local returns + The other indicates we are returning normally with a value." + process shiftLevelUp. + wasMeta := true. + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + process shiftLevelDown. + wasMeta := false. + + "Mark the execution as complete to avoid double execution of the unwind handler" + complete := true. + ^ result ]. + + "If we are here, this is maybe a meta call. + Two possibilities: + - we are in the same thread of another meta call: we should just forward without instrumenting + - we are in another thread: increase the meta-level normally" + + process := Processor activeProcess. + MetaOwner == Processor activeProcess ifTrue: [ + ^ self originalMessage ]. + + "Set the deactivator literal for the slow path. + It will be patched to an exception handler" + deactivator := #slowdeactivator. "Move to the meta level and call the before hook" process shiftLevelUp. @@ -168,12 +228,67 @@ MpMethodProxy class >> trapMethod [ | deactivator complete result process wasMeta | - "Quick check, if we are in a meta-level do not instrument" - process := thisProcess. + "Set the deactivator literal for the fast path. + It will be patched to an exception handler" + deactivator := #fastdeactivator. + process := Processor activeProcess. process isMeta ifTrue: [ ^ self trapMethod ]. - "Set the deactivator literal that will be later patched as exception handler" - deactivator := #deactivator. + "Quick check, if we are not in a meta-level, we are the first one here! + Chances are there are never meta-recursions. + Mark it and go FAST" + MetaOwner ifNil: [ "Take the ownership of the meta-level to call before" + MetaOwner := process. + #handler beforeExecutionWithReceiver: self arguments: #( ). + + "Release it before forwarding the call" + MetaOwner := nil. + result := self trapMethod. + + "Try to get it back and do the fast path if that's the case." + MetaOwner ifNil: [ + MetaOwner := process. + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + MetaOwner := nil. + ^ result ]. + + "However, maybe another process took it. + In that case we will need to fall back to the slow case" + + "Set the deactivator literal for the slow path. + It will be patched to an exception handler" + deactivator := #slowdeactivator. + + "Move to the meta level and call the after hooks. + Two after hooks are required. + One indicates the method is returning either because a normal return, + or a stack unwind due to exceptions or non-local returns + The other indicates we are returning normally with a value." + process shiftLevelUp. + wasMeta := true. + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + process shiftLevelDown. + wasMeta := false. + + "Mark the execution as complete to avoid double execution of the unwind handler" + complete := true. + ^ result ]. + + "If we are here, this is maybe a meta call. + Two possibilities: + - we are in the same thread of another meta call: we should just forward without instrumenting + - we are in another thread: increase the meta-level normally" + MetaOwner == process ifTrue: [ ^ self trapMethod ]. + + "Set the deactivator literal for the slow path. + It will be patched to an exception handler" + deactivator := #slowdeactivator. "Move to the meta level and call the before hook" process shiftLevelUp. @@ -208,18 +323,76 @@ MpMethodProxy class >> trapMethod [ ] { #category : #'as yet unclassified' } -MpMethodProxy class >> trapwith: arg1 [ +MpMethodProxy class >> trapMethodwith: arg1 [ "The unwind handler should be the first temp, the complete flag should be the second temp. Then this method is free to use as many extra temporaries and arguments as is wants" | deactivator complete result process wasMeta | - "Quick check, if we are in a meta-level do not instrument" - process := thisProcess. - process isMeta ifTrue: [ ^ self trapwith: arg1 ]. - - "Set the deactivator literal that will be later patched as exception handler" - deactivator := #deactivator. + "Set the deactivator literal for the fast path. + It will be patched to an exception handler" + deactivator := #fastdeactivator. + + "Quick check, if we are not in a meta-level, we are the first one here! + Chances are there are never meta-recursions. + Mark it and go FAST" + MetaOwner ifNil: [ "Take the ownership of the meta-level to call before" + MetaOwner := Processor activeProcess. + #handler beforeExecutionWithReceiver: self arguments: #( ). + + "Release it before forwarding the call" + MetaOwner := nil. + result := self trapMethodwith: arg1. + + "Try to get it back and do the fast path if that's the case." + MetaOwner ifNil: [ + MetaOwner := Processor activeProcess. + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + MetaOwner := nil. + ^ result ]. + + "However, maybe another process took it. + In that case we will need to fall back to the slow case" + + "Set the deactivator literal for the slow path. + It will be patched to an exception handler" + deactivator := #slowdeactivator. + + + process := Processor activeProcess. + "Move to the meta level and call the after hooks. + Two after hooks are required. + One indicates the method is returning either because a normal return, + or a stack unwind due to exceptions or non-local returns + The other indicates we are returning normally with a value." + process shiftLevelUp. + wasMeta := true. + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + process shiftLevelDown. + wasMeta := false. + + "Mark the execution as complete to avoid double execution of the unwind handler" + complete := true. + ^ result ]. + + "If we are here, this is maybe a meta call. + Two possibilities: + - we are in the same thread of another meta call: we should just forward without instrumenting + - we are in another thread: increase the meta-level normally" + + process := Processor activeProcess. + MetaOwner == Processor activeProcess ifTrue: [ + ^ self trapMethodwith: arg1 ]. + + "Set the deactivator literal for the slow path. + It will be patched to an exception handler" + deactivator := #slowdeactivator. "Move to the meta level and call the before hook" process shiftLevelUp. @@ -233,7 +406,7 @@ MpMethodProxy class >> trapwith: arg1 [ The core idea is that - the original method is installed in the same method dictionary using a unique symbol - this call is patched to use that symbol for the send" - result := self trapwith: arg1. + result := self trapMethodwith: arg1. "Move to the meta level and call the after hooks. Two after hooks are required. @@ -254,18 +427,76 @@ MpMethodProxy class >> trapwith: arg1 [ ] { #category : #'as yet unclassified' } -MpMethodProxy class >> trapwith: arg1 with: arg2 [ +MpMethodProxy class >> trapMethodwith: arg1 with: arg2 [ "The unwind handler should be the first temp, the complete flag should be the second temp. Then this method is free to use as many extra temporaries and arguments as is wants" | deactivator complete result process wasMeta | - "Quick check, if we are in a meta-level do not instrument" - process := thisProcess. - process isMeta ifTrue: [ ^ self trapwith: arg1 with: arg2 ]. - - "Set the deactivator literal that will be later patched as exception handler" - deactivator := #deactivator. + "Set the deactivator literal for the fast path. + It will be patched to an exception handler" + deactivator := #fastdeactivator. + + "Quick check, if we are not in a meta-level, we are the first one here! + Chances are there are never meta-recursions. + Mark it and go FAST" + MetaOwner ifNil: [ "Take the ownership of the meta-level to call before" + MetaOwner := Processor activeProcess. + #handler beforeExecutionWithReceiver: self arguments: #( ). + + "Release it before forwarding the call" + MetaOwner := nil. + result := self trapMethodwith: arg1 with: arg2. + + "Try to get it back and do the fast path if that's the case." + MetaOwner ifNil: [ + MetaOwner := Processor activeProcess. + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + MetaOwner := nil. + ^ result ]. + + "However, maybe another process took it. + In that case we will need to fall back to the slow case" + + "Set the deactivator literal for the slow path. + It will be patched to an exception handler" + deactivator := #slowdeactivator. + + + process := Processor activeProcess. + "Move to the meta level and call the after hooks. + Two after hooks are required. + One indicates the method is returning either because a normal return, + or a stack unwind due to exceptions or non-local returns + The other indicates we are returning normally with a value." + process shiftLevelUp. + wasMeta := true. + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + process shiftLevelDown. + wasMeta := false. + + "Mark the execution as complete to avoid double execution of the unwind handler" + complete := true. + ^ result ]. + + "If we are here, this is maybe a meta call. + Two possibilities: + - we are in the same thread of another meta call: we should just forward without instrumenting + - we are in another thread: increase the meta-level normally" + + process := Processor activeProcess. + MetaOwner == Processor activeProcess ifTrue: [ + ^ self trapMethodwith: arg1 with: arg2 ]. + + "Set the deactivator literal for the slow path. + It will be patched to an exception handler" + deactivator := #slowdeactivator. "Move to the meta level and call the before hook" process shiftLevelUp. @@ -279,7 +510,7 @@ MpMethodProxy class >> trapwith: arg1 with: arg2 [ The core idea is that - the original method is installed in the same method dictionary using a unique symbol - this call is patched to use that symbol for the send" - result := self trapwith: arg1 with: arg2. + result := self trapMethodwith: arg1 with: arg2. "Move to the meta level and call the after hooks. Two after hooks are required. @@ -300,18 +531,76 @@ MpMethodProxy class >> trapwith: arg1 with: arg2 [ ] { #category : #'as yet unclassified' } -MpMethodProxy class >> trapwith: arg1 with: arg2 with: arg3 [ +MpMethodProxy class >> trapMethodwith: arg1 with: arg2 with: arg3 [ "The unwind handler should be the first temp, the complete flag should be the second temp. Then this method is free to use as many extra temporaries and arguments as is wants" | deactivator complete result process wasMeta | - "Quick check, if we are in a meta-level do not instrument" - process := thisProcess. - process isMeta ifTrue: [ ^ self trapwith: arg1 with: arg2 with: arg3 ]. - - "Set the deactivator literal that will be later patched as exception handler" - deactivator := #deactivator. + "Set the deactivator literal for the fast path. + It will be patched to an exception handler" + deactivator := #fastdeactivator. + + "Quick check, if we are not in a meta-level, we are the first one here! + Chances are there are never meta-recursions. + Mark it and go FAST" + MetaOwner ifNil: [ "Take the ownership of the meta-level to call before" + MetaOwner := Processor activeProcess. + #handler beforeExecutionWithReceiver: self arguments: #( ). + + "Release it before forwarding the call" + MetaOwner := nil. + result := self trapMethodwith: arg1 with: arg2 with: arg3. + + "Try to get it back and do the fast path if that's the case." + MetaOwner ifNil: [ + MetaOwner := Processor activeProcess. + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + MetaOwner := nil. + ^ result ]. + + "However, maybe another process took it. + In that case we will need to fall back to the slow case" + + "Set the deactivator literal for the slow path. + It will be patched to an exception handler" + deactivator := #slowdeactivator. + + + process := Processor activeProcess. + "Move to the meta level and call the after hooks. + Two after hooks are required. + One indicates the method is returning either because a normal return, + or a stack unwind due to exceptions or non-local returns + The other indicates we are returning normally with a value." + process shiftLevelUp. + wasMeta := true. + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + process shiftLevelDown. + wasMeta := false. + + "Mark the execution as complete to avoid double execution of the unwind handler" + complete := true. + ^ result ]. + + "If we are here, this is maybe a meta call. + Two possibilities: + - we are in the same thread of another meta call: we should just forward without instrumenting + - we are in another thread: increase the meta-level normally" + + process := Processor activeProcess. + MetaOwner == Processor activeProcess ifTrue: [ + ^ self trapMethodwith: arg1 with: arg2 with: arg3 ]. + + "Set the deactivator literal for the slow path. + It will be patched to an exception handler" + deactivator := #slowdeactivator. "Move to the meta level and call the before hook" process shiftLevelUp. @@ -325,7 +614,7 @@ MpMethodProxy class >> trapwith: arg1 with: arg2 with: arg3 [ The core idea is that - the original method is installed in the same method dictionary using a unique symbol - this call is patched to use that symbol for the send" - result := self trapwith: arg1 with: arg2 with: arg3. + result := self trapMethodwith: arg1 with: arg2 with: arg3. "Move to the meta level and call the after hooks. Two after hooks are required. @@ -346,79 +635,86 @@ MpMethodProxy class >> trapwith: arg1 with: arg2 with: arg3 [ ] { #category : #'as yet unclassified' } -MpMethodProxy class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 [ +MpMethodProxy class >> trapMethodwith: arg1 with: arg2 with: arg3 with: arg4 with: arg5 [ "The unwind handler should be the first temp, the complete flag should be the second temp. Then this method is free to use as many extra temporaries and arguments as is wants" | deactivator complete result process wasMeta | - "Quick check, if we are in a meta-level do not instrument" - process := thisProcess. - process isMeta ifTrue: [ + "Set the deactivator literal for the fast path. + It will be patched to an exception handler" + deactivator := #fastdeactivator. + + "Quick check, if we are not in a meta-level, we are the first one here! + Chances are there are never meta-recursions. + Mark it and go FAST" + MetaOwner ifNil: [ "Take the ownership of the meta-level to call before" + MetaOwner := Processor activeProcess. + #handler beforeExecutionWithReceiver: self arguments: #( ). + + "Release it before forwarding the call" + MetaOwner := nil. + result := self + trapMethodwith: arg1 + with: arg2 + with: arg3 + with: arg4 + with: arg5. + + "Try to get it back and do the fast path if that's the case." + MetaOwner ifNil: [ + MetaOwner := Processor activeProcess. + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + MetaOwner := nil. + ^ result ]. + + "However, maybe another process took it. + In that case we will need to fall back to the slow case" + + "Set the deactivator literal for the slow path. + It will be patched to an exception handler" + deactivator := #slowdeactivator. + + + process := Processor activeProcess. + "Move to the meta level and call the after hooks. + Two after hooks are required. + One indicates the method is returning either because a normal return, + or a stack unwind due to exceptions or non-local returns + The other indicates we are returning normally with a value." + process shiftLevelUp. + wasMeta := true. + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + process shiftLevelDown. + wasMeta := false. + + "Mark the execution as complete to avoid double execution of the unwind handler" + complete := true. + ^ result ]. + + "If we are here, this is maybe a meta call. + Two possibilities: + - we are in the same thread of another meta call: we should just forward without instrumenting + - we are in another thread: increase the meta-level normally" + + process := Processor activeProcess. + MetaOwner == Processor activeProcess ifTrue: [ ^ self - trapwith: arg1 - with: arg2 - with: arg3 - with: arg4 ]. - - "Set the deactivator literal that will be later patched as exception handler" - deactivator := #deactivator. - - "Move to the meta level and call the before hook" - process shiftLevelUp. - wasMeta := true. - #handler beforeExecutionWithReceiver: self arguments: #( ). - process shiftLevelDown. - wasMeta := false. - - "Back in the base-level forward the original message. - This is a message to self that will be monomorphically linked by the VM. - The core idea is that - - the original method is installed in the same method dictionary using a unique symbol - - this call is patched to use that symbol for the send" - result := self - trapwith: arg1 - with: arg2 - with: arg3 - with: arg4. - - "Move to the meta level and call the after hooks. - Two after hooks are required. - One indicates the method is returning either because a normal return, or a stack unwind due to exceptions or non-local returns - The other indicates we are returning normally with a value." - process shiftLevelUp. - wasMeta := true. - result := #handler - afterExecutionWithReceiver: self - arguments: #( ) - returnValue: result. - process shiftLevelDown. - wasMeta := false. - - "Mark the execution as complete to avoid double execution of the unwind handler" - complete := true. - ^ result -] - -{ #category : #'as yet unclassified' } -MpMethodProxy class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg5 [ - "The unwind handler should be the first temp, the complete flag should be the second temp. - Then this method is free to use as many extra temporaries and arguments as is wants" - - - | deactivator complete result process wasMeta | - "Quick check, if we are in a meta-level do not instrument" - process := thisProcess. - process isMeta ifTrue: [ - ^ self - trapwith: arg1 + trapMethodwith: arg1 with: arg2 with: arg3 with: arg4 with: arg5 ]. - "Set the deactivator literal that will be later patched as exception handler" - deactivator := #deactivator. + "Set the deactivator literal for the slow path. + It will be patched to an exception handler" + deactivator := #slowdeactivator. "Move to the meta level and call the before hook" process shiftLevelUp. @@ -433,7 +729,7 @@ MpMethodProxy class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg - the original method is installed in the same method dictionary using a unique symbol - this call is patched to use that symbol for the send" result := self - trapwith: arg1 + trapMethodwith: arg1 with: arg2 with: arg3 with: arg4 @@ -458,25 +754,88 @@ MpMethodProxy class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg ] { #category : #'as yet unclassified' } -MpMethodProxy class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 [ +MpMethodProxy class >> trapMethodwith: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 [ "The unwind handler should be the first temp, the complete flag should be the second temp. Then this method is free to use as many extra temporaries and arguments as is wants" | deactivator complete result process wasMeta | - "Quick check, if we are in a meta-level do not instrument" - process := thisProcess. - process isMeta ifTrue: [ + "Set the deactivator literal for the fast path. + It will be patched to an exception handler" + deactivator := #fastdeactivator. + + "Quick check, if we are not in a meta-level, we are the first one here! + Chances are there are never meta-recursions. + Mark it and go FAST" + MetaOwner ifNil: [ "Take the ownership of the meta-level to call before" + MetaOwner := Processor activeProcess. + #handler beforeExecutionWithReceiver: self arguments: #( ). + + "Release it before forwarding the call" + MetaOwner := nil. + result := self + trapMethodwith: arg1 + with: arg2 + with: arg3 + with: arg4 + with: arg5 + with: arg6. + + "Try to get it back and do the fast path if that's the case." + MetaOwner ifNil: [ + MetaOwner := Processor activeProcess. + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + MetaOwner := nil. + ^ result ]. + + "However, maybe another process took it. + In that case we will need to fall back to the slow case" + + "Set the deactivator literal for the slow path. + It will be patched to an exception handler" + deactivator := #slowdeactivator. + + + process := Processor activeProcess. + "Move to the meta level and call the after hooks. + Two after hooks are required. + One indicates the method is returning either because a normal return, + or a stack unwind due to exceptions or non-local returns + The other indicates we are returning normally with a value." + process shiftLevelUp. + wasMeta := true. + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + process shiftLevelDown. + wasMeta := false. + + "Mark the execution as complete to avoid double execution of the unwind handler" + complete := true. + ^ result ]. + + "If we are here, this is maybe a meta call. + Two possibilities: + - we are in the same thread of another meta call: we should just forward without instrumenting + - we are in another thread: increase the meta-level normally" + + process := Processor activeProcess. + MetaOwner == Processor activeProcess ifTrue: [ ^ self - trapwith: arg1 + trapMethodwith: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 ]. - "Set the deactivator literal that will be later patched as exception handler" - deactivator := #deactivator. + "Set the deactivator literal for the slow path. + It will be patched to an exception handler" + deactivator := #slowdeactivator. "Move to the meta level and call the before hook" process shiftLevelUp. @@ -491,7 +850,7 @@ MpMethodProxy class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg - the original method is installed in the same method dictionary using a unique symbol - this call is patched to use that symbol for the send" result := self - trapwith: arg1 + trapMethodwith: arg1 with: arg2 with: arg3 with: arg4 @@ -517,17 +876,80 @@ MpMethodProxy class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg ] { #category : #'as yet unclassified' } -MpMethodProxy class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7 [ +MpMethodProxy class >> trapMethodwith: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7 [ "The unwind handler should be the first temp, the complete flag should be the second temp. Then this method is free to use as many extra temporaries and arguments as is wants" | deactivator complete result process wasMeta | - "Quick check, if we are in a meta-level do not instrument" - process := thisProcess. - process isMeta ifTrue: [ + "Set the deactivator literal for the fast path. + It will be patched to an exception handler" + deactivator := #fastdeactivator. + + "Quick check, if we are not in a meta-level, we are the first one here! + Chances are there are never meta-recursions. + Mark it and go FAST" + MetaOwner ifNil: [ "Take the ownership of the meta-level to call before" + MetaOwner := Processor activeProcess. + #handler beforeExecutionWithReceiver: self arguments: #( ). + + "Release it before forwarding the call" + MetaOwner := nil. + result := self + trapMethodwith: arg1 + with: arg2 + with: arg3 + with: arg4 + with: arg5 + with: arg6 + with: arg7. + + "Try to get it back and do the fast path if that's the case." + MetaOwner ifNil: [ + MetaOwner := Processor activeProcess. + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + MetaOwner := nil. + ^ result ]. + + "However, maybe another process took it. + In that case we will need to fall back to the slow case" + + "Set the deactivator literal for the slow path. + It will be patched to an exception handler" + deactivator := #slowdeactivator. + + + process := Processor activeProcess. + "Move to the meta level and call the after hooks. + Two after hooks are required. + One indicates the method is returning either because a normal return, + or a stack unwind due to exceptions or non-local returns + The other indicates we are returning normally with a value." + process shiftLevelUp. + wasMeta := true. + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + process shiftLevelDown. + wasMeta := false. + + "Mark the execution as complete to avoid double execution of the unwind handler" + complete := true. + ^ result ]. + + "If we are here, this is maybe a meta call. + Two possibilities: + - we are in the same thread of another meta call: we should just forward without instrumenting + - we are in another thread: increase the meta-level normally" + + process := Processor activeProcess. + MetaOwner == Processor activeProcess ifTrue: [ ^ self - trapwith: arg1 + trapMethodwith: arg1 with: arg2 with: arg3 with: arg4 @@ -535,8 +957,9 @@ MpMethodProxy class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg with: arg6 with: arg7 ]. - "Set the deactivator literal that will be later patched as exception handler" - deactivator := #deactivator. + "Set the deactivator literal for the slow path. + It will be patched to an exception handler" + deactivator := #slowdeactivator. "Move to the meta level and call the before hook" process shiftLevelUp. @@ -551,7 +974,7 @@ MpMethodProxy class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg - the original method is installed in the same method dictionary using a unique symbol - this call is patched to use that symbol for the send" result := self - trapwith: arg1 + trapMethodwith: arg1 with: arg2 with: arg3 with: arg4 @@ -578,17 +1001,81 @@ MpMethodProxy class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg ] { #category : #'as yet unclassified' } -MpMethodProxy class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7 with: arg8 [ +MpMethodProxy class >> trapMethodwith: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7 with: arg8 [ "The unwind handler should be the first temp, the complete flag should be the second temp. Then this method is free to use as many extra temporaries and arguments as is wants" | deactivator complete result process wasMeta | - "Quick check, if we are in a meta-level do not instrument" - process := thisProcess. - process isMeta ifTrue: [ + "Set the deactivator literal for the fast path. + It will be patched to an exception handler" + deactivator := #fastdeactivator. + + "Quick check, if we are not in a meta-level, we are the first one here! + Chances are there are never meta-recursions. + Mark it and go FAST" + MetaOwner ifNil: [ "Take the ownership of the meta-level to call before" + MetaOwner := Processor activeProcess. + #handler beforeExecutionWithReceiver: self arguments: #( ). + + "Release it before forwarding the call" + MetaOwner := nil. + result := self + trapMethodwith: arg1 + with: arg2 + with: arg3 + with: arg4 + with: arg5 + with: arg6 + with: arg7 + with: arg8. + + "Try to get it back and do the fast path if that's the case." + MetaOwner ifNil: [ + MetaOwner := Processor activeProcess. + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + MetaOwner := nil. + ^ result ]. + + "However, maybe another process took it. + In that case we will need to fall back to the slow case" + + "Set the deactivator literal for the slow path. + It will be patched to an exception handler" + deactivator := #slowdeactivator. + + + process := Processor activeProcess. + "Move to the meta level and call the after hooks. + Two after hooks are required. + One indicates the method is returning either because a normal return, + or a stack unwind due to exceptions or non-local returns + The other indicates we are returning normally with a value." + process shiftLevelUp. + wasMeta := true. + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + process shiftLevelDown. + wasMeta := false. + + "Mark the execution as complete to avoid double execution of the unwind handler" + complete := true. + ^ result ]. + + "If we are here, this is maybe a meta call. + Two possibilities: + - we are in the same thread of another meta call: we should just forward without instrumenting + - we are in another thread: increase the meta-level normally" + + process := Processor activeProcess. + MetaOwner == Processor activeProcess ifTrue: [ ^ self - trapwith: arg1 + trapMethodwith: arg1 with: arg2 with: arg3 with: arg4 @@ -597,8 +1084,9 @@ MpMethodProxy class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg with: arg7 with: arg8 ]. - "Set the deactivator literal that will be later patched as exception handler" - deactivator := #deactivator. + "Set the deactivator literal for the slow path. + It will be patched to an exception handler" + deactivator := #slowdeactivator. "Move to the meta level and call the before hook" process shiftLevelUp. @@ -613,7 +1101,7 @@ MpMethodProxy class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg - the original method is installed in the same method dictionary using a unique symbol - this call is patched to use that symbol for the send" result := self - trapwith: arg1 + trapMethodwith: arg1 with: arg2 with: arg3 with: arg4 @@ -641,17 +1129,82 @@ MpMethodProxy class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg ] { #category : #'as yet unclassified' } -MpMethodProxy class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7 with: arg8 with: arg9 [ +MpMethodProxy class >> trapMethodwith: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7 with: arg8 with: arg9 [ "The unwind handler should be the first temp, the complete flag should be the second temp. Then this method is free to use as many extra temporaries and arguments as is wants" | deactivator complete result process wasMeta | - "Quick check, if we are in a meta-level do not instrument" - process := thisProcess. - process isMeta ifTrue: [ + "Set the deactivator literal for the fast path. + It will be patched to an exception handler" + deactivator := #fastdeactivator. + + "Quick check, if we are not in a meta-level, we are the first one here! + Chances are there are never meta-recursions. + Mark it and go FAST" + MetaOwner ifNil: [ "Take the ownership of the meta-level to call before" + MetaOwner := Processor activeProcess. + #handler beforeExecutionWithReceiver: self arguments: #( ). + + "Release it before forwarding the call" + MetaOwner := nil. + result := self + trapMethodwith: arg1 + with: arg2 + with: arg3 + with: arg4 + with: arg5 + with: arg6 + with: arg7 + with: arg8 + with: arg9. + + "Try to get it back and do the fast path if that's the case." + MetaOwner ifNil: [ + MetaOwner := Processor activeProcess. + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + MetaOwner := nil. + ^ result ]. + + "However, maybe another process took it. + In that case we will need to fall back to the slow case" + + "Set the deactivator literal for the slow path. + It will be patched to an exception handler" + deactivator := #slowdeactivator. + + + process := Processor activeProcess. + "Move to the meta level and call the after hooks. + Two after hooks are required. + One indicates the method is returning either because a normal return, + or a stack unwind due to exceptions or non-local returns + The other indicates we are returning normally with a value." + process shiftLevelUp. + wasMeta := true. + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + process shiftLevelDown. + wasMeta := false. + + "Mark the execution as complete to avoid double execution of the unwind handler" + complete := true. + ^ result ]. + + "If we are here, this is maybe a meta call. + Two possibilities: + - we are in the same thread of another meta call: we should just forward without instrumenting + - we are in another thread: increase the meta-level normally" + + process := Processor activeProcess. + MetaOwner == Processor activeProcess ifTrue: [ ^ self - trapwith: arg1 + trapMethodwith: arg1 with: arg2 with: arg3 with: arg4 @@ -661,8 +1214,9 @@ MpMethodProxy class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg with: arg8 with: arg9 ]. - "Set the deactivator literal that will be later patched as exception handler" - deactivator := #deactivator. + "Set the deactivator literal for the slow path. + It will be patched to an exception handler" + deactivator := #slowdeactivator. "Move to the meta level and call the before hook" process shiftLevelUp. @@ -677,7 +1231,7 @@ MpMethodProxy class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg - the original method is installed in the same method dictionary using a unique symbol - this call is patched to use that symbol for the send" result := self - trapwith: arg1 + trapMethodwith: arg1 with: arg2 with: arg3 with: arg4 @@ -706,17 +1260,83 @@ MpMethodProxy class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg ] { #category : #'as yet unclassified' } -MpMethodProxy class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7 with: arg8 with: arg9 with: arg10 [ +MpMethodProxy class >> trapMethodwith: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7 with: arg8 with: arg9 with: arg10 [ "The unwind handler should be the first temp, the complete flag should be the second temp. Then this method is free to use as many extra temporaries and arguments as is wants" | deactivator complete result process wasMeta | - "Quick check, if we are in a meta-level do not instrument" - process := thisProcess. - process isMeta ifTrue: [ + "Set the deactivator literal for the fast path. + It will be patched to an exception handler" + deactivator := #fastdeactivator. + + "Quick check, if we are not in a meta-level, we are the first one here! + Chances are there are never meta-recursions. + Mark it and go FAST" + MetaOwner ifNil: [ "Take the ownership of the meta-level to call before" + MetaOwner := Processor activeProcess. + #handler beforeExecutionWithReceiver: self arguments: #( ). + + "Release it before forwarding the call" + MetaOwner := nil. + result := self + trapMethodwith: arg1 + with: arg2 + with: arg3 + with: arg4 + with: arg5 + with: arg6 + with: arg7 + with: arg8 + with: arg9 + with: arg10. + + "Try to get it back and do the fast path if that's the case." + MetaOwner ifNil: [ + MetaOwner := Processor activeProcess. + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + MetaOwner := nil. + ^ result ]. + + "However, maybe another process took it. + In that case we will need to fall back to the slow case" + + "Set the deactivator literal for the slow path. + It will be patched to an exception handler" + deactivator := #slowdeactivator. + + + process := Processor activeProcess. + "Move to the meta level and call the after hooks. + Two after hooks are required. + One indicates the method is returning either because a normal return, + or a stack unwind due to exceptions or non-local returns + The other indicates we are returning normally with a value." + process shiftLevelUp. + wasMeta := true. + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + process shiftLevelDown. + wasMeta := false. + + "Mark the execution as complete to avoid double execution of the unwind handler" + complete := true. + ^ result ]. + + "If we are here, this is maybe a meta call. + Two possibilities: + - we are in the same thread of another meta call: we should just forward without instrumenting + - we are in another thread: increase the meta-level normally" + + process := Processor activeProcess. + MetaOwner == Processor activeProcess ifTrue: [ ^ self - trapwith: arg1 + trapMethodwith: arg1 with: arg2 with: arg3 with: arg4 @@ -727,8 +1347,9 @@ MpMethodProxy class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg with: arg9 with: arg10 ]. - "Set the deactivator literal that will be later patched as exception handler" - deactivator := #deactivator. + "Set the deactivator literal for the slow path. + It will be patched to an exception handler" + deactivator := #slowdeactivator. "Move to the meta level and call the before hook" process shiftLevelUp. @@ -743,7 +1364,7 @@ MpMethodProxy class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg - the original method is installed in the same method dictionary using a unique symbol - this call is patched to use that symbol for the send" result := self - trapwith: arg1 + trapMethodwith: arg1 with: arg2 with: arg3 with: arg4 @@ -773,17 +1394,84 @@ MpMethodProxy class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg ] { #category : #'as yet unclassified' } -MpMethodProxy class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7 with: arg8 with: arg9 with: arg10 with: arg11 [ +MpMethodProxy class >> trapMethodwith: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7 with: arg8 with: arg9 with: arg10 with: arg11 [ "The unwind handler should be the first temp, the complete flag should be the second temp. Then this method is free to use as many extra temporaries and arguments as is wants" | deactivator complete result process wasMeta | - "Quick check, if we are in a meta-level do not instrument" - process := thisProcess. - process isMeta ifTrue: [ + "Set the deactivator literal for the fast path. + It will be patched to an exception handler" + deactivator := #fastdeactivator. + + "Quick check, if we are not in a meta-level, we are the first one here! + Chances are there are never meta-recursions. + Mark it and go FAST" + MetaOwner ifNil: [ "Take the ownership of the meta-level to call before" + MetaOwner := Processor activeProcess. + #handler beforeExecutionWithReceiver: self arguments: #( ). + + "Release it before forwarding the call" + MetaOwner := nil. + result := self + trapMethodwith: arg1 + with: arg2 + with: arg3 + with: arg4 + with: arg5 + with: arg6 + with: arg7 + with: arg8 + with: arg9 + with: arg10 + with: arg11. + + "Try to get it back and do the fast path if that's the case." + MetaOwner ifNil: [ + MetaOwner := Processor activeProcess. + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + MetaOwner := nil. + ^ result ]. + + "However, maybe another process took it. + In that case we will need to fall back to the slow case" + + "Set the deactivator literal for the slow path. + It will be patched to an exception handler" + deactivator := #slowdeactivator. + + + process := Processor activeProcess. + "Move to the meta level and call the after hooks. + Two after hooks are required. + One indicates the method is returning either because a normal return, + or a stack unwind due to exceptions or non-local returns + The other indicates we are returning normally with a value." + process shiftLevelUp. + wasMeta := true. + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + process shiftLevelDown. + wasMeta := false. + + "Mark the execution as complete to avoid double execution of the unwind handler" + complete := true. + ^ result ]. + + "If we are here, this is maybe a meta call. + Two possibilities: + - we are in the same thread of another meta call: we should just forward without instrumenting + - we are in another thread: increase the meta-level normally" + + process := Processor activeProcess. + MetaOwner == Processor activeProcess ifTrue: [ ^ self - trapwith: arg1 + trapMethodwith: arg1 with: arg2 with: arg3 with: arg4 @@ -795,8 +1483,9 @@ MpMethodProxy class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg with: arg10 with: arg11 ]. - "Set the deactivator literal that will be later patched as exception handler" - deactivator := #deactivator. + "Set the deactivator literal for the slow path. + It will be patched to an exception handler" + deactivator := #slowdeactivator. "Move to the meta level and call the before hook" process shiftLevelUp. @@ -811,7 +1500,7 @@ MpMethodProxy class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg - the original method is installed in the same method dictionary using a unique symbol - this call is patched to use that symbol for the send" result := self - trapwith: arg1 + trapMethodwith: arg1 with: arg2 with: arg3 with: arg4 @@ -842,17 +1531,85 @@ MpMethodProxy class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg ] { #category : #'as yet unclassified' } -MpMethodProxy class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7 with: arg8 with: arg9 with: arg10 with: arg11 with: arg12 [ +MpMethodProxy class >> trapMethodwith: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7 with: arg8 with: arg9 with: arg10 with: arg11 with: arg12 [ "The unwind handler should be the first temp, the complete flag should be the second temp. Then this method is free to use as many extra temporaries and arguments as is wants" | deactivator complete result process wasMeta | - "Quick check, if we are in a meta-level do not instrument" - process := thisProcess. - process isMeta ifTrue: [ + "Set the deactivator literal for the fast path. + It will be patched to an exception handler" + deactivator := #fastdeactivator. + + "Quick check, if we are not in a meta-level, we are the first one here! + Chances are there are never meta-recursions. + Mark it and go FAST" + MetaOwner ifNil: [ "Take the ownership of the meta-level to call before" + MetaOwner := Processor activeProcess. + #handler beforeExecutionWithReceiver: self arguments: #( ). + + "Release it before forwarding the call" + MetaOwner := nil. + result := self + trapMethodwith: arg1 + with: arg2 + with: arg3 + with: arg4 + with: arg5 + with: arg6 + with: arg7 + with: arg8 + with: arg9 + with: arg10 + with: arg11 + with: arg12. + + "Try to get it back and do the fast path if that's the case." + MetaOwner ifNil: [ + MetaOwner := Processor activeProcess. + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + MetaOwner := nil. + ^ result ]. + + "However, maybe another process took it. + In that case we will need to fall back to the slow case" + + "Set the deactivator literal for the slow path. + It will be patched to an exception handler" + deactivator := #slowdeactivator. + + + process := Processor activeProcess. + "Move to the meta level and call the after hooks. + Two after hooks are required. + One indicates the method is returning either because a normal return, + or a stack unwind due to exceptions or non-local returns + The other indicates we are returning normally with a value." + process shiftLevelUp. + wasMeta := true. + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + process shiftLevelDown. + wasMeta := false. + + "Mark the execution as complete to avoid double execution of the unwind handler" + complete := true. + ^ result ]. + + "If we are here, this is maybe a meta call. + Two possibilities: + - we are in the same thread of another meta call: we should just forward without instrumenting + - we are in another thread: increase the meta-level normally" + + process := Processor activeProcess. + MetaOwner == Processor activeProcess ifTrue: [ ^ self - trapwith: arg1 + trapMethodwith: arg1 with: arg2 with: arg3 with: arg4 @@ -865,8 +1622,9 @@ MpMethodProxy class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg with: arg11 with: arg12 ]. - "Set the deactivator literal that will be later patched as exception handler" - deactivator := #deactivator. + "Set the deactivator literal for the slow path. + It will be patched to an exception handler" + deactivator := #slowdeactivator. "Move to the meta level and call the before hook" process shiftLevelUp. @@ -881,7 +1639,7 @@ MpMethodProxy class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg - the original method is installed in the same method dictionary using a unique symbol - this call is patched to use that symbol for the send" result := self - trapwith: arg1 + trapMethodwith: arg1 with: arg2 with: arg3 with: arg4 @@ -913,17 +1671,86 @@ MpMethodProxy class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg ] { #category : #'as yet unclassified' } -MpMethodProxy class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7 with: arg8 with: arg9 with: arg10 with: arg11 with: arg12 with: arg13 [ +MpMethodProxy class >> trapMethodwith: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7 with: arg8 with: arg9 with: arg10 with: arg11 with: arg12 with: arg13 [ "The unwind handler should be the first temp, the complete flag should be the second temp. Then this method is free to use as many extra temporaries and arguments as is wants" | deactivator complete result process wasMeta | - "Quick check, if we are in a meta-level do not instrument" - process := thisProcess. - process isMeta ifTrue: [ + "Set the deactivator literal for the fast path. + It will be patched to an exception handler" + deactivator := #fastdeactivator. + + "Quick check, if we are not in a meta-level, we are the first one here! + Chances are there are never meta-recursions. + Mark it and go FAST" + MetaOwner ifNil: [ "Take the ownership of the meta-level to call before" + MetaOwner := Processor activeProcess. + #handler beforeExecutionWithReceiver: self arguments: #( ). + + "Release it before forwarding the call" + MetaOwner := nil. + result := self + trapMethodwith: arg1 + with: arg2 + with: arg3 + with: arg4 + with: arg5 + with: arg6 + with: arg7 + with: arg8 + with: arg9 + with: arg10 + with: arg11 + with: arg12 + with: arg13. + + "Try to get it back and do the fast path if that's the case." + MetaOwner ifNil: [ + MetaOwner := Processor activeProcess. + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + MetaOwner := nil. + ^ result ]. + + "However, maybe another process took it. + In that case we will need to fall back to the slow case" + + "Set the deactivator literal for the slow path. + It will be patched to an exception handler" + deactivator := #slowdeactivator. + + + process := Processor activeProcess. + "Move to the meta level and call the after hooks. + Two after hooks are required. + One indicates the method is returning either because a normal return, + or a stack unwind due to exceptions or non-local returns + The other indicates we are returning normally with a value." + process shiftLevelUp. + wasMeta := true. + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + process shiftLevelDown. + wasMeta := false. + + "Mark the execution as complete to avoid double execution of the unwind handler" + complete := true. + ^ result ]. + + "If we are here, this is maybe a meta call. + Two possibilities: + - we are in the same thread of another meta call: we should just forward without instrumenting + - we are in another thread: increase the meta-level normally" + + process := Processor activeProcess. + MetaOwner == Processor activeProcess ifTrue: [ ^ self - trapwith: arg1 + trapMethodwith: arg1 with: arg2 with: arg3 with: arg4 @@ -937,8 +1764,9 @@ MpMethodProxy class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg with: arg12 with: arg13 ]. - "Set the deactivator literal that will be later patched as exception handler" - deactivator := #deactivator. + "Set the deactivator literal for the slow path. + It will be patched to an exception handler" + deactivator := #slowdeactivator. "Move to the meta level and call the before hook" process shiftLevelUp. @@ -953,7 +1781,7 @@ MpMethodProxy class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg - the original method is installed in the same method dictionary using a unique symbol - this call is patched to use that symbol for the send" result := self - trapwith: arg1 + trapMethodwith: arg1 with: arg2 with: arg3 with: arg4 @@ -986,17 +1814,87 @@ MpMethodProxy class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg ] { #category : #'as yet unclassified' } -MpMethodProxy class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7 with: arg8 with: arg9 with: arg10 with: arg11 with: arg12 with: arg13 with: arg14 [ +MpMethodProxy class >> trapMethodwith: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7 with: arg8 with: arg9 with: arg10 with: arg11 with: arg12 with: arg13 with: arg14 [ "The unwind handler should be the first temp, the complete flag should be the second temp. Then this method is free to use as many extra temporaries and arguments as is wants" | deactivator complete result process wasMeta | - "Quick check, if we are in a meta-level do not instrument" - process := thisProcess. - process isMeta ifTrue: [ + "Set the deactivator literal for the fast path. + It will be patched to an exception handler" + deactivator := #fastdeactivator. + + "Quick check, if we are not in a meta-level, we are the first one here! + Chances are there are never meta-recursions. + Mark it and go FAST" + MetaOwner ifNil: [ "Take the ownership of the meta-level to call before" + MetaOwner := Processor activeProcess. + #handler beforeExecutionWithReceiver: self arguments: #( ). + + "Release it before forwarding the call" + MetaOwner := nil. + result := self + trapMethodwith: arg1 + with: arg2 + with: arg3 + with: arg4 + with: arg5 + with: arg6 + with: arg7 + with: arg8 + with: arg9 + with: arg10 + with: arg11 + with: arg12 + with: arg13 + with: arg14. + + "Try to get it back and do the fast path if that's the case." + MetaOwner ifNil: [ + MetaOwner := Processor activeProcess. + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + MetaOwner := nil. + ^ result ]. + + "However, maybe another process took it. + In that case we will need to fall back to the slow case" + + "Set the deactivator literal for the slow path. + It will be patched to an exception handler" + deactivator := #slowdeactivator. + + + process := Processor activeProcess. + "Move to the meta level and call the after hooks. + Two after hooks are required. + One indicates the method is returning either because a normal return, + or a stack unwind due to exceptions or non-local returns + The other indicates we are returning normally with a value." + process shiftLevelUp. + wasMeta := true. + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + process shiftLevelDown. + wasMeta := false. + + "Mark the execution as complete to avoid double execution of the unwind handler" + complete := true. + ^ result ]. + + "If we are here, this is maybe a meta call. + Two possibilities: + - we are in the same thread of another meta call: we should just forward without instrumenting + - we are in another thread: increase the meta-level normally" + + process := Processor activeProcess. + MetaOwner == Processor activeProcess ifTrue: [ ^ self - trapwith: arg1 + trapMethodwith: arg1 with: arg2 with: arg3 with: arg4 @@ -1011,8 +1909,9 @@ MpMethodProxy class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg with: arg13 with: arg14 ]. - "Set the deactivator literal that will be later patched as exception handler" - deactivator := #deactivator. + "Set the deactivator literal for the slow path. + It will be patched to an exception handler" + deactivator := #slowdeactivator. "Move to the meta level and call the before hook" process shiftLevelUp. @@ -1027,7 +1926,7 @@ MpMethodProxy class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg - the original method is installed in the same method dictionary using a unique symbol - this call is patched to use that symbol for the send" result := self - trapwith: arg1 + trapMethodwith: arg1 with: arg2 with: arg3 with: arg4 @@ -1061,17 +1960,88 @@ MpMethodProxy class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg ] { #category : #'as yet unclassified' } -MpMethodProxy class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7 with: arg8 with: arg9 with: arg10 with: arg11 with: arg12 with: arg13 with: arg14 with: arg15 [ +MpMethodProxy class >> trapMethodwith: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7 with: arg8 with: arg9 with: arg10 with: arg11 with: arg12 with: arg13 with: arg14 with: arg15 [ "The unwind handler should be the first temp, the complete flag should be the second temp. Then this method is free to use as many extra temporaries and arguments as is wants" | deactivator complete result process wasMeta | - "Quick check, if we are in a meta-level do not instrument" - process := thisProcess. - process isMeta ifTrue: [ + "Set the deactivator literal for the fast path. + It will be patched to an exception handler" + deactivator := #fastdeactivator. + + "Quick check, if we are not in a meta-level, we are the first one here! + Chances are there are never meta-recursions. + Mark it and go FAST" + MetaOwner ifNil: [ "Take the ownership of the meta-level to call before" + MetaOwner := Processor activeProcess. + #handler beforeExecutionWithReceiver: self arguments: #( ). + + "Release it before forwarding the call" + MetaOwner := nil. + result := self + trapMethodwith: arg1 + with: arg2 + with: arg3 + with: arg4 + with: arg5 + with: arg6 + with: arg7 + with: arg8 + with: arg9 + with: arg10 + with: arg11 + with: arg12 + with: arg13 + with: arg14 + with: arg15. + + "Try to get it back and do the fast path if that's the case." + MetaOwner ifNil: [ + MetaOwner := Processor activeProcess. + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + MetaOwner := nil. + ^ result ]. + + "However, maybe another process took it. + In that case we will need to fall back to the slow case" + + "Set the deactivator literal for the slow path. + It will be patched to an exception handler" + deactivator := #slowdeactivator. + + + process := Processor activeProcess. + "Move to the meta level and call the after hooks. + Two after hooks are required. + One indicates the method is returning either because a normal return, + or a stack unwind due to exceptions or non-local returns + The other indicates we are returning normally with a value." + process shiftLevelUp. + wasMeta := true. + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + process shiftLevelDown. + wasMeta := false. + + "Mark the execution as complete to avoid double execution of the unwind handler" + complete := true. + ^ result ]. + + "If we are here, this is maybe a meta call. + Two possibilities: + - we are in the same thread of another meta call: we should just forward without instrumenting + - we are in another thread: increase the meta-level normally" + + process := Processor activeProcess. + MetaOwner == Processor activeProcess ifTrue: [ ^ self - trapwith: arg1 + trapMethodwith: arg1 with: arg2 with: arg3 with: arg4 @@ -1087,8 +2057,9 @@ MpMethodProxy class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg with: arg14 with: arg15 ]. - "Set the deactivator literal that will be later patched as exception handler" - deactivator := #deactivator. + "Set the deactivator literal for the slow path. + It will be patched to an exception handler" + deactivator := #slowdeactivator. "Move to the meta level and call the before hook" process shiftLevelUp. @@ -1103,7 +2074,7 @@ MpMethodProxy class >> trapwith: arg1 with: arg2 with: arg3 with: arg4 with: arg - the original method is installed in the same method dictionary using a unique symbol - this call is patched to use that symbol for the send" result := self - trapwith: arg1 + trapMethodwith: arg1 with: arg2 with: arg3 with: arg4 @@ -1152,27 +2123,48 @@ MpMethodProxy >> handler: anObject [ { #category : #installation } MpMethodProxy >> install [ - | deactivator newTrap index trapSelector | + | slowdeactivator newTrap index trapSelector fastdeactivator | thisProcess runInMetaLevel: [ + MetaOwner := Processor activeProcess. + [ (proxifiedMethod hasPragmaNamed: #noInstrumentation) ifTrue: [ ^ MpCannotInstall signalWith: self ]. - deactivator := [ "Execution handler for the slow path. An exception or a non local return happened during proxy execution" - | wasMeta trapContext | - - "Jump to the meta level (to avoid meta-recursions) to observe if the handler was in a meta level, marked by the wasMeta flag. + slowdeactivator := [ "Execution handler for the slow path. An exception or a non local return happened during proxy execution" + | wasMeta trapContext | + "Jump to the meta level (to avoid meta-recursions) to observe if the handler was in a meta level, marked by the wasMeta flag. During the meta-jump call the handler to tell there was an unwind. " - thisProcess shiftLevelUp. - trapContext := thisContext findContextSuchThat: [ :ctx | ctx isUnwindContext ]. - wasMeta := trapContext tempNamed: 'wasMeta'. - handler aboutToReturnWithReceiver: trapContext receiver arguments: trapContext arguments. - thisProcess shiftLevelDown. - - "If the handler was in a meta-state (i.e., the exception or non-local return happened in the handler), shift it back to the base level before returning. + thisProcess shiftLevelUp. + trapContext := thisContext findContextSuchThat: [ + :ctx | ctx isUnwindContext ]. + wasMeta := trapContext tempNamed: 'wasMeta'. + handler + aboutToReturnWithReceiver: trapContext receiver + arguments: trapContext arguments. + thisProcess shiftLevelDown. + + "If the handler was in a meta-state (i.e., the exception or non-local return happened in the handler), shift it back to the base level before returning. Otherwise, we were already in the base level and we need to do nothing!" - wasMeta ifTrue: [ thisProcess shiftLevelDown ]. - ]. + wasMeta ifTrue: [ thisProcess shiftLevelDown ] ]. + + fastdeactivator := [ | trapContext | + "If we fall in here, we were in the fast path. + This means we were the owners of the meta level when calling before or after. + If that it the case, release ownership. + + But! this could have been stolen when forwarding. + If that is the case, leave the ownership to the othe thread + " + thisProcess shiftLevelUp. + trapContext := thisContext findContextSuchThat: [ + :ctx | ctx isUnwindContext ]. + handler + aboutToReturnWithReceiver: trapContext receiver + arguments: trapContext arguments. + thisProcess shiftLevelDown. + MetaOwner == Processor activeProcess + ifTrue: [ MetaOwner := nil ] ]. newTrap := self prototypeTrapMethod copy. trapSelector := newTrap selector. @@ -1187,14 +2179,17 @@ MpMethodProxy >> install [ index := newTrap literals indexOf: #handler. newTrap literalAt: index put: handler. - index := newTrap literals indexOf: #deactivator. - newTrap literalAt: index put: deactivator. + index := newTrap literals indexOf: #fastdeactivator. + newTrap literalAt: index put: fastdeactivator. + + index := newTrap literals indexOf: #slowdeactivator. + newTrap literalAt: index put: slowdeactivator. "It could happen that a proxy wraps a proxy. Remember the object that was installed at this moment. This is the object to restore during uninstall" - wrappedMethod := proxifiedMethod methodClass methodDict - at: proxifiedMethod selector. + wrappedMethod := proxifiedMethod methodClass methodDict at: + proxifiedMethod selector. proxifiedMethod methodClass methodDict at: hiddenSelector @@ -1202,8 +2197,8 @@ MpMethodProxy >> install [ proxifiedMethod methodClass methodDict at: proxifiedMethod selector put: newTrap. - - trapMethod := newTrap ] + + trapMethod := newTrap ] ensure: [ MetaOwner := nil ] ] ] { #category : #testing } From a6bfb87134d53e1ab9685315b2ff3bead505e871 Mon Sep 17 00:00:00 2001 From: Guille Polito Date: Tue, 12 Sep 2023 09:23:47 +0200 Subject: [PATCH 12/12] Add trap method with 4 args --- src/MethodProxies/MpMethodProxy.class.st | 116 +++++++++++++++++++++++ 1 file changed, 116 insertions(+) diff --git a/src/MethodProxies/MpMethodProxy.class.st b/src/MethodProxies/MpMethodProxy.class.st index 865bb5d..08cb0c4 100644 --- a/src/MethodProxies/MpMethodProxy.class.st +++ b/src/MethodProxies/MpMethodProxy.class.st @@ -634,6 +634,122 @@ MpMethodProxy class >> trapMethodwith: arg1 with: arg2 with: arg3 [ ^ result ] +{ #category : #'as yet unclassified' } +MpMethodProxy class >> trapMethodwith: arg1 with: arg2 with: arg3 with: arg4 [ + "The unwind handler should be the first temp, the complete flag should be the second temp. + Then this method is free to use as many extra temporaries and arguments as is wants" + + + | deactivator complete result process wasMeta | + "Set the deactivator literal for the fast path. + It will be patched to an exception handler" + deactivator := #fastdeactivator. + + "Quick check, if we are not in a meta-level, we are the first one here! + Chances are there are never meta-recursions. + Mark it and go FAST" + MetaOwner ifNil: [ "Take the ownership of the meta-level to call before" + MetaOwner := Processor activeProcess. + #handler beforeExecutionWithReceiver: self arguments: #( ). + + "Release it before forwarding the call" + MetaOwner := nil. + result := self + trapMethodwith: arg1 + with: arg2 + with: arg3 + with: arg4. + + "Try to get it back and do the fast path if that's the case." + MetaOwner ifNil: [ + MetaOwner := Processor activeProcess. + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + MetaOwner := nil. + ^ result ]. + + "However, maybe another process took it. + In that case we will need to fall back to the slow case" + + "Set the deactivator literal for the slow path. + It will be patched to an exception handler" + deactivator := #slowdeactivator. + + + process := Processor activeProcess. + "Move to the meta level and call the after hooks. + Two after hooks are required. + One indicates the method is returning either because a normal return, + or a stack unwind due to exceptions or non-local returns + The other indicates we are returning normally with a value." + process shiftLevelUp. + wasMeta := true. + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + process shiftLevelDown. + wasMeta := false. + + "Mark the execution as complete to avoid double execution of the unwind handler" + complete := true. + ^ result ]. + + "If we are here, this is maybe a meta call. + Two possibilities: + - we are in the same thread of another meta call: we should just forward without instrumenting + - we are in another thread: increase the meta-level normally" + + process := Processor activeProcess. + MetaOwner == Processor activeProcess ifTrue: [ + ^ self + trapMethodwith: arg1 + with: arg2 + with: arg3 + with: arg4 ]. + + "Set the deactivator literal for the slow path. + It will be patched to an exception handler" + deactivator := #slowdeactivator. + + "Move to the meta level and call the before hook" + process shiftLevelUp. + wasMeta := true. + #handler beforeExecutionWithReceiver: self arguments: #( ). + process shiftLevelDown. + wasMeta := false. + + "Back in the base-level forward the original message. + This is a message to self that will be monomorphically linked by the VM. + The core idea is that + - the original method is installed in the same method dictionary using a unique symbol + - this call is patched to use that symbol for the send" + result := self + trapMethodwith: arg1 + with: arg2 + with: arg3 + with: arg4. + + "Move to the meta level and call the after hooks. + Two after hooks are required. + One indicates the method is returning either because a normal return, or a stack unwind due to exceptions or non-local returns + The other indicates we are returning normally with a value." + process shiftLevelUp. + wasMeta := true. + result := #handler + afterExecutionWithReceiver: self + arguments: #( ) + returnValue: result. + process shiftLevelDown. + wasMeta := false. + + "Mark the execution as complete to avoid double execution of the unwind handler" + complete := true. + ^ result +] + { #category : #'as yet unclassified' } MpMethodProxy class >> trapMethodwith: arg1 with: arg2 with: arg3 with: arg4 with: arg5 [ "The unwind handler should be the first temp, the complete flag should be the second temp.