Context.st
author Claus Gittinger <cg@exept.de>
Fri, 08 Jul 2005 19:15:03 +0200
changeset 8913 b9498d27a554
parent 8910 ab8803abd335
child 9355 860d76b815aa
permissions -rw-r--r--
64bit; mkSmallInteger

"
 COPYRIGHT (c) 1988 by Claus Gittinger
	      All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"

"{ Package: 'stx:libbasic' }"

Object variableSubclass:#Context
	instanceVariableNames:'flags sender* home receiver selector searchClass lineNr
		retvalTemp handle*'
	classVariableNames:'InvalidReturnSignal SingleStepInterruptRequest'
	poolDictionaries:''
	category:'Kernel-Methods'
!

!Context class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 1988 by Claus Gittinger
	      All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"
!

documentation
"
    Contexts represent the stack frame objects, which keep the processing
    state of a method or block (i.e. its local variables, temporaries etc.)
    Every message send adds a context to a chain, which can be traced back via 
    the sender field. The context of the currently active method is always
    accessable via the pseuodoVariable called 'thisContext'.
    (The actual implementation uses the machines stack for this, building real 
     contexts on demand only).

    For both method- and block-contexts, the layout is the same. 
    For method contexts, the home-field is nil, while for block contexts the home-
    field is either the context of its surrounding block (i.e. the context of the
    block, in which the receiving block was created, if its a nested block) or of
    its home method. 

    Contexts of cheap blocks do not have a home context - their home field is 
    also nil.

    Currently, contexts do not contain a reference to the method or block which
    created it - this is not needed for program execution, but could get the debugger
    somewhat into trouble: it has to search the class hierarchy for receiver/selector
    combinations to find the method. This usually works, but fails in case of methods
    which are not anchored in any class - especially leading to problems with wrapper-
    and lazy methods. Also, Method>>valueWithReceiver - type of invocations cannot
    be easily debugged.
    Therefore, the implementation may be changed in the near future, to include a
    field for the method/block, and set it in the VM during program execution.
    (there may be some small performance penalty for this, though).

    LineNumbers vs. program counter:

    Due to the compilation to machine code, methods and/or block do not
    always (actually: do seldom) contain bytecodes. Thus, there is no such concept
    as a bytecode p-counter. To support debugging, the linenumber within the
    original source is instead remembered when a send or loop entry is performed.
    Since linenumbers are not always sufficient for debugging (multiple sends in one
    line), this may be changed in future versions to a character offset, giving
    the position of the selector in the source.

    Restartable / Returnable contexts:

    In previous versions (up to ST/X 2.10.5), every method stored enough
    information in the context for that one to be restartable later (for example,
    via the debuggers restart button). With 2.10.6, this is now an stc-compiler
    option, and the system as delivered is compiled to only create restartable
    contexts for those which contain blocks. This resulted in an overall speedup of
    roughly 10-20% percent, depending on the type of CPU. However, it makes most
    methods non-restartable (however, abort, signal handling and unwind blocks work
    as usual).
    In practice, this was reported to be not a severe limitation and all users were happy
    to trade the increased performance for that slight inconvenience.
    (during development, this is seldom a problem, since interpreted methods are always
     returnable and restartable)
    If you do not like this (and you are a happy owner of the full distribution), you
    should recompile all classes with stc's '-optContext' flag.

    Resuming contexts:

    Strictly speaking, ST/X does not support a context to be resumed. However,
    it does support a forced return (i.e. non-local-return) from a context.
    Thus, resume of a context is implemented by forcing a return from the context
    which was created by the method called from the first one. The effect is the same.

    Returning from a dead method:

    Blocksreturn from an outlived context (i.e. its home method has already returned)
    is now rewarded by an invalidReturn exception - it used to be a noop in previous
    releases (The blue book described this to be a noop, but other smalltalk implementations
    changed this to be an invalid operation -  good decision)


    [instance variables:]
        flags       <SmallInteger>          used by the VM; never touch.
                                            contains info about number of args, 
                                            locals and temporaries.

        sender      <Context>               the 'calling / sending' context
                                            This is not directly accessable, since it may
                                            be a lazy context (i.e. an empty frame).
                                            The #sender method cares for this.

        home        <Context>               the context, where this block was 
                                            created, or nil if its a method context
                                            There are also cheap blocks, which do
                                            not need a reference to the home context,
                                            for those, its nil too.

        receiver    <Object>                the receiver of this message

        selector    <Symbol>                the selector of this message

        searchClass <Class>                 the class, where the message lookup started
                                            (for super sends) or nil, for regular sends.

        lineNr      <SmallInteger>          the position where the context left off
                                            (kind of p-counter). Only the low 16bits
                                             are valid.

        retValTemp  nil                     temporary - always nil, when you see the context
                                            (used in the VM as temporary)

        handle      *noObject*              used by the VM; not accessable, not an object

        <indexed>                           arguments of the send followed by
                                            locals of the method/block followed by
                                            temporaries.

    [errors:]
        CannotReturnError                   raised when a block tries
                                            to return ('^') from a method context
                                            which itself has already returned
                                            (i.e. there is no place to return to)
        
    WARNING: layout and size known by the compiler and runtime system - do not change.


    [author:]
        Claus Gittinger

    [see also:]
        Block Process Method
        ( contexts, stacks & unwinding : programming/contexts.html)
"
! !

!Context class methodsFor:'initialization'!

initialize
"/    InvalidReturnSignal isNil ifTrue:[
"/        InvalidReturnSignal := ErrorSignal newSignalMayProceed:true.
"/        InvalidReturnSignal nameClass:self message:#invalidReturnSignal.
"/        InvalidReturnSignal notifierString:'invalid return; method cannot return twice'.
"/
    CannotReturnError notifierString:'invalid return; method cannot return twice'.
    CannotResumeError notifierString:'invalid resume'.

    SingleStepInterruptRequest isNil ifTrue:[
        SingleStepInterruptRequest := QuerySignal new.
        SingleStepInterruptRequest nameClass:self message:#singleStepInterruptRequest.
        SingleStepInterruptRequest notifierString:'single step'.
    ]

    "Modified: 6.5.1996 / 16:46:03 / cg"
! !

!Context class methodsFor:'Signal constants'!

cannotResumeSignal
    "return the signal used when a method is tried to be resumed, which cannot"

    ^ CannotResumeError
!

cannotReturnSignal
    "return the signal used when a method is tried to be returned twice
     or, when some dead context is unwound or restarted."

    ^ CannotReturnError
!

invalidReturnSignal
    "return the signal used when a method is tried to be returned twice
     or, when some dead context is unwound or restarted."

    <resource: #obsolete>
    self obsoleteMethodWarning:'use #cannotReturnSignal'.
    ^ self cannotReturnSignal.
!

singleStepInterruptRequest
    "return the dummy query signal to ask for single stepping"

    ^ SingleStepInterruptRequest

    "Created: 6.5.1996 / 16:46:32 / cg"
! !

!Context class methodsFor:'queries'!

isBuiltInClass
    "return true if this class is known by the run-time-system.
     Here, true is returned."

    ^ true

    "Modified: 23.4.1996 / 15:58:00 / cg"
! !

!Context class methodsFor:'special searching'!

findFirstSpecialHandle:searchForHandle raise:searchForRaise
    |c|

%{
    OBJ __c__;

    __c__ = __ContextInstPtr(__thisContext)->c_sender;
    if (__isLazy(__c__)) {
        __PATCHUPCONTEXT(__c__);
    }
    c = __c__;
%}.
    ^ c findSpecialHandle:searchForHandle raise:searchForRaise


! !

!Context methodsFor:'Compatibility-VW'!

resumeWith:value
    "same as #resume: - visualWorks compatibility"

    self resume:value
