The Inbox: Kernel-nice.1394.mcz

Nicolas Cellier uploaded a new version of Kernel to project The Inbox:
http://source.squeak.org/inbox/Kernel-nice.1394.mcz

==================== Summary ====================

Name: Kernel-nice.1394
Author: nice
Time: 26 April 2021, 1:50:12.861556 am
UUID: 3a981b94-0213-44f3-8263-838dda062f8a
Ancestors: Kernel-bp.1393

Revise exception handling so as to
- inactivate inner handler blocks when the exception is signalled in an outer handler
- except when the inner handler has been explicitely rearmed (see rearmHandlerDuring:)

Implementation notes: add a marker <primitive: 199> to handleSignal:, so as to detect the case when an exception is signalled within the execution of a handler block.

This induces a subtle difference:
- findNextHandlerContext might now return a handleSignal: context,
- while nextHandlerContext will only return a on:do: context (or nil).

The new workhorse for finding the proper handler is now #nextHandlerContextForSignal:
It finds and answers the (handler) context that will handle the exception, but if it finds a handleSignal: during the scan, it will restrict the search to rearmed handlers, until it reaches the handler of prior exception, at which step it continues to search normally.

Due to the scanning of inner blocks, we still need a marker for blocking re-entrancy (handlerActive temp in on:do:), but also a marker for rearmed blocks (handlerRearmed in on:do:). This can't be the same marker: an example is testHandlerReentrancy: when the rearmed inner handler pass the exception to its outer handler, the outer handler must still be inactive if it raised the Exception.

Borrow resumeEvaluating: to Cuis and use it in resignalAs:

Use many small methods in order to make the intention more explicit than with those mysterious tempAt: tempAt:put:

=============== Diff against Kernel-bp.1393 ===============

Item was changed:
  ----- Method: BlockClosure>>on:do: (in category 'exceptions') -----
  on: exceptionOrExceptionSet do: handlerAction
  "Evaluate the receiver in the scope of an exception handler."
 
+ | handlerActive handlerRearmed |
- | handlerActive |
  <primitive: 199>  "just a marker, fail and execute the following"
  handlerActive := true.
+ handlerRearmed := false.
  ^ self value!

Item was changed:
  ----- Method: Context>>canHandleSignal: (in category 'private-exceptions') -----
  canHandleSignal: exception
  "Sent to handler (on:do:) contexts only.  If my exception class (first arg) handles exception then return true, otherwise forward this message to the next handler context.  If none left, return false (see nil>>canHandleSignal:)"
 
+ ^ (self willHandleSignal: exception)
- ^ (((self tempAt: 1) handles: exception) and: [self tempAt: 3])
  or: [self nextHandlerContext canHandleSignal: exception].
  !

Item was added:
+ ----- Method: Context>>deactivateHandler (in category 'private-exceptions') -----
+ deactivateHandler
+ "Private - sent to exception handler context only (on:do:)"
+
+ stackp >= 3 ifTrue: [self tempAt: 3 put: false] "this is temporary handlerActive in #on:do:"!

Item was added:
+ ----- Method: Context>>desarmHandler (in category 'private-exceptions') -----
+ desarmHandler
+ "Private - sent to exception handler context only (on:do:)"
+
+ stackp >= 4 ifTrue: [self tempAt: 4 put: false] "this is temporary handlerRearmed in #on:do:"!

Item was added:
+ ----- Method: Context>>findNextHandlerContext (in category 'private-exceptions') -----
+ findNextHandlerContext
+ "find next context marked with <primitive: 199>.
+ This can be either a handler context (on:do:),
+ or a handling context (handleSignal:)"
+
+ ^ self sender findNextHandlerContextStarting!

Item was added:
+ ----- Method: Context>>fireHandlerActionForSignal: (in category 'private-exceptions') -----
+ fireHandlerActionForSignal: exception
+ "Sent to handler (on:do:) contexts only.
+ Perform the second argument, which is the handler action"
+
+ ^(self tempAt: 2) cull: exception!

