[squeak-dev] SimulationSideEffectWarning (was: The Trunk: Kernel-nice.1386.mcz)christoph.thiede at student.hpi.uni-potsdam.de christoph.thiede at student.hpi.uni-potsdam.deSun Feb 6 19:17:27 UTC 2022
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 > -------------- next part -------------- > An HTML attachment was scrubbed... > URL: <http://lists.squeakfoundation.org/pipermail/squeak-dev/attachments/20210509/a1ca34e3/attachment.html> > > ["SimulationSideEffectWarning.3.cs"] -------------- next part -------------- An HTML attachment was scrubbed... URL: <http://lists.squeakfoundation.org/pipermail/squeak-dev/attachments/20220206/19a867e0/attachment-0001.html> -------------- next part -------------- A non-text attachment was scrubbed... Name: SimulationSideEffectWarning.3.cs Type: application/octet-stream Size: 15909 bytes Desc: not available URL: <http://lists.squeakfoundation.org/pipermail/squeak-dev/attachments/20220206/19a867e0/attachment-0001.obj>
More information about the Squeak-dev mailing list |