'From Squeak3.7beta of ''1 April 2004'' [latest update: #5905] on 20 May 2004 at 5:35:35 pm'! "Change Set: ContextJumpCleanup-ajh Date: 20 May 2004 Author: Anthony Hannan Cleans up context jump and return code a little. There is now only one #jump command (#jumpTop is removed)."! !ContextPart methodsFor: 'controlling' stamp: 'ajh 3/25/2004 00:07'! jump "Abandon thisContext and resume self instead (using the same current process). You may want to save thisContext's sender before calling this so you can jump back to it. Self MUST BE a top context (ie. a suspended context or a abandoned context that was jumped out of). A top context already has its return value on its stack (see Interpreter>>primitiveSuspend and other suspending primitives). thisContext's sender is converted to a top context (by pushing a nil return value on its stack) so it can be jump back to." | top | "Make abandoned context a top context (has return value (nil)) so it can be jumped back to" thisContext sender push: nil. "Pop self return value then return it to self (since we jump to self by returning to it)" stackp = 0 ifTrue: [self stepToSendOrReturn]. stackp = 0 ifTrue: [self push: nil]. "must be quick return self/constant" top _ self pop. thisContext privSender: self. ^ top! ! !ContextPart methodsFor: 'controlling' stamp: 'ajh 5/20/2004 17:32'! restart "Unwind thisContext to self and resume from beginning. Execute unwind blocks when unwinding. ASSUMES self is a sender of thisContext" | ctxt unwindBlock | self isDead ifTrue: [self cannotReturn: nil to: self]. self privRefresh. ctxt _ thisContext. [ ctxt _ ctxt findNextUnwindContextUpTo: self. ctxt isNil ] whileFalse: [ unwindBlock _ ctxt tempAt: 1. unwindBlock ifNotNil: [ ctxt tempAt: 1 put: nil. thisContext terminateTo: ctxt. unwindBlock value]. ]. thisContext terminateTo: self. self jump. ! ! !ContextPart methodsFor: 'controlling' stamp: 'ajh 5/20/2004 17:32'! 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" | ctxt unwindBlock | self isDead ifTrue: [self cannotReturn: value to: self]. ctxt _ thisContext. [ ctxt _ ctxt findNextUnwindContextUpTo: self. ctxt isNil ] whileFalse: [ unwindBlock _ ctxt tempAt: 1. unwindBlock ifNotNil: [ ctxt tempAt: 1 put: nil. thisContext terminateTo: ctxt. unwindBlock value]. ]. thisContext terminateTo: self. ^ value ! ! !ContextPart methodsFor: 'controlling' stamp: 'ajh 5/20/2004 17:27'! return: value "Unwind thisContext to self and return value to self's sender. Execute any unwind blocks while unwinding. ASSUMES self is a sender of thisContext" sender ifNil: [self cannotReturn: value to: sender]. sender resume: value! ! !ContextPart methodsFor: 'controlling' stamp: 'ajh 5/20/2004 17:20'! runUntilErrorOrReturnFrom: aSender "ASSUMES aSender is a sender of self. Execute self's stack until aSender returns or an unhandled exception is raised. Return a pair containing the new top context and a possibly nil exception. The exception is not nil if it was raised before aSender returned and it was not handled. The exception is returned rather than openning the debugger, giving the caller the choice of how to handle it." "Self is run by jumping directly to it (the active process abandons thisContext and executes self). However, before jumping to self we insert an ensure block under aSender that jumps back to thisContext when evaluated. We also insert an exception handler under aSender that jumps back to thisContext when an unhandled exception is raised. In either case, the inserted ensure and exception handler are removed once control jumps back to thisContext." | error ctxt here topContext | here _ thisContext. "Insert ensure and exception handler contexts under aSender" error _ nil. ctxt _ aSender insertSender: (ContextPart contextOn: UnhandledError do: [:ex | error ifNil: [ error _ ex exception. topContext _ thisContext. ex resumeUnchecked: here jump] ifNotNil: [ex pass] ]). ctxt _ ctxt insertSender: (ContextPart contextEnsure: [error ifNil: [ topContext _ thisContext. here jump] ]). self jump. "Control jumps to self" "Control resumes here once above ensure block or exception handler is executed" ^ error ifNil: [ "No error was raised, remove ensure context by stepping until popped" [ctxt isDead] whileFalse: [topContext _ topContext stepToCallee]. {topContext. nil} ] ifNotNil: [ "Error was raised, remove inserted above contexts then return signaler context" aSender terminateTo: ctxt sender. "remove above ensure and handler contexts" {topContext. error} ]. ! ! !ContextPart methodsFor: 'private' stamp: 'ajh 5/20/2004 16:27'! activateReturn: aContext value: value "Activate 'aContext return: value' in place of self, so execution will return to aContext's sender" ^ self activateMethod: ContextPart theReturnMethod withArgs: {value} receiver: aContext class: aContext class! ! !ContextPart class methodsFor: 'special context creation' stamp: 'ajh 5/20/2004 16:25'! theReturnMethod | meth | meth _ self lookupSelector: #return:. meth primitive = 0 ifFalse: [^ self error: 'expected #return: to not be a primitive']. ^ meth! ! !Process methodsFor: 'changing process state' stamp: 'ajh 5/20/2004 17:34'! terminate "Stop the process that the receiver represents forever. Unwind to execute pending ensure:/ifCurtailed: blocks before terminating." | ctxt unwindBlock | self isActiveProcess ifTrue: [ ctxt _ thisContext. [ ctxt _ ctxt findNextUnwindContextUpTo: nil. ctxt isNil ] whileFalse: [ unwindBlock _ ctxt tempAt: 1. unwindBlock ifNotNil: [ ctxt tempAt: 1 put: nil. thisContext terminateTo: ctxt. unwindBlock value]. ]. thisContext terminateTo: nil. myList _ nil. self primitiveSuspend. ] ifFalse: [ myList ifNotNil: [ myList remove: self ifAbsent: []. myList _ nil]. ctxt _ self popTo: suspendedContext bottomContext. ctxt == suspendedContext bottomContext ifFalse: [ self debug: ctxt title: 'Unwind error during termination']. ]. ! ! ContextPart removeSelector: #jumpTop!