! !

!Context methodsFor:'accessing'!

argAt:n
    "return the n'th argument"

    n > self numArgs ifTrue:[
	^ self error:'invalid arg access'
    ].
    ^ self at:n

    "Modified: 12.10.1996 / 21:44:28 / cg"
!

argAt:n put:value
    "set the n'th argument - useful when the receiver should be restarted"

    n > self numArgs ifTrue:[
        ^ self error:'invalid arg access'
    ].
    self at:n put:value.
    ^ value

    "Modified: 12.10.1996 / 21:44:32 / cg"
!

args
    "return an array filled with the arguments of this context"

    |n|

    n := self numArgs.
    n == 0 ifTrue:[
	"/ little optimization here - avaoid creating empty containers
	^ #()
    ].
    ^ (Array new:n) replaceFrom:1 to:n with:self.
!

argsAndVars
    "return an array filled with the arguments and variables of this context"

    |n|

    n := self numArgs + self numVars.
    n == 0 ifTrue:[
	"/ little optimization here - avoid creating empty containers
	^ #()
    ].
    ^ (Array new:n) replaceFrom:1 to:n with:self.

    "Modified: 23.10.1996 / 16:19:41 / cg"
!

argumentCount
    "ANSI alias for numArgs: return the number of arguments to the Block/Method"

%{  /* NOCONTEXT */

    RETURN ( __mkSmallInteger( (__intVal(__INST(flags)) >> __NARG_SHIFT) & __NARG_MASK) );
%}
!

at:n put:value
    super at:n put:value.

    "/ need some aid for optimized code -
    "/ some machines have the arguments/receiver etc. kept in register vars ...
    "/ the unfix updates the machine-stack version of the receiver.
%{
    __UNFIXCONTEXT(self, 0);
%}.
    ^ value
!

home
    "return the immediate home of the receiver.
     for block contexts, this is the methodcontext, where the block was created,
     for nested block contexts, its the surrounding blocks context.
     for method-contexts this is nil."

    ^ nil "home"
!

homeReceiver
    "return the receiver from the context, where the receiver was defined"

    ^ receiver

    "Created: / 5.3.1998 / 16:18:26 / stefan"
!

instVarAt:index
    "have to catch instVar access to retVal and handle - they are invalid.
     Notice, that one of the next ST/X versions will get some syntactic
     extension to get this automatically)."

    (index == 2) ifTrue:[^ self sender]."/ sender - must be accessed specially
    (index == 8) ifTrue:[^ nil].	"/ retvalTemp - invisible
    (index == 9) ifTrue:[^ nil].	"/ handle to machine stack - invisible
    ^ super instVarAt:index
!

instVarAt:index put:value
    "have to catch instVar access to retVal and handle - they are invalid.
     Notice, that one of the next ST/X versions will get some syntactic
     extension to get this automatically)."

    (index == 2) ifTrue:[^ nil].        "/ sender - not allowed to change
    (index == 8) ifTrue:[^ nil].        "/ retvalTemp - not allowed to change
    (index == 9) ifTrue:[^ nil].        "/ handle to machine stack - not allowed to change
    super instVarAt:index put:value.

    "/ need some aid for optimized code -
    "/ some machines have the arguments kept in register vars ...
    "/ the unfix updates the machine-stack version of the receiver.
%{
    __UNFIXCONTEXT(self, 0);
%}.
    ^ value

!

javaLineNumber
    |nr pc|

    lineNr notNil ifTrue:[
        pc := lineNr bitAnd:16rFFFF.
    ].

"/ 'ask line for pc:' print. pc printCR.
    pc isNil ifTrue:[
        nr := self lineNumberFromMethod.
        nr notNil ifTrue:[
            ^ nr
        ].
        " '-> 0 [a]' printCR. " 
        ^0
    ].

    nr := self method lineNumberForPC:pc.
    nr isNil ifTrue:[
        nr := self lineNumberFromMethod.
        nr notNil ifTrue:[
            ^ nr
        ].
        " '-> 0 [b]' printCR. " 
        ^ 0
    ].
"/ '-> ' print. nr printCR.
     ^ nr.

!

lineNumber
    "this returns the lineNumber within the methods source, where the context was
     interrupted or called another method. (currently, sometimes this information
     is not available - in this case 0 is returned)"

    |l|

    receiver isJavaObject ifTrue:[
        "/ chances are good that I am a javContext ...
        self method isJavaMethod ifTrue:[
            ^ self javaLineNumber
        ]
    ].

    lineNr notNil ifTrue:[
        l := lineNr bitAnd:16rFFFF.
    ].

"/    self isJavaContext ifTrue:[ |nr m|
"/        m := self method.
"/        l isNil ifTrue:[
"/            m notNil ifTrue:[
"/                nr := m lineNumber
"/            ].
"/            nr notNil ifTrue:[
"/                ^ nr
"/            ].
"/            ^0
"/        ].
"/        nr := self method lineNumberForPC:l.
"/        nr isNil ifTrue:[
"/            m notNil ifTrue:[
"/                nr := m lineNumber
"/            ].
"/            nr notNil ifTrue:[
"/                ^ nr
"/            ].
"/            ^ 0
"/        ].
"/         ^ nr.
"/    ].

    ^ l

    "Modified: / 10.11.1998 / 13:19:48 / cg"
!

lineNumberFromMethod
   ^ 1
!

message

    ^ Message selector:selector arguments:self args

    "
        thisContext methodHome message
        thisContext message
    "
!

method
    "return the method for which the receiver was created.
     To save time during normal execution, this information is not held in the
     context, but computed here on request."

    |c sender sendersSelector m|

    c := self searchClass.
    "
     the below cannot happen in normal circumstances
     (added to avoid recursive errors in case of a broken sender chain)
    "
    c isBehavior ifFalse:[
	'Context [error]: non class in searchClass' errorPrintCR.
	'      selector: ' errorPrint. selector errorPrint.
	' receiver: ' errorPrint. receiver errorPrintCR.
	^ nil
    ].

    c := c whichClassIncludesSelector:selector.
    c notNil ifTrue:[
	^ c compiledMethodAt:selector
    ].

    "mhmh - seems to be a context for an unbound method (as generated by doIt);
     look in the senders context. Consider this a kludge.
     (maybe it was not too good of an idea to NOT keep the current
      method in the context ...)
     Future versions of ST/X's message lookup may store the method in
     the context.
    "
    sender := self sender.
    sender notNil ifTrue:[
	sendersSelector := sender selector.
	sendersSelector notNil ifTrue:[
	    (sendersSelector startsWith:'valueWithReceiver:') ifTrue:[
		m := sender receiver.
		m isMethod ifTrue:[
		    ^ m
		]
	    ]
	]
    ].

    ^ nil

    "Modified: / 4.1.1998 / 21:15:32 / cg"
!

methodClass
    "return the class in which the method for which the receiver was created is."

    |cls m|

    cls := self searchClass.
    (cls isMeta
     and:[cls soleInstance isJavaClass]) ifTrue:[
        cls := cls soleInstance
    ].

    [cls notNil] whileTrue:[
        cls := cls whichClassIncludesSelector:selector.
        cls isNil ifTrue:[^ nil].

        m := cls compiledMethodAt:selector.
        m notNil ifTrue:[
            m isIgnored ifFalse:[^ cls].
        ].
        cls := cls superclass
    ].
    ^ cls

    "Modified: / 5.11.1998 / 19:07:43 / cg"
!

methodHome
    "return the method-home - for method contexts this is the receiver"

    ^ self
!

ntemp
    "return the number of temporary variables of the Block/Method.
     (for debugging only).
     I dont like the name of this method; its here for compatibility."

    ^ self numTemps

    "Modified: 23.10.1996 / 16:19:06 / cg"