Item was changed:
  ----- Method: Context>>handleSignal: (in category 'private-exceptions') -----
  handleSignal: exception
+ "Sent to handler (on:do:) contexts only.
+ Execute the handler action block"
- "Sent to handler (on:do:) contexts only.  If my exception class (first arg) handles exception
- and the handler is active then execute my handle block (second arg), otherwise forward
- this message to the next handler context.  If none left, execute exception's defaultAction
- (see nil>>handleSignal:)."
 
+ | val |
+ <primitive: 199>  "just a marker, fail and execute the following"
- | handlerActive val |
- "If the context has been returned from the handlerActive temp var may not be accessible."
- handlerActive := stackp >= 3 and: [(self tempAt: 3) == true].
- (((self tempAt: 1) handles: exception) and: [handlerActive]) ifFalse:
- [stackp >= 3 ifTrue: [self tempAt: 3 put: false].
- ^self nextHandlerContext handleSignal: exception].
-
  exception privHandlerContext: self contextTag.
+ self deactivateHandler. "Prevent re-entering the action block, unless it is explicitely rearmed"
+ val := [self fireHandlerActionForSignal: exception] ensure: [self reactivateHandler].
+ self return: val  "return from self if not otherwise directed in handle block"!
- self tempAt: 3 put: false.  "disable self while executing handle block"
- val := [(self tempAt: 2) cull: exception]
- ifCurtailed: [self tempAt: 3 put: true].
- self return: val  "return from self if not otherwise directed in handle block"
- !

Item was added:
+ ----- Method: Context>>isHandlerActive (in category 'private-exceptions') -----
+ isHandlerActive
+ "Private - sent to exception handler context only (on:do:)"
+
+ ^stackp >= 3 and: [(self tempAt: 3) == true] "this is temporary handlerActive in #on:do:"!

Item was added:
+ ----- Method: Context>>isHandlerRearmed (in category 'private-exceptions') -----
+ isHandlerRearmed
+ "Private - sent to exception handler context only (on:do:)"
+
+ ^stackp >= 4 and: [(self tempAt: 4) == true] "this is temporary handlerRearmed in #on:do:"!

Item was changed:
  ----- Method: Context>>nextHandlerContext (in category 'private-exceptions') -----
  nextHandlerContext
