"

 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 t itle to or ownership of the software is

 hereby transferred.

"

"{ Package: 'stx:libbasic' }"

Object variableSubclass:#Context

	instanceVariableNames:'flags sender* home receiver selector searchClass method 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 t itle 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:

    Blockreturn 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

        method                              the corresponding method

        <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:'error handling'!

showWhereWeCameFrom

    "show the stack backtrace: at least 4 levels, or until the first

     send to a non-collection object (because we want to know,

     which non-collection send invoked a bad collection-method)."

    |con count|

    con := thisContext sender sender.

    count := 0.

    [

        ('    from ' , con printString) errorPrintCR.

        con := con sender.

        count := count + 1.

    ] doWhile:[con notNil and:[count < 5 or:[con receiver isCollection]]].

    "/ one more

    con notNil ifTrue:[

        ('    from ' , con printString) errorPrintCR.

    ].

    "

      #() asSet add:nil

    "

! !

!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 (!__isNonNilObject(__c__)) {

        RETURN(nil)

    }

    if (__isLazy(__c__)) {

        __PATCHUPCONTEXT(__c__);

    }

    c = __c__;

%}.

    ^ c findSpecialHandle:searchForHandle raise:searchForRaise

! !

!Context methodsFor:'Compatibility-Squeak'!

longStack

    ^ String streamContents:[:s |

            self fullPrintAllOn:s

    ]

! !

!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 might get some syntactic

     extension to get this automatically)."

    (index == %{ __MKSMALLINT(__SLOT_CONTEXT_SENDER) %} ) ifTrue:[^ self sender]."/ sender - must be accessed specially

    (index == %{ __MKSMALLINT(__SLOT_CONTEXT_RETVAL) %} ) ifTrue:[^ nil].        "/ retvalTemp - invisible

    (index == %{ __MKSMALLINT(__SLOT_CONTEXT_HANDLE) %} ) 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 might get some syntactic

     extension to get this automatically)."

    (index == %{ __MKSMALLINT(__SLOT_CONTEXT_SENDER) %} ) ifTrue:[^ nil].        "/ sender - not allowed to change

    (index == %{ __MKSMALLINT(__SLOT_CONTEXT_RETVAL) %} ) ifTrue:[^ nil].        "/ retvalTemp - not allowed to change

    (index == %{ __MKSMALLINT(__SLOT_CONTEXT_HANDLE) %} ) 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