Nicolas Cellier uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-nice.1386.mcz
==================== Summary ====================
Name: Kernel-nice.1386 Author: nice Time: 14 April 2021, 2:56:48.575456 pm UUID: e7612c01-14d8-0940-87fe-45e2fb4d2719 Ancestors: Kernel-mt.1385, Kernel-ct.1383, Kernel-ct.1364
Merge commit. Note that Kernel-ct.1383 supersedes Kernel-ct.1382 and removes the annoying warning.
Kernel-mt.1385: Clean up and comment on the idiom #perform:orSendTo:.
Kernel-ct.1383: Fixes simulation of the #perform:... primitives 83, 84, and 100 for all edge cases. If the primitive is called with the wrong arguments, the primitive must fail but not the simulator.
Kernel-ct.1364: Fixes primitive comments in BlockClosure >> (cull:){3,4}.
=============== Diff against Kernel-mt.1385 ===============
Item was changed: ----- Method: BlockClosure>>cull:cull:cull: (in category 'evaluating') ----- cull: firstArg cull: secondArg cull: thirdArg "Activate the receiver, with three or less arguments." + <primitive: 204> "Handle the three argument case primitively" - <primitive: 204> "Handle the two argument case primitively" numArgs >= 2 ifTrue: [ numArgs >= 3 ifTrue: [ ^self value: firstArg value: secondArg value: thirdArg ]. ^self value: firstArg value: secondArg ]. numArgs = 1 ifTrue: [ ^self value: firstArg ]. ^self value!
Item was changed: ----- Method: BlockClosure>>cull:cull:cull:cull: (in category 'evaluating') ----- cull: firstArg cull: secondArg cull: thirdArg cull: fourthArg "Activate the receiver, with four or less arguments." + <primitive: 205> "Handle the four argument case primitively" - <primitive: 205> "Handle the two argument case primitively" numArgs >= 3 ifTrue: [ numArgs >= 4 ifTrue: [ ^self value: firstArg value: secondArg value: thirdArg value: fourthArg ]. ^self value: firstArg value: secondArg value: thirdArg ]. numArgs = 2 ifTrue: [ ^self value: firstArg value: secondArg ]. numArgs = 1 ifTrue: [ ^self value: firstArg ]. ^self value!
Item was changed: ----- Method: Context>>doPrimitive:method:receiver:args: (in category 'private') ----- doPrimitive: primitiveIndex method: meth receiver: receiver args: arguments "Simulate a primitive method whose index is primitiveIndex. The simulated receiver and arguments are given as arguments to this message. If successful, push result and return resuming context, else ^ {errCode, PrimitiveFailToken}. Any primitive which provokes execution needs to be intercepted and simulated to avoid execution running away."
| value | "Judicious use of primitive 19 (a null primitive that doesn't do anything) prevents the debugger from entering various run-away activities such as spawning a new process, etc. Injudicious use results in the debugger not being able to debug interesting code, such as the debugger itself. Hence use primitive 19 with care :-)" "SystemNavigation new browseAllSelect: [:m| m primitive = 19]" + primitiveIndex = 19 ifTrue: [ - (primitiveIndex = 19 or: [primitiveIndex >= 85 and: [primitiveIndex <= 88] "control primitives"]) ifTrue: [ [self notify: ('The code being simulated is trying to control a process ({1}). Process controlling cannot be simulated. If you proceed, things may happen outside the observable area of the simulator.' translated format: {meth reference})] ifCurtailed: [self push: nil "Cheap fix of the context's internal state"]]. ((primitiveIndex between: 201 and: 222) and: [(self objectClass: receiver) includesBehavior: BlockClosure]) ifTrue: [(primitiveIndex = 206 or: [primitiveIndex = 208]) ifTrue: "[Full]BlockClosure>>valueWithArguments:" [^receiver simulateValueWithArguments: arguments first caller: self]. ((primitiveIndex between: 201 and: 209) "[Full]BlockClosure>>value[:value:...]" or: [primitiveIndex between: 221 and: 222]) ifTrue: "[Full]BlockClosure>>valueNoContextSwitch[:]" [^receiver simulateValueWithArguments: arguments caller: self]].
primitiveIndex = 83 ifTrue: "afr 9/11/1998 19:50" "Object>>perform:[with:...]" + [| selector | + selector := arguments at: 1 ifAbsent: + [^ self class primitiveFailTokenFor: #'bad argument']. + arguments size - 1 = selector numArgs ifFalse: + [^ self class primitiveFailTokenFor: #'bad number of arguments']. + ^self send: selector to: receiver with: arguments allButFirst]. - [^self send: arguments first to: receiver with: arguments allButFirst]. primitiveIndex = 84 ifTrue: "afr 9/11/1998 19:50 & eem 8/18/2009 17:04" "Object>>perform:withArguments:" + [| selector args | + arguments size = 2 ifFalse: + [^ self class primitiveFailTokenFor: #'bad argument']. + selector := arguments first. + args := arguments second. + args isArray ifFalse: + [^ self class primitiveFailTokenFor: #'bad argument']. + args size = selector numArgs ifFalse: + [^ self class primitiveFailTokenFor: #'bad number of arguments']. + ^self send: selector to: receiver with: args]. - [^self send: arguments first to: receiver with: (arguments at: 2) lookupIn: (self objectClass: receiver)]. primitiveIndex = 100 ifTrue: "eem 8/18/2009 16:57" "Object>>perform:withArguments:inSuperclass:" + [| rcvr selector args superclass | + arguments size + caseOf: { + [3] -> [ + rcvr := receiver. + selector := arguments first. + args := arguments second. + superclass := arguments third]. + [4] -> ["mirror primitive" + rcvr := arguments first. + selector := arguments second. + args := arguments third. + superclass := arguments fourth] } + otherwise: [^ self class primitiveFailTokenFor: #'bad argument']. + args isArray ifFalse: + [^ self class primitiveFailTokenFor: #'bad argument']. + args size = selector numArgs ifFalse: + [^ self class primitiveFailTokenFor: #'bad number of arguments']. + ((self objectClass: rcvr) includesBehavior: superclass) ifFalse: + [^ self class primitiveFailTokenFor: #'bad argument']. + ^self send: selector to: rcvr with: args lookupIn: superclass]. - [^self send: arguments first to: receiver with: (arguments at: 2) lookupIn: (arguments at: 3)].
"Mutex>>primitiveEnterCriticalSection Mutex>>primitiveTestAndSetOwnershipOfCriticalSection" (primitiveIndex = 186 or: [primitiveIndex = 187]) ifTrue: + [| effective | + effective := Processor activeProcess effectiveProcess. + "active == effective" + value := primitiveIndex = 186 + ifTrue: [receiver primitiveEnterCriticalSectionOnBehalfOf: effective] + ifFalse: [receiver primitiveTestAndSetOwnershipOfCriticalSectionOnBehalfOf: effective]. - [value := primitiveIndex = 186 - ifTrue: [receiver primitiveEnterCriticalSectionOnBehalfOf: Processor activeProcess] - ifFalse: [receiver primitiveTestAndSetOwnershipOfCriticalSectionOnBehalfOf: Processor activeProcess]. ^(self isPrimFailToken: value) ifTrue: [value] ifFalse: [self push: value]].
primitiveIndex = 188 ifTrue: "Object>>withArgs:executeMethod: CompiledMethod class>>receiver:withArguments:executeMethod: VMMirror>>ifFail:object:with:executeMethod: et al" [| n args methodArg thisReceiver | ((n := arguments size) between: 2 and: 4) ifFalse: [^self class primitiveFailTokenFor: #'unsupported operation']. ((self objectClass: (args := arguments at: n - 1)) == Array and: [(self objectClass: (methodArg := arguments at: n)) includesBehavior: CompiledMethod]) ifFalse: [^self class primitiveFailTokenFor: #'bad argument']. methodArg numArgs = args size ifFalse: [^self class primitiveFailTokenFor: #'bad number of arguments']. thisReceiver := arguments at: n - 2 ifAbsent: [receiver]. methodArg primitive > 0 ifTrue: [methodArg isQuick ifTrue: [^self push: (methodArg valueWithReceiver: thisReceiver arguments: args)]. ^self doPrimitive: methodArg primitive method: meth receiver: thisReceiver args: args]. ^Context sender: self receiver: thisReceiver method: methodArg arguments: args].
primitiveIndex = 118 ifTrue: "[receiver:]tryPrimitive:withArgs:; avoid recursing in the VM" [(arguments size = 3 and: [(self objectClass: arguments second) == SmallInteger and: [(self objectClass: arguments last) == Array]]) ifTrue: [^self doPrimitive: arguments second method: meth receiver: arguments first args: arguments last]. (arguments size = 2 and: [(self objectClass: arguments first) == SmallInteger and: [(self objectClass: arguments last) == Array]]) ifFalse: [^self class primitiveFailTokenFor: nil]. ^self doPrimitive: arguments first method: meth receiver: receiver args: arguments last].
value := primitiveIndex = 120 "FFI method" ifTrue: [(meth literalAt: 1) tryInvokeWithArguments: arguments] ifFalse: [primitiveIndex = 117 "named primitives" ifTrue: [self tryNamedPrimitiveIn: meth for: receiver withArgs: arguments] ifFalse: "should use self receiver: receiver tryPrimitive: primitiveIndex withArgs: arguments but this is only in later VMs (and appears to be broken)" [receiver tryPrimitive: primitiveIndex withArgs: arguments]].
^(self isPrimFailToken: value) ifTrue: [value] ifFalse: [self push: value]!
Hi Nicolas,
I see that you reverted Kernel-ct.1382 (which has been merged into the Trunk earlier via Kernel-mt.1383). Was this a merge error or an intended rollback?
Assuming the latter, I would like to discuss this again, please. :-) I already noticed by myself that the control primitive warning occurred a bit too often in situations where you would not expect it (for instance, when stepping through "Object sourceCodeAt: #at:"). Still, do we indeed do not want to get informed about any attempt by the debugged process to execute logic in another process? Also, the simulator is not only used by the debugger but also in miscellaneous non-interactive situations, including MessageTally, some KernelTests, and SimulationStudio where the warning might be even more relevant because the assumption or the contract is that the passed logic will be simulated completely. Would it be a compromise for you to signal a custom EscapeFromSimulationWarning (better name proposals are welcome :-) ) instead and to ignore them in the Debugger?
I am looking forward to your reply! :-)
Best, Christoph
----- Carpe Squeak! -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html
PS: I also see that you touched the simulation of criticalSection primitives (primitiveIndex = 186 ...) again. Again, was this intended or an incident? :-)
(OT: We are really treading on each other's toes in this method ... What can we learn from this? Is it too large and should be split up? Or should we improve our tooling support for resolving merge conflicts?)
Best, Christoph
----- Carpe Squeak! -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html
Hi Christoph,
the commit message in Kernel-nice.1386 reads: "[...] Note that Kernel-ct.1383 supersedes Kernel-ct.1382 and removes the annoying warning. [...]"
I think the problem was that both ct.1382 and ct.1382 change the same method but do not actually consider each other. With our current tools, sub-method merging is rather tricky and hence the author should take care that this does not happen. :-)
Please review the current state of Context >> #doPrimitive:method:receiver:args: and upload the missing lines again into the inbox if necessary.
Best, Marcel Am 16.04.2021 15:16:18 schrieb Christoph Thiede christoph.thiede@student.hpi.uni-potsdam.de: PS: I also see that you touched the simulation of criticalSection primitives (primitiveIndex = 186 ...) again. Again, was this intended or an incident? :-)
(OT: We are really treading on each other's toes in this method ... What can we learn from this? Is it too large and should be split up? Or should we improve our tooling support for resolving merge conflicts?)
Best, Christoph
----- Carpe Squeak! -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html
Hi Christoph, Hmm, there must have been some confusion on my side. I've tried to carefully review the remaining contributions in the inbox. To my understanding Kernel-ct.1383 fixes more simulation cases than Kernel-ct.1382. Since - the tests simulating primitives 83, 84 & 100 were failing, - and that a more recent inbox contribution was trying to fix that, I thought that merging this contribution was a good idea. It apparently was fixing two tests out of three after trial.
Also, to my experience, generating a warning when we simulate primitiveIndex >= 85 and: [primitiveIndex <= 88] "control primitives"]) is super annoying! It always happens when running some kernel tests and forces me to switch warning off altogether. But switching warning off is not a good solution (and it makes some more tests fail !). Kernel-ct.1383 being more recent, I thought that the removal of warnings was intentional...
I saw later that you removed <primitive: 19> from newProcess... SHould we?
My understanding now is that you need this warning in some specific context. Is that it? We can't fix one usage by breaking another. We have to find a solution that fits both purposes.
Le ven. 16 avr. 2021 à 15:40, Marcel Taeumel marcel.taeumel@hpi.de a écrit :
Hi Christoph,
the commit message in Kernel-nice.1386 reads: "[...] Note that Kernel-ct.1383 supersedes Kernel-ct.1382 and removes the annoying warning. [...]"
I think the problem was that both ct.1382 and ct.1382 change the same method but do not actually consider each other. With our current tools, sub-method merging is rather tricky and hence the author should take care that this does not happen. :-)
Please review the current state of Context >> #doPrimitive:method:receiver:args: and upload the missing lines again into the inbox if necessary.
Best, Marcel
Am 16.04.2021 15:16:18 schrieb Christoph Thiede christoph.thiede@student.hpi.uni-potsdam.de:
PS: I also see that you touched the simulation of criticalSection primitives (primitiveIndex = 186 ...) again. Again, was this intended or an incident? :-)
(OT: We are really treading on each other's toes in this method ... What can we learn from this? Is it too large and should be split up? Or should we improve our tooling support for resolving merge conflicts?)
Best, Christoph
Carpe Squeak!
Sent from: http://forum.world.st/Squeak-Dev-f45488.html
Hi Nicolas,
in general, I use to submit one inbox version per proposal/fix/change. They all branch from the main Trunk line so I consider each of them something that you would call a Pull Request in the GitHub world. This also means that no inbox proposal is to be considered deprecated only because I upload a newer version. When I indeed intend to replace the former version, I usually add a notice "replaces version Package-ct.xxx" to the message of the new version. :-)
I think our special problem in this case was that it is not a straightforward task to merge multiple changes of a single method with our tooling.
I see the problem with annoying warnings, which is why I proposed to create a new subclass for these warnings! Then we could easily ignore these warnings when they are raised inside of the debugger. For other use cases such as automated tests or SimulationStudio, however, we would still see them.
I saw later that you removed <primitive: 19> from newProcess... SHould we?
I think we should. Either a simulator client is interested to be informed about attempts of the code to escape from simulation, or it isn't. In every case, creating a process is an absolutely boring event with regard to that interest, but all actions such as resuming, terminating, or signaling a process could be of interest.
Please review the current state of Context >> #doPrimitive:method:receiver:args: and upload the missing lines again into the inbox if necessary.
I'll put that onto my list, but I've myself lost track of the changes regarding primitive 186 et al. I'm not the author of these changes ...
Best, Christoph
________________________________ Von: Squeak-dev squeak-dev-bounces@lists.squeakfoundation.org im Auftrag von Nicolas Cellier nicolas.cellier.aka.nice@gmail.com Gesendet: Freitag, 16. April 2021 19:34:20 An: The general-purpose Squeak developers list Betreff: Re: [squeak-dev] The Trunk: Kernel-nice.1386.mcz
Hi Christoph, Hmm, there must have been some confusion on my side. I've tried to carefully review the remaining contributions in the inbox. To my understanding Kernel-ct.1383 fixes more simulation cases than Kernel-ct.1382. Since - the tests simulating primitives 83, 84 & 100 were failing, - and that a more recent inbox contribution was trying to fix that, I thought that merging this contribution was a good idea. It apparently was fixing two tests out of three after trial.
Also, to my experience, generating a warning when we simulate primitiveIndex >= 85 and: [primitiveIndex <= 88] "control primitives"]) is super annoying! It always happens when running some kernel tests and forces me to switch warning off altogether. But switching warning off is not a good solution (and it makes some more tests fail !). Kernel-ct.1383 being more recent, I thought that the removal of warnings was intentional...
I saw later that you removed <primitive: 19> from newProcess... SHould we?
My understanding now is that you need this warning in some specific context. Is that it? We can't fix one usage by breaking another. We have to find a solution that fits both purposes.
Le ven. 16 avr. 2021 à 15:40, Marcel Taeumel marcel.taeumel@hpi.de a écrit :
Hi Christoph,
the commit message in Kernel-nice.1386 reads: "[...] Note that Kernel-ct.1383 supersedes Kernel-ct.1382 and removes the annoying warning. [...]"
I think the problem was that both ct.1382 and ct.1382 change the same method but do not actually consider each other. With our current tools, sub-method merging is rather tricky and hence the author should take care that this does not happen. :-)
Please review the current state of Context >> #doPrimitive:method:receiver:args: and upload the missing lines again into the inbox if necessary.
Best, Marcel
Am 16.04.2021 15:16:18 schrieb Christoph Thiede christoph.thiede@student.hpi.uni-potsdam.de:
PS: I also see that you touched the simulation of criticalSection primitives (primitiveIndex = 186 ...) again. Again, was this intended or an incident? :-)
(OT: We are really treading on each other's toes in this method ... What can we learn from this? Is it too large and should be split up? Or should we improve our tooling support for resolving merge conflicts?)
Best, Christoph
Carpe Squeak!
Sent from: http://forum.world.st/Squeak-Dev-f45488.html
Hi Christoph,
Le lun. 19 avr. 2021 à 13:32, Thiede, Christoph Christoph.Thiede@student.hpi.uni-potsdam.de a écrit :
Hi Nicolas,
in general, I use to submit one inbox version per proposal/fix/change. They all branch from the main Trunk line so I consider each of them something that you would call a Pull Request in the GitHub world. This also means that no inbox proposal is to be considered deprecated only because I upload a newer version. When I indeed intend to replace the former version, I usually add a notice "replaces version Package-ct.xxx" to the message of the new version. :-)
I think our special problem in this case was that it is not a straightforward task to merge multiple changes of a single method with our tooling.
Yes, changing several times the same method is necessarily a conflict for our tools. IMO it's a good thing, because it will require human attention for resolution. Merging based on line editions is not the right solution IMO. If both editions modify the temps, they will conflict anyway.
Even if methods are atomic pieces, two modifications of the same method are not necessarily exclusive. It happens that we updated a comment in one branch, or renamed a message, inst var or class in the other, etc... But here, I failed to identify this situation. I might have been biased by the desire to see the warnings go ;)
I see the problem with annoying warnings, which is why I proposed to create a new subclass for these warnings! Then we could easily ignore these warnings when they are raised inside of the debugger. For other use cases such as automated tests or SimulationStudio, however, we would still see them.
Yes, this could work. I also wondered if we could disable warnings at specific send sites on user request (instead of disabling all the Warnings). A good way to exercise new super powers for the Sorcerer's Apprentices ;)
I saw later that you removed <primitive: 19> from newProcess... SHould we?
I think we should. Either a simulator client is interested to be informed about attempts of the code to escape from simulation, or it isn't. In every case, creating a process is an absolutely boring event with regard to that interest, but all actions such as resuming, terminating, or signaling a process could be of interest.
Please review the current state of Context >> #doPrimitive:method:receiver:args: and upload the missing lines again into the inbox if necessary.
I'll put that onto my list, but I've myself lost track of the changes regarding primitive 186 et al. I'm not the author of these changes ...
Best, Christoph
Von: Squeak-dev squeak-dev-bounces@lists.squeakfoundation.org im Auftrag von Nicolas Cellier nicolas.cellier.aka.nice@gmail.com Gesendet: Freitag, 16. April 2021 19:34:20 An: The general-purpose Squeak developers list Betreff: Re: [squeak-dev] The Trunk: Kernel-nice.1386.mcz
Hi Christoph, Hmm, there must have been some confusion on my side. I've tried to carefully review the remaining contributions in the inbox. To my understanding Kernel-ct.1383 fixes more simulation cases than Kernel-ct.1382. Since
- the tests simulating primitives 83, 84 & 100 were failing,
- and that a more recent inbox contribution was trying to fix that,
I thought that merging this contribution was a good idea. It apparently was fixing two tests out of three after trial.
Also, to my experience, generating a warning when we simulate primitiveIndex >= 85 and: [primitiveIndex <= 88] "control primitives"]) is super annoying! It always happens when running some kernel tests and forces me to switch warning off altogether. But switching warning off is not a good solution (and it makes some more tests fail !). Kernel-ct.1383 being more recent, I thought that the removal of warnings was intentional...
I saw later that you removed <primitive: 19> from newProcess... SHould we?
My understanding now is that you need this warning in some specific context. Is that it? We can't fix one usage by breaking another. We have to find a solution that fits both purposes.
Le ven. 16 avr. 2021 à 15:40, Marcel Taeumel marcel.taeumel@hpi.de a écrit :
Hi Christoph,
the commit message in Kernel-nice.1386 reads: "[...] Note that Kernel-ct.1383 supersedes Kernel-ct.1382 and removes the annoying warning. [...]"
I think the problem was that both ct.1382 and ct.1382 change the same method but do not actually consider each other. With our current tools, sub-method merging is rather tricky and hence the author should take care that this does not happen. :-)
Please review the current state of Context >> #doPrimitive:method:receiver:args: and upload the missing lines again into the inbox if necessary.
Best, Marcel
Am 16.04.2021 15:16:18 schrieb Christoph Thiede christoph.thiede@student.hpi.uni-potsdam.de:
PS: I also see that you touched the simulation of criticalSection primitives (primitiveIndex = 186 ...) again. Again, was this intended or an incident? :-)
(OT: We are really treading on each other's toes in this method ... What can we learn from this? Is it too large and should be split up? Or should we improve our tooling support for resolving merge conflicts?)
Best, Christoph
Carpe Squeak!
Sent from: http://forum.world.st/Squeak-Dev-f45488.html
Hi Nicolas,
Yes, this could work.
Great! It's on my list. :-)
Yes, changing several times the same method is necessarily a conflict for our tools.
IMO it's a good thing, because it will require human attention for resolution. Merging based on line editions is not the right solution IMO. If both editions modify the temps, they will conflict anyway.
Agreed. Still, I think it would be nice if you could just accept your manual resolution of a conflicting method right into a merge browser. By accepting the entire merge then, your manually resolved method should be installed into the image. How would you think about that?
I also wondered if we could disable warnings at specific send sites on user request (instead of disabling all the Warnings).
Ah, something like "ignore deprecation warnings for sends from specific method/class/package"? This could be worth a thought. But I do not yet have a real use case for this. :-)
Best, Christoph
________________________________ Von: Squeak-dev squeak-dev-bounces@lists.squeakfoundation.org im Auftrag von Nicolas Cellier nicolas.cellier.aka.nice@gmail.com Gesendet: Montag, 19. April 2021 16:04:28 An: The general-purpose Squeak developers list Betreff: Re: [squeak-dev] The Trunk: Kernel-nice.1386.mcz
Hi Christoph,
Le lun. 19 avr. 2021 à 13:32, Thiede, Christoph Christoph.Thiede@student.hpi.uni-potsdam.de a écrit :
Hi Nicolas,
in general, I use to submit one inbox version per proposal/fix/change. They all branch from the main Trunk line so I consider each of them something that you would call a Pull Request in the GitHub world. This also means that no inbox proposal is to be considered deprecated only because I upload a newer version. When I indeed intend to replace the former version, I usually add a notice "replaces version Package-ct.xxx" to the message of the new version. :-)
I think our special problem in this case was that it is not a straightforward task to merge multiple changes of a single method with our tooling.
Yes, changing several times the same method is necessarily a conflict for our tools. IMO it's a good thing, because it will require human attention for resolution. Merging based on line editions is not the right solution IMO. If both editions modify the temps, they will conflict anyway.
Even if methods are atomic pieces, two modifications of the same method are not necessarily exclusive. It happens that we updated a comment in one branch, or renamed a message, inst var or class in the other, etc... But here, I failed to identify this situation. I might have been biased by the desire to see the warnings go ;)
I see the problem with annoying warnings, which is why I proposed to create a new subclass for these warnings! Then we could easily ignore these warnings when they are raised inside of the debugger. For other use cases such as automated tests or SimulationStudio, however, we would still see them.
Yes, this could work. I also wondered if we could disable warnings at specific send sites on user request (instead of disabling all the Warnings). A good way to exercise new super powers for the Sorcerer's Apprentices ;)
I saw later that you removed <primitive: 19> from newProcess... SHould we?
I think we should. Either a simulator client is interested to be informed about attempts of the code to escape from simulation, or it isn't. In every case, creating a process is an absolutely boring event with regard to that interest, but all actions such as resuming, terminating, or signaling a process could be of interest.
Please review the current state of Context >> #doPrimitive:method:receiver:args: and upload the missing lines again into the inbox if necessary.
I'll put that onto my list, but I've myself lost track of the changes regarding primitive 186 et al. I'm not the author of these changes ...
Best, Christoph
Von: Squeak-dev squeak-dev-bounces@lists.squeakfoundation.org im Auftrag von Nicolas Cellier nicolas.cellier.aka.nice@gmail.com Gesendet: Freitag, 16. April 2021 19:34:20 An: The general-purpose Squeak developers list Betreff: Re: [squeak-dev] The Trunk: Kernel-nice.1386.mcz
Hi Christoph, Hmm, there must have been some confusion on my side. I've tried to carefully review the remaining contributions in the inbox. To my understanding Kernel-ct.1383 fixes more simulation cases than Kernel-ct.1382. Since
- the tests simulating primitives 83, 84 & 100 were failing,
- and that a more recent inbox contribution was trying to fix that,
I thought that merging this contribution was a good idea. It apparently was fixing two tests out of three after trial.
Also, to my experience, generating a warning when we simulate primitiveIndex >= 85 and: [primitiveIndex <= 88] "control primitives"]) is super annoying! It always happens when running some kernel tests and forces me to switch warning off altogether. But switching warning off is not a good solution (and it makes some more tests fail !). Kernel-ct.1383 being more recent, I thought that the removal of warnings was intentional...
I saw later that you removed <primitive: 19> from newProcess... SHould we?
My understanding now is that you need this warning in some specific context. Is that it? We can't fix one usage by breaking another. We have to find a solution that fits both purposes.
Le ven. 16 avr. 2021 à 15:40, Marcel Taeumel marcel.taeumel@hpi.de a écrit :
Hi Christoph,
the commit message in Kernel-nice.1386 reads: "[...] Note that Kernel-ct.1383 supersedes Kernel-ct.1382 and removes the annoying warning. [...]"
I think the problem was that both ct.1382 and ct.1382 change the same method but do not actually consider each other. With our current tools, sub-method merging is rather tricky and hence the author should take care that this does not happen. :-)
Please review the current state of Context >> #doPrimitive:method:receiver:args: and upload the missing lines again into the inbox if necessary.
Best, Marcel
Am 16.04.2021 15:16:18 schrieb Christoph Thiede christoph.thiede@student.hpi.uni-potsdam.de:
PS: I also see that you touched the simulation of criticalSection primitives (primitiveIndex = 186 ...) again. Again, was this intended or an incident? :-)
(OT: We are really treading on each other's toes in this method ... What can we learn from this? Is it too large and should be split up? Or should we improve our tooling support for resolving merge conflicts?)
Best, Christoph
Carpe Squeak!
Sent from: http://forum.world.st/Squeak-Dev-f45488.html
Hi all,
I just wanted to pick up this item from my list again and add a SimulationSideEffectWarning (I think this is a better name than my former proposal, EscapeFromSimulationWarning) to #doPrimitive:method:receiver:args:.
As discussed below, it should allow pedantic clients of the simulator to avoid situations in which the code to be executed escapes from the control of the simulator, e.g. when it uses #fork. On the other hand, unaware clients such as the debugger should not be disturbed by unimportant warnings. However, critical attempts should still be reported, i.e. when a debugger reaches a simulation guard (primitive 19).
However, I'm not yet sure in which exact situations the warning should be caught/suppressed and in which not. Here is a list of possible situations:
- Use the stepping buttons in a debugger: SUPPRESS (except simulation guard) - Return entered value in a debugger: SUPPRESS (except simulation guard) - Terminate a process: SUPPRESS - Context class >> #trace.../#tally...: NOTIFY - MessageTally: NOTIFY - Context class >> #runSimulated:: NOTIFY - Morphic "debug action" (of a button, menu item, etc.): SUPPRESS - Debug it: SUPPRESS (what about simulation guards?) - (external project) SimulationStudio/Sandbox: NOTIFY (!)
Based on this collection, I considered adding a handler in the public Process selectors for debugging (protocols: *System-debugging and 'changing suspended state'). This would also emphasize the different roles of Context and Process in the debugging machinery (Process also holds the responsibility for process-faithful debugging).
Still, there is one edge case that would violate this rule: Imagine a subclass of Debugger that would be side-effect aware, i.e. care about EscapeFromSimulationWarnings. Since the debugger only talks to the Process, it would not be able to handle these warnings following my proposal from above. This is not only a fictive experiment but I'm indeed considering a SandboxDebugger at the moment which would actually need this. For this concrete case, of course, I could hack my exception handler into my Context subclass, too, but the existence of this example makes we wonder whether my proposal from above is actually useful.
What is your opinion on this matter? Would you agree to my list of aware and non-aware simulation clients? When do you think we should suppress EscapeFromSimulationWarnings and when not?
Best, Christoph
----- Carpe Squeak! -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html
Hi all!
After rethinking the case again, here is my proposed solution (please find it in the attachment). SimulationSideEffectWarning.cs http://forum.world.st/file/t372205/SimulationSideEffectWarning.cs
In a nutshell, I decided on a strict separation between the different causes for a side effect warning since control primitives and simulation guards actually reside on different levels of abstraction. They only have in common that the user of the simulator should maybe know about them. The detailed changelog is in the postscript of the changelog, here is a copy:
SimulationSideEffectWarning.cs wrote
- Replace generic Warning in Context >> #doPrimitive:method:receiver:args:
by specific warning of new class SimulationSideEffectWarning.
- Also signal SimulationSideEffectWarning if primitive 87
(primitiveResume) is hit.
- SimulationSideEffectWarning contains logic to detect the type
(simulation guard/control primitive) of the side effect. It can also be suppressed or unsuppressed along the handler chain using the '*suppress*' selectors. Control primitive side effects are suppressed by default.
- Add tests for the changes above.
- In the debugger, unsuppress control primitive warnings.
- Replace definitions of primitive 19 (currently only in ControlManager)
with a named alias pragma,
<simulationGuard> , which is implemented on Parser.
For more information, see: http://forum.world.st/The-Trunk-Kernel-nice-1386-mcz-td5128636.html
(* Sorry, this should be in the preamble, not in the postscript, I know, but the preamble editor in the ChangeSorter is currently broken. ¯_(ツ)_/¯)
Please let us know how I can improve it or just merge it directly! :-)
Best, Christoph
----- Carpe Squeak! -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html
It is extremely confusing that Nabble strips of the revision number of the changeset upon upload. :-)
---
Community service, here is the inlined diff:
"Change Set: SimulationSideEffectWarning Date: 9 May 2021 Author: Christoph Thiede
<your descriptive text goes here>"
Warning subclass: #SimulationSideEffectWarning instanceVariableNames: 'primitiveIndex sender suppressed' classVariableNames: '' poolDictionaries: '' category: 'Kernel-Exceptions'
I am signaled to notify the client of a simulation operation (i.e., a sender of Context) about potential side effects that might occur when resuming the simulation. See Context >> #doPrimitive:method:receiver:args:, #messageText, and Parser >> #simulationGuard for more information.
doPrimitive: primitiveIndex method: meth receiver: receiver args: arguments "Simulate a primitive method whose index is primitiveIndex. The simulated receiver and arguments are given as arguments to this message. If successful, push result and return resuming context, else ^ {errCode, PrimitiveFailToken}. Any primitive which provokes execution needs to be intercepted and simulated to avoid execution running away."
| value | "Judicious use of primitive 19 (a null primitive that doesn't do anything) prevents the debugger from entering various run-away activities such as spawning a new process, etc. Injudicious use results in the debugger not being able to debug interesting code, such as the debugger itself. Hence use primitive 19 with care :-)" "SystemNavigation new browseAllSelect: [:m| m primitive = 19]" primitiveIndex = 19 ifTrue: [ [self notify: ('The code being simulated is trying to control a process ({1}). Process controlling cannot be simulated. If you proceed, things may happen outside the observable area of the simulator.' translated format: {meth reference})] ifCurtailed: [self push: nil "Cheap fix of the context's internal state"]]. *"Test for unsimulatable side effects (that is, code that will be triggered in the image outside of the simulator range). This includes simulation guards, which are traditionally flagged using primitive 19 (a null primitive that doesn't do anything), as well as certain control primitives that might trigger code on other processes. If a side effect is detected, raise a warning to give the user a chance to cancel the operation." "#(19 87) do: [:primitive | self systemNavigation browseAllSelect: [:m | m primitive = primitive]]" (primitiveIndex = 19 "simulationGuard" or: [primitiveIndex = 87 "primitiveResume"]) ifTrue: [ [SimulationSideEffectWarning signalForPrimitive: primitiveIndex sender: self] ifCurtailed: [self push: nil "Cheap fix of the context's internal state. Note that unwinding the receiver -- so that the next step would invoke the primitive again -- would be challenging due to to the variety of senders to this method."]].* ((primitiveIndex between: 201 and: 222) and: [(self objectClass: receiver) includesBehavior: BlockClosure]) ifTrue: [(primitiveIndex = 206 or: [primitiveIndex = 208]) ifTrue: "[Full]BlockClosure>>valueWithArguments:" [^receiver simulateValueWithArguments: arguments first caller: self]. ((primitiveIndex between: 201 and: 209) "[Full]BlockClosure>>value[:value:...]" or: [primitiveIndex between: 221 and: 222]) ifTrue: "[Full]BlockClosure>>valueNoContextSwitch[:]" [^receiver simulateValueWithArguments: arguments caller: self]].
primitiveIndex = 83 ifTrue: "afr 9/11/1998 19:50" "Object>>perform:[with:...]" [| selector | selector := arguments at: 1 ifAbsent: [^ self class primitiveFailTokenFor: #'bad argument']. arguments size - 1 = selector numArgs ifFalse: [^ self class primitiveFailTokenFor: #'bad number of arguments']. ^self send: selector to: receiver with: arguments allButFirst]. primitiveIndex = 84 ifTrue: "afr 9/11/1998 19:50 & eem 8/18/2009 17:04" "Object>>perform:withArguments:" [| selector args | arguments size = 2 ifFalse: [^ self class primitiveFailTokenFor: #'bad argument']. selector := arguments first. args := arguments second. args isArray ifFalse: [^ self class primitiveFailTokenFor: #'bad argument']. args size = selector numArgs ifFalse: [^ self class primitiveFailTokenFor: #'bad number of arguments']. ^self send: selector to: receiver with: args]. primitiveIndex = 100 ifTrue: "eem 8/18/2009 16:57" "Object>>perform:withArguments:inSuperclass:" [| rcvr selector args superclass | arguments size caseOf: { [3] -> [ rcvr := receiver. selector := arguments first. args := arguments second. superclass := arguments third]. [4] -> ["mirror primitive" rcvr := arguments first. selector := arguments second. args := arguments third. superclass := arguments fourth] } otherwise: [^ self class primitiveFailTokenFor: #'bad argument']. args isArray ifFalse: [^ self class primitiveFailTokenFor: #'bad argument']. args size = selector numArgs ifFalse: [^ self class primitiveFailTokenFor: #'bad number of arguments']. ((self objectClass: rcvr) includesBehavior: superclass) ifFalse: [^ self class primitiveFailTokenFor: #'bad argument']. ^self send: selector to: rcvr with: args lookupIn: superclass].
"Mutex>>primitiveEnterCriticalSection Mutex>>primitiveTestAndSetOwnershipOfCriticalSection" (primitiveIndex = 186 or: [primitiveIndex = 187]) ifTrue: [| effective | effective := Processor activeProcess effectiveProcess. "active == effective" value := primitiveIndex = 186 ifTrue: [receiver primitiveEnterCriticalSectionOnBehalfOf: effective] ifFalse: [receiver primitiveTestAndSetOwnershipOfCriticalSectionOnBehalfOf: effective]. ^(self isPrimFailToken: value) ifTrue: [value] ifFalse: [self push: value]].
primitiveIndex = 188 ifTrue: "Object>>withArgs:executeMethod: CompiledMethod class>>receiver:withArguments:executeMethod: VMMirror>>ifFail:object:with:executeMethod: et al" [| n args methodArg thisReceiver | ((n := arguments size) between: 2 and: 4) ifFalse: [^self class primitiveFailTokenFor: #'unsupported operation']. ((self objectClass: (args := arguments at: n - 1)) == Array and: [(self objectClass: (methodArg := arguments at: n)) includesBehavior: CompiledMethod]) ifFalse: [^self class primitiveFailTokenFor: #'bad argument']. methodArg numArgs = args size ifFalse: [^self class primitiveFailTokenFor: #'bad number of arguments']. thisReceiver := arguments at: n - 2 ifAbsent: [receiver]. methodArg primitive > 0 ifTrue: [methodArg isQuick ifTrue: [^self push: (methodArg valueWithReceiver: thisReceiver arguments: args)]. ^self doPrimitive: methodArg primitive method: meth receiver: thisReceiver args: args]. ^Context sender: self receiver: thisReceiver method: methodArg arguments: args].
primitiveIndex = 118 ifTrue: "[receiver:]tryPrimitive:withArgs:; avoid recursing in the VM" [(arguments size = 3 and: [(self objectClass: arguments second) == SmallInteger and: [(self objectClass: arguments last) == Array]]) ifTrue: [^self doPrimitive: arguments second method: meth receiver: arguments first args: arguments last]. (arguments size = 2 and: [(self objectClass: arguments first) == SmallInteger and: [(self objectClass: arguments last) == Array]]) ifFalse: [^self class primitiveFailTokenFor: nil]. ^self doPrimitive: arguments first method: meth receiver: receiver args: arguments last].
value := primitiveIndex = 120 "FFI method" ifTrue: [(meth literalAt: 1) tryInvokeWithArguments: arguments] ifFalse: [primitiveIndex = 117 "named primitives" ifTrue: [self tryNamedPrimitiveIn: meth for: receiver withArgs: arguments] ifFalse: "should use self receiver: receiver tryPrimitive: primitiveIndex withArgs: arguments but this is only in later VMs (and appears to be broken)" [receiver tryPrimitive: primitiveIndex withArgs: arguments]].
^(self isPrimFailToken: value) ifTrue: [value] ifFalse: [self push: value]
invokeSimulationGuard <simulationGuard> "Nothing to see here, please move along!" ^ 42
testSimulationSideEffectWarningControl
| warning | [Context runSimulated: [[] fork]] on: SimulationSideEffectWarning do: [:ex | warning := ex]. self assert: warning notNil. self assert: warning isControlPrimitive. self assert: warning suppressed.
testSimulationSideEffectWarningGuard
| warning | [Context runSimulated: [self invokeSimulationGuard]] on: SimulationSideEffectWarning do: [:ex | warning := ex]. self assert: warning notNil. self assert: warning isSimulationGuard. self deny: warning suppressed.
testSimulationSideEffectWarningSuppress
self shouldnt: [(SimulationSideEffectWarning forPrimitive: 42 sender: thisContext) suppress; defaultAction] raise: UnhandledWarning; should: [(SimulationSideEffectWarning forPrimitive: 42 sender: thisContext) unsuppress; defaultAction] raise: UnhandledWarning.
activeController: aController "Set aController to be the currently active controller. Give the user control in it." <primitive: 19> "Simulation guard" *"Set aController to be the currently active controller. Give the user control in it." <simulationGuard>*
activeController := aController. (activeController == screenController) ifFalse: [self promote: activeController]. activeControllerProcess := [activeController startUp. self searchForActiveController] newProcess. activeControllerProcess priority: Processor userSchedulingPriority. activeControllerProcess resume
scheduleActive: aController "Make aController be scheduled as the active controller. Presumably the active scheduling process asked to schedule this controller and that a new process associated this controller takes control. So this is the last act of the active scheduling process." <primitive: 19> "Simulation guard" *"Make aController be scheduled as the active controller. Presumably the active scheduling process asked to schedule this controller and that a new process associated this controller takes control. So this is the last act of the active scheduling process." <simulationGuard>*
self scheduleActiveNoTerminate: aController. Processor terminateActive
handleLabelUpdatesIn: aBlock whenExecuting: aContext "Send the selected message in the accessed method, and regain control after the invoked method returns." ^aBlock on: Notification do: [:ex| (ex tag isArray and: [ex tag size = 2 and: [(ex tag first == aContext or: [ex tag first hasSender: aContext])]]) ifTrue: [self labelString: ex tag second description. ex resume] ifFalse: [ex pass]] *[ex pass]] on: SimulationSideEffectWarning do: [:ex | ex isControlPrimitive ifTrue: [ex unsuppress]. ex pass]*
simulationGuard "primitive 19 is a null primitive that always fails. Just a marker for the simulator." <pragmaParser>
self addPragma: (Pragma keyword: #primitive: arguments: #(19)). self advance. ^ true
isControlPrimitive "See StackInterpreter class>>#initializePrimitiveTable."
^ self primitive between: 80 and: 89
isSimulationGuard "See Parser >> #simulationGuard."
^ self primitive = 19
primitive
^ primitiveIndex
sender
^ sender
suppress
suppressed := true.
suppressed
^ suppressed ifNil: [self isSimulationGuard not]
unsuppress
suppressed := false.
primitive: anInteger sender: senderContext
primitiveIndex := anInteger. sender := senderContext.
messageText
^ messageText ifNil: [ 'The code being simulated is trying to control a process ({1}). {2}' translated format: { self sender method reference. self isSimulationGuard ifTrue: ['If you proceed, your image may become unusable. Continue at own risk, and better save your image before.' translated] ifFalse: ['Process controlling cannot be simulated. If you proceed, side effects may occur outside the observable area of the simulator.' translated]}]
defaultAction
^ self suppressed ifFalse: [super defaultAction]
forPrimitive: primitiveIndex sender: senderContext
^ self new primitive: primitiveIndex sender: senderContext
signalForPrimitive: primitiveIndex sender: senderContext
^ (self forPrimitive: primitiveIndex sender: senderContext) signal
('instance creation' forPrimitive:sender:) ('signaling' signalForPrimitive:sender:)
('testing' isControlPrimitive isSimulationGuard) ('accessing' primitive sender suppress suppressed unsuppress) ('initialize-release' primitive:sender:) ('printing' messageText) ('priv handling' defaultAction)
"Postscript: CHANGELOG*:
- Replace generic Warning in Context >> #doPrimitive:method:receiver:args: by specific warning of new class SimulationSideEffectWarning. - Also signal SimulationSideEffectWarning if primitive 87 (primitiveResume) is hit. - SimulationSideEffectWarning contains logic to detect the type (simulation guard/control primitive) of the side effect. It can also be suppressed or unsuppressed along the handler chain using the '*suppress*' selectors. Control primitive side effects are suppressed by default. - Add tests for the changes above. - In the debugger, unsuppress control primitive warnings. - Replace definitions of primitive 19 (currently only in ControlManager) by a named alias pragma, <simulationGuard>, which is implemented on Parser.
For more information, see: http://forum.world.st/The-Trunk-Kernel-nice-1386-mcz-td5128636.html
(* Sorry, this should be in the preamble, not in the postscript, I know, but the preamble editor in the ChangeSorter is currently broken. ¯_(?)_/¯) "
----- Carpe Squeak! -- Sent from: http://forum.world.st/Squeak-Dev-f45488.html
Hi all,
I have revised this changeset and still think that we should merge it into the Trunk before the release. Do you have any other critique or can I merge it? :-)
Best, Christoph
=============== Summary ===============
Change Set: SimulationSideEffectWarning Date: 9 May 2021 Author: Christoph Thiede
CHANGELOG:
- Replace generic Warning in Context >> #doPrimitive:method:receiver:args: by specific warning of new class SimulationSideEffectWarning. - Also signal SimulationSideEffectWarning if primitive 87 (primitiveResume) is hit. - SimulationSideEffectWarning contains logic to detect the type (simulation guard/control primitive) of the side effect. It can also be suppressed or unsuppressed along the handler chain using the '*suppress*' selectors. Control primitive side effects are suppressed by default. - Add tests for the changes above. - In the debugger, unsuppress control primitive warnings. - Replace definitions of primitive 19 (currently only in ControlManager) by a named alias pragma, <simulationGuard>, which is implemented on Parser. - In the Parser, add support for pragmaParsers without arguments.
For more information, see: http://forum.world.st/The-Trunk-Kernel-nice-1386-mcz-td5128636.html
=============== Postscript ===============
SimulationSideEffectWarning removeSelector: #sender
=============== Diff ===============
Context>>doPrimitive:method:receiver:args: {private} · ct 2/6/2022 20:15 (changed) doPrimitive: primitiveIndex method: meth receiver: receiver args: arguments "Simulate a primitive method whose index is primitiveIndex. The simulated receiver and arguments are given as arguments to this message. If successful, push result and return resuming context, else ^ {errCode, PrimitiveFailToken}. Any primitive which provokes execution needs to be intercepted and simulated to avoid execution running away."
| value | - "Judicious use of primitive 19 (a null primitive that doesn't do anything) prevents - the debugger from entering various run-away activities such as spawning a new - process, etc. Injudicious use results in the debugger not being able to debug - interesting code, such as the debugger itself. Hence use primitive 19 with care :-)" - "SystemNavigation new browseAllSelect: [:m| m primitive = 19]" - primitiveIndex = 19 ifTrue: [ - [self notify: ('The code being simulated is trying to control a process ({1}). Process controlling cannot be simulated. If you proceed, things may happen outside the observable area of the simulator.' translated format: {meth reference})] - ifCurtailed: [self push: nil "Cheap fix of the context's internal state"]]. + "Test for unsimulatable side effects (that is, code that will be triggered in the image outside of the simulator range). This includes simulation guards, which are traditionally flagged using primitive 19 (a null primitive that doesn't do anything), as well as certain control primitives that might trigger code on other processes. If a side effect is detected, raise a warning to give the user a chance to cancel the operation." + "#(19 87) do: [:primitive | self systemNavigation browseAllSelect: [:m | m primitive = primitive]]" + (primitiveIndex = 19 "simulationGuard" or: [primitiveIndex = 87 "primitiveResume"]) ifTrue: [ + [SimulationSideEffectWarning signalForPrimitive: primitiveIndex context: self] + ifCurtailed: [self push: nil "Cheap fix of the context's internal state. Note that unwinding the receiver -- so that the next step would invoke the primitive again -- would be challenging due to to the variety of senders to this method."]]. ((primitiveIndex between: 201 and: 222) and: [(self objectClass: receiver) includesBehavior: BlockClosure]) ifTrue: [(primitiveIndex = 206 or: [primitiveIndex = 208]) ifTrue: "[Full]BlockClosure>>valueWithArguments:" [^receiver simulateValueWithArguments: arguments first caller: self]. ((primitiveIndex between: 201 and: 209) "[Full]BlockClosure>>value[:value:...]" or: [primitiveIndex between: 221 and: 222]) ifTrue: "[Full]BlockClosure>>valueNoContextSwitch[:]" [^receiver simulateValueWithArguments: arguments caller: self]].
primitiveIndex = 83 ifTrue: "afr 9/11/1998 19:50" "Object>>perform:[with:...]" [| selector | selector := arguments at: 1 ifAbsent: [^ self class primitiveFailTokenFor: #'bad argument']. arguments size - 1 = selector numArgs ifFalse: [^ self class primitiveFailTokenFor: #'bad number of arguments']. ^self send: selector to: receiver with: arguments allButFirst]. primitiveIndex = 84 ifTrue: "afr 9/11/1998 19:50 & eem 8/18/2009 17:04" "Object>>perform:withArguments:" [| selector args | arguments size = 2 ifFalse: [^ self class primitiveFailTokenFor: #'bad argument']. selector := arguments first. args := arguments second. args isArray ifFalse: [^ self class primitiveFailTokenFor: #'bad argument']. args size = selector numArgs ifFalse: [^ self class primitiveFailTokenFor: #'bad number of arguments']. ^self send: selector to: receiver with: args]. primitiveIndex = 100 ifTrue: "eem 8/18/2009 16:57" "Object>>perform:withArguments:inSuperclass:" [| rcvr selector args superclass | arguments size caseOf: { [3] -> [ rcvr := receiver. selector := arguments first. args := arguments second. superclass := arguments third]. [4] -> ["mirror primitive" rcvr := arguments first. selector := arguments second. args := arguments third. superclass := arguments fourth] } otherwise: [^ self class primitiveFailTokenFor: #'bad argument']. args isArray ifFalse: [^ self class primitiveFailTokenFor: #'bad argument']. args size = selector numArgs ifFalse: [^ self class primitiveFailTokenFor: #'bad number of arguments']. ((self objectClass: rcvr) includesBehavior: superclass) ifFalse: [^ self class primitiveFailTokenFor: #'bad argument']. ^self send: selector to: rcvr with: args lookupIn: superclass].
"Mutex>>primitiveEnterCriticalSection Mutex>>primitiveTestAndSetOwnershipOfCriticalSection" (primitiveIndex = 186 or: [primitiveIndex = 187]) ifTrue: [| effective | effective := Processor activeProcess effectiveProcess. "active == effective" value := primitiveIndex = 186 ifTrue: [receiver primitiveEnterCriticalSectionOnBehalfOf: effective] ifFalse: [receiver primitiveTestAndSetOwnershipOfCriticalSectionOnBehalfOf: effective]. ^(self isPrimFailToken: value) ifTrue: [value] ifFalse: [self push: value]].
primitiveIndex = 188 ifTrue: "Object>>withArgs:executeMethod: CompiledMethod class>>receiver:withArguments:executeMethod: VMMirror>>ifFail:object:with:executeMethod: et al" [| n args methodArg thisReceiver | ((n := arguments size) between: 2 and: 4) ifFalse: [^self class primitiveFailTokenFor: #'unsupported operation']. ((self objectClass: (args := arguments at: n - 1)) == Array and: [(self objectClass: (methodArg := arguments at: n)) includesBehavior: CompiledMethod]) ifFalse: [^self class primitiveFailTokenFor: #'bad argument']. methodArg numArgs = args size ifFalse: [^self class primitiveFailTokenFor: #'bad number of arguments']. thisReceiver := arguments at: n - 2 ifAbsent: [receiver]. methodArg primitive > 0 ifTrue: [methodArg isQuick ifTrue: [^self push: (methodArg valueWithReceiver: thisReceiver arguments: args)]. ^self doPrimitive: methodArg primitive method: meth receiver: thisReceiver args: args]. ^self activateMethod: methodArg withArgs: args receiver: thisReceiver].
primitiveIndex = 118 ifTrue: "[receiver:]tryPrimitive:withArgs:; avoid recursing in the VM" [(arguments size = 3 and: [(self objectClass: arguments second) == SmallInteger and: [(self objectClass: arguments last) == Array]]) ifTrue: [^self doPrimitive: arguments second method: meth receiver: arguments first args: arguments last]. (arguments size = 2 and: [(self objectClass: arguments first) == SmallInteger and: [(self objectClass: arguments last) == Array]]) ifFalse: [^self class primitiveFailTokenFor: nil]. ^self doPrimitive: arguments first method: meth receiver: receiver args: arguments last].
value := primitiveIndex = 120 "FFI method" ifTrue: [(meth literalAt: 1) tryInvokeWithArguments: arguments] ifFalse: [primitiveIndex = 117 "named primitives" ifTrue: [self tryNamedPrimitiveIn: meth for: receiver withArgs: arguments] ifFalse: "should use self receiver: receiver tryPrimitive: primitiveIndex withArgs: arguments but this is only in later VMs (and appears to be broken)" [receiver tryPrimitive: primitiveIndex withArgs: arguments]].
^(self isPrimFailToken: value) ifTrue: [value] ifFalse: [self push: value]
ContextTest>>invokeSimulationGuard {private} · ct 2/6/2022 20:07 + invokeSimulationGuard + <simulationGuard> + "Nothing to see here, please move along!" + ^ 42
ContextTest>>testSimulationSideEffectWarningControl {tests} · ct 2/6/2022 20:07 + testSimulationSideEffectWarningControl + + self + should: [Context runSimulated: [[] fork]] + raise: SimulationSideEffectWarning + withExceptionDo: [:warning | + self assert: warning notNil. + self assert: warning isControlPrimitive. + self assert: warning suppressed].
ContextTest>>testSimulationSideEffectWarningGuard {tests} · ct 2/6/2022 20:07 + testSimulationSideEffectWarningGuard + + self + should: [Context runSimulated: + [self invokeSimulationGuard]] + raise: SimulationSideEffectWarning + withExceptionDo: [:warning | + self assert: warning notNil. + self assert: warning isSimulationGuard. + self deny: warning suppressed].
ContextTest>>testSimulationSideEffectWarningSuppress {tests} · ct 2/6/2022 20:05 + testSimulationSideEffectWarningSuppress + + self + shouldnt: [(SimulationSideEffectWarning forPrimitive: 42 context: thisContext) + suppress; + defaultAction] raise: UnhandledWarning; + should: [(SimulationSideEffectWarning forPrimitive: 42 context: thisContext) + unsuppress; + defaultAction] raise: UnhandledWarning.
ControlManager>>activeController: {accessing} · ct 2/6/2022 19:54 (changed) activeController: aController - "Set aController to be the currently active controller. Give the user - control in it." - <primitive: 19> "Simulation guard" + "Set aController to be the currently active controller. Give the user control in it." + <simulationGuard> + activeController := aController. (activeController == screenController) ifFalse: [self promote: activeController]. activeControllerProcess := [activeController startUp. self searchForActiveController] newProcess. activeControllerProcess priority: Processor userSchedulingPriority. activeControllerProcess resume
ControlManager>>scheduleActive: {scheduling} · ct 2/6/2022 19:50 (changed) scheduleActive: aController - "Make aController be scheduled as the active controller. Presumably the - active scheduling process asked to schedule this controller and that a - new process associated this controller takes control. So this is the last act - of the active scheduling process." - <primitive: 19> "Simulation guard" + "Make aController be scheduled as the active controller. Presumably the active scheduling process asked to schedule this controller and that a new process associated this controller takes control. So this is the last act of the active scheduling process." + <simulationGuard> + self scheduleActiveNoTerminate: aController. Processor terminateActive
Debugger>>handleLabelUpdatesIn:whenExecuting: {context stack menu} · ct 5/9/2021 20:13 (changed) handleLabelUpdatesIn: aBlock whenExecuting: aContext "Send the selected message in the accessed method, and regain control after the invoked method returns." ^aBlock on: Notification do: [:ex| (ex tag isArray and: [ex tag size = 2 and: [(ex tag first == aContext or: [ex tag first hasSender: aContext])]]) ifTrue: [self labelString: ex tag second description. ex resume] ifFalse: - [ex pass]] + [ex pass]] + on: SimulationSideEffectWarning + do: [:ex | + ex isControlPrimitive ifTrue: [ex unsuppress]. + ex pass]
Debugger>>send {context stack menu} · ct 2/6/2022 20:03 (changed) send "Send the selected message in the accessed method, and take control in the method invoked to allow further step or send."
+ | currentContext | self okToChange ifFalse: [^ self]. self checkContextSelection. - interruptedProcess step: self selectedContext. + currentContext := self selectedContext. + self + handleLabelUpdatesIn: [interruptedProcess step: currentContext] + whenExecuting: currentContext. self resetContext: interruptedProcess stepToSendOrReturn.
Parser>>pragmaStatement {pragmas} · ct 2/6/2022 19:52 (changed) pragmaStatement "Parse a pragma statement. The leading '<' has already been consumed. The 'here' token is the first one in the pragma. Use that token to dispatch to a custom pragma-parsing method if one can be found with a selector that matches it. Note that custom pragma parsers need to fulfill two requirements: - method selector must match the current token as simple getter, e.g., <apicall: ...> matches #apicall or <primitive: ...> matches #primitive - method must have pragma <pragmaParser> to be called." "0) Early exit" (hereType = #keyword or: [ hereType = #word or: [ hereType = #binary ] ]) ifFalse: [ ^ self expected: 'pragma declaration' ]. - + "1) Do not consider one-word pragmas such as <primitive> and <foobar>. Only keyword pragmas." - here last == $: ifTrue: [ - "2) Avoid interning new symbols for made-up pragmas such as #my for <my: 1 pragma: 2>." - (Symbol lookup: here allButLast) ifNotNil: [:parserSelector | + "2) Avoid interning new symbols for made-up pragmas such as #my for <my: 1 pragma: 2>." + (Symbol lookup: (here last == $: ifTrue: [here allButLast] ifFalse: [here])) + ifNotNil: [:parserSelector | Parser methodDict at: parserSelector ifPresent: [:parserMethod | "3) Only call methods that claim to be a custom pragma parser via <pragmaParser>." (parserMethod hasPragma: #pragmaParser) - ifTrue: [^ self executeMethod: parserMethod]]]]. - + ifTrue: [^ self executeMethod: parserMethod]]]. + "X) No custom pragma parser found. Use the default one." ^ self pragmaStatementKeywords
Parser>>simulationGuard {primitives} · ct 2/6/2022 20:09 + simulationGuard + "primitive 19 is a null primitive that always fails. Just a marker for the simulator for methods that are typically undebuggable and likely to crash your image." + <pragmaParser> + + self addPragma: (Pragma keyword: #primitive: arguments: #(19)). + + self advance. + ^ true
SimulationSideEffectWarning + Warning subclass: #SimulationSideEffectWarning + instanceVariableNames: 'primitiveIndex context suppressed' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel-Exceptions' + + SimulationSideEffectWarning class + instanceVariableNames: '' + + ""
SimulationSideEffectWarning class>>forPrimitive:context: {instance creation} · ct 2/6/2022 20:05 + forPrimitive: primitiveIndex context: topContext + + ^ self new primitive: primitiveIndex context: topContext
SimulationSideEffectWarning class>>signalForPrimitive:context: {signaling} · ct 2/6/2022 20:05 + signalForPrimitive: primitiveIndex context: topContext + + ^ (self forPrimitive: primitiveIndex context: topContext) signal
SimulationSideEffectWarning>>context {accessing} · ct 2/6/2022 20:04 + context + + ^ context
SimulationSideEffectWarning>>defaultAction {priv handling} · ct 5/9/2021 20:16 + defaultAction + + ^ self suppressed ifFalse: [super defaultAction]
SimulationSideEffectWarning>>isControlPrimitive {testing} · ct 5/9/2021 20:43 + isControlPrimitive + "See StackInterpreter class>>#initializePrimitiveTable." + + ^ self primitive between: 80 and: 89
SimulationSideEffectWarning>>isSimulationGuard {testing} · ct 5/9/2021 20:43 + isSimulationGuard + "See Parser >> #simulationGuard." + + ^ self primitive = 19
SimulationSideEffectWarning>>messageText {printing} · ct 2/6/2022 20:04 + messageText + + ^ messageText ifNil: [ + 'The code being simulated is trying to control a process ({1}). {2}' translated format: { + self context method reference. + self isSimulationGuard + ifTrue: ['If you proceed, your image may become unusable. Continue at own risk, and better save your image before.' translated] + ifFalse: ['Process controlling cannot be simulated. If you proceed, side effects may occur outside the observable area of the simulator.' translated]}]
SimulationSideEffectWarning>>primitive {accessing} · ct 5/2/2021 16:01 + primitive + + ^ primitiveIndex
SimulationSideEffectWarning>>primitive:context: {initialize-release} · ct 2/6/2022 20:04 + primitive: anInteger context: topContext + + primitiveIndex := anInteger. + context := topContext.
SimulationSideEffectWarning>>suppress {accessing} · ct 5/9/2021 20:14 + suppress + + suppressed := true.
SimulationSideEffectWarning>>suppressed {accessing} · ct 5/9/2021 20:14 + suppressed + + ^ suppressed ifNil: [self isSimulationGuard not]
SimulationSideEffectWarning>>unsuppress {accessing} · ct 5/9/2021 20:14 + unsuppress + + suppressed := false.
--- Sent from Squeak Inbox Talk
On 2021-05-09T14:17:06-05:00, christoph.thiede@student.hpi.uni-potsdam.de wrote:
It is extremely confusing that Nabble strips of the revision number of the changeset upon upload. :-)
Community service, here is the inlined diff:
"Change Set: SimulationSideEffectWarning Date: 9 May 2021 Author: Christoph Thiede
<your descriptive text goes here>"
Warning subclass: #SimulationSideEffectWarning instanceVariableNames: 'primitiveIndex sender suppressed' classVariableNames: '' poolDictionaries: '' category: 'Kernel-Exceptions'
I am signaled to notify the client of a simulation operation (i.e., a sender of Context) about potential side effects that might occur when resuming the simulation. See Context >> #doPrimitive:method:receiver:args:, #messageText, and Parser >> #simulationGuard for more information.
doPrimitive: primitiveIndex method: meth receiver: receiver args: arguments "Simulate a primitive method whose index is primitiveIndex. The simulated receiver and arguments are given as arguments to this message. If successful, push result and return resuming context, else ^ {errCode, PrimitiveFailToken}. Any primitive which provokes execution needs to be intercepted and simulated to avoid execution running away."
| value | "Judicious use of primitive 19 (a null primitive that doesn't do anything) prevents the debugger from entering various run-away activities such as spawning a new process, etc. Injudicious use results in the debugger not being able to debug interesting code, such as the debugger itself. Hence use primitive 19 with care :-)" "SystemNavigation new browseAllSelect: [:m| m primitive = 19]" primitiveIndex = 19 ifTrue: [ [self notify: ('The code being simulated is trying to control a process ({1}). Process controlling cannot be simulated. If you proceed, things may happen outside the observable area of the simulator.' translated format: {meth reference})] ifCurtailed: [self push: nil "Cheap fix of the context's internal state"]]. *"Test for unsimulatable side effects (that is, code that will be triggered in the image outside of the simulator range). This includes simulation guards, which are traditionally flagged using primitive 19 (a null primitive that doesn't do anything), as well as certain control primitives that might trigger code on other processes. If a side effect is detected, raise a warning to give the user a chance to cancel the operation." "#(19 87) do: [:primitive | self systemNavigation browseAllSelect: [:m | m primitive = primitive]]" (primitiveIndex = 19 "simulationGuard" or: [primitiveIndex = 87 "primitiveResume"]) ifTrue: [ [SimulationSideEffectWarning signalForPrimitive: primitiveIndex sender: self] ifCurtailed: [self push: nil "Cheap fix of the context's internal state. Note that unwinding the receiver -- so that the next step would invoke the primitive again -- would be challenging due to to the variety of senders to this method."]].* ((primitiveIndex between: 201 and: 222) and: [(self objectClass: receiver) includesBehavior: BlockClosure]) ifTrue: [(primitiveIndex = 206 or: [primitiveIndex = 208]) ifTrue: "[Full]BlockClosure>>valueWithArguments:" [^receiver simulateValueWithArguments: arguments first caller: self]. ((primitiveIndex between: 201 and: 209) "[Full]BlockClosure>>value[:value:...]" or: [primitiveIndex between: 221 and: 222]) ifTrue: "[Full]BlockClosure>>valueNoContextSwitch[:]" [^receiver simulateValueWithArguments: arguments caller: self]].
primitiveIndex = 83 ifTrue: "afr 9/11/1998 19:50" "Object>>perform:[with:...]" [| selector | selector := arguments at: 1 ifAbsent: [^ self class primitiveFailTokenFor: #'bad argument']. arguments size - 1 = selector numArgs ifFalse: [^ self class primitiveFailTokenFor: #'bad number of arguments']. ^self send: selector to: receiver with: arguments allButFirst]. primitiveIndex = 84 ifTrue: "afr 9/11/1998 19:50 & eem 8/18/2009 17:04" "Object>>perform:withArguments:" [| selector args | arguments size = 2 ifFalse: [^ self class primitiveFailTokenFor: #'bad argument']. selector := arguments first. args := arguments second. args isArray ifFalse: [^ self class primitiveFailTokenFor: #'bad argument']. args size = selector numArgs ifFalse: [^ self class primitiveFailTokenFor: #'bad number of arguments']. ^self send: selector to: receiver with: args]. primitiveIndex = 100 ifTrue: "eem 8/18/2009 16:57" "Object>>perform:withArguments:inSuperclass:" [| rcvr selector args superclass | arguments size caseOf: { [3] -> [ rcvr := receiver. selector := arguments first. args := arguments second. superclass := arguments third]. [4] -> ["mirror primitive" rcvr := arguments first. selector := arguments second. args := arguments third. superclass := arguments fourth] } otherwise: [^ self class primitiveFailTokenFor: #'bad argument']. args isArray ifFalse: [^ self class primitiveFailTokenFor: #'bad argument']. args size = selector numArgs ifFalse: [^ self class primitiveFailTokenFor: #'bad number of arguments']. ((self objectClass: rcvr) includesBehavior: superclass) ifFalse: [^ self class primitiveFailTokenFor: #'bad argument']. ^self send: selector to: rcvr with: args lookupIn: superclass].
"Mutex>>primitiveEnterCriticalSection Mutex>>primitiveTestAndSetOwnershipOfCriticalSection" (primitiveIndex = 186 or: [primitiveIndex = 187]) ifTrue: [| effective | effective := Processor activeProcess effectiveProcess. "active == effective" value := primitiveIndex = 186 ifTrue: [receiver primitiveEnterCriticalSectionOnBehalfOf: effective] ifFalse: [receiver primitiveTestAndSetOwnershipOfCriticalSectionOnBehalfOf: effective]. ^(self isPrimFailToken: value) ifTrue: [value] ifFalse: [self push: value]].
primitiveIndex = 188 ifTrue: "Object>>withArgs:executeMethod: CompiledMethod class>>receiver:withArguments:executeMethod: VMMirror>>ifFail:object:with:executeMethod: et al" [| n args methodArg thisReceiver | ((n := arguments size) between: 2 and: 4) ifFalse: [^self class primitiveFailTokenFor: #'unsupported operation']. ((self objectClass: (args := arguments at: n - 1)) == Array and: [(self objectClass: (methodArg := arguments at: n)) includesBehavior: CompiledMethod]) ifFalse: [^self class primitiveFailTokenFor: #'bad argument']. methodArg numArgs = args size ifFalse: [^self class primitiveFailTokenFor: #'bad number of arguments']. thisReceiver := arguments at: n - 2 ifAbsent: [receiver]. methodArg primitive > 0 ifTrue: [methodArg isQuick ifTrue: [^self push: (methodArg valueWithReceiver: thisReceiver arguments: args)]. ^self doPrimitive: methodArg primitive method: meth receiver: thisReceiver args: args]. ^Context sender: self receiver: thisReceiver method: methodArg arguments: args].
primitiveIndex = 118 ifTrue: "[receiver:]tryPrimitive:withArgs:; avoid recursing in the VM" [(arguments size = 3 and: [(self objectClass: arguments second) == SmallInteger and: [(self objectClass: arguments last) == Array]]) ifTrue: [^self doPrimitive: arguments second method: meth receiver: arguments first args: arguments last]. (arguments size = 2 and: [(self objectClass: arguments first) == SmallInteger and: [(self objectClass: arguments last) == Array]]) ifFalse: [^self class primitiveFailTokenFor: nil]. ^self doPrimitive: arguments first method: meth receiver: receiver args: arguments last].
value := primitiveIndex = 120 "FFI method" ifTrue: [(meth literalAt: 1) tryInvokeWithArguments: arguments] ifFalse: [primitiveIndex = 117 "named primitives" ifTrue: [self tryNamedPrimitiveIn: meth for: receiver withArgs: arguments] ifFalse: "should use self receiver: receiver tryPrimitive: primitiveIndex withArgs: arguments but this is only in later VMs (and appears to be broken)" [receiver tryPrimitive: primitiveIndex withArgs: arguments]].
^(self isPrimFailToken: value) ifTrue: [value] ifFalse: [self push: value]
invokeSimulationGuard <simulationGuard> "Nothing to see here, please move along!" ^ 42
testSimulationSideEffectWarningControl
| warning | [Context runSimulated: [[] fork]] on: SimulationSideEffectWarning do: [:ex | warning := ex]. self assert: warning notNil. self assert: warning isControlPrimitive. self assert: warning suppressed.
testSimulationSideEffectWarningGuard
| warning | [Context runSimulated: [self invokeSimulationGuard]] on: SimulationSideEffectWarning do: [:ex | warning := ex]. self assert: warning notNil. self assert: warning isSimulationGuard. self deny: warning suppressed.
testSimulationSideEffectWarningSuppress
self shouldnt: [(SimulationSideEffectWarning forPrimitive: 42 sender: thisContext) suppress; defaultAction] raise: UnhandledWarning; should: [(SimulationSideEffectWarning forPrimitive: 42 sender: thisContext) unsuppress; defaultAction] raise: UnhandledWarning.
activeController: aController "Set aController to be the currently active controller. Give the user control in it." <primitive: 19> "Simulation guard" *"Set aController to be the currently active controller. Give the user control in it." <simulationGuard>*
activeController := aController. (activeController == screenController) ifFalse: [self promote: activeController]. activeControllerProcess := [activeController startUp. self searchForActiveController] newProcess. activeControllerProcess priority: Processor userSchedulingPriority. activeControllerProcess resume
scheduleActive: aController "Make aController be scheduled as the active controller. Presumably the active scheduling process asked to schedule this controller and that a new process associated this controller takes control. So this is the last act of the active scheduling process." <primitive: 19> "Simulation guard" *"Make aController be scheduled as the active controller. Presumably the active scheduling process asked to schedule this controller and that a new process associated this controller takes control. So this is the last act of the active scheduling process." <simulationGuard>*
self scheduleActiveNoTerminate: aController. Processor terminateActive
handleLabelUpdatesIn: aBlock whenExecuting: aContext "Send the selected message in the accessed method, and regain control after the invoked method returns." ^aBlock on: Notification do: [:ex| (ex tag isArray and: [ex tag size = 2 and: [(ex tag first == aContext or: [ex tag first hasSender: aContext])]]) ifTrue: [self labelString: ex tag second description. ex resume] ifFalse: [ex pass]] *[ex pass]] on: SimulationSideEffectWarning do: [:ex | ex isControlPrimitive ifTrue: [ex unsuppress]. ex pass]*
simulationGuard "primitive 19 is a null primitive that always fails. Just a marker for the simulator." <pragmaParser>
self addPragma: (Pragma keyword: #primitive: arguments: #(19)). self advance. ^ true
isControlPrimitive "See StackInterpreter class>>#initializePrimitiveTable."
^ self primitive between: 80 and: 89
isSimulationGuard "See Parser >> #simulationGuard."
^ self primitive = 19
primitive
^ primitiveIndex
sender
^ sender
suppress
suppressed := true.
suppressed
^ suppressed ifNil: [self isSimulationGuard not]
unsuppress
suppressed := false.
primitive: anInteger sender: senderContext
primitiveIndex := anInteger. sender := senderContext.
messageText
^ messageText ifNil: [ 'The code being simulated is trying to control a process ({1}). {2}' translated format: { self sender method reference. self isSimulationGuard ifTrue: ['If you proceed, your image may become unusable. Continue at own risk, and better save your image before.' translated] ifFalse: ['Process controlling cannot be simulated. If you proceed, side effects may occur outside the observable area of the simulator.' translated]}]
defaultAction
^ self suppressed ifFalse: [super defaultAction]
forPrimitive: primitiveIndex sender: senderContext
^ self new primitive: primitiveIndex sender: senderContext
signalForPrimitive: primitiveIndex sender: senderContext
^ (self forPrimitive: primitiveIndex sender: senderContext) signal
('instance creation' forPrimitive:sender:) ('signaling' signalForPrimitive:sender:)
('testing' isControlPrimitive isSimulationGuard) ('accessing' primitive sender suppress suppressed unsuppress) ('initialize-release' primitive:sender:) ('printing' messageText) ('priv handling' defaultAction)
"Postscript: CHANGELOG*:
- Replace generic Warning in Context >>
#doPrimitive:method:receiver:args: by specific warning of new class SimulationSideEffectWarning.
- Also signal SimulationSideEffectWarning if primitive 87 (primitiveResume)
is hit.
- SimulationSideEffectWarning contains logic to detect the type (simulation
guard/control primitive) of the side effect. It can also be suppressed or unsuppressed along the handler chain using the '*suppress*' selectors. Control primitive side effects are suppressed by default.
- Add tests for the changes above.
- In the debugger, unsuppress control primitive warnings.
- Replace definitions of primitive 19 (currently only in ControlManager) by
a named alias pragma, <simulationGuard>, which is implemented on Parser.
For more information, see: http://forum.world.st/The-Trunk-Kernel-nice-1386-mcz-td5128636.html
(* Sorry, this should be in the preamble, not in the postscript, I know, but the preamble editor in the ChangeSorter is currently broken. ¯_(?)_/¯) "
Carpe Squeak!
Sent from: http://forum.world.st/Squeak-Dev-f45488.html
Hi all,
here is a newer revision of the changeset which gives the handler of the exception more information and control about the invocation of the primitives. See debugFork.cs for an example. :-)
Best, Christoph
=============== Summary ===============
Change Set: SimulationSideEffectWarning Date: 9 May 2021 Author: Christoph Thiede
CHANGELOG:
- Replace generic Warning in Context >> #doPrimitive:method:receiver:args: by specific warning of new class SimulationSideEffectWarning. - Also signal SimulationSideEffectWarning if primitive 87 (primitiveResume) is hit. - SimulationSideEffectWarning contains logic to detect the type (simulation guard/control primitive) of the side effect. It can also be suppressed or unsuppressed along the handler chain using the '*suppress*' selectors. Control primitive side effects are suppressed by default. It also provides access to the parameters of the primitive invocation. The primitive invocation can also be skipped. - Add tests for the changes above. - In the debugger, unsuppress control primitive warnings. - Replace definitions of primitive 19 (currently only in ControlManager) by a named alias pragma, <simulationGuard>, which is implemented on Parser. - In the Parser, add support for pragmaParsers without arguments.
For more information, see: http://forum.world.st/The-Trunk-Kernel-nice-1386-mcz-td5128636.html
=============== Postscript ===============
('testing' isControlPrimitive isSimulationGuard) ('accessing' arguments context method primitive suppress suppressed theReceiver unsuppress) ('initialize-release' context:method:receiver:arguments: primitive:) ('printing' messageText) ('priv handling' defaultAction) ('defaults' defaultResumeValue) ('handling' skipPrimitive) ('signaling' signalIfSkipped:)
=============== Diff ===============
Context>>doPrimitive:method:receiver:args: {private} · ct 2/6/2022 20:39 (changed) doPrimitive: primitiveIndex method: meth receiver: receiver args: arguments "Simulate a primitive method whose index is primitiveIndex. The simulated receiver and arguments are given as arguments to this message. If successful, push result and return resuming context, else ^ {errCode, PrimitiveFailToken}. Any primitive which provokes execution needs to be intercepted and simulated to avoid execution running away."
| value | - "Judicious use of primitive 19 (a null primitive that doesn't do anything) prevents - the debugger from entering various run-away activities such as spawning a new - process, etc. Injudicious use results in the debugger not being able to debug - interesting code, such as the debugger itself. Hence use primitive 19 with care :-)" - "SystemNavigation new browseAllSelect: [:m| m primitive = 19]" - primitiveIndex = 19 ifTrue: [ - [self notify: ('The code being simulated is trying to control a process ({1}). Process controlling cannot be simulated. If you proceed, things may happen outside the observable area of the simulator.' translated format: {meth reference})] - ifCurtailed: [self push: nil "Cheap fix of the context's internal state"]]. + "Test for unsimulatable side effects (that is, code that will be triggered in the image outside of the simulator range). This includes simulation guards, which are traditionally flagged using primitive 19 (a null primitive that doesn't do anything), as well as certain control primitives that might trigger code on other processes. If a side effect is detected, raise a warning to give the user a chance to cancel the operation." + "#(19 87) do: [:primitive | self systemNavigation browseAllSelect: [:m | m primitive = primitive]]" + (primitiveIndex = 19 "simulationGuard" or: [primitiveIndex = 87 "primitiveResume"]) ifTrue: + [[(SimulationSideEffectWarning forPrimitive: primitiveIndex) + context: self method: meth receiver: receiver arguments: arguments; + signalIfSkipped: [^ self]] + ifCurtailed: + [self push: receiver "Cheap fix of the context's internal state. Note that unwinding the receiver -- so that the next step would invoke the primitive again -- would be challenging due to to the variety of senders to this method."]]. ((primitiveIndex between: 201 and: 222) and: [(self objectClass: receiver) includesBehavior: BlockClosure]) ifTrue: [(primitiveIndex = 206 or: [primitiveIndex = 208]) ifTrue: "[Full]BlockClosure>>valueWithArguments:" [^receiver simulateValueWithArguments: arguments first caller: self]. ((primitiveIndex between: 201 and: 209) "[Full]BlockClosure>>value[:value:...]" or: [primitiveIndex between: 221 and: 222]) ifTrue: "[Full]BlockClosure>>valueNoContextSwitch[:]" [^receiver simulateValueWithArguments: arguments caller: self]].
primitiveIndex = 83 ifTrue: "afr 9/11/1998 19:50" "Object>>perform:[with:...]" [| selector | selector := arguments at: 1 ifAbsent: [^ self class primitiveFailTokenFor: #'bad argument']. arguments size - 1 = selector numArgs ifFalse: [^ self class primitiveFailTokenFor: #'bad number of arguments']. ^self send: selector to: receiver with: arguments allButFirst]. primitiveIndex = 84 ifTrue: "afr 9/11/1998 19:50 & eem 8/18/2009 17:04" "Object>>perform:withArguments:" [| selector args | arguments size = 2 ifFalse: [^ self class primitiveFailTokenFor: #'bad argument']. selector := arguments first. args := arguments second. args isArray ifFalse: [^ self class primitiveFailTokenFor: #'bad argument']. args size = selector numArgs ifFalse: [^ self class primitiveFailTokenFor: #'bad number of arguments']. ^self send: selector to: receiver with: args]. primitiveIndex = 100 ifTrue: "eem 8/18/2009 16:57" "Object>>perform:withArguments:inSuperclass:" [| rcvr selector args superclass | arguments size caseOf: { [3] -> [ rcvr := receiver. selector := arguments first. args := arguments second. superclass := arguments third]. [4] -> ["mirror primitive" rcvr := arguments first. selector := arguments second. args := arguments third. superclass := arguments fourth] } otherwise: [^ self class primitiveFailTokenFor: #'bad argument']. args isArray ifFalse: [^ self class primitiveFailTokenFor: #'bad argument']. args size = selector numArgs ifFalse: [^ self class primitiveFailTokenFor: #'bad number of arguments']. ((self objectClass: rcvr) includesBehavior: superclass) ifFalse: [^ self class primitiveFailTokenFor: #'bad argument']. ^self send: selector to: rcvr with: args lookupIn: superclass].
"Mutex>>primitiveEnterCriticalSection Mutex>>primitiveTestAndSetOwnershipOfCriticalSection" (primitiveIndex = 186 or: [primitiveIndex = 187]) ifTrue: [| effective | effective := Processor activeProcess effectiveProcess. "active == effective" value := primitiveIndex = 186 ifTrue: [receiver primitiveEnterCriticalSectionOnBehalfOf: effective] ifFalse: [receiver primitiveTestAndSetOwnershipOfCriticalSectionOnBehalfOf: effective]. ^(self isPrimFailToken: value) ifTrue: [value] ifFalse: [self push: value]].
primitiveIndex = 188 ifTrue: "Object>>withArgs:executeMethod: CompiledMethod class>>receiver:withArguments:executeMethod: VMMirror>>ifFail:object:with:executeMethod: et al" [| n args methodArg thisReceiver | ((n := arguments size) between: 2 and: 4) ifFalse: [^self class primitiveFailTokenFor: #'unsupported operation']. ((self objectClass: (args := arguments at: n - 1)) == Array and: [(self objectClass: (methodArg := arguments at: n)) includesBehavior: CompiledMethod]) ifFalse: [^self class primitiveFailTokenFor: #'bad argument']. methodArg numArgs = args size ifFalse: [^self class primitiveFailTokenFor: #'bad number of arguments']. thisReceiver := arguments at: n - 2 ifAbsent: [receiver]. methodArg primitive > 0 ifTrue: [methodArg isQuick ifTrue: [^self push: (methodArg valueWithReceiver: thisReceiver arguments: args)]. ^self doPrimitive: methodArg primitive method: meth receiver: thisReceiver args: args]. ^self activateMethod: methodArg withArgs: args receiver: thisReceiver].
primitiveIndex = 118 ifTrue: "[receiver:]tryPrimitive:withArgs:; avoid recursing in the VM" [(arguments size = 3 and: [(self objectClass: arguments second) == SmallInteger and: [(self objectClass: arguments last) == Array]]) ifTrue: [^self doPrimitive: arguments second method: meth receiver: arguments first args: arguments last]. (arguments size = 2 and: [(self objectClass: arguments first) == SmallInteger and: [(self objectClass: arguments last) == Array]]) ifFalse: [^self class primitiveFailTokenFor: nil]. ^self doPrimitive: arguments first method: meth receiver: receiver args: arguments last].
value := primitiveIndex = 120 "FFI method" ifTrue: [(meth literalAt: 1) tryInvokeWithArguments: arguments] ifFalse: [primitiveIndex = 117 "named primitives" ifTrue: [self tryNamedPrimitiveIn: meth for: receiver withArgs: arguments] ifFalse: "should use self receiver: receiver tryPrimitive: primitiveIndex withArgs: arguments but this is only in later VMs (and appears to be broken)" [receiver tryPrimitive: primitiveIndex withArgs: arguments]].
^(self isPrimFailToken: value) ifTrue: [value] ifFalse: [self push: value]
ContextTest>>invokeSimulationGuard {private} · ct 2/6/2022 20:07 + invokeSimulationGuard + <simulationGuard> + "Nothing to see here, please move along!" + ^ 42
ContextTest>>testSimulationSideEffectWarningControl {tests} · ct 2/6/2022 20:07 + testSimulationSideEffectWarningControl + + self + should: [Context runSimulated: [[] fork]] + raise: SimulationSideEffectWarning + withExceptionDo: [:warning | + self assert: warning notNil. + self assert: warning isControlPrimitive. + self assert: warning suppressed].
ContextTest>>testSimulationSideEffectWarningGuard {tests} · ct 2/6/2022 20:07 + testSimulationSideEffectWarningGuard + + self + should: [Context runSimulated: + [self invokeSimulationGuard]] + raise: SimulationSideEffectWarning + withExceptionDo: [:warning | + self assert: warning notNil. + self assert: warning isSimulationGuard. + self deny: warning suppressed].
ContextTest>>testSimulationSideEffectWarningSkip {tests} · ct 2/6/2022 20:48 + testSimulationSideEffectWarningSkip + + self + should: + [[(SimulationSideEffectWarning forPrimitive: 42) + unsuppress; + signalIfSkipped: [self fail]. + true] + on: SimulationSideEffectWarning do: [:ex | ex resume]]. + + [ + [:exit | + [(SimulationSideEffectWarning forPrimitive: 42) + unsuppress; + signalIfSkipped: [exit value]. + self fail] + on: SimulationSideEffectWarning do: [:ex | ex skipPrimitive]] + valueWithExit].
ContextTest>>testSimulationSideEffectWarningSuppress {tests} · ct 2/6/2022 20:24 + testSimulationSideEffectWarningSuppress + + self + shouldnt: [(SimulationSideEffectWarning forPrimitive: 42) + suppress; + defaultAction] raise: UnhandledWarning; + should: [(SimulationSideEffectWarning forPrimitive: 42) + unsuppress; + defaultAction] raise: UnhandledWarning.
ControlManager>>activeController: {accessing} · ct 2/6/2022 19:54 (changed) activeController: aController - "Set aController to be the currently active controller. Give the user - control in it." - <primitive: 19> "Simulation guard" + "Set aController to be the currently active controller. Give the user control in it." + <simulationGuard> + activeController := aController. (activeController == screenController) ifFalse: [self promote: activeController]. activeControllerProcess := [activeController startUp. self searchForActiveController] newProcess. activeControllerProcess priority: Processor userSchedulingPriority. activeControllerProcess resume
ControlManager>>scheduleActive: {scheduling} · ct 2/6/2022 19:50 (changed) scheduleActive: aController - "Make aController be scheduled as the active controller. Presumably the - active scheduling process asked to schedule this controller and that a - new process associated this controller takes control. So this is the last act - of the active scheduling process." - <primitive: 19> "Simulation guard" + "Make aController be scheduled as the active controller. Presumably the active scheduling process asked to schedule this controller and that a new process associated this controller takes control. So this is the last act of the active scheduling process." + <simulationGuard> + self scheduleActiveNoTerminate: aController. Processor terminateActive
Debugger>>handleLabelUpdatesIn:whenExecuting: {context stack menu} · ct 5/9/2021 20:13 (changed) handleLabelUpdatesIn: aBlock whenExecuting: aContext "Send the selected message in the accessed method, and regain control after the invoked method returns." ^aBlock on: Notification do: [:ex| (ex tag isArray and: [ex tag size = 2 and: [(ex tag first == aContext or: [ex tag first hasSender: aContext])]]) ifTrue: [self labelString: ex tag second description. ex resume] ifFalse: - [ex pass]] + [ex pass]] + on: SimulationSideEffectWarning + do: [:ex | + ex isControlPrimitive ifTrue: [ex unsuppress]. + ex pass]
Debugger>>send {context stack menu} · ct 2/6/2022 20:03 (changed) send "Send the selected message in the accessed method, and take control in the method invoked to allow further step or send."
+ | currentContext | self okToChange ifFalse: [^ self]. self checkContextSelection. - interruptedProcess step: self selectedContext. + currentContext := self selectedContext. + self + handleLabelUpdatesIn: [interruptedProcess step: currentContext] + whenExecuting: currentContext. self resetContext: interruptedProcess stepToSendOrReturn.
Parser>>pragmaStatement {pragmas} · ct 2/6/2022 19:52 (changed) pragmaStatement "Parse a pragma statement. The leading '<' has already been consumed. The 'here' token is the first one in the pragma. Use that token to dispatch to a custom pragma-parsing method if one can be found with a selector that matches it. Note that custom pragma parsers need to fulfill two requirements: - method selector must match the current token as simple getter, e.g., <apicall: ...> matches #apicall or <primitive: ...> matches #primitive - method must have pragma <pragmaParser> to be called." "0) Early exit" (hereType = #keyword or: [ hereType = #word or: [ hereType = #binary ] ]) ifFalse: [ ^ self expected: 'pragma declaration' ]. - + "1) Do not consider one-word pragmas such as <primitive> and <foobar>. Only keyword pragmas." - here last == $: ifTrue: [ - "2) Avoid interning new symbols for made-up pragmas such as #my for <my: 1 pragma: 2>." - (Symbol lookup: here allButLast) ifNotNil: [:parserSelector | + "2) Avoid interning new symbols for made-up pragmas such as #my for <my: 1 pragma: 2>." + (Symbol lookup: (here last == $: ifTrue: [here allButLast] ifFalse: [here])) + ifNotNil: [:parserSelector | Parser methodDict at: parserSelector ifPresent: [:parserMethod | "3) Only call methods that claim to be a custom pragma parser via <pragmaParser>." (parserMethod hasPragma: #pragmaParser) - ifTrue: [^ self executeMethod: parserMethod]]]]. - + ifTrue: [^ self executeMethod: parserMethod]]]. + "X) No custom pragma parser found. Use the default one." ^ self pragmaStatementKeywords
Parser>>simulationGuard {primitives} · ct 2/6/2022 20:09 + simulationGuard + "primitive 19 is a null primitive that always fails. Just a marker for the simulator for methods that are typically undebuggable and likely to crash your image." + <pragmaParser> + + self addPragma: (Pragma keyword: #primitive: arguments: #(19)). + + self advance. + ^ true
SimulationSideEffectWarning + Warning subclass: #SimulationSideEffectWarning + instanceVariableNames: 'primitiveIndex context method receiver arguments suppressed' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel-Exceptions' + + SimulationSideEffectWarning class + instanceVariableNames: '' + + ""
SimulationSideEffectWarning class>>forPrimitive: {instance creation} · ct 2/6/2022 20:22 + forPrimitive: primitiveIndex + + ^ self new primitive: primitiveIndex
SimulationSideEffectWarning>>arguments {accessing} · ct 2/6/2022 20:32 + arguments + + ^ arguments
SimulationSideEffectWarning>>context {accessing} · ct 2/6/2022 20:04 + context + + ^ context
SimulationSideEffectWarning>>context:method:receiver:arguments: {initialize-release} · ct 2/6/2022 20:24 + context: aContext method: aCompiledMethod receiver: rcvr arguments: args + + context := aContext. + method := aCompiledMethod. + receiver := rcvr. + arguments := args.
SimulationSideEffectWarning>>defaultAction {priv handling} · ct 5/9/2021 20:16 + defaultAction + + ^ self suppressed ifFalse: [super defaultAction]
SimulationSideEffectWarning>>defaultResumeValue {defaults} · ct 2/6/2022 20:34 + defaultResumeValue + + ^ true
SimulationSideEffectWarning>>isControlPrimitive {testing} · ct 5/9/2021 20:43 + isControlPrimitive + "See StackInterpreter class>>#initializePrimitiveTable." + + ^ self primitive between: 80 and: 89
SimulationSideEffectWarning>>isSimulationGuard {testing} · ct 5/9/2021 20:43 + isSimulationGuard + "See Parser >> #simulationGuard." + + ^ self primitive = 19
SimulationSideEffectWarning>>messageText {printing} · ct 2/6/2022 20:04 + messageText + + ^ messageText ifNil: [ + 'The code being simulated is trying to control a process ({1}). {2}' translated format: { + self context method reference. + self isSimulationGuard + ifTrue: ['If you proceed, your image may become unusable. Continue at own risk, and better save your image before.' translated] + ifFalse: ['Process controlling cannot be simulated. If you proceed, side effects may occur outside the observable area of the simulator.' translated]}]
SimulationSideEffectWarning>>method {accessing} · ct 2/6/2022 20:32 + method + + ^ method
SimulationSideEffectWarning>>primitive {accessing} · ct 5/2/2021 16:01 + primitive + + ^ primitiveIndex
SimulationSideEffectWarning>>primitive: {initialize-release} · ct 2/6/2022 20:23 + primitive: anInteger + + primitiveIndex := anInteger.
SimulationSideEffectWarning>>signalIfSkipped: {signaling} · ct 2/6/2022 20:38 + signalIfSkipped: skipBlock + + ^ self signal ifFalse: skipBlock
SimulationSideEffectWarning>>skipPrimitive {handling} · ct 2/6/2022 20:37 + skipPrimitive + + ^ self resume: false
SimulationSideEffectWarning>>suppress {accessing} · ct 5/9/2021 20:14 + suppress + + suppressed := true.
SimulationSideEffectWarning>>suppressed {accessing} · ct 5/9/2021 20:14 + suppressed + + ^ suppressed ifNil: [self isSimulationGuard not]
SimulationSideEffectWarning>>theReceiver {accessing} · ct 2/6/2022 20:33 + theReceiver + + ^ receiver
SimulationSideEffectWarning>>unsuppress {accessing} · ct 5/9/2021 20:14 + unsuppress + + suppressed := false.
--- Sent from Squeak Inbox Talk
On 2022-02-06T20:17:27+01:00, christoph.thiede@student.hpi.uni-potsdam.de wrote:
Hi all,
I have revised this changeset and still think that we should merge it into the Trunk before the release. Do you have any other critique or can I merge it? :-)
Best, Christoph
=============== Summary ===============
Change Set: SimulationSideEffectWarning Date: 9 May 2021 Author: Christoph Thiede
CHANGELOG:
- Replace generic Warning in Context >> #doPrimitive:method:receiver:args: by specific warning of new class SimulationSideEffectWarning.
- Also signal SimulationSideEffectWarning if primitive 87 (primitiveResume) is hit.
- SimulationSideEffectWarning contains logic to detect the type (simulation guard/control primitive) of the side effect. It can also be suppressed or unsuppressed along the handler chain using the '*suppress*' selectors. Control primitive side effects are suppressed by default.
- Add tests for the changes above.
- In the debugger, unsuppress control primitive warnings.
- Replace definitions of primitive 19 (currently only in ControlManager) by a named alias pragma, <simulationGuard>, which is implemented on Parser.
- In the Parser, add support for pragmaParsers without arguments.
For more information, see: http://forum.world.st/The-Trunk-Kernel-nice-1386-mcz-td5128636.html
=============== Postscript ===============
SimulationSideEffectWarning removeSelector: #sender
=============== Diff ===============
Context>>doPrimitive:method:receiver:args: {private} ? ct 2/6/2022 20:15 (changed) doPrimitive: primitiveIndex method: meth receiver: receiver args: arguments "Simulate a primitive method whose index is primitiveIndex. The simulated receiver and arguments are given as arguments to this message. If successful, push result and return resuming context, else ^ {errCode, PrimitiveFailToken}. Any primitive which provokes execution needs to be intercepted and simulated to avoid execution running away."
| value |
- "Judicious use of primitive 19 (a null primitive that doesn't do anything) prevents
- the debugger from entering various run-away activities such as spawning a new
- process, etc. Injudicious use results in the debugger not being able to debug
- interesting code, such as the debugger itself. Hence use primitive 19 with care :-)"
- "SystemNavigation new browseAllSelect: [:m| m primitive = 19]"
- primitiveIndex = 19 ifTrue: [
- [self notify: ('The code being simulated is trying to control a process ({1}). Process controlling cannot be simulated. If you proceed, things may happen outside the observable area of the simulator.' translated format: {meth reference})]
- ifCurtailed: [self push: nil "Cheap fix of the context's internal state"]].
- "Test for unsimulatable side effects (that is, code that will be triggered in the image outside of the simulator range). This includes simulation guards, which are traditionally flagged using primitive 19 (a null primitive that doesn't do anything), as well as certain control primitives that might trigger code on other processes. If a side effect is detected, raise a warning to give the user a chance to cancel the operation."
- "#(19 87) do: [:primitive | self systemNavigation browseAllSelect: [:m | m primitive = primitive]]"
- (primitiveIndex = 19 "simulationGuard" or: [primitiveIndex = 87 "primitiveResume"]) ifTrue: [
- [SimulationSideEffectWarning signalForPrimitive: primitiveIndex context: self]
- ifCurtailed: [self push: nil "Cheap fix of the context's internal state. Note that unwinding the receiver -- so that the next step would invoke the primitive again -- would be challenging due to to the variety of senders to this method."]].
((primitiveIndex between: 201 and: 222) and: [(self objectClass: receiver) includesBehavior: BlockClosure]) ifTrue: [(primitiveIndex = 206 or: [primitiveIndex = 208]) ifTrue: "[Full]BlockClosure>>valueWithArguments:" [^receiver simulateValueWithArguments: arguments first caller: self]. ((primitiveIndex between: 201 and: 209) "[Full]BlockClosure>>value[:value:...]" or: [primitiveIndex between: 221 and: 222]) ifTrue: "[Full]BlockClosure>>valueNoContextSwitch[:]" [^receiver simulateValueWithArguments: arguments caller: self]].
primitiveIndex = 83 ifTrue: "afr 9/11/1998 19:50" "Object>>perform:[with:...]" [| selector | selector := arguments at: 1 ifAbsent: [^ self class primitiveFailTokenFor: #'bad argument']. arguments size - 1 = selector numArgs ifFalse: [^ self class primitiveFailTokenFor: #'bad number of arguments']. ^self send: selector to: receiver with: arguments allButFirst]. primitiveIndex = 84 ifTrue: "afr 9/11/1998 19:50 & eem 8/18/2009 17:04" "Object>>perform:withArguments:" [| selector args | arguments size = 2 ifFalse: [^ self class primitiveFailTokenFor: #'bad argument']. selector := arguments first. args := arguments second. args isArray ifFalse: [^ self class primitiveFailTokenFor: #'bad argument']. args size = selector numArgs ifFalse: [^ self class primitiveFailTokenFor: #'bad number of arguments']. ^self send: selector to: receiver with: args]. primitiveIndex = 100 ifTrue: "eem 8/18/2009 16:57" "Object>>perform:withArguments:inSuperclass:" [| rcvr selector args superclass | arguments size caseOf: { [3] -> [ rcvr := receiver. selector := arguments first. args := arguments second. superclass := arguments third]. [4] -> ["mirror primitive" rcvr := arguments first. selector := arguments second. args := arguments third. superclass := arguments fourth] } otherwise: [^ self class primitiveFailTokenFor: #'bad argument']. args isArray ifFalse: [^ self class primitiveFailTokenFor: #'bad argument']. args size = selector numArgs ifFalse: [^ self class primitiveFailTokenFor: #'bad number of arguments']. ((self objectClass: rcvr) includesBehavior: superclass) ifFalse: [^ self class primitiveFailTokenFor: #'bad argument']. ^self send: selector to: rcvr with: args lookupIn: superclass].
"Mutex>>primitiveEnterCriticalSection Mutex>>primitiveTestAndSetOwnershipOfCriticalSection" (primitiveIndex = 186 or: [primitiveIndex = 187]) ifTrue: [| effective | effective := Processor activeProcess effectiveProcess. "active == effective" value := primitiveIndex = 186 ifTrue: [receiver primitiveEnterCriticalSectionOnBehalfOf: effective] ifFalse: [receiver primitiveTestAndSetOwnershipOfCriticalSectionOnBehalfOf: effective]. ^(self isPrimFailToken: value) ifTrue: [value] ifFalse: [self push: value]].
primitiveIndex = 188 ifTrue: "Object>>withArgs:executeMethod: CompiledMethod class>>receiver:withArguments:executeMethod: VMMirror>>ifFail:object:with:executeMethod: et al" [| n args methodArg thisReceiver | ((n := arguments size) between: 2 and: 4) ifFalse: [^self class primitiveFailTokenFor: #'unsupported operation']. ((self objectClass: (args := arguments at: n - 1)) == Array and: [(self objectClass: (methodArg := arguments at: n)) includesBehavior: CompiledMethod]) ifFalse: [^self class primitiveFailTokenFor: #'bad argument']. methodArg numArgs = args size ifFalse: [^self class primitiveFailTokenFor: #'bad number of arguments']. thisReceiver := arguments at: n - 2 ifAbsent: [receiver]. methodArg primitive > 0 ifTrue: [methodArg isQuick ifTrue: [^self push: (methodArg valueWithReceiver: thisReceiver arguments: args)]. ^self doPrimitive: methodArg primitive method: meth receiver: thisReceiver args: args]. ^self activateMethod: methodArg withArgs: args receiver: thisReceiver].
primitiveIndex = 118 ifTrue: "[receiver:]tryPrimitive:withArgs:; avoid recursing in the VM" [(arguments size = 3 and: [(self objectClass: arguments second) == SmallInteger and: [(self objectClass: arguments last) == Array]]) ifTrue: [^self doPrimitive: arguments second method: meth receiver: arguments first args: arguments last]. (arguments size = 2 and: [(self objectClass: arguments first) == SmallInteger and: [(self objectClass: arguments last) == Array]]) ifFalse: [^self class primitiveFailTokenFor: nil]. ^self doPrimitive: arguments first method: meth receiver: receiver args: arguments last].
value := primitiveIndex = 120 "FFI method" ifTrue: [(meth literalAt: 1) tryInvokeWithArguments: arguments] ifFalse: [primitiveIndex = 117 "named primitives" ifTrue: [self tryNamedPrimitiveIn: meth for: receiver withArgs: arguments] ifFalse: "should use self receiver: receiver tryPrimitive: primitiveIndex withArgs: arguments but this is only in later VMs (and appears to be broken)" [receiver tryPrimitive: primitiveIndex withArgs: arguments]].
^(self isPrimFailToken: value) ifTrue: [value] ifFalse: [self push: value]
ContextTest>>invokeSimulationGuard {private} ? ct 2/6/2022 20:07
- invokeSimulationGuard
- <simulationGuard>
- "Nothing to see here, please move along!"
- ^ 42
ContextTest>>testSimulationSideEffectWarningControl {tests} ? ct 2/6/2022 20:07
- testSimulationSideEffectWarningControl
- self
- should: [Context runSimulated: [[] fork]]
- raise: SimulationSideEffectWarning
- withExceptionDo: [:warning |
- self assert: warning notNil.
- self assert: warning isControlPrimitive.
- self assert: warning suppressed].
ContextTest>>testSimulationSideEffectWarningGuard {tests} ? ct 2/6/2022 20:07
- testSimulationSideEffectWarningGuard
- self
- should: [Context runSimulated:
- [self invokeSimulationGuard]]
- raise: SimulationSideEffectWarning
- withExceptionDo: [:warning |
- self assert: warning notNil.
- self assert: warning isSimulationGuard.
- self deny: warning suppressed].
ContextTest>>testSimulationSideEffectWarningSuppress {tests} ? ct 2/6/2022 20:05
- testSimulationSideEffectWarningSuppress
- self
- shouldnt: [(SimulationSideEffectWarning forPrimitive: 42 context: thisContext)
- suppress;
- defaultAction] raise: UnhandledWarning;
- should: [(SimulationSideEffectWarning forPrimitive: 42 context: thisContext)
- unsuppress;
- defaultAction] raise: UnhandledWarning.
ControlManager>>activeController: {accessing} ? ct 2/6/2022 19:54 (changed) activeController: aController
- "Set aController to be the currently active controller. Give the user
- control in it."
- <primitive: 19> "Simulation guard"
- "Set aController to be the currently active controller. Give the user control in it."
- <simulationGuard>
activeController := aController. (activeController == screenController) ifFalse: [self promote: activeController]. activeControllerProcess := [activeController startUp. self searchForActiveController] newProcess. activeControllerProcess priority: Processor userSchedulingPriority. activeControllerProcess resume
ControlManager>>scheduleActive: {scheduling} ? ct 2/6/2022 19:50 (changed) scheduleActive: aController
- "Make aController be scheduled as the active controller. Presumably the
- active scheduling process asked to schedule this controller and that a
- new process associated this controller takes control. So this is the last act
- of the active scheduling process."
- <primitive: 19> "Simulation guard"
- "Make aController be scheduled as the active controller. Presumably the active scheduling process asked to schedule this controller and that a new process associated this controller takes control. So this is the last act of the active scheduling process."
- <simulationGuard>
self scheduleActiveNoTerminate: aController. Processor terminateActive
Debugger>>handleLabelUpdatesIn:whenExecuting: {context stack menu} ? ct 5/9/2021 20:13 (changed) handleLabelUpdatesIn: aBlock whenExecuting: aContext "Send the selected message in the accessed method, and regain control after the invoked method returns." ^aBlock on: Notification do: [:ex| (ex tag isArray and: [ex tag size = 2 and: [(ex tag first == aContext or: [ex tag first hasSender: aContext])]]) ifTrue: [self labelString: ex tag second description. ex resume] ifFalse:
- [ex pass]]
- [ex pass]]
- on: SimulationSideEffectWarning
- do: [:ex |
- ex isControlPrimitive ifTrue: [ex unsuppress].
- ex pass]
Debugger>>send {context stack menu} ? ct 2/6/2022 20:03 (changed) send "Send the selected message in the accessed method, and take control in the method invoked to allow further step or send."
- | currentContext |
self okToChange ifFalse: [^ self]. self checkContextSelection.
- interruptedProcess step: self selectedContext.
- currentContext := self selectedContext.
- self
- handleLabelUpdatesIn: [interruptedProcess step: currentContext]
- whenExecuting: currentContext.
self resetContext: interruptedProcess stepToSendOrReturn.
Parser>>pragmaStatement {pragmas} ? ct 2/6/2022 19:52 (changed) pragmaStatement "Parse a pragma statement. The leading '<' has already been consumed. The 'here' token is the first one in the pragma. Use that token to dispatch to a custom pragma-parsing method if one can be found with a selector that matches it. Note that custom pragma parsers need to fulfill two requirements: - method selector must match the current token as simple getter, e.g., <apicall: ...> matches #apicall or <primitive: ...> matches #primitive - method must have pragma <pragmaParser> to be called." "0) Early exit" (hereType = #keyword or: [ hereType = #word or: [ hereType = #binary ] ]) ifFalse: [ ^ self expected: 'pragma declaration' ].
"1) Do not consider one-word pragmas such as <primitive> and <foobar>. Only keyword pragmas."
- here last == $: ifTrue: [
- "2) Avoid interning new symbols for made-up pragmas such as #my for <my: 1 pragma: 2>."
- (Symbol lookup: here allButLast) ifNotNil: [:parserSelector |
- "2) Avoid interning new symbols for made-up pragmas such as #my for <my: 1 pragma: 2>."
- (Symbol lookup: (here last == $: ifTrue: [here allButLast] ifFalse: [here]))
- ifNotNil: [:parserSelector |
Parser methodDict at: parserSelector ifPresent: [:parserMethod | "3) Only call methods that claim to be a custom pragma parser via <pragmaParser>." (parserMethod hasPragma: #pragmaParser)
- ifTrue: [^ self executeMethod: parserMethod]]]].
- ifTrue: [^ self executeMethod: parserMethod]]].
"X) No custom pragma parser found. Use the default one." ^ self pragmaStatementKeywords
Parser>>simulationGuard {primitives} ? ct 2/6/2022 20:09
- simulationGuard
- "primitive 19 is a null primitive that always fails. Just a marker for the simulator for methods that are typically undebuggable and likely to crash your image."
- <pragmaParser>
- self addPragma: (Pragma keyword: #primitive: arguments: #(19)).
- self advance.
- ^ true
SimulationSideEffectWarning
- Warning subclass: #SimulationSideEffectWarning
- instanceVariableNames: 'primitiveIndex context suppressed'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Kernel-Exceptions'
- SimulationSideEffectWarning class
- instanceVariableNames: ''
- ""
SimulationSideEffectWarning class>>forPrimitive:context: {instance creation} ? ct 2/6/2022 20:05
- forPrimitive: primitiveIndex context: topContext
- ^ self new primitive: primitiveIndex context: topContext
SimulationSideEffectWarning class>>signalForPrimitive:context: {signaling} ? ct 2/6/2022 20:05
- signalForPrimitive: primitiveIndex context: topContext
- ^ (self forPrimitive: primitiveIndex context: topContext) signal
SimulationSideEffectWarning>>context {accessing} ? ct 2/6/2022 20:04
- context
- ^ context
SimulationSideEffectWarning>>defaultAction {priv handling} ? ct 5/9/2021 20:16
- defaultAction
- ^ self suppressed ifFalse: [super defaultAction]
SimulationSideEffectWarning>>isControlPrimitive {testing} ? ct 5/9/2021 20:43
- isControlPrimitive
- "See StackInterpreter class>>#initializePrimitiveTable."
- ^ self primitive between: 80 and: 89
SimulationSideEffectWarning>>isSimulationGuard {testing} ? ct 5/9/2021 20:43
- isSimulationGuard
- "See Parser >> #simulationGuard."
- ^ self primitive = 19
SimulationSideEffectWarning>>messageText {printing} ? ct 2/6/2022 20:04
- messageText
- ^ messageText ifNil: [
- 'The code being simulated is trying to control a process ({1}). {2}' translated format: {
- self context method reference.
- self isSimulationGuard
- ifTrue: ['If you proceed, your image may become unusable. Continue at own risk, and better save your image before.' translated]
- ifFalse: ['Process controlling cannot be simulated. If you proceed, side effects may occur outside the observable area of the simulator.' translated]}]
SimulationSideEffectWarning>>primitive {accessing} ? ct 5/2/2021 16:01
- primitive
- ^ primitiveIndex
SimulationSideEffectWarning>>primitive:context: {initialize-release} ? ct 2/6/2022 20:04
- primitive: anInteger context: topContext
- primitiveIndex := anInteger.
- context := topContext.
SimulationSideEffectWarning>>suppress {accessing} ? ct 5/9/2021 20:14
- suppress
- suppressed := true.
SimulationSideEffectWarning>>suppressed {accessing} ? ct 5/9/2021 20:14
- suppressed
- ^ suppressed ifNil: [self isSimulationGuard not]
SimulationSideEffectWarning>>unsuppress {accessing} ? ct 5/9/2021 20:14
- unsuppress
- suppressed := false.
Sent from Squeak Inbox Talk
On 2021-05-09T14:17:06-05:00, christoph.thiede at student.hpi.uni-potsdam.de wrote:
It is extremely confusing that Nabble strips of the revision number of the changeset upon upload. :-)
Community service, here is the inlined diff:
"Change Set: SimulationSideEffectWarning Date: 9 May 2021 Author: Christoph Thiede
<your descriptive text goes here>"
Warning subclass: #SimulationSideEffectWarning instanceVariableNames: 'primitiveIndex sender suppressed' classVariableNames: '' poolDictionaries: '' category: 'Kernel-Exceptions'
I am signaled to notify the client of a simulation operation (i.e., a sender of Context) about potential side effects that might occur when resuming the simulation. See Context >> #doPrimitive:method:receiver:args:, #messageText, and Parser >> #simulationGuard for more information.
doPrimitive: primitiveIndex method: meth receiver: receiver args: arguments "Simulate a primitive method whose index is primitiveIndex. The simulated receiver and arguments are given as arguments to this message. If successful, push result and return resuming context, else ^ {errCode, PrimitiveFailToken}. Any primitive which provokes execution needs to be intercepted and simulated to avoid execution running away."
| value | "Judicious use of primitive 19 (a null primitive that doesn't do anything) prevents the debugger from entering various run-away activities such as spawning a new process, etc. Injudicious use results in the debugger not being able to debug interesting code, such as the debugger itself. Hence use primitive 19 with care :-)" "SystemNavigation new browseAllSelect: [:m| m primitive = 19]" primitiveIndex = 19 ifTrue: [ [self notify: ('The code being simulated is trying to control a process ({1}). Process controlling cannot be simulated. If you proceed, things may happen outside the observable area of the simulator.' translated format: {meth reference})] ifCurtailed: [self push: nil "Cheap fix of the context's internal state"]]. *"Test for unsimulatable side effects (that is, code that will be triggered in the image outside of the simulator range). This includes simulation guards, which are traditionally flagged using primitive 19 (a null primitive that doesn't do anything), as well as certain control primitives that might trigger code on other processes. If a side effect is detected, raise a warning to give the user a chance to cancel the operation." "#(19 87) do: [:primitive | self systemNavigation browseAllSelect: [:m | m primitive = primitive]]" (primitiveIndex = 19 "simulationGuard" or: [primitiveIndex = 87 "primitiveResume"]) ifTrue: [ [SimulationSideEffectWarning signalForPrimitive: primitiveIndex sender: self] ifCurtailed: [self push: nil "Cheap fix of the context's internal state. Note that unwinding the receiver -- so that the next step would invoke the primitive again -- would be challenging due to to the variety of senders to this method."]].* ((primitiveIndex between: 201 and: 222) and: [(self objectClass: receiver) includesBehavior: BlockClosure]) ifTrue: [(primitiveIndex = 206 or: [primitiveIndex = 208]) ifTrue: "[Full]BlockClosure>>valueWithArguments:" [^receiver simulateValueWithArguments: arguments first caller: self]. ((primitiveIndex between: 201 and: 209) "[Full]BlockClosure>>value[:value:...]" or: [primitiveIndex between: 221 and: 222]) ifTrue: "[Full]BlockClosure>>valueNoContextSwitch[:]" [^receiver simulateValueWithArguments: arguments caller: self]].
primitiveIndex = 83 ifTrue: "afr 9/11/1998 19:50" "Object>>perform:[with:...]" [| selector | selector := arguments at: 1 ifAbsent: [^ self class primitiveFailTokenFor: #'bad argument']. arguments size - 1 = selector numArgs ifFalse: [^ self class primitiveFailTokenFor: #'bad number of arguments']. ^self send: selector to: receiver with: arguments allButFirst]. primitiveIndex = 84 ifTrue: "afr 9/11/1998 19:50 & eem 8/18/2009 17:04" "Object>>perform:withArguments:" [| selector args | arguments size = 2 ifFalse: [^ self class primitiveFailTokenFor: #'bad argument']. selector := arguments first. args := arguments second. args isArray ifFalse: [^ self class primitiveFailTokenFor: #'bad argument']. args size = selector numArgs ifFalse: [^ self class primitiveFailTokenFor: #'bad number of arguments']. ^self send: selector to: receiver with: args]. primitiveIndex = 100 ifTrue: "eem 8/18/2009 16:57" "Object>>perform:withArguments:inSuperclass:" [| rcvr selector args superclass | arguments size caseOf: { [3] -> [ rcvr := receiver. selector := arguments first. args := arguments second. superclass := arguments third]. [4] -> ["mirror primitive" rcvr := arguments first. selector := arguments second. args := arguments third. superclass := arguments fourth] } otherwise: [^ self class primitiveFailTokenFor: #'bad argument']. args isArray ifFalse: [^ self class primitiveFailTokenFor: #'bad argument']. args size = selector numArgs ifFalse: [^ self class primitiveFailTokenFor: #'bad number of arguments']. ((self objectClass: rcvr) includesBehavior: superclass) ifFalse: [^ self class primitiveFailTokenFor: #'bad argument']. ^self send: selector to: rcvr with: args lookupIn: superclass].
"Mutex>>primitiveEnterCriticalSection Mutex>>primitiveTestAndSetOwnershipOfCriticalSection" (primitiveIndex = 186 or: [primitiveIndex = 187]) ifTrue: [| effective | effective := Processor activeProcess effectiveProcess. "active == effective" value := primitiveIndex = 186 ifTrue: [receiver primitiveEnterCriticalSectionOnBehalfOf: effective] ifFalse: [receiver primitiveTestAndSetOwnershipOfCriticalSectionOnBehalfOf: effective]. ^(self isPrimFailToken: value) ifTrue: [value] ifFalse: [self push: value]].
primitiveIndex = 188 ifTrue: "Object>>withArgs:executeMethod: CompiledMethod class>>receiver:withArguments:executeMethod: VMMirror>>ifFail:object:with:executeMethod: et al" [| n args methodArg thisReceiver | ((n := arguments size) between: 2 and: 4) ifFalse: [^self class primitiveFailTokenFor: #'unsupported operation']. ((self objectClass: (args := arguments at: n - 1)) == Array and: [(self objectClass: (methodArg := arguments at: n)) includesBehavior: CompiledMethod]) ifFalse: [^self class primitiveFailTokenFor: #'bad argument']. methodArg numArgs = args size ifFalse: [^self class primitiveFailTokenFor: #'bad number of arguments']. thisReceiver := arguments at: n - 2 ifAbsent: [receiver]. methodArg primitive > 0 ifTrue: [methodArg isQuick ifTrue: [^self push: (methodArg valueWithReceiver: thisReceiver arguments: args)]. ^self doPrimitive: methodArg primitive method: meth receiver: thisReceiver args: args]. ^Context sender: self receiver: thisReceiver method: methodArg arguments: args].
primitiveIndex = 118 ifTrue: "[receiver:]tryPrimitive:withArgs:; avoid recursing in the VM" [(arguments size = 3 and: [(self objectClass: arguments second) == SmallInteger and: [(self objectClass: arguments last) == Array]]) ifTrue: [^self doPrimitive: arguments second method: meth receiver: arguments first args: arguments last]. (arguments size = 2 and: [(self objectClass: arguments first) == SmallInteger and: [(self objectClass: arguments last) == Array]]) ifFalse: [^self class primitiveFailTokenFor: nil]. ^self doPrimitive: arguments first method: meth receiver: receiver args: arguments last].
value := primitiveIndex = 120 "FFI method" ifTrue: [(meth literalAt: 1) tryInvokeWithArguments: arguments] ifFalse: [primitiveIndex = 117 "named primitives" ifTrue: [self tryNamedPrimitiveIn: meth for: receiver withArgs: arguments] ifFalse: "should use self receiver: receiver tryPrimitive: primitiveIndex withArgs: arguments but this is only in later VMs (and appears to be broken)" [receiver tryPrimitive: primitiveIndex withArgs: arguments]].
^(self isPrimFailToken: value) ifTrue: [value] ifFalse: [self push: value]
invokeSimulationGuard <simulationGuard> "Nothing to see here, please move along!" ^ 42
testSimulationSideEffectWarningControl
| warning | [Context runSimulated: [[] fork]] on: SimulationSideEffectWarning do: [:ex | warning := ex]. self assert: warning notNil. self assert: warning isControlPrimitive. self assert: warning suppressed.
testSimulationSideEffectWarningGuard
| warning | [Context runSimulated: [self invokeSimulationGuard]] on: SimulationSideEffectWarning do: [:ex | warning := ex]. self assert: warning notNil. self assert: warning isSimulationGuard. self deny: warning suppressed.
testSimulationSideEffectWarningSuppress
self shouldnt: [(SimulationSideEffectWarning forPrimitive: 42 sender: thisContext) suppress; defaultAction] raise: UnhandledWarning; should: [(SimulationSideEffectWarning forPrimitive: 42 sender: thisContext) unsuppress; defaultAction] raise: UnhandledWarning.
activeController: aController "Set aController to be the currently active controller. Give the user control in it." <primitive: 19> "Simulation guard" *"Set aController to be the currently active controller. Give the user control in it." <simulationGuard>*
activeController := aController. (activeController == screenController) ifFalse: [self promote: activeController]. activeControllerProcess := [activeController startUp. self searchForActiveController] newProcess. activeControllerProcess priority: Processor userSchedulingPriority. activeControllerProcess resume
scheduleActive: aController "Make aController be scheduled as the active controller. Presumably the active scheduling process asked to schedule this controller and that a new process associated this controller takes control. So this is the last act of the active scheduling process." <primitive: 19> "Simulation guard" *"Make aController be scheduled as the active controller. Presumably the active scheduling process asked to schedule this controller and that a new process associated this controller takes control. So this is the last act of the active scheduling process." <simulationGuard>*
self scheduleActiveNoTerminate: aController. Processor terminateActive
handleLabelUpdatesIn: aBlock whenExecuting: aContext "Send the selected message in the accessed method, and regain control after the invoked method returns." ^aBlock on: Notification do: [:ex| (ex tag isArray and: [ex tag size = 2 and: [(ex tag first == aContext or: [ex tag first hasSender: aContext])]]) ifTrue: [self labelString: ex tag second description. ex resume] ifFalse: [ex pass]] *[ex pass]] on: SimulationSideEffectWarning do: [:ex | ex isControlPrimitive ifTrue: [ex unsuppress]. ex pass]*
simulationGuard "primitive 19 is a null primitive that always fails. Just a marker for the simulator." <pragmaParser>
self addPragma: (Pragma keyword: #primitive: arguments: #(19)). self advance. ^ true
isControlPrimitive "See StackInterpreter class>>#initializePrimitiveTable."
^ self primitive between: 80 and: 89
isSimulationGuard "See Parser >> #simulationGuard."
^ self primitive = 19
primitive
^ primitiveIndex
sender
^ sender
suppress
suppressed := true.
suppressed
^ suppressed ifNil: [self isSimulationGuard not]
unsuppress
suppressed := false.
primitive: anInteger sender: senderContext
primitiveIndex := anInteger. sender := senderContext.
messageText
^ messageText ifNil: [ 'The code being simulated is trying to control a process ({1}). {2}' translated format: { self sender method reference. self isSimulationGuard ifTrue: ['If you proceed, your image may become unusable. Continue at own risk, and better save your image before.' translated] ifFalse: ['Process controlling cannot be simulated. If you proceed, side effects may occur outside the observable area of the simulator.' translated]}]
defaultAction
^ self suppressed ifFalse: [super defaultAction]
forPrimitive: primitiveIndex sender: senderContext
^ self new primitive: primitiveIndex sender: senderContext
signalForPrimitive: primitiveIndex sender: senderContext
^ (self forPrimitive: primitiveIndex sender: senderContext) signal
('instance creation' forPrimitive:sender:) ('signaling' signalForPrimitive:sender:)
('testing' isControlPrimitive isSimulationGuard) ('accessing' primitive sender suppress suppressed unsuppress) ('initialize-release' primitive:sender:) ('printing' messageText) ('priv handling' defaultAction)
"Postscript: CHANGELOG*:
- Replace generic Warning in Context >>
#doPrimitive:method:receiver:args: by specific warning of new class SimulationSideEffectWarning.
- Also signal SimulationSideEffectWarning if primitive 87 (primitiveResume)
is hit.
- SimulationSideEffectWarning contains logic to detect the type (simulation
guard/control primitive) of the side effect. It can also be suppressed or unsuppressed along the handler chain using the '*suppress*' selectors. Control primitive side effects are suppressed by default.
- Add tests for the changes above.
- In the debugger, unsuppress control primitive warnings.
- Replace definitions of primitive 19 (currently only in ControlManager) by
a named alias pragma, <simulationGuard>, which is implemented on Parser.
For more information, see: http://forum.world.st/The-Trunk-Kernel-nice-1386-mcz-td5128636.html
(* Sorry, this should be in the preamble, not in the postscript, I know, but the preamble editor in the ChangeSorter is currently broken. ¯_(?)_/¯) "
Carpe Squeak!
Sent from: http://forum.world.st/Squeak-Dev-f45488.html
Hi all,
merged via Compiler-ct.497 & Kernel-ct.1559 et al. Note that currently, all SimulationSideEffectWarnings are suppressed by default except for simulation guards to maximize compatibility. The debugger is the only simulation client which already activates warnings for control primitives, e.g., when stepping through [self halt] fork. :-)
Best, Christoph
--- Sent from Squeak Inbox Talk
On 2022-02-06T21:02:15+01:00, christoph.thiede@student.hpi.uni-potsdam.de wrote:
Hi all,
here is a newer revision of the changeset which gives the handler of the exception more information and control about the invocation of the primitives. See debugFork.cs for an example. :-)
Best, Christoph
=============== Summary ===============
Change Set: SimulationSideEffectWarning Date: 9 May 2021 Author: Christoph Thiede
CHANGELOG:
- Replace generic Warning in Context >> #doPrimitive:method:receiver:args: by specific warning of new class SimulationSideEffectWarning.
- Also signal SimulationSideEffectWarning if primitive 87 (primitiveResume) is hit.
- SimulationSideEffectWarning contains logic to detect the type (simulation guard/control primitive) of the side effect. It can also be suppressed or unsuppressed along the handler chain using the '*suppress*' selectors. Control primitive side effects are suppressed by default. It also provides access to the parameters of the primitive invocation. The primitive invocation can also be skipped.
- Add tests for the changes above.
- In the debugger, unsuppress control primitive warnings.
- Replace definitions of primitive 19 (currently only in ControlManager) by a named alias pragma, <simulationGuard>, which is implemented on Parser.
- In the Parser, add support for pragmaParsers without arguments.
For more information, see: http://forum.world.st/The-Trunk-Kernel-nice-1386-mcz-td5128636.html
=============== Postscript ===============
('testing' isControlPrimitive isSimulationGuard) ('accessing' arguments context method primitive suppress suppressed theReceiver unsuppress) ('initialize-release' context:method:receiver:arguments: primitive:) ('printing' messageText) ('priv handling' defaultAction) ('defaults' defaultResumeValue) ('handling' skipPrimitive) ('signaling' signalIfSkipped:)
=============== Diff ===============
Context>>doPrimitive:method:receiver:args: {private} � ct 2/6/2022 20:39 (changed) doPrimitive: primitiveIndex method: meth receiver: receiver args: arguments "Simulate a primitive method whose index is primitiveIndex. The simulated receiver and arguments are given as arguments to this message. If successful, push result and return resuming context, else ^ {errCode, PrimitiveFailToken}. Any primitive which provokes execution needs to be intercepted and simulated to avoid execution running away."
| value |
- "Judicious use of primitive 19 (a null primitive that doesn't do anything) prevents
- the debugger from entering various run-away activities such as spawning a new
- process, etc. Injudicious use results in the debugger not being able to debug
- interesting code, such as the debugger itself. Hence use primitive 19 with care :-)"
- "SystemNavigation new browseAllSelect: [:m| m primitive = 19]"
- primitiveIndex = 19 ifTrue: [
- [self notify: ('The code being simulated is trying to control a process ({1}). Process controlling cannot be simulated. If you proceed, things may happen outside the observable area of the simulator.' translated format: {meth reference})]
- ifCurtailed: [self push: nil "Cheap fix of the context's internal state"]].
- "Test for unsimulatable side effects (that is, code that will be triggered in the image outside of the simulator range). This includes simulation guards, which are traditionally flagged using primitive 19 (a null primitive that doesn't do anything), as well as certain control primitives that might trigger code on other processes. If a side effect is detected, raise a warning to give the user a chance to cancel the operation."
- "#(19 87) do: [:primitive | self systemNavigation browseAllSelect: [:m | m primitive = primitive]]"
- (primitiveIndex = 19 "simulationGuard" or: [primitiveIndex = 87 "primitiveResume"]) ifTrue:
- [[(SimulationSideEffectWarning forPrimitive: primitiveIndex)
- context: self method: meth receiver: receiver arguments: arguments;
- signalIfSkipped: [^ self]]
- ifCurtailed:
- [self push: receiver "Cheap fix of the context's internal state. Note that unwinding the receiver -- so that the next step would invoke the primitive again -- would be challenging due to to the variety of senders to this method."]].
((primitiveIndex between: 201 and: 222) and: [(self objectClass: receiver) includesBehavior: BlockClosure]) ifTrue: [(primitiveIndex = 206 or: [primitiveIndex = 208]) ifTrue: "[Full]BlockClosure>>valueWithArguments:" [^receiver simulateValueWithArguments: arguments first caller: self]. ((primitiveIndex between: 201 and: 209) "[Full]BlockClosure>>value[:value:...]" or: [primitiveIndex between: 221 and: 222]) ifTrue: "[Full]BlockClosure>>valueNoContextSwitch[:]" [^receiver simulateValueWithArguments: arguments caller: self]].
primitiveIndex = 83 ifTrue: "afr 9/11/1998 19:50" "Object>>perform:[with:...]" [| selector | selector := arguments at: 1 ifAbsent: [^ self class primitiveFailTokenFor: #'bad argument']. arguments size - 1 = selector numArgs ifFalse: [^ self class primitiveFailTokenFor: #'bad number of arguments']. ^self send: selector to: receiver with: arguments allButFirst]. primitiveIndex = 84 ifTrue: "afr 9/11/1998 19:50 & eem 8/18/2009 17:04" "Object>>perform:withArguments:" [| selector args | arguments size = 2 ifFalse: [^ self class primitiveFailTokenFor: #'bad argument']. selector := arguments first. args := arguments second. args isArray ifFalse: [^ self class primitiveFailTokenFor: #'bad argument']. args size = selector numArgs ifFalse: [^ self class primitiveFailTokenFor: #'bad number of arguments']. ^self send: selector to: receiver with: args]. primitiveIndex = 100 ifTrue: "eem 8/18/2009 16:57" "Object>>perform:withArguments:inSuperclass:" [| rcvr selector args superclass | arguments size caseOf: { [3] -> [ rcvr := receiver. selector := arguments first. args := arguments second. superclass := arguments third]. [4] -> ["mirror primitive" rcvr := arguments first. selector := arguments second. args := arguments third. superclass := arguments fourth] } otherwise: [^ self class primitiveFailTokenFor: #'bad argument']. args isArray ifFalse: [^ self class primitiveFailTokenFor: #'bad argument']. args size = selector numArgs ifFalse: [^ self class primitiveFailTokenFor: #'bad number of arguments']. ((self objectClass: rcvr) includesBehavior: superclass) ifFalse: [^ self class primitiveFailTokenFor: #'bad argument']. ^self send: selector to: rcvr with: args lookupIn: superclass].
"Mutex>>primitiveEnterCriticalSection Mutex>>primitiveTestAndSetOwnershipOfCriticalSection" (primitiveIndex = 186 or: [primitiveIndex = 187]) ifTrue: [| effective | effective := Processor activeProcess effectiveProcess. "active == effective" value := primitiveIndex = 186 ifTrue: [receiver primitiveEnterCriticalSectionOnBehalfOf: effective] ifFalse: [receiver primitiveTestAndSetOwnershipOfCriticalSectionOnBehalfOf: effective]. ^(self isPrimFailToken: value) ifTrue: [value] ifFalse: [self push: value]].
primitiveIndex = 188 ifTrue: "Object>>withArgs:executeMethod: CompiledMethod class>>receiver:withArguments:executeMethod: VMMirror>>ifFail:object:with:executeMethod: et al" [| n args methodArg thisReceiver | ((n := arguments size) between: 2 and: 4) ifFalse: [^self class primitiveFailTokenFor: #'unsupported operation']. ((self objectClass: (args := arguments at: n - 1)) == Array and: [(self objectClass: (methodArg := arguments at: n)) includesBehavior: CompiledMethod]) ifFalse: [^self class primitiveFailTokenFor: #'bad argument']. methodArg numArgs = args size ifFalse: [^self class primitiveFailTokenFor: #'bad number of arguments']. thisReceiver := arguments at: n - 2 ifAbsent: [receiver]. methodArg primitive > 0 ifTrue: [methodArg isQuick ifTrue: [^self push: (methodArg valueWithReceiver: thisReceiver arguments: args)]. ^self doPrimitive: methodArg primitive method: meth receiver: thisReceiver args: args]. ^self activateMethod: methodArg withArgs: args receiver: thisReceiver].
primitiveIndex = 118 ifTrue: "[receiver:]tryPrimitive:withArgs:; avoid recursing in the VM" [(arguments size = 3 and: [(self objectClass: arguments second) == SmallInteger and: [(self objectClass: arguments last) == Array]]) ifTrue: [^self doPrimitive: arguments second method: meth receiver: arguments first args: arguments last]. (arguments size = 2 and: [(self objectClass: arguments first) == SmallInteger and: [(self objectClass: arguments last) == Array]]) ifFalse: [^self class primitiveFailTokenFor: nil]. ^self doPrimitive: arguments first method: meth receiver: receiver args: arguments last].
value := primitiveIndex = 120 "FFI method" ifTrue: [(meth literalAt: 1) tryInvokeWithArguments: arguments] ifFalse: [primitiveIndex = 117 "named primitives" ifTrue: [self tryNamedPrimitiveIn: meth for: receiver withArgs: arguments] ifFalse: "should use self receiver: receiver tryPrimitive: primitiveIndex withArgs: arguments but this is only in later VMs (and appears to be broken)" [receiver tryPrimitive: primitiveIndex withArgs: arguments]].
^(self isPrimFailToken: value) ifTrue: [value] ifFalse: [self push: value]
ContextTest>>invokeSimulationGuard {private} � ct 2/6/2022 20:07
- invokeSimulationGuard
- <simulationGuard>
- "Nothing to see here, please move along!"
- ^ 42
ContextTest>>testSimulationSideEffectWarningControl {tests} � ct 2/6/2022 20:07
- testSimulationSideEffectWarningControl
- self
- should: [Context runSimulated: [[] fork]]
- raise: SimulationSideEffectWarning
- withExceptionDo: [:warning |
- self assert: warning notNil.
- self assert: warning isControlPrimitive.
- self assert: warning suppressed].
ContextTest>>testSimulationSideEffectWarningGuard {tests} � ct 2/6/2022 20:07
- testSimulationSideEffectWarningGuard
- self
- should: [Context runSimulated:
- [self invokeSimulationGuard]]
- raise: SimulationSideEffectWarning
- withExceptionDo: [:warning |
- self assert: warning notNil.
- self assert: warning isSimulationGuard.
- self deny: warning suppressed].
ContextTest>>testSimulationSideEffectWarningSkip {tests} � ct 2/6/2022 20:48
- testSimulationSideEffectWarningSkip
- self
- should:
- [[(SimulationSideEffectWarning forPrimitive: 42)
- unsuppress;
- signalIfSkipped: [self fail].
- true]
- on: SimulationSideEffectWarning do: [:ex | ex resume]].
- [
- [:exit |
- [(SimulationSideEffectWarning forPrimitive: 42)
- unsuppress;
- signalIfSkipped: [exit value].
- self fail]
- on: SimulationSideEffectWarning do: [:ex | ex skipPrimitive]]
- valueWithExit].
ContextTest>>testSimulationSideEffectWarningSuppress {tests} � ct 2/6/2022 20:24
- testSimulationSideEffectWarningSuppress
- self
- shouldnt: [(SimulationSideEffectWarning forPrimitive: 42)
- suppress;
- defaultAction] raise: UnhandledWarning;
- should: [(SimulationSideEffectWarning forPrimitive: 42)
- unsuppress;
- defaultAction] raise: UnhandledWarning.
ControlManager>>activeController: {accessing} � ct 2/6/2022 19:54 (changed) activeController: aController
- "Set aController to be the currently active controller. Give the user
- control in it."
- <primitive: 19> "Simulation guard"
- "Set aController to be the currently active controller. Give the user control in it."
- <simulationGuard>
activeController := aController. (activeController == screenController) ifFalse: [self promote: activeController]. activeControllerProcess := [activeController startUp. self searchForActiveController] newProcess. activeControllerProcess priority: Processor userSchedulingPriority. activeControllerProcess resume
ControlManager>>scheduleActive: {scheduling} � ct 2/6/2022 19:50 (changed) scheduleActive: aController
- "Make aController be scheduled as the active controller. Presumably the
- active scheduling process asked to schedule this controller and that a
- new process associated this controller takes control. So this is the last act
- of the active scheduling process."
- <primitive: 19> "Simulation guard"
- "Make aController be scheduled as the active controller. Presumably the active scheduling process asked to schedule this controller and that a new process associated this controller takes control. So this is the last act of the active scheduling process."
- <simulationGuard>
self scheduleActiveNoTerminate: aController. Processor terminateActive
Debugger>>handleLabelUpdatesIn:whenExecuting: {context stack menu} � ct 5/9/2021 20:13 (changed) handleLabelUpdatesIn: aBlock whenExecuting: aContext "Send the selected message in the accessed method, and regain control after the invoked method returns." ^aBlock on: Notification do: [:ex| (ex tag isArray and: [ex tag size = 2 and: [(ex tag first == aContext or: [ex tag first hasSender: aContext])]]) ifTrue: [self labelString: ex tag second description. ex resume] ifFalse:
- [ex pass]]
- [ex pass]]
- on: SimulationSideEffectWarning
- do: [:ex |
- ex isControlPrimitive ifTrue: [ex unsuppress].
- ex pass]
Debugger>>send {context stack menu} � ct 2/6/2022 20:03 (changed) send "Send the selected message in the accessed method, and take control in the method invoked to allow further step or send."
- | currentContext |
self okToChange ifFalse: [^ self]. self checkContextSelection.
- interruptedProcess step: self selectedContext.
- currentContext := self selectedContext.
- self
- handleLabelUpdatesIn: [interruptedProcess step: currentContext]
- whenExecuting: currentContext.
self resetContext: interruptedProcess stepToSendOrReturn.
Parser>>pragmaStatement {pragmas} � ct 2/6/2022 19:52 (changed) pragmaStatement "Parse a pragma statement. The leading '<' has already been consumed. The 'here' token is the first one in the pragma. Use that token to dispatch to a custom pragma-parsing method if one can be found with a selector that matches it. Note that custom pragma parsers need to fulfill two requirements: - method selector must match the current token as simple getter, e.g., <apicall: ...> matches #apicall or <primitive: ...> matches #primitive - method must have pragma <pragmaParser> to be called." "0) Early exit" (hereType = #keyword or: [ hereType = #word or: [ hereType = #binary ] ]) ifFalse: [ ^ self expected: 'pragma declaration' ].
"1) Do not consider one-word pragmas such as <primitive> and <foobar>. Only keyword pragmas."
- here last == $: ifTrue: [
- "2) Avoid interning new symbols for made-up pragmas such as #my for <my: 1 pragma: 2>."
- (Symbol lookup: here allButLast) ifNotNil: [:parserSelector |
- "2) Avoid interning new symbols for made-up pragmas such as #my for <my: 1 pragma: 2>."
- (Symbol lookup: (here last == $: ifTrue: [here allButLast] ifFalse: [here]))
- ifNotNil: [:parserSelector |
Parser methodDict at: parserSelector ifPresent: [:parserMethod | "3) Only call methods that claim to be a custom pragma parser via <pragmaParser>." (parserMethod hasPragma: #pragmaParser)
- ifTrue: [^ self executeMethod: parserMethod]]]].
- ifTrue: [^ self executeMethod: parserMethod]]].
"X) No custom pragma parser found. Use the default one." ^ self pragmaStatementKeywords
Parser>>simulationGuard {primitives} � ct 2/6/2022 20:09
- simulationGuard
- "primitive 19 is a null primitive that always fails. Just a marker for the simulator for methods that are typically undebuggable and likely to crash your image."
- <pragmaParser>
- self addPragma: (Pragma keyword: #primitive: arguments: #(19)).
- self advance.
- ^ true
SimulationSideEffectWarning
- Warning subclass: #SimulationSideEffectWarning
- instanceVariableNames: 'primitiveIndex context method receiver arguments suppressed'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Kernel-Exceptions'
- SimulationSideEffectWarning class
- instanceVariableNames: ''
- ""
SimulationSideEffectWarning class>>forPrimitive: {instance creation} � ct 2/6/2022 20:22
- forPrimitive: primitiveIndex
- ^ self new primitive: primitiveIndex
SimulationSideEffectWarning>>arguments {accessing} � ct 2/6/2022 20:32
- arguments
- ^ arguments
SimulationSideEffectWarning>>context {accessing} � ct 2/6/2022 20:04
- context
- ^ context
SimulationSideEffectWarning>>context:method:receiver:arguments: {initialize-release} � ct 2/6/2022 20:24
- context: aContext method: aCompiledMethod receiver: rcvr arguments: args
- context := aContext.
- method := aCompiledMethod.
- receiver := rcvr.
- arguments := args.
SimulationSideEffectWarning>>defaultAction {priv handling} � ct 5/9/2021 20:16
- defaultAction
- ^ self suppressed ifFalse: [super defaultAction]
SimulationSideEffectWarning>>defaultResumeValue {defaults} � ct 2/6/2022 20:34
- defaultResumeValue
- ^ true
SimulationSideEffectWarning>>isControlPrimitive {testing} � ct 5/9/2021 20:43
- isControlPrimitive
- "See StackInterpreter class>>#initializePrimitiveTable."
- ^ self primitive between: 80 and: 89
SimulationSideEffectWarning>>isSimulationGuard {testing} � ct 5/9/2021 20:43
- isSimulationGuard
- "See Parser >> #simulationGuard."
- ^ self primitive = 19
SimulationSideEffectWarning>>messageText {printing} � ct 2/6/2022 20:04
- messageText
- ^ messageText ifNil: [
- 'The code being simulated is trying to control a process ({1}). {2}' translated format: {
- self context method reference.
- self isSimulationGuard
- ifTrue: ['If you proceed, your image may become unusable. Continue at own risk, and better save your image before.' translated]
- ifFalse: ['Process controlling cannot be simulated. If you proceed, side effects may occur outside the observable area of the simulator.' translated]}]
SimulationSideEffectWarning>>method {accessing} � ct 2/6/2022 20:32
- method
- ^ method
SimulationSideEffectWarning>>primitive {accessing} � ct 5/2/2021 16:01
- primitive
- ^ primitiveIndex
SimulationSideEffectWarning>>primitive: {initialize-release} � ct 2/6/2022 20:23
- primitive: anInteger
- primitiveIndex := anInteger.
SimulationSideEffectWarning>>signalIfSkipped: {signaling} � ct 2/6/2022 20:38
- signalIfSkipped: skipBlock
- ^ self signal ifFalse: skipBlock
SimulationSideEffectWarning>>skipPrimitive {handling} � ct 2/6/2022 20:37
- skipPrimitive
- ^ self resume: false
SimulationSideEffectWarning>>suppress {accessing} � ct 5/9/2021 20:14
- suppress
- suppressed := true.
SimulationSideEffectWarning>>suppressed {accessing} � ct 5/9/2021 20:14
- suppressed
- ^ suppressed ifNil: [self isSimulationGuard not]
SimulationSideEffectWarning>>theReceiver {accessing} � ct 2/6/2022 20:33
- theReceiver
- ^ receiver
SimulationSideEffectWarning>>unsuppress {accessing} � ct 5/9/2021 20:14
- unsuppress
- suppressed := false.
Sent from Squeak Inbox Talk
On 2022-02-06T20:17:27+01:00, christoph.thiede at student.hpi.uni-potsdam.de wrote:
Hi all,
I have revised this changeset and still think that we should merge it into the Trunk before the release. Do you have any other critique or can I merge it? :-)
Best, Christoph
=============== Summary ===============
Change Set:��������SimulationSideEffectWarning Date:������������9 May 2021 Author:������������Christoph Thiede
CHANGELOG:
- Replace generic Warning in Context >> #doPrimitive:method:receiver:args: by specific warning of new class SimulationSideEffectWarning.
- Also signal SimulationSideEffectWarning if primitive 87 (primitiveResume) is hit.
- SimulationSideEffectWarning contains logic to detect the type (simulation guard/control primitive) of the side effect. It can also be suppressed or unsuppressed along the handler chain using the '*suppress*' selectors. Control primitive side effects are suppressed by default.
- Add tests for the changes above.
- In the debugger, unsuppress control primitive warnings.
- Replace definitions of primitive 19 (currently only in ControlManager) by a named alias pragma, <simulationGuard>, which is implemented on Parser.
- In the Parser, add support for pragmaParsers without arguments.
For more information, see: http://forum.world.st/The-Trunk-Kernel-nice-1386-mcz-td5128636.html
=============== Postscript ===============
SimulationSideEffectWarning removeSelector: #sender
=============== Diff ===============
Context>>doPrimitive:method:receiver:args: {private} ? ct 2/6/2022 20:15 (changed) doPrimitive: primitiveIndex method: meth receiver: receiver args: arguments ����"Simulate a primitive method whose index is primitiveIndex. The simulated receiver and ���� arguments are given as arguments to this message. If successful, push result and return ���� resuming context, else ^ {errCode, PrimitiveFailToken}. Any primitive which provokes ���� execution needs to be intercepted and simulated to avoid execution running away."
����| value |
- ����"Judicious use of primitive 19 (a null primitive that doesn't do anything) prevents
- ���� the debugger from entering various run-away activities such as spawning a new
- ���� process, etc. Injudicious use results in the debugger not being able to debug
- ���� interesting code, such as the debugger itself. Hence use primitive 19 with care :-)"
- ����"SystemNavigation new browseAllSelect: [:m| m primitive = 19]"
- ����primitiveIndex = 19 ifTrue: [
- ��������[self notify: ('The code being simulated is trying to control a process ({1}). Process controlling cannot be simulated. If you proceed, things may happen outside the observable area of the simulator.' translated format: {meth reference})]
- ������������ifCurtailed: [self push: nil "Cheap fix of the context's internal state"]].
- ����"Test for unsimulatable side effects (that is, code that will be triggered in the image outside of the simulator range). This includes simulation guards, which are traditionally flagged using primitive 19 (a null primitive that doesn't do anything), as well as certain control primitives that might trigger code on other processes. If a side effect is detected, raise a warning to give the user a chance to cancel the operation."
- ����"#(19 87) do: [:primitive | self systemNavigation browseAllSelect: [:m | m primitive = primitive]]"
- ����(primitiveIndex = 19 "simulationGuard" or: [primitiveIndex = 87 "primitiveResume"]) ifTrue: [
- ��������[SimulationSideEffectWarning signalForPrimitive: primitiveIndex context: self]
- ������������ifCurtailed: [self push: nil "Cheap fix of the context's internal state. Note that unwinding the receiver -- so that the next step would invoke the primitive again -- would be challenging due to to the variety of senders to this method."]].
���� ����((primitiveIndex between: 201 and: 222) ���� and: [(self objectClass: receiver) includesBehavior: BlockClosure]) ifTrue: ��������[(primitiveIndex = 206 �������� or: [primitiveIndex = 208]) ifTrue:������������������������"[Full]BlockClosure>>valueWithArguments:" ������������[^receiver simulateValueWithArguments: arguments first caller: self]. �������� ((primitiveIndex between: 201 and: 209)������������ "[Full]BlockClosure>>value[:value:...]" �������� or: [primitiveIndex between: 221 and: 222]) ifTrue: "[Full]BlockClosure>>valueNoContextSwitch[:]" ������������[^receiver simulateValueWithArguments: arguments caller: self]].
����primitiveIndex = 83 ifTrue: "afr 9/11/1998 19:50" "Object>>perform:[with:...]" ��������[| selector | ��������selector := arguments at: 1 ifAbsent: ������������[^ self class primitiveFailTokenFor: #'bad argument']. ��������arguments size - 1 = selector numArgs ifFalse: ������������[^ self class primitiveFailTokenFor: #'bad number of arguments']. ��������^self send: selector to: receiver with: arguments allButFirst]. ����primitiveIndex = 84 ifTrue: "afr 9/11/1998 19:50 & eem 8/18/2009 17:04" "Object>>perform:withArguments:" ��������[| selector args | ��������arguments size = 2 ifFalse: ������������[^ self class primitiveFailTokenFor: #'bad argument']. ��������selector := arguments first. ��������args := arguments second. ��������args isArray ifFalse: ������������[^ self class primitiveFailTokenFor: #'bad argument']. ��������args size = selector numArgs ifFalse: ������������[^ self class primitiveFailTokenFor: #'bad number of arguments']. ��������^self send: selector to: receiver with: args]. ����primitiveIndex = 100 ifTrue: "eem 8/18/2009 16:57" "Object>>perform:withArguments:inSuperclass:" ��������[| rcvr selector args superclass | ��������arguments size ������������caseOf: { ����������������[3] -> [ ��������������������rcvr := receiver. ��������������������selector := arguments first. ��������������������args := arguments second. ��������������������superclass := arguments third]. ����������������[4] -> ["mirror primitive" ��������������������rcvr := arguments first. ��������������������selector := arguments second. ��������������������args := arguments third. ��������������������superclass := arguments fourth] } ������������otherwise: [^ self class primitiveFailTokenFor: #'bad argument']. ��������args isArray ifFalse: ������������[^ self class primitiveFailTokenFor: #'bad argument']. ��������args size = selector numArgs ifFalse: ������������[^ self class primitiveFailTokenFor: #'bad number of arguments']. ��������((self objectClass: rcvr) includesBehavior: superclass) ifFalse: ������������[^ self class primitiveFailTokenFor: #'bad argument']. ��������^self send: selector to: rcvr with: args lookupIn: superclass].
����"Mutex>>primitiveEnterCriticalSection ���� Mutex>>primitiveTestAndSetOwnershipOfCriticalSection" ����(primitiveIndex = 186 or: [primitiveIndex = 187]) ifTrue: ��������[| effective | �������� effective := Processor activeProcess effectiveProcess. �������� "active == effective" �������� value := primitiveIndex = 186 ��������������������ifTrue: [receiver primitiveEnterCriticalSectionOnBehalfOf: effective] ��������������������ifFalse: [receiver primitiveTestAndSetOwnershipOfCriticalSectionOnBehalfOf: effective]. �������� ^(self isPrimFailToken: value) ������������ifTrue: [value] ������������ifFalse: [self push: value]].
����primitiveIndex = 188 ifTrue:����"Object>>withArgs:executeMethod: ������������������������������������CompiledMethod class>>receiver:withArguments:executeMethod: ������������������������������������VMMirror>>ifFail:object:with:executeMethod: et al" ��������[| n args methodArg thisReceiver | �������� ((n := arguments size) between: 2 and: 4) ifFalse: ������������[^self class primitiveFailTokenFor: #'unsupported operation']. �������� ((self objectClass: (args := arguments at: n - 1)) == Array �������� and: [(self objectClass: (methodArg := arguments at: n)) includesBehavior: CompiledMethod]) ifFalse: ������������[^self class primitiveFailTokenFor: #'bad argument']. �������� methodArg numArgs = args size ifFalse: ������������[^self class primitiveFailTokenFor: #'bad number of arguments']. �������� thisReceiver := arguments at: n - 2 ifAbsent: [receiver]. �������� methodArg primitive > 0 ifTrue: ������������[methodArg isQuick ifTrue: ����������������[^self push: (methodArg valueWithReceiver: thisReceiver arguments: args)]. ������������ ^self doPrimitive: methodArg primitive method: meth receiver: thisReceiver args: args]. �������� ^self ������������activateMethod: methodArg ������������withArgs: args ������������receiver: thisReceiver].
����primitiveIndex = 118 ifTrue: "[receiver:]tryPrimitive:withArgs:; avoid recursing in the VM" ��������[(arguments size = 3 �������� and: [(self objectClass: arguments second) == SmallInteger �������� and: [(self objectClass: arguments last) == Array]]) ifTrue: ������������[^self doPrimitive: arguments second method: meth receiver: arguments first args: arguments last]. �������� (arguments size = 2 �������� and: [(self objectClass: arguments first) == SmallInteger �������� and: [(self objectClass: arguments last) == Array]]) ifFalse: ������������[^self class primitiveFailTokenFor: nil]. �������� ^self doPrimitive: arguments first method: meth receiver: receiver args: arguments last].
����value := primitiveIndex = 120 "FFI method" ����������������ifTrue: [(meth literalAt: 1) tryInvokeWithArguments: arguments] ����������������ifFalse: ��������������������[primitiveIndex = 117 "named primitives" ������������������������ifTrue: [self tryNamedPrimitiveIn: meth for: receiver withArgs: arguments] ������������������������ifFalse: "should use self receiver: receiver tryPrimitive: primitiveIndex withArgs: arguments but this is only in later VMs (and appears to be broken)" ����������������������������[receiver tryPrimitive: primitiveIndex withArgs: arguments]].
����^(self isPrimFailToken: value) ��������ifTrue: [value] ��������ifFalse: [self push: value]
ContextTest>>invokeSimulationGuard {private} ? ct 2/6/2022 20:07
- invokeSimulationGuard
- ����<simulationGuard>
- ����"Nothing to see here, please move along!"
- ����^ 42
ContextTest>>testSimulationSideEffectWarningControl {tests} ? ct 2/6/2022 20:07
- testSimulationSideEffectWarningControl
- ����self
- ��������should: [Context runSimulated: [[] fork]]
- ��������raise: SimulationSideEffectWarning
- ��������withExceptionDo: [:warning |
- ������������self assert: warning notNil.
- ������������self assert: warning isControlPrimitive.
- ������������self assert: warning suppressed].
ContextTest>>testSimulationSideEffectWarningGuard {tests} ? ct 2/6/2022 20:07
- testSimulationSideEffectWarningGuard
- ����self
- ��������should: [Context runSimulated:
- ������������[self invokeSimulationGuard]]
- ��������raise: SimulationSideEffectWarning
- ��������withExceptionDo: [:warning |
- ������������self assert: warning notNil.
- ������������self assert: warning isSimulationGuard.
- ������������self deny: warning suppressed].
ContextTest>>testSimulationSideEffectWarningSuppress {tests} ? ct 2/6/2022 20:05
- testSimulationSideEffectWarningSuppress
- ����self
- ��������shouldnt: [(SimulationSideEffectWarning forPrimitive: 42 context: thisContext)
- ������������suppress;
- ������������defaultAction] raise: UnhandledWarning;
- ��������should: [(SimulationSideEffectWarning forPrimitive: 42 context: thisContext)
- ������������unsuppress;
- ������������defaultAction] raise: UnhandledWarning.
ControlManager>>activeController: {accessing} ? ct 2/6/2022 19:54 (changed) activeController: aController
- ����"Set aController to be the currently active controller. Give the user
- ����control in it."
- ����<primitive: 19> "Simulation guard"
- ����"Set aController to be the currently active controller. Give the user control in it."
- ����<simulationGuard>
����activeController := aController. ����(activeController == screenController) ��������ifFalse: [self promote: activeController]. ����activeControllerProcess := ������������[activeController startUp. ������������self searchForActiveController] newProcess. ����activeControllerProcess priority: Processor userSchedulingPriority. ����activeControllerProcess resume
ControlManager>>scheduleActive: {scheduling} ? ct 2/6/2022 19:50 (changed) scheduleActive: aController
- ����"Make aController be scheduled as the active controller. Presumably the
- ����active scheduling process asked to schedule this controller and that a
- ����new process associated this controller takes control. So this is the last act
- ����of the active scheduling process."
- ����<primitive: 19> "Simulation guard"
- ����"Make aController be scheduled as the active controller. Presumably the active scheduling process asked to schedule this controller and that a new process associated this controller takes control. So this is the last act of the active scheduling process."
- ����<simulationGuard>
����self scheduleActiveNoTerminate: aController. ����Processor terminateActive
Debugger>>handleLabelUpdatesIn:whenExecuting: {context stack menu} ? ct 5/9/2021 20:13 (changed) handleLabelUpdatesIn: aBlock whenExecuting: aContext ����"Send the selected message in the accessed method, and regain control ����after the invoked method returns." ���� ����^aBlock ��������on: Notification ��������do: [:ex| ������������(ex tag isArray ������������ and: [ex tag size = 2 ������������ and: [(ex tag first == aContext or: [ex tag first hasSender: aContext])]]) ����������������ifTrue: ��������������������[self labelString: ex tag second description. �������������������� ex resume] ����������������ifFalse:
- ��������������������[ex pass]]
- ��������������������[ex pass]]
- ��������on: SimulationSideEffectWarning
- ��������do: [:ex |
- ������������ex isControlPrimitive ifTrue: [ex unsuppress].
- ������������ex pass]
Debugger>>send {context stack menu} ? ct 2/6/2022 20:03 (changed) send ����"Send the selected message in the accessed method, and take control in ����the method invoked to allow further step or send."
- ����| currentContext |
����self okToChange ifFalse: [^ self]. ����self checkContextSelection.
- ����interruptedProcess step: self selectedContext.
- ����currentContext := self selectedContext.
- ����self
- ��������handleLabelUpdatesIn: [interruptedProcess step: currentContext]
- ��������whenExecuting: currentContext.
����self resetContext: interruptedProcess stepToSendOrReturn.
Parser>>pragmaStatement {pragmas} ? ct 2/6/2022 19:52 (changed) pragmaStatement ����"Parse a pragma statement. The leading '<' has already been consumed. The 'here' token is the first one in the pragma. Use that token to dispatch to a custom pragma-parsing method if one can be found with a selector that matches it. ���� ����Note that custom pragma parsers need to fulfill two requirements: ��������- method selector must match the current token as simple getter, ����������������e.g., <apicall: ...> matches #apicall or <primitive: ...> matches #primitive ��������- method must have pragma <pragmaParser> to be called." ���� ����"0) Early exit" ����(hereType = #keyword or: [ hereType = #word or: [ hereType = #binary ] ]) ��������ifFalse: [ ^ self expected: 'pragma declaration' ].
- ����
����"1) Do not consider one-word pragmas such as <primitive> and <foobar>. Only keyword pragmas."
- ����here last == $: ifTrue: [
- ��������"2) Avoid interning new symbols for made-up pragmas such as #my for <my: 1 pragma: 2>."
- ��������(Symbol lookup: here allButLast) ifNotNil: [:parserSelector |
- ����"2) Avoid interning new symbols for made-up pragmas such as #my for <my: 1 pragma: 2>."
- ����(Symbol lookup: (here last == $: ifTrue: [here allButLast] ifFalse: [here]))
- ��������ifNotNil: [:parserSelector |
������������Parser methodDict at: parserSelector ifPresent: [:parserMethod | ����������������"3) Only call methods that claim to be a custom pragma parser via <pragmaParser>." ����������������(parserMethod hasPragma: #pragmaParser)
- ��������������������ifTrue: [^ self executeMethod: parserMethod]]]].
- ��������������������ifTrue: [^ self executeMethod: parserMethod]]].
- ����
����"X) No custom pragma parser found. Use the default one." ����^ self pragmaStatementKeywords
Parser>>simulationGuard {primitives} ? ct 2/6/2022 20:09
- simulationGuard
- ����"primitive 19 is a null primitive that always fails. Just a marker for the simulator for methods that are typically undebuggable and likely to crash your image."
- ����<pragmaParser>
- ����self addPragma: (Pragma keyword: #primitive: arguments: #(19)).
- ����
- ����self advance.
- ����^ true
SimulationSideEffectWarning
- Warning subclass: #SimulationSideEffectWarning
- ����instanceVariableNames: 'primitiveIndex context suppressed'
- ����classVariableNames: ''
- ����poolDictionaries: ''
- ����category: 'Kernel-Exceptions'
- SimulationSideEffectWarning class
- ����instanceVariableNames: ''
- ""
SimulationSideEffectWarning class>>forPrimitive:context: {instance creation} ? ct 2/6/2022 20:05
- forPrimitive: primitiveIndex context: topContext
- ����^ self new primitive: primitiveIndex context: topContext
SimulationSideEffectWarning class>>signalForPrimitive:context: {signaling} ? ct 2/6/2022 20:05
- signalForPrimitive: primitiveIndex context: topContext
- ����^ (self forPrimitive: primitiveIndex context: topContext) signal
SimulationSideEffectWarning>>context {accessing} ? ct 2/6/2022 20:04
- context
- ����^ context
SimulationSideEffectWarning>>defaultAction {priv handling} ? ct 5/9/2021 20:16
- defaultAction
- ����^ self suppressed ifFalse: [super defaultAction]
SimulationSideEffectWarning>>isControlPrimitive {testing} ? ct 5/9/2021 20:43
- isControlPrimitive
- ����"See StackInterpreter class>>#initializePrimitiveTable."
- ����^ self primitive between: 80 and: 89
SimulationSideEffectWarning>>isSimulationGuard {testing} ? ct 5/9/2021 20:43
- isSimulationGuard
- ����"See Parser >> #simulationGuard."
- ����^ self primitive = 19
SimulationSideEffectWarning>>messageText {printing} ? ct 2/6/2022 20:04
- messageText
- ����^ messageText ifNil: [
- ��������'The code being simulated is trying to control a process ({1}). {2}' translated format: {
- ������������self context method reference.
- ������������self isSimulationGuard
- ����������������ifTrue: ['If you proceed, your image may become unusable. Continue at own risk, and better save your image before.' translated]
- ����������������ifFalse: ['Process controlling cannot be simulated. If you proceed, side effects may occur outside the observable area of the simulator.' translated]}]
SimulationSideEffectWarning>>primitive {accessing} ? ct 5/2/2021 16:01
- primitive
- ����^ primitiveIndex
SimulationSideEffectWarning>>primitive:context: {initialize-release} ? ct 2/6/2022 20:04
- primitive: anInteger context: topContext
- ����primitiveIndex := anInteger.
- ����context := topContext.
SimulationSideEffectWarning>>suppress {accessing} ? ct 5/9/2021 20:14
- suppress
- ����suppressed := true.
SimulationSideEffectWarning>>suppressed {accessing} ? ct 5/9/2021 20:14
- suppressed
- ����^ suppressed ifNil: [self isSimulationGuard not]
SimulationSideEffectWarning>>unsuppress {accessing} ? ct 5/9/2021 20:14
- unsuppress
- ����suppressed := false.
Sent from Squeak Inbox Talk
On 2021-05-09T14:17:06-05:00, christoph.thiede at student.hpi.uni-potsdam.de wrote:
It is extremely confusing that Nabble strips of the revision number of the changeset upon upload. :-)
Community service, here is the inlined diff:
"Change Set: SimulationSideEffectWarning Date: 9 May 2021 Author: Christoph Thiede
<your descriptive text goes here>"
Warning subclass: #SimulationSideEffectWarning instanceVariableNames: 'primitiveIndex sender suppressed' classVariableNames: '' poolDictionaries: '' category: 'Kernel-Exceptions'
I am signaled to notify the client of a simulation operation (i.e., a sender of Context) about potential side effects that might occur when resuming the simulation. See Context >> #doPrimitive:method:receiver:args:, #messageText, and Parser >> #simulationGuard for more information.
doPrimitive: primitiveIndex method: meth receiver: receiver args: arguments "Simulate a primitive method whose index is primitiveIndex. The simulated receiver and arguments are given as arguments to this message. If successful, push result and return resuming context, else ^ {errCode, PrimitiveFailToken}. Any primitive which provokes execution needs to be intercepted and simulated to avoid execution running away."
| value | "Judicious use of primitive 19 (a null primitive that doesn't do anything) prevents the debugger from entering various run-away activities such as spawning a new process, etc. Injudicious use results in the debugger not being able to debug interesting code, such as the debugger itself. Hence use primitive 19 with care :-)" "SystemNavigation new browseAllSelect: [:m| m primitive = 19]" primitiveIndex = 19 ifTrue: [ [self notify: ('The code being simulated is trying to control a process ({1}). Process controlling cannot be simulated. If you proceed, things may happen outside the observable area of the simulator.' translated format: {meth reference})] ifCurtailed: [self push: nil "Cheap fix of the context's internal state"]]. *"Test for unsimulatable side effects (that is, code that will be triggered in the image outside of the simulator range). This includes simulation guards, which are traditionally flagged using primitive 19 (a null primitive that doesn't do anything), as well as certain control primitives that might trigger code on other processes. If a side effect is detected, raise a warning to give the user a chance to cancel the operation." "#(19 87) do: [:primitive | self systemNavigation browseAllSelect: [:m | m primitive = primitive]]" (primitiveIndex = 19 "simulationGuard" or: [primitiveIndex = 87 "primitiveResume"]) ifTrue: [ [SimulationSideEffectWarning signalForPrimitive: primitiveIndex sender: self] ifCurtailed: [self push: nil "Cheap fix of the context's internal state. Note that unwinding the receiver -- so that the next step would invoke the primitive again -- would be challenging due to to the variety of senders to this method."]].* ((primitiveIndex between: 201 and: 222) and: [(self objectClass: receiver) includesBehavior: BlockClosure]) ifTrue: [(primitiveIndex = 206 or: [primitiveIndex = 208]) ifTrue: "[Full]BlockClosure>>valueWithArguments:" [^receiver simulateValueWithArguments: arguments first caller: self]. ((primitiveIndex between: 201 and: 209) "[Full]BlockClosure>>value[:value:...]" or: [primitiveIndex between: 221 and: 222]) ifTrue: "[Full]BlockClosure>>valueNoContextSwitch[:]" [^receiver simulateValueWithArguments: arguments caller: self]].
primitiveIndex = 83 ifTrue: "afr 9/11/1998 19:50" "Object>>perform:[with:...]" [| selector | selector := arguments at: 1 ifAbsent: [^ self class primitiveFailTokenFor: #'bad argument']. arguments size - 1 = selector numArgs ifFalse: [^ self class primitiveFailTokenFor: #'bad number of arguments']. ^self send: selector to: receiver with: arguments allButFirst]. primitiveIndex = 84 ifTrue: "afr 9/11/1998 19:50 & eem 8/18/2009 17:04" "Object>>perform:withArguments:" [| selector args | arguments size = 2 ifFalse: [^ self class primitiveFailTokenFor: #'bad argument']. selector := arguments first. args := arguments second. args isArray ifFalse: [^ self class primitiveFailTokenFor: #'bad argument']. args size = selector numArgs ifFalse: [^ self class primitiveFailTokenFor: #'bad number of arguments']. ^self send: selector to: receiver with: args]. primitiveIndex = 100 ifTrue: "eem 8/18/2009 16:57" "Object>>perform:withArguments:inSuperclass:" [| rcvr selector args superclass | arguments size caseOf: { [3] -> [ rcvr := receiver. selector := arguments first. args := arguments second. superclass := arguments third]. [4] -> ["mirror primitive" rcvr := arguments first. selector := arguments second. args := arguments third. superclass := arguments fourth] } otherwise: [^ self class primitiveFailTokenFor: #'bad argument']. args isArray ifFalse: [^ self class primitiveFailTokenFor: #'bad argument']. args size = selector numArgs ifFalse: [^ self class primitiveFailTokenFor: #'bad number of arguments']. ((self objectClass: rcvr) includesBehavior: superclass) ifFalse: [^ self class primitiveFailTokenFor: #'bad argument']. ^self send: selector to: rcvr with: args lookupIn: superclass].
"Mutex>>primitiveEnterCriticalSection Mutex>>primitiveTestAndSetOwnershipOfCriticalSection" (primitiveIndex = 186 or: [primitiveIndex = 187]) ifTrue: [| effective | effective := Processor activeProcess effectiveProcess. "active == effective" value := primitiveIndex = 186 ifTrue: [receiver primitiveEnterCriticalSectionOnBehalfOf: effective] ifFalse: [receiver primitiveTestAndSetOwnershipOfCriticalSectionOnBehalfOf: effective]. ^(self isPrimFailToken: value) ifTrue: [value] ifFalse: [self push: value]].
primitiveIndex = 188 ifTrue: "Object>>withArgs:executeMethod: CompiledMethod class>>receiver:withArguments:executeMethod: VMMirror>>ifFail:object:with:executeMethod: et al" [| n args methodArg thisReceiver | ((n := arguments size) between: 2 and: 4) ifFalse: [^self class primitiveFailTokenFor: #'unsupported operation']. ((self objectClass: (args := arguments at: n - 1)) == Array and: [(self objectClass: (methodArg := arguments at: n)) includesBehavior: CompiledMethod]) ifFalse: [^self class primitiveFailTokenFor: #'bad argument']. methodArg numArgs = args size ifFalse: [^self class primitiveFailTokenFor: #'bad number of arguments']. thisReceiver := arguments at: n - 2 ifAbsent: [receiver]. methodArg primitive > 0 ifTrue: [methodArg isQuick ifTrue: [^self push: (methodArg valueWithReceiver: thisReceiver arguments: args)]. ^self doPrimitive: methodArg primitive method: meth receiver: thisReceiver args: args]. ^Context sender: self receiver: thisReceiver method: methodArg arguments: args].
primitiveIndex = 118 ifTrue: "[receiver:]tryPrimitive:withArgs:; avoid recursing in the VM" [(arguments size = 3 and: [(self objectClass: arguments second) == SmallInteger and: [(self objectClass: arguments last) == Array]]) ifTrue: [^self doPrimitive: arguments second method: meth receiver: arguments first args: arguments last]. (arguments size = 2 and: [(self objectClass: arguments first) == SmallInteger and: [(self objectClass: arguments last) == Array]]) ifFalse: [^self class primitiveFailTokenFor: nil]. ^self doPrimitive: arguments first method: meth receiver: receiver args: arguments last].
value := primitiveIndex = 120 "FFI method" ifTrue: [(meth literalAt: 1) tryInvokeWithArguments: arguments] ifFalse: [primitiveIndex = 117 "named primitives" ifTrue: [self tryNamedPrimitiveIn: meth for: receiver withArgs: arguments] ifFalse: "should use self receiver: receiver tryPrimitive: primitiveIndex withArgs: arguments but this is only in later VMs (and appears to be broken)" [receiver tryPrimitive: primitiveIndex withArgs: arguments]].
^(self isPrimFailToken: value) ifTrue: [value] ifFalse: [self push: value]
invokeSimulationGuard <simulationGuard> "Nothing to see here, please move along!" ^ 42
testSimulationSideEffectWarningControl
| warning | [Context runSimulated: [[] fork]] on: SimulationSideEffectWarning do: [:ex | warning := ex]. self assert: warning notNil. self assert: warning isControlPrimitive. self assert: warning suppressed.
testSimulationSideEffectWarningGuard
| warning | [Context runSimulated: [self invokeSimulationGuard]] on: SimulationSideEffectWarning do: [:ex | warning := ex]. self assert: warning notNil. self assert: warning isSimulationGuard. self deny: warning suppressed.
testSimulationSideEffectWarningSuppress
self shouldnt: [(SimulationSideEffectWarning forPrimitive: 42 sender: thisContext) suppress; defaultAction] raise: UnhandledWarning; should: [(SimulationSideEffectWarning forPrimitive: 42 sender: thisContext) unsuppress; defaultAction] raise: UnhandledWarning.
activeController: aController "Set aController to be the currently active controller. Give the user control in it." <primitive: 19> "Simulation guard" *"Set aController to be the currently active controller. Give the user control in it." <simulationGuard>*
activeController := aController. (activeController == screenController) ifFalse: [self promote: activeController]. activeControllerProcess := [activeController startUp. self searchForActiveController] newProcess. activeControllerProcess priority: Processor userSchedulingPriority. activeControllerProcess resume
scheduleActive: aController "Make aController be scheduled as the active controller. Presumably the active scheduling process asked to schedule this controller and that a new process associated this controller takes control. So this is the last act of the active scheduling process." <primitive: 19> "Simulation guard" *"Make aController be scheduled as the active controller. Presumably the active scheduling process asked to schedule this controller and that a new process associated this controller takes control. So this is the last act of the active scheduling process." <simulationGuard>*
self scheduleActiveNoTerminate: aController. Processor terminateActive
handleLabelUpdatesIn: aBlock whenExecuting: aContext "Send the selected message in the accessed method, and regain control after the invoked method returns." ^aBlock on: Notification do: [:ex| (ex tag isArray and: [ex tag size = 2 and: [(ex tag first == aContext or: [ex tag first hasSender: aContext])]]) ifTrue: [self labelString: ex tag second description. ex resume] ifFalse: [ex pass]] *[ex pass]] on: SimulationSideEffectWarning do: [:ex | ex isControlPrimitive ifTrue: [ex unsuppress]. ex pass]*
simulationGuard "primitive 19 is a null primitive that always fails. Just a marker for the simulator." <pragmaParser>
self addPragma: (Pragma keyword: #primitive: arguments: #(19)). self advance. ^ true
isControlPrimitive "See StackInterpreter class>>#initializePrimitiveTable."
^ self primitive between: 80 and: 89
isSimulationGuard "See Parser >> #simulationGuard."
^ self primitive = 19
primitive
^ primitiveIndex
sender
^ sender
suppress
suppressed := true.
suppressed
^ suppressed ifNil: [self isSimulationGuard not]
unsuppress
suppressed := false.
primitive: anInteger sender: senderContext
primitiveIndex := anInteger. sender := senderContext.
messageText
^ messageText ifNil: [ 'The code being simulated is trying to control a process ({1}). {2}' translated format: { self sender method reference. self isSimulationGuard ifTrue: ['If you proceed, your image may become unusable. Continue at own risk, and better save your image before.' translated] ifFalse: ['Process controlling cannot be simulated. If you proceed, side effects may occur outside the observable area of the simulator.' translated]}]
defaultAction
^ self suppressed ifFalse: [super defaultAction]
forPrimitive: primitiveIndex sender: senderContext
^ self new primitive: primitiveIndex sender: senderContext
signalForPrimitive: primitiveIndex sender: senderContext
^ (self forPrimitive: primitiveIndex sender: senderContext) signal
('instance creation' forPrimitive:sender:) ('signaling' signalForPrimitive:sender:)
('testing' isControlPrimitive isSimulationGuard) ('accessing' primitive sender suppress suppressed unsuppress) ('initialize-release' primitive:sender:) ('printing' messageText) ('priv handling' defaultAction)
"Postscript: CHANGELOG*:
- Replace generic Warning in Context >>
#doPrimitive:method:receiver:args: by specific warning of new class SimulationSideEffectWarning.
- Also signal SimulationSideEffectWarning if primitive 87 (primitiveResume)
is hit.
- SimulationSideEffectWarning contains logic to detect the type (simulation
guard/control primitive) of the side effect. It can also be suppressed or unsuppressed along the handler chain using the '*suppress*' selectors. Control primitive side effects are suppressed by default.
- Add tests for the changes above.
- In the debugger, unsuppress control primitive warnings.
- Replace definitions of primitive 19 (currently only in ControlManager) by
a named alias pragma, <simulationGuard>, which is implemented on Parser.
For more information, see: http://forum.world.st/The-Trunk-Kernel-nice-1386-mcz-td5128636.html
(* Sorry, this should be in the preamble, not in the postscript, I know, but the preamble editor in the ChangeSorter is currently broken. ¯_(?)_/¯) "
Carpe Squeak!
Sent from: http://forum.world.st/Squeak-Dev-f45488.html
squeak-dev@lists.squeakfoundation.org
-
Christoph Thiede -
christoph.thiede＠student.hpi.uni-potsdam.de
-
commits＠source.squeak.org -
Marcel Taeumel -
Nicolas Cellier -
Thiede, Christoph