!

numArgs
    "return the number of arguments to the Block/Method"

%{  /* NOCONTEXT */

    RETURN ( __mkSmallInteger( (__intVal(__INST(flags)) >> __NARG_SHIFT) & __NARG_MASK) );
%}
!

numTemps
    "return the number of temporary variables of the Block/Method.
     (for debugging only)"

    ^ self size - self numArgs - self numVars

    "Created: 23.10.1996 / 16:19:10 / cg"
    "Modified: 23.10.1996 / 16:19:48 / cg"
!

numVars
    "return the number of local variables of the Block/Method"

%{  /* NOCONTEXT */

    RETURN ( __mkSmallInteger( (__intVal(__INST(flags)) >> __NVAR_SHIFT) & __NVAR_MASK) );
%}
!

nvars
    "return the number of local variables of the Block/Method.
     I dont like the name of this method; its here for compatibility."

    ^ self numVars

    "Modified: 23.10.1996 / 16:18:44 / cg"
!

receiver
    "return the receiver of the context"

    ^ receiver
!

receiver:aCompiledCode
    "set the receiver of the message"

    receiver := aCompiledCode.

    "/ need some aid for optimized code -
    "/ some machines have the arguments kept in register vars ...
    "/ the unfix updates the machine-stack version of the receiver.
%{
    __UNFIXCONTEXT(self, 0);
%}.

!

searchClass
    "this is the class where the method-lookup started;
     for normal sends, it is nil (or sometimes the receivers class).
     For supersends, its the superclass of the one, in which the
     caller was defined."

    searchClass notNil ifTrue:[^ searchClass].
    ^ receiver class
!

selector
    "return the selector of the method for which the context was created"

    ^ selector
!

sender
    "return the sender of the context"

%{  /* NOCONTEXT */
    OBJ theContext;

    theContext = __INST(sender_);
    /*
     * this special nil test is for the very first context (startup-context);
     * actually, its cosmetics, to avoid a visible nil>>nil context in the debugger.
     */
    if (__isNonNilObject(theContext)) {

	if (__isLazy(theContext)) {
	    /*
	     * this cannot happen
	     */
	    __PATCHUPCONTEXT(theContext);
	}
	if (! __isNonLIFO(theContext)) {
	    /* 
	     * to be prepared for the worst situation 
	     * (the sender is not stored, so the trap wont catch it)
	     * make the writeBarrier trigger manually.
	     * We'll see, if this is really required.
	     */
	    theContext->o_space |= CATCHMARK;
	    _markNonLIFO(theContext);
	}
    }
    RETURN (theContext);
%}
!

senderIsNil
    "return true, if I have no sender"

%{  /* NOCONTEXT */
    if ( __INST(sender_) == nil ) {
        RETURN (true);
    }
    RETURN (false);
%}.
    ^ self sender isNil
!

setLineNumber:aNumber
    "private entry for uncompiledCodeObject ..."

    lineNr := aNumber
!

setNumArgs:nA numVars:nV
    "set the number of arguments and variables"

%{  /* NOCONTEXT */
    INT flg;

    flg = __intVal(__INST(flags));
    flg = flg & ~(__NARG_MASK << __NARG_SHIFT);
    flg = flg & ~(__NVAR_MASK << __NVAR_SHIFT);
    flg = flg | __intVal(nA) << __NARG_SHIFT;
    flg = flg | __intVal(nV) << __NVAR_SHIFT;
    __INST(flags) = __mkSmallInteger(flg);
%}
!

tempAt:index 
    "return the n'th stack-temporary variable"

    ^ self at:index
!

temporaries 
    "return an array filled with the temporaries of this context"

    |nonTemps mySize|

    nonTemps := self numArgs + self numVars.
    mySize := self numTemps.
    mySize == 0 ifTrue:[
	"/ little optimization here - avaoid creating empty containers
	^ #()
    ].
    ^ (Array new:mySize) replaceFrom:1 to:mySize with:self startingAt:nonTemps+1

    "Modified: 23.10.1996 / 16:20:00 / cg"
!

varAt:n
    "return the n'th local variable"

    ^ self at:(n + self numArgs)
!

varAt:n put:value
    "set the n'th local variable - useful when the receiver should be restarted
     or continued"

    self at:(n + self numArgs) put:value
!

vars 
    "return an array filled with the local variables of this context"

    |nonVars mySize|

    nonVars := self numArgs.
    mySize := self numVars.
    mySize == 0 ifTrue:[
	"/ little optimization here - avaoid creating empty containers
	^ #()
    ].
    ^ (Array new:mySize) replaceFrom:1 to:mySize with:self startingAt:nonVars+1

    "Modified: 23.10.1996 / 16:20:06 / cg"
! !

!Context methodsFor:'copying'!

deepCopyUsing:aDictionary
    "raise an error - deepCopy is not allowed for contexts"

    ^ self deepCopyError

    "Created: / 31.3.1998 / 15:51:14 / cg"
! !

!Context methodsFor:'error handling'!

invalidReturn:returnValue
    "this message is sent by the VM, when a methods context
     which has already returned is about to return again.
     (i.e. about to execute a return from an already returned
      method in a block).
    We raise a signal here, to allow catching of that situation."

    "
     in previous versions of ST/X and ST-80, this was no error;
     (instead, a normal blockreturn was performed to the value-sender).
     From a note in comp.lang.smalltalk, I conclude that new ST-80 versions
     now raise an error if this happens.
     Comment out the raise below to get that (old) behavior
     BETTER REWRITE YOUR APPLICATION
    " 
"/ old behavior:
"/  ^ returnValue

"/ new behavior:

    "/ if this context is one of another process,
    "/ use another error message.

    (home notNil and:[home sender notNil]) ifTrue:[
        ^ CannotReturnError 
            raiseRequestWith:returnValue
            errorString:'cannot return from another process''s context'.
    ].

    ^ CannotReturnError 
        raiseRequestWith:returnValue.

    "Modified: / 2.2.1998 / 15:19:52 / cg"
!

invalidReturnOrRestart:returnValue
    "this message is sent by the VM, when a methods context
     which was compiled non-returnable is about to return again.
     We raise a signal here, to allow catching of that situation."

    ^ CannotReturnError
        raiseRequestWith:returnValue
        errorString:'method was compiled non-resumable'
!

invalidReturnOrRestartError:how with:value
    "common error reporter for restart/return errors"
    
    self canReturn ifTrue:[
        "
         tried to return from/restart a context which is already dead
         (i.e. the method/block has already executed a return)
        "
        ^ CannotReturnError 
              raiseRequestWith:value
              errorString:(how , ' context not on calling chain')
    ].
    "
     tried to return from/restart a context of a method which was compiled
     unrestartable or of a block (which is never restartable)
    "
    ^ CannotReturnError 
          raiseRequestWith:value
          errorString:(how , ' context cannot be restarted/returned from')
! !

!Context methodsFor:'fixups'!

fixAllLineNumbers
%{
    __PATCHUPCONTEXTS(__thisContext);
    __CONTEXTLINENOS(self);
%}
! !

!Context methodsFor:'minidebugger printing'!

fullPrint
    "print the receiver, selector and args of the context 
     - used only for MiniDebuggers walkback print"

    self receiverPrintString print. ' ' print. selector print.
    self size ~~ 0 ifTrue: [
	' ' print. self argsDisplayString print
    ].
    ' [' print. self lineNumber print. ']' printCR

    "
     thisContext fullPrint
    "

    "Modified: 20.5.1996 / 10:27:14 / cg"
!

fullPrintAll
    "print a full walkback starting at the receiver
     - used only for MiniDebuggers walkback print"

    |context|

    context := self.
    [context notNil] whileTrue: [
	context fullPrint.
	context := context sender
    ]

    "
     thisContext fullPrintAll
    "