+ "Answer the next handler context (on:do:) in the call chain.
+ Answer nil if none found"
+
+ | handler |
+ handler := self findNextHandlerContext.
+ [handler ifNil: [^nil].
+ handler selector == #handleSignal:]
+ whileTrue: [handler := handler findNextHandlerContext].
+ ^handler!
-
- ^ self sender findNextHandlerContextStarting!

Item was added:
+ ----- Method: Context>>nextHandlerContextForSignal: (in category 'private-exceptions') -----
+ nextHandlerContextForSignal: exception
+ "Answer the handler context (on:do:) for this exception
+ Answer nil if none found"
+
+ | handler priorHandler |
+ handler := self.
+ [(handler := handler findNextHandlerContext) ifNil: [^nil].
+ handler selector == #handleSignal:]
+ whileFalse: [(handler willHandleSignal: exception) ifTrue: [^handler]].
+
+ "exception has been signalled in the scope of another signal handler (while #handleSignal:)
+ Check for a rearmed inner handler. If none, jump to outer handler context."
+ priorHandler := (handler tempAt: 1) "the exception argument to handleSignal:"
+ privHandlerContext.
+
+ [(handler := handler nextHandlerContext) ifNil: [^nil].
+ (handler isHandlerRearmed and: [handler willHandleSignal: exception]) ifTrue: [^handler].
+ handler == priorHandler] whileFalse.
+
+ ^priorHandler nextHandlerContextForSignal: exception!

Item was added:
+ ----- Method: Context>>reactivateHandler (in category 'private-exceptions') -----
+ reactivateHandler
+ "Private - sent to exception handler context only (on:do:)"
+
+ stackp >= 3 ifTrue: [self tempAt: 3 put: true] "this is temporary handlerActive in #on:do:"!

Item was changed:
  ----- Method: Context>>reactivateHandlers (in category 'private-exceptions') -----
  reactivateHandlers
+ "Private - exception handling
+ do nothing, this method is only here for smooth transition.
+ It shall be removed at next update map."
- "Private - sent to exception handler context only (on:do:).
- Reactivate all the handlers into the chain"
 
+ ^self!
- self tempAt: 3 put: true. "this is temporary handlerActive in #on:do:"
- self nextHandlerContext reactivateHandlers!

Item was added:
+ ----- Method: Context>>rearmHandler (in category 'private-exceptions') -----
+ rearmHandler
+ "Private - sent to exception handler context only (on:do:)"
+
+ self reactivateHandler.
+ stackp >= 4 ifTrue: [self tempAt: 4 put: true] "this is temporary handlerRearmed in #on:do:"!

Item was changed:
  ----- Method: Context>>rearmHandlerDuring: (in category 'private-exceptions') -----
  rearmHandlerDuring: aBlock
  "Sent to handler (on:do:) contexts only. Makes me re-entrant for the duration of aBlock. Only works in a closure-enabled image"
 
+ ^ [self rearmHandler. aBlock value]
+ ensure: [self desarmHandler]!
- ^ [self tempAt: 3 put: true. aBlock value]
- ensure: [self tempAt: 3 put: false]!

Item was added:
+ ----- Method: Context>>rearmHandlersWhich:upTo: (in category 'private-exceptions') -----
+ rearmHandlersWhich: selectBlock upTo: aHandlerContext
+ "Private - sent to exception handler context only (on:do:).
+ Rearm the inner handlers into the chain, up to, but not including, aHandlerContext, that satisfy the selectBlock predicate"
+
+ self == aHandlerContext ifTrue: [^self].
+ (selectBlock value: self) ifTrue: [self rearmHandler].
+ self nextHandlerContext rearmHandlersWhich: selectBlock upTo: aHandlerContext!

Item was changed:
  ----- Method: Context>>resume: (in category 'controlling') -----
  resume: value
  "Unwind thisContext to self and resume with value as result of last send.  Execute unwind blocks when unwinding.  ASSUMES self is a sender of thisContext"
 
+ ^self resumeEvaluating: [value]
- | ctxt unwindBlock |
- self isDead ifTrue: [self cannotReturn: value to: self].
- ctxt := thisContext.
- [ ctxt := ctxt findNextUnwindContextUpTo: self.
- ctxt isNil
- ] whileFalse: [
- (ctxt tempAt: 2) ifNil:[
- ctxt tempAt: 2 put: true.
- unwindBlock := ctxt tempAt: 1.
- thisContext terminateTo: ctxt.
- unwindBlock value].
- ].
- thisContext terminateTo: self.
- ^ value
  !

Item was added:
+ ----- Method: Context>>resumeEvaluating: (in category 'controlling') -----
+ resumeEvaluating: aBlock
+ "Unwind thisContext to self and resume with value as result of last send.
+ Execute unwind blocks when unwinding.
+ ASSUMES self is a sender of thisContext"
+
+ | ctxt unwindBlock |
+ self isDead ifTrue: [self cannotReturn: aBlock value to: self].
+ ctxt := thisContext.
+ [ ctxt := ctxt findNextUnwindContextUpTo: self.
+ ctxt isNil
+ ] whileFalse: [
+ (ctxt tempAt: 2) ifNil:[
+ ctxt tempAt: 2 put: true.
+ unwindBlock := ctxt tempAt: 1.
+ thisContext terminateTo: ctxt.
+ unwindBlock value].
+ ].
+ thisContext terminateTo: self.
+ ^ aBlock value
+ !

Item was added:
+ ----- Method: Context>>returnEvaluating: (in category 'controlling') -----
+ returnEvaluating: aBlock
+ "Unwind thisContext to self and return aBlock value to self's sender.
+ Execute any unwind blocks while unwinding.
+ ASSUMES self is a sender of thisContext"
+
+ sender ifNil: [self cannotReturn: aBlock value to: sender].
+ sender resumeEvaluating: aBlock!

Item was added:
+ ----- Method: Context>>willHandleSignal: (in category 'private-exceptions') -----
+ willHandleSignal: exception
+ "Sent to handler (on:do:) contexts only."
+
+ ^self isHandlerActive and: [(self tempAt: 1) handles: exception]
+ !

Item was changed:
  ----- Method: Exception>>pass (in category 'handling') -----
  pass
  "Yield control to the enclosing exception action for the receiver."
 
+ (handlerContext nextHandlerContextForSignal: self) handleSignal: self!
- handlerContext nextHandlerContext handleSignal: self!

Item was added:
+ ----- Method: Exception>>privHandlerContext (in category 'priv handling') -----
+ privHandlerContext
+ ^handlerContext!

Item was changed:
  ----- Method: Exception>>reactivateHandlers (in category 'priv handling') -----
  reactivateHandlers
+ "Private - exception handling
+ do nothing, this method is only here for smooth transition.
+ It shall be removed at next update map."
+
+ ^self!
- "reactivate all the exception handlers in the context chain"
- self canSearchForSignalerContext
- ifTrue: [signalContext nextHandlerContext reactivateHandlers]!

Item was changed:
  ----- Method: Exception>>resignalAs: (in category 'handling') -----
  resignalAs: replacementException
  "Signal an alternative exception in place of the receiver."
 
+ self resumeEvaluating: [replacementException signal]!
- self reactivateHandlers.
- self resumeUnchecked: replacementException signal!

Item was changed:
  ----- Method: Exception>>resume: (in category 'handling') -----
  resume: resumptionValue
  "Return resumptionValue as the value of the signal message."
 
  self isResumable ifFalse: [IllegalResumeAttempt signal].
- self reactivateHandlers.
  self resumeUnchecked: resumptionValue!

Item was added:
+ ----- Method: Exception>>resumeEvaluating: (in category 'handling') -----
+ resumeEvaluating: aBlock
+ "Return result of evaluating aBlock as the value of #signal, unless this was called after an #outer message, then return resumptionValue as the value of #outer.
+ The block is only evaluated after unwinding the stack."
+
+ | ctxt |
+ outerContext ifNil: [
+ signalContext returnEvaluating: aBlock
+ ] ifNotNil: [
+ ctxt := outerContext.
+ outerContext := ctxt tempAt: 1. "prevOuterContext in #outer"
+ ctxt returnEvaluating: aBlock
+ ].
+ !

Item was changed:
  ----- Method: Exception>>signal (in category 'signaling') -----
  signal
  "Ask ContextHandlers in the sender chain to handle this signal.  The default is to execute and return my defaultAction."
 
  signalContext := thisContext contextTag.
+ ^(thisContext nextHandlerContextForSignal: self) handleSignal: self!
- ^ thisContext nextHandlerContext handleSignal: self!

Item was changed:
  ----- Method: UndefinedObject>>handleSignal: (in category 'bottom context') -----
  handleSignal: exception
+ "When no more handler (on:do:) context left in sender chain this gets called.  Return from signal with default action."
- "When no more handler (on:do:) context left in sender chain this gets called.  Return from signal with default action.
- Before doing that, reactivate the handlers so that they can catch eventual secondary exceptions raised by defaultAction."
 
+ ^ exception resumeUnchecked: exception defaultAction!
- ^ exception reactivateHandlers; resumeUnchecked: exception defaultAction!

Item was removed:
- ----- Method: UndefinedObject>>reactivateHandlers (in category 'bottom context') -----
- reactivateHandlers
- "nothing to do for bottom context"
-
- ^ self!

Item was added:
+ ----- Method: UndefinedObject>>rearmHandlersWhich:upTo: (in category 'bottom context') -----
+ rearmHandlersWhich: selectBlock upTo: aHandlerContext
+
+ ^ self!