"

 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' }"

"{ NameSpace: Smalltalk }"

Object variableSubclass:#Context

	instanceVariableNames:'flags sender* home receiver selector searchClass method lineNr

		retvalTemp handle*'

	classVariableNames:'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, whenever a contexts is needed. Also, initially these are

    allocated on the stack and only moved to the heap, when a context outlives its

    activation.

    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.

    Cheap blocks are blocks which do not refer to any locals or the receiver (currently),

    but only access globals, class vars or arguments (for example: [:a :b | a < b] is a cheap block).

    Cheap blocks do not need a home and therefore never require that their home context be moved

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

    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 debugger's restart button). As stc is supposed to generate portable C-code,

    this means that technically, a setjmp needs to be done at the beginning of the method

    in order to have a resumable (and portable) state (however, inline asm code does this setjmp,

    so it is much faster than the libc-setjmo, which stores a lot of additional state, not needed here).

    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 or are marked as special

    via a directive.

    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, you should recompile all classes with stc's '-optContext' flag.

    Resuming contexts:

    Strictly speaking, ST/X does not support a context to be resumed (because the setjmp is

    not done on the caller side, but in the callee).

    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:

    Block-return 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 - a good decision, as it makes debugging much easier.

    [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

    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__;

#endif

%}.

    ^ c findSpecialHandle:searchForHandle raise:searchForRaise

! !

!Context methodsFor:'Compatibility-Squeak'!

longStack

    ^ self fullPrintAllString

! !

!Context methodsFor:'Compatibility-VW'!

resumeWith:value

    "same as #resume: - visualWorks compatibility"

    self resume:value

! !

!Context methodsFor:'accessing'!

arg1Index

    "return the index of the 1st arg (redefined in JavaContext)"

    ^ 1

!

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 context._RETURN( STInteger._new( ((STContinuation)self).numStArgs() ) );

#else

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

#endif

%}

!

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);

#endif

%}.

    ^ 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, it's the surrounding block's 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)."

    |what|

%{

    {

	int idx = context.stArg(0).intValue("[instVarAt:]");

	if (idx == I_sender) {

	    return context._RETURN( ((STContinuation)self).caller() );

	}

	if (idx == I_retvalTemp) {

	    return context._RETURN( Nil );

	}

	if (idx == I_handle) {

	    return context._RETURN( Nil );

	}

    }

#else

    if (index == __MKSMALLINT(__SLOT_CONTEXT_SENDER)) {                 // sender - must be accessed specially

	 what = @symbol(sender);

    } else if (index == __MKSMALLINT(__SLOT_CONTEXT_RETVAL)) {          // retvalTemp - invisible

	 RETURN (nil);

    } else if (index == __MKSMALLINT(__SLOT_CONTEXT_HANDLE)) {          // handle to machine stack - invisible

	 RETURN (nil);

    }

#endif

%}.

    what == #sender ifTrue:[

	^ self sender

    ].

    ^ 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)."

%{

    ERROR("unimplemented");

#else

    if (index == __MKSMALLINT(__SLOT_CONTEXT_SENDER)) {                 // sender - not allowed to change

	 RETURN (nil);

    } else if (index == __MKSMALLINT(__SLOT_CONTEXT_RETVAL)) {          // retvalTemp - not allowed to change

	 RETURN (nil);

    } else if (index == __MKSMALLINT(__SLOT_CONTEXT_HANDLE)) {          // handle to machine stack - not allowed to change

	 RETURN (nil);

    }

#endif

%}.

    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);

#endif

%}.

    ^ 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.