!

fullPrintAllLevels:nOrNil
    "print a full walkback starting at the receiver, only print n levels
     - used only for MiniDebuggers walkback print"

    |context count|

    count := 0.
    context := self.
    [context notNil] whileTrue: [
        context fullPrint.
        context := context sender.
        nOrNil notNil ifTrue:[
            (count := count+1) > nOrNil ifTrue:[^self].
        ]
    ]

    "
     thisContext fullPrintAllLevels:5
    "

    "Created: / 3.9.1999 / 14:02:38 / ps"
! !

!Context methodsFor:'non local control flow'!

evaluateUnwindActionsUpTo:aContext
    "walk up the calling chain, looking for unwind-cleanup actions to
     be performed. This depends upon those contexts being specially
     marked using #markForUnwind.
     Returns the argument (i.e. non-nil), if all went well,
     nil if aContext is not on the caller chain (definitely an error)"

    |con unwindBlock|

    "
     start with this context, moving up, looking for unwind actions
    "
    con := self findNextUnwindContextOr:aContext.
    [con notNil and:[con ~~ aContext]] whileTrue:[
        unwindBlock := con receiver unwindHandlerInContext:con.
        con unmarkForUnwind.
        unwindBlock value.

        con := con findNextUnwindContextOr:aContext.
    ].
    ^ con
!

restart
    "restart the receiver - i.e. the method is evaluated again.
     if the context to restart already died, trigger an error.
     This is a low level helper for unwindAndRestart.

     NOTICE: 
	 NO unwind actions are performed - this is usually not
	 what you want (see Context>>unwindAndRestart).

     LIMITATION: 
	 currently a context can only be restarted by
	 the owning process - not from outside.
	 Also, the compiler has an option (+optcontext) to create
	 non-restartable contexts (which are faster).
	 If such a context is restarted, a runtime error is raised."

%{  /* NOCONTEXT */
    if (__INST(sender_) != nil) {
	__RESUMECONTEXT__(self, RESTART_VALUE, 0);
    }
%}.
    self sender isNil ifTrue:[^ nil].

    "
     when we arrive here, something went wrong.
     debugging ...
    "
    ^ self invalidReturnOrRestartError:#restart with:nil
!

resume
    "resume execution in this context. I.e. as if the method called
     last by the receiver did a ^ nil.
     If the context has already returned, report an error.

     NOTICE:
	 NO unwind actions are performed (see Context>>unwind).

     LIMITATION: 
	 currently a context can only be resumed by
	 the owning process - not from outside.
	 Also, the compiler has an option (+optcontext) to create
	 non-resumable contexts (which are faster).
	 If such a context is restarted, a runtime error is raised."

    ^ self resume:nil
!

resume:value
    "resume the receiver - as if it got 'value' from whatever
     it called. This continues execution in the receivers method
     after the point where it did its last send.
     If the context has already returned - report an error. 

     NOTICE:
         NO unwind actions are performed (see Context>>unwind:).

     LIMITATION: 
         currently a context can only be resumed by
         the owning process - not from outside.
         Also, the compiler has an option (+optcontext) to create
         non-resumable contexts (which are faster).
         If such a context is restarted, a runtime error is raised."

    |theContext|

    "
     starting with this context, find the one below
     (i.e. the one that I have called) and return from it.
    "

%{
    OBJ sndr;

    theContext = __thisContext;
    while (theContext != nil) {
        sndr = __ContextInstPtr(theContext)->c_sender;
        if (sndr == self) break;
        theContext = sndr;
    }
    if (theContext != nil) {
        if (__isLazy(theContext)) {
            __PATCHUPCONTEXT(theContext);
        }
    }
%}.

    theContext isNil ifTrue:[
        "
         tried to resume in context which is already dead
         (i.e. the method/block has already executed a return)
        "
        ^ thisContext invalidReturnOrRestartError:#'resume:' with:value
    ].
    ^ theContext return:value
!

resumeIgnoringErrors:value
    "resume the receiver - as if it got 'value' from whatever
     it called. This continues execution in the receivers method
     after the point where it did its last send.
     If the context has already returned - simply return. 

     NOTICE:
         NO unwind actions are performed (see Context>>unwind:).

     LIMITATION: 
         currently a context can only be resumed by
         the owning process - not from outside.
         Also, the compiler has an option (+optcontext) to create
         non-resumable contexts (which are faster).
         If such a context is restarted, a runtime error is raised."

    "
     starting with this context, find the one below
     (i.e. the one that I have called) and return from it.
    "

%{
    OBJ theContext, sndr;

    theContext = __thisContext;
    while (theContext != nil) {
        sndr = __ContextInstPtr(theContext)->c_sender;
        if (sndr == self) break;
        theContext = sndr;
    }
    if (theContext != nil) {
        if (__ContextInstPtr(theContext)->c_sender) {
            if (!((INT)(__ContextInstPtr(theContext)->c_flags) & __MASKSMALLINT(__CANNOT_RETURN))) {
                __RESUMECONTEXT__(theContext, value, 0);
            }
        }
    }
%}.

    "/ no error reporting
!

resumeOnErrorProceed:value
    "resume the receiver - as if it got 'value' from whatever
     it called. This continues execution in the receivers method
     after the point where it did its last send.
     If the context has already returned - simply return. 

     NOTICE:
         NO unwind actions are performed (see Context>>unwind:).

     LIMITATION: 
         currently a context can only be resumed by
         the owning process - not from outside.
         Also, the compiler has an option (+optcontext) to create
         non-resumable contexts (which are faster).
         If such a context is restarted, a runtime error is raised."

    "
     starting with this context, find the one below
     (i.e. the one that I have called) and return from it.
    "

%{
    OBJ theContext, sndr;

    theContext = __thisContext;
    while (theContext != nil) {
        sndr = __ContextInstPtr(theContext)->c_sender;
        if (sndr == self) break;
        theContext = sndr;
    }
    if (theContext != nil) {
        if (__ContextInstPtr(theContext)->c_sender) {
            __RESUMECONTEXT__(theContext, value, 0);
        }
    }
%}.

    "/ no error reporting
!

return
    "return from this context with nil. I.e. as if it did a ^ nil.
     NOTICE:
	 NO unwind actions are performed - this is usually not
	 what you want (See Context>>unwind).
	 This is a low level method - a helper for unwind.

     LIMITATION: 
	 currently a context can only be returned by
	 the owning process - not from outside.
	 Also, the compiler has an option (+optcontext) to create
	 non-returnable contexts (which are faster).
	 If such a context is restarted, a runtime error is raised."

    ^ self return:nil
!

return:value
    "return from this context as if it did a '^ value'.
     NOTICE:
         NO unwind actions are performed - this is usually not
         what you want (See Context>>unwind:).
         This is a low level method - a helper for unwind.

     LIMITATION: 
         currently a context can only be returned by
         the owning process - not from outside.
         Also, the compiler has an option (+optcontext) to create
         non-returnable contexts (which are faster).
         If such a context is restarted, a runtime error is raised."

%{  /* NOCONTEXT */
    if (__INST(sender_) != nil) {
        __RESUMECONTEXT__(self, value, 0);
    }
%}.
    self sender isNil ifTrue:[^ nil].

    "
     when we arrive here, something went wrong.
     debugging ...
    "
    ^ self invalidReturnOrRestartError:#'return' with:value
!

returnDoing:aBlock
    "return from this context as if it did a '^ aBlock value'.
     The block is evaluated as if called by the receiver context;
     NOT the true executing context.
     NOTICE:
         NO unwind actions are performed - this is usually not
         what you want (See Context>>unwindThenDo:).
         This is a low level method - a helper for unwind.

     LIMITATION:
         currently a context can only be returned by
         the owning process - not from outside.
         Also, the compiler has an option (+optcontext) to create
         non-returnable contexts (which are faster).
         If such a context is restarted, a runtime error is raised."

%{  
    if (__INST(sender_) != nil) {
        __RESUMECONTEXT__(self, aBlock, 2);
    }
%}.
    self sender isNil ifTrue:[^ nil].

    "
     when we arrive here, something went wrong.
     debugging ...
    "
    ^ self invalidReturnOrRestartError:#'returnDoing' with:aBlock
!

unwind
    "return nil from the receiver - i.e. simulate a '^ nil'.
     If the context has already retruned, report an error.
     Evaluate all unwind-blocks as specified in Block>>valueNowOrOnUnwind:
     and Block>>valueOnUnwindDo: on the way.

     LIMITATION: 
         currently a context can only be unwound by
         the owning process - not from outside.
         i.e. it is not possible for one thread to unwind
         another threads context - which does not make sense anyway.
         However, you can force another thread to do this in its own process
         context, by giving it an interrupt action - this does make sense.

         Also, the compiler has an option (+optcontext) to create
         non-returnable contexts (which are faster).
         If such a context is restarted, a runtime error is raised."

    ^ self unwind:nil
!

unwind:value
    "return value from the receiver - i.e. simulate a '^ value'.
     If the context has already returned , report an error.
     Evaluate all unwind-blocks as specified in Block>>valueNowOrOnUnwind:
     and Block>>valueOnUnwindDo: on the way.

     LIMITATION: 
         currently a context can only be unwound by
         the owning process - not from outside.
         i.e. it is not possible for one thread to unwind
         another threads context - which does not make sense anyway.
         However, you can force another thread to do this in its own process
         context, by giving it an interrupt action - this does make sense.

         Also, the compiler has an option (+optcontext) to create
         non-returnable contexts (which are faster).
         If such a context is restarted, a runtime error is raised."

    |con|

    self senderIsNil ifFalse:[
        con := thisContext evaluateUnwindActionsUpTo:self.
    ].

    "oops, if nil, I am not on the calling chain;
     (bad bad, unwind action have already been performed.
      should we check for this situation first and NOT evaluate
      the unwind actions in this case ?)
    "
    con isNil ifTrue:[
        "
         tried to return to a context which is already dead
         (i.e. the method/block has already executed a return)
        "
        ^ self invalidReturnOrRestartError:#'unwind:' with:value
    ].
    "
     now, that all unwind-actions are done, I can use the
     low-level return ...
    "
    ^ self return:value
!

unwindAndRestart
    "restart the receiver - i.e. the method is evaluated again.
     if the context to restart already died report an error.
     Evaluate all unwind-blocks as specified in Block>>valueNowOrOnUnwind:
     and Block>>valueOnUnwindDo: before restarting.

     LIMITATION: 
         a context can only be restarted by
         the owning process - not from outside.
         i.e. it is not possible for one thread to unwindAndRestart
         another threads context - which does not make sense anyway.
         However, you can force another thread to do this in its own process
         context, by giving it an interrupt action - this does make sense.

         Also, the compiler has an option (+optcontext) to create
         non-restartable contexts (which are faster).
         If such a context is restarted, a runtime error is raised."

    |con|

    self senderIsNil ifFalse:[
        con := thisContext evaluateUnwindActionsUpTo:self.
    ].

    "oops, if nil, I am not on the calling chain;
     (bad bad, unwind action have already been performed.
      should we check for this situation first and NOT evaluate
      the unwind actions in this case ?)
    "
    con isNil ifTrue:[
        "
         tried to return to a context which is already dead
         (i.e. the method/block has already executed a return)
        "
        ^ self invalidReturnOrRestartError:#'unwindAndRestart:' with:nil
    ].
    "
     now, that all unwind-actions are done, I can use the
     low-level restart ...
    "
    ^ self restart
!

unwindAndResume:value
    "resume execution in the the receiver - i.e. simulate a '^ value'
     from whatever it called last.
     If the context has already returned , report an error.
     Evaluate all unwind-blocks as specified in Block>>valueNowOrOnUnwind:
     and Block>>valueOnUnwindDo: on the way.

     LIMITATION: 
         currently a context can only be unwound by
         the owning process - not from outside.
         i.e. it is not possible for one thread to unwind
         another threads context - which does not make sense anyway.
         However, you can force another thread to do this in its own process
         context, by giving it an interrupt action - this does make sense.

         Also, the compiler has an option (+optcontext) to create
         non-returnable contexts (which are faster).
         If such a context is restarted, a runtime error is raised."

    |con|

    self senderIsNil ifFalse:[
        con := thisContext evaluateUnwindActionsUpTo:self.
    ].

    "oops, if nil, I am not on the calling chain;
     (bad bad, unwind action have already been performed.
      should we check for this situation first and NOT evaluate
      the unwind actions in this case ?)
    "
    con isNil ifTrue:[
        "
         tried to return to a context which is already dead
         (i.e. the method/block has already executed a return)
        "
        ^ self invalidReturnOrRestartError:#'unwindAndResume:' with:value
    ].
    "
     now, that all unwind-actions are done, I can use the
     low-level resume ...
    "
    ^ self resume:value
!

unwindThenDo:aBlock 
    "return the value of aBlock from the receiver - i.e. simulate a '^ aBlock value'.
     If the context has already returned , report an error.
     Evaluate all unwind-blocks as specified in Block>>valueNowOrOnUnwind:
     and Block>>valueOnUnwindDo: on the way.
     The block is evaluated AFTER all unwind actions are performed
     (i.e. the blocks sender will be the receiving context, not the
      currently executing context)

     LIMITATION: 
         currently a context can only be unwound by
         the owning process - not from outside
         i.e. it is not possible for one thread to unwindThenDo
         another threads context - which does not make sense anyway.
         However, you can force another thread to do this in its own process
         context, by giving it an interrupt action - this does make sense.

         Also, the compiler has an option (+optcontext) to create
         non-returnable contexts (which are faster).
         If such a context is restarted, a runtime error is raised."

    |con|

    self senderIsNil ifFalse:[
        con := thisContext evaluateUnwindActionsUpTo:self.
    ].

    "oops, if nil, I am not on the calling chain;
     (bad bad, unwind action have already been performed.
      should we check for this situation first and NOT evaluate
      the unwind actions in this case ?)
    "
    con isNil ifTrue:[
        "
         tried to return to a context which is already dead
         (i.e. the method/block has already executed a return)
        "
        ^ self invalidReturnOrRestartError:#'unwindThenDo:' with:aBlock
    ].
    "
     now, that all unwind-actions are done, I can use the
     low-level return ...
    "
    ^ self returnDoing:aBlock 
! !

!Context methodsFor:'printing & storing'!

argStringFor:someObject

    |name|
%{
    /*
     * special handling for (invalid) free objects.
     * these only appear if some primitiveCode does not correctly use SEND macros,
     * which may lead to sends to free objects. In normal operation, this 'cannot' happen.
     */ 
    if (__isNonNilObject(someObject) && (__qClass(someObject)==nil)) {
	name = __MKSTRING("FreeObject");
    }
%}.
    name notNil ifTrue:[^ name].
    ^ someObject displayString
!

argsDisplayString
    |fullString n "{ Class: SmallInteger }" |

    fullString := ''.
    n := self numArgs.
    1 to:n do:[:index |
	fullString := fullString , ' ' , (self argStringFor:(self at:index))
    ].
    ^ fullString
!

displayArgsOn:aStream
    | n "{ Class: SmallInteger }" |

    n := self numArgs.
    1 to:n do:[:index |
        aStream nextPutAll:(self argStringFor:(self at:index)).
        aStream nextPutAll:' '.
    ].
!

displayString
    "return a string describing the context - for display in Inspector" 

    ^ self class name , '(' , self printString , ')'
!

fullPrintAllOn:aStream
    "print a full walkback starting at the receiver"

    |context|

    context := self.
    [context notNil] whileTrue: [
        context fullPrintOn:aStream.
        aStream cr.
        context := context sender
    ]

    "
     thisContext fullPrintAllOn:Transcript
    "

    "Created: 15.1.1997 / 18:09:05 / cg"
!

fullPrintOn:aStream
    "print the receiver, selector and args of the context"

    self receiverPrintString printOn:aStream. 
    aStream nextPutAll:' '. 
    selector printOn:aStream.

    self size ~~ 0 ifTrue: [
        aStream nextPutAll:' '. 
        self displayArgsOn:aStream
    ].
    aStream nextPutAll:' ['. 
    self lineNumber printOn:aStream.
    aStream nextPutAll:']'.

    "
     thisContext fullPrintOn:Transcript
    "

    "Modified: 20.5.1996 / 10:27:14 / cg"
    "Created: 15.1.1997 / 18:09:06 / cg"
!

fullPrintString
    "return a string describing the context - this includes the linenumber,
     receiver printString and argument printString"

    |s|

    s := WriteStream on:String new.
    self fullPrintOn:s.
    ^ s contents

    "
     thisContext fullPrintString
    "
!

methodPrintString
    "return a string describing the contexts method as 'implementorClass>>selector'" 

    |mthd who|

    mthd := self method.
    mthd notNil ifTrue:[
	who := mthd who.
	who notNil ifTrue:[
	    ^ who methodClass name , '>>' , who methodSelector
	]
    ].
    ^ mthd displayString.

    "
     thisContext methodPrintString 
     thisContext sender methodPrintString  
    "

    "Modified: 1.11.1996 / 16:21:49 / cg"
!

printOn:aStream
    "append a printed description of the receiver onto aStream"

    aStream nextPutAll:(self receiverPrintString).
    aStream space.
    self selector printOn:aStream.
    aStream space.
    aStream nextPutAll:' ['; nextPutAll:self lineNumber printString; nextPutAll:']' .

!

receiverPrintString
    "return a string describing the receiver of the context" 

    |receiverClass receiverClassName newString implementorClass|

%{
    /*
     * special handling for (invalid) free objects.
     * these only appear if some primitiveCode does not correctly use SEND macros,
     * which may lead to sends to free objects. In normal operation, this 'cannot' happen.
     */ 
    if (__isNonNilObject(__INST(receiver)) && (__qClass(__INST(receiver))==nil)) {
        receiverClassName = __MKSTRING("FreeObject");
    }
%}.
    receiverClassName notNil ifTrue:[^ receiverClassName].

    receiverClass := receiver class.
    receiverClass isJavaClass ifTrue:[
        receiverClassName := receiverClass displayString
    ] ifFalse:[
        (receiverClass isBehavior
        and:[receiverClass isMeta 
        and:[receiverClass soleInstance isJavaClass]]) ifTrue:[
"/            receiverClassName := receiverClass soleInstance fullName.
            receiverClassName := receiverClass name.
        ] ifFalse:[
            receiverClassName := receiverClass name.
        ]
    ].
    (receiverClass == SmallInteger
    or:[receiverClass == Float]) ifTrue:[
        newString := '(' , receiver printString , ') ' , receiverClassName
    ] ifFalse:[
        newString := receiverClassName
    ].

    selector notNil ifTrue:[
"/        implementorClass := self searchClass whichClassIncludesSelector:selector.

        "
         kludge to avoid slow search for containing class
        "
        (selector ~~ #doIt and:[selector ~~ #doIt:]) ifTrue:[
            implementorClass := self methodClass. 
        ].

        implementorClass notNil ifTrue: [
            (implementorClass ~~ receiverClass) ifTrue: [
                newString := newString , '>>>',
                             implementorClass name printString
            ]
        ] ifFalse:[
            self searchClass ~~ receiverClass ifTrue:[
                newString := newString , '>>>' , self searchClass name
            ].
            "
             kludge for doIt - these unbound methods are not
             found in the classes methodDictionary
            "
            (selector ~~ #doIt and:[selector ~~ #doIt:]) ifTrue:[
                newString := newString , '>>>**NONE**'
            ]
        ]
    ].

    ^ newString

    "Modified: / 16.11.2001 / 16:04:21 / cg"
! !

!Context methodsFor:'private-accessing'!

markForHandle
    "set the mark for exception handle flag in the receiver.
     The VM needs this to know that some special action is to be performed with
     this context - a highly internal mechanism and not for public use."

%{  /* NOCONTEXT */
     __INST(flags) = (OBJ)((INT)__INST(flags) | __MASKSMALLINT(__HANDLE_MARK));
%}

    "Modified: 13.12.1995 / 19:05:22 / cg"
!

markForInterrupt
    "set the interrupt flag.
     The VM needs this to know that some special action is to be performed with
     this context upon return - a highly internal mechanism and not for public use."

%{  /* NOCONTEXT */
     __markInterrupted(__ContextInstPtr(self));
%}
!

markForInterruptOnUnwind
    "set the interrupt-on-unwind flag in the receiver.
     The VM will generate a stepInterrupt, when this context returns or
     is unwound. This is used by the debugger for faster single-stepping;
     - a highly internal mechanism and not for public use."

%{  /* NOCONTEXT */
     __INST(flags) = (OBJ)((INT)__INST(flags) | __MASKSMALLINT(__IRQ_ON_UNWIND));
%}
!

markForRaise
    "set the mark for exception raise flag in the receiver.
     The VM needs this to know that some special action is to be performed with
     this context - a highly internal mechanism and not for public use."

%{  /* NOCONTEXT */
     __INST(flags) = (OBJ)((INT)__INST(flags) | __MASKSMALLINT(__RAISE_MARK));
%}

    "Modified: 13.12.1995 / 19:05:22 / cg"
!

markForUnwind
    "set the mark for unwind flag in the receiver.
     The VM needs this to know that some special action is to be performed with
     this context - a highly internal mechanism and not for public use."

%{  /* NOCONTEXT */
     __INST(flags) = (OBJ)((INT)__INST(flags) | __MASKSMALLINT(__UNWIND_MARK));
%}

    "Modified: 13.12.1995 / 19:05:22 / cg"
!

setHome:aContext
    "set the homeContext.
     DANGER: this is for experimental, internal use only (byteCode interpreters)"

    home := aContext.
!

setSender:aContext
    "set the sender of the context.
     DANGER: this is for experimental, internal use only (byteCode interpreters)"

%{  /* NOCONTEXT */
    __INST(sender_) = aContext;
%}
!

unmarkForUnwind
    "clear the mark for unwind flag in the receiver.
     The VM needs this to know that some special action is to be performed with
     this context - a highly internal mechanism and not for public use."

%{  /* NOCONTEXT */
    __INST(flags) = (OBJ)((INT)__INST(flags) & ~__MASKSMALLINT(__UNWIND_MARK));
%}
! !

!Context methodsFor:'searching'!

findExceptional
    "walk along the sender chain (starting with the sender), 
     for a context which is marked as handle or raise context.
     This non-standard interface is only to be used by exception"

    "/ this could have been (actually: was) implemented as:
    "/
    "/  |con|
    "/
    "/  con := self.
    "/  [con notNil] whileTrue:[
    "/      [con isHandleContext] ifTrue:[^con].
    "/      [con isRaiseContext] ifTrue:[^con].
    "/      con := con sender.
    "/  ].
    "/  ^ nil
    "/
    "/ and the code below does exactly this (somewhat faster, though).
    "/
    "/ (it avoids referencing all intermediate contexts, which would mark them special,
    "/  although they aren't really - this is expert knowledge, no need to understand that ...)

%{  /* NOCONTEXT */

    OBJ theContext;

    theContext = self;
    while (__isNonNilObject(theContext)) {
        if ((INT)(__ContextInstPtr(theContext)->c_flags) & __MASKSMALLINT(__HANDLE_MARK|__RAISE_MARK)) {
            if (__isLazy(theContext)) {
                __PATCHUPCONTEXT(theContext);
            }

            if (! __isNonLIFO(theContext)) {
                /* 
                 * to be prepared for the worst situation 
                 * (the sender is not stored, so the trap won't catch it)
                 * make the writeBarrier trigger manually.
                 * We'll see, if this is really required.
                 */
                theContext->o_space |= CATCHMARK;
#if 0
                _markNonLIFO(theContext);
#endif
            }
            RETURN (theContext);
        }
        theContext = __ContextInstPtr(theContext)->c_sender;
    }
%}.
    ^ nil
!

findNextContextWithSelector:selector1 or:selector2 or:selector3
    "walk along the sender chain (starting with the sender), 
     for a context with either one of the given selectors.
     This non-standard interface is only to be used by exception"

    "/ this could have been (actually: was) implemented as:
    "/
    "/  |con|
    "/
    "/  con := self sender.
    "/  [con notNil] whileTrue:[
    "/      con selector == aSelector ifTrue:[^ con].
    "/      con := con sender.
    "/  ].
    "/  ^ nil
    "/
    "/ and the code below does exactly this (somewhat faster, though).
    "/
    "/ (it avoids referencing all intermediate contexts, which would mark them special,
    "/  although they aren't really - this is expert knowledge, no need to understand that ...)

%{  /* NOCONTEXT */

    OBJ theContext;
    OBJ sel;
    OBJ __FETCHSELECTOR();

    theContext = __INST(sender_);
    while (__isNonNilObject(theContext)) {
        if (__isLazy(theContext)) {
#ifdef TRADITIONAL_STACK_FRAME
            sel = __FETCHSELECTOR(theContext);
#else
            /* mhmh - not really needed */
            __PATCHUPCONTEXT(theContext);
            sel = __ContextInstPtr(theContext)->c_selector;
#endif
        } else {
            sel = __ContextInstPtr(theContext)->c_selector;
        }

        if ((sel == selector1)
         || ((selector2 != nil) && (sel == selector2))
         || ((selector3 != nil) && (sel == selector3))) {
            if (__isLazy(theContext)) {
                __PATCHUPCONTEXT(theContext);
            }

            if (! __isNonLIFO(theContext)) {
                /* 
                 * to be prepared for the worst situation 
                 * (the sender is not stored, so the trap wont catch it)
                 * make the writeBarrier trigger manually.
                 * We'll see, if this is really required.
                 */
                theContext->o_space |= CATCHMARK;
                _markNonLIFO(theContext);
            }
            RETURN (theContext);
        }
        theContext = __ContextInstPtr(theContext)->c_sender;
    }
    RETURN (nil);
%}.
    "
     |con sel|

     con := self sender.
     [con notNil] whileTrue:[
        sel := con selector.
        sel == selector1 ifTrue:[^ con].
        (selector2 notNil and:[sel == selector2]) ifTrue:[^ con].
        (selector3 notNil and:[sel == selector3]) ifTrue:[^ con].
        con := con sender.
     ].
     ^ nil
    "
!

findNextUnwindContextOr:aContext
    "walk along the sender chain (starting at the sender), 
     for a context marked for unwindAction or aContext.
     This non-standard interface is only to be used by mySelf"

    "/ this could have been (actually: was) implemented as:
    "/
    "/  |con|
    "/
    "/  con := self sender.
    "/  [con notNil
    "/   and:[con ~~ aContext
    "/   and:[con isUnwindContext not]]] whileTrue:[con := con sender].
    "/  ^ con
    "/
    "/ and the code below does exactly this (somewhat faster, though).
    "/ (it avoids referencing all intermediate contexts, which would mark them special,
    "/  although they aren't really - this is expert knowledge, no need to understand that ...)

%{  /* NOCONTEXT */

    OBJ theContext;

    if (self == aContext) {
        RETURN (self);
    }

    theContext = __INST(sender_);
    while (__isNonNilObject(theContext)) {
        if ((theContext == aContext)
         || ((INT)(__ContextInstPtr(theContext)->c_flags) & __MASKSMALLINT(__UNWIND_MARK))) {
            if (__isLazy(theContext)) {
                __PATCHUPCONTEXT(theContext);
            }
            if (! __isNonLIFO(theContext)) {
                /*
                 * to be prepared for the worst situation
                 * (the sender is not stored, so the trap wont catch it)
                 * make the writeBarrier trigger manually.
                 * We'll see, if this is really required.
                 */
                theContext->o_space |= CATCHMARK;
#if 0
                _markNonLIFO(theContext);
#endif
            }
            RETURN (theContext);
        }
        theContext = __ContextInstPtr(theContext)->c_sender;
    }
%}.
    ^ nil
!

findSpecialHandle:findHandleContext raise:findRaiseContext
    "walk along the sender chain (starting with the sender), 
     for a context which is marked as handle or raise context.
     This non-standard interface is only to be used by exception"

    "/ this could have been (actually: was) implemented as:
    "/
    "/  |con|
    "/
    "/  con := self sender.
    "/  [con notNil] whileTrue:[
    "/      (findHandleContext and:[con isHandleContext]) ifTrue:[^con].
    "/      (findRaiseContext and:[con isRaiseContext]) ifTrue:[^con].
    "/      con := con sender.
    "/  ].
    "/  ^ nil
    "/
    "/ and the code below does exactly this (somewhat faster, though).
    "/
    "/ (it avoids referencing all intermediate contexts, which would mark them special,
    "/  although they aren't really - this is expert knowledge, no need to understand that ...)

%{  /* NOCONTEXT */

    OBJ theContext;
    int flagMask = 0;
    INT mask;

    if (findHandleContext == true)
        flagMask = __HANDLE_MARK;
    if (findRaiseContext == true)
        flagMask |= __RAISE_MARK;

    mask = __MASKSMALLINT(flagMask);    
    theContext = __INST(sender_);
    while (__isNonNilObject(theContext)) {
        if ((INT)(__ContextInstPtr(theContext)->c_flags) & mask) {
            if (__isLazy(theContext)) {
                __PATCHUPCONTEXT(theContext);
            }

            if (! __isNonLIFO(theContext)) {
                /* 
                 * to be prepared for the worst situation 
                 * (the sender is not stored, so the trap won't catch it)
                 * make the writeBarrier trigger manually.
                 * We'll see, if this is really required.
                 */
                theContext->o_space |= CATCHMARK;
#if 0
                _markNonLIFO(theContext);
#endif
            }
            RETURN (theContext);
        }
        theContext = __ContextInstPtr(theContext)->c_sender;
    }
%}.
    ^ nil
! !

!Context methodsFor:'special accessing'!

argAndVarNames
    "helper: given a context, return a collection of arg&var names"

    |homeContext method block numArgs numVars m src 
     sel isDoIt blocksLineNr extractFromBlock sender|

    numArgs := self numArgs.
    numVars := self numVars.
    (numArgs == 0 and:[numVars == 0]) ifTrue:[^ #()].

    homeContext := self methodHome.
    homeContext notNil ifTrue:[
        sel := homeContext selector.
        method := homeContext method.
    ].

    extractFromBlock := 
        [
            |blockNode argNames varNames vars args blocksHome|

            blockNode := Compiler
                            blockAtLine:blocksLineNr
                            in:m
                            orSource:src
                            numArgs:numArgs 
                            numVars:numVars.

            blockNode notNil ifTrue:[
                "/ a kludge
                blockNode lineNumber == blocksLineNr ifTrue:[
                    blocksHome := blockNode home.
                    (blocksHome notNil and:[blocksHome isBlockNode]) ifTrue:[
                        (blocksHome numArgs == numArgs
                        and:[ blocksHome numVars == numVars ]) ifTrue:[
                            blockNode := blocksHome
                        ].
                    ].
                ].

                argNames := #().
                varNames := #().

                numArgs > 0 ifTrue:[
                    vars := blockNode arguments.
                    vars size > 0 ifTrue:[
                        argNames := vars collect:[:var | var name]
                    ]
                ].
                numVars > 0 ifTrue:[
                    vars := blockNode variables.
                    vars size > 0 ifTrue:[
                        varNames := vars collect:[:var | var name].
                    ]
                ].
                ^ argNames , varNames
            ].
        ].

    "/ #doIt needs special handling below
    isDoIt := (sel == #'doIt') or:[sel == #'doIt:'].
    self isBlockContext ifFalse:[
        isDoIt ifTrue:[
            method notNil ifTrue:[
                "/ special for #doIt
                m := nil.
                src := ('[' , method source , '\]') withCRs.
                "/ blocksLineNr := self lineNumber.
                blocksLineNr := (self home ? self) lineNumber.
                extractFromBlock value.
            ]
        ].

        method notNil ifTrue:[
            ^ method methodArgAndVarNames.
        ].
        ^ #()
    ].

    method notNil ifTrue:[
        isDoIt ifTrue:[
            "/ special for #doIt
            "/ my source is found in the method.
            m := nil.
            src := ('[' , method source , '\]') withCRs.
        ] ifFalse:[
            m := method.
            src := nil.
        ].
        blocksLineNr := self lineNumber.
        extractFromBlock value.
        blocksLineNr := self home lineNumber.
        extractFromBlock value.
    ].

    blocksLineNr isNil ifTrue:[
        self isBlockContext ifTrue:[
            sender := self sender.
            (sender notNil
            and:[sender receiver isBlock
            and:[sender selector startsWith:'value']])
            ifTrue:[
                block := sender receiver.
                src := block source.
                src isNil ifTrue:[
                    self error:'no source'.
                ].
                blocksLineNr := 1.
                extractFromBlock value.
            ].
            sender := nil.
        ].
    ].

    ^ #()
!

canResume
    "return true, if the receiver allows to be resumed.
     Due to the implementation, this requires that the context which
     is right below the receiver is returnable."

    |theContext|

    "
     starting with this context, find the one below
     (i.e. the one that I have called) and return from it.
    "
%{
    OBJ sndr;

    theContext = __thisContext;
    while (theContext != nil) {
        sndr = __ContextInstPtr(theContext)->c_sender;
        if (sndr == self) break;
        theContext = sndr;
    }
    if (theContext != nil) {
        if (__isLazy(theContext)) {
            __PATCHUPCONTEXT(theContext);
        }
    }
%}.
    theContext isNil ifTrue:[
        ^ false
    ].
    ^ theContext canReturn
!

canReturn
    "return true, if the receiver allows returning through it.
     Blocks, (currently) always return false.
     Methods which contain a (non-inlined) block are always
     returnable - for other methods, it depends on how the system
     was compiled (stc flag +/-optContext).
     If it was compiled with +optContext, methods are compiled
     non returnable, unless a return-pragma was present in the method.
     Since this saves some administrative work in every method
     invocation and makes overall execution faster, the system classes
     are all compiled with this flag turned on."

%{  /* NOCONTEXT */

    RETURN ( ((INT)(__INST(flags)) & __MASKSMALLINT(__CANNOT_RETURN)) ? false : true );
%}.
    ^ true
!

hasStackToShow
    "private interface to the debugger.
     Smalltalk contexts return false here - other language frames
     (i.e. Java frames) may want to show the evaluation stack"

    ^ false

    "Created: 28.6.1996 / 14:48:39 / cg"
    "Modified: 13.5.1997 / 16:31:12 / cg"
!

isHandleContext
    "return true, if this is a context with exception-handle flag set"

%{  /* NOCONTEXT */
     RETURN ( ((INT)__INST(flags) & __MASKSMALLINT(__HANDLE_MARK)) ? true : false );
%}
!

isNonLifo
    "return true, if this is a nonLifo context.
     A nonLifo context is one that is still on the machine stack,
     but has a reference taken and needs to be converted to a real
     object (in objectMemory) when the method/block returns.
     You dont have to understand this - this is a special ST/X
     debug query, which may be removed without notice."

%{  /* NOCONTEXT */
     RETURN ( ((INT)__INST(flags) & __MASKSMALLINT(__NONLIFO)) ? true : false );
%}
!

isOnMachineStack
    "return true, if this is a machine stack context as opposed to a 
     real heap context.
     You dont have to understand this - this is a special ST/X
     debug query, which may be removed without notice."

%{  /* NOCONTEXT */
     RETURN ( (__qSpace(self) >= STACKSPACE) ? true : false );
%}
!

isRaiseContext
    "return true, if this is a context with exception-raise flag set"

%{  /* NOCONTEXT */
     RETURN ( ((INT)__INST(flags) & __MASKSMALLINT(__RAISE_MARK)) ? true : false );
%}
!

isSpecial
    "return true, if this is either a nonLifo or interrupted context"

%{  /* NOCONTEXT */
     RETURN ( ((INT)__INST(flags) & __MASKSMALLINT(__SPECIAL)) ? true : false );
%}
!

isUnwindContext
    "return true, if this is an unwindContext"

%{  /* NOCONTEXT */
     RETURN ( ((INT)__INST(flags) & __MASKSMALLINT(__UNWIND_MARK)) ? true : false );
%}
!

tempNames
    "helper: given a context, return a collection of arg, var and temporary names"

    |names nTemps|

    names := self argAndVarNames.
    (nTemps := self numTemps) > 0 ifTrue:[
        ^ names , ((1 to:nTemps) collect:[:idx | '_tmp' , idx printString]).
    ].
    ^ names.
! !

!Context methodsFor:'testing'!

isBlockContext
    "return true, iff the receiver is a BlockContext, false otherwise"

    ^ false
!

isContext
    "return true, iff the receiver is a Context, false otherwise"

    ^ true
!

isRecursive
    "return true, if this context is one of a recursive send of the same
     selector to the same receiver before.
     Here, different arguments are ignored - i.e. only the same method
     counts for recursiveness.
     Used to detect recursive errors or recursive printing - for example."

    |c count "{Class: SmallInteger }" myMethodsClass|

    count := 0.

    c := self findNextContextWithSelector:selector or:nil or:nil.
    [c notNil] whileTrue:[
	(c receiver == receiver) ifTrue:[
	    "
	     stupid: the current ST/X context does not include
	     the method, but the class, in which the search started ...
	    "
	    myMethodsClass isNil ifTrue:[
		myMethodsClass := self methodClass.
	    ].
	    c methodClass == myMethodsClass ifTrue:[
		^ true
	    ]
	].
	c := c findNextContextWithSelector:selector or:nil or:nil.

	"
	 this special test was added to get out after a while
	 if the sender chain is corrupt - this gives us at least
	 a chance to find those errors.
	"
	count := count + 1.
	count >= 100000 ifTrue:[
	    'Context [warning]: bad context chain' errorPrintCR.
	    ^ true
	]
    ].
    ^ false

    "Modified: 10.1.1997 / 17:34:26 / cg"
! !

!Context class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libbasic/Context.st,v 1.132 2005-07-08 17:15:01 cg Exp $'
! !

Context initialize!