"
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.
"
Object variableSubclass:#Context
instanceVariableNames:'flags sender home receiver selector searchClass
lineNr retvalTemp handle*'
classVariableNames:'InvalidReturnSignal'
poolDictionaries:''
category:'Kernel-Methods'
!
Context comment:'
COPYRIGHT (c) 1988 by Claus Gittinger
All Rights Reserved
$Header: /cvs/stx/stx/libbasic/Context.st,v 1.18 1994-08-23 23:08:34 claus Exp $
'!
!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.
"
!
version
"
$Header: /cvs/stx/stx/libbasic/Context.st,v 1.18 1994-08-23 23:08:34 claus Exp $
"
!
documentation
"
Context represents the stack context objects; each message send adds a context
to a chain, which can be traced back via the sender field.
(The actual implementation uses the machines stack for this, building real
contexts when needed only).
For both method- and block-contexts, the layout is the same.
For method contexts, the home-field is nil, while for blockcontexts 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 will 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).
instance variables:
flags <SmallInteger> - used by the VM; never touch.
contains info about number of args, locals and
temporaries.
sender <Context> - the 'calling' context
home <Context> - the context, where this block was created, or nil
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)
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
WARNING: layout and size known by the compiler and runtime system - do not change.
"
! !
!Context class methodsFor:'initialization'!
initialize
InvalidReturnSignal isNil ifTrue:[
InvalidReturnSignal := (Signal new) mayProceed:true.
InvalidReturnSignal notifierString:'invalid return; method cannot return twice'.
]
! !
!Context class methodsFor:'signal access'!
invalidReturnSignal
"return the signal used when a method is tried to be returned twice
or, when some dead context is unwound or restarted."
^ InvalidReturnSignal
! !
!Context class methodsFor:'queries'!
isBuiltInClass
"this class & subclasses are known by the run-time-system"
^ true
! !
!Context methodsFor:'testing'!
isContext
"return true, iff the receiver is a Context, false otherwise"
^ true
!
isBlockContext
"return true, iff the receiver is a BlockContext, false otherwise"
^ false
!
isRecursive
"return true, if this context is one of a recursive send of the same
selector to the same receiver before.
Used to detect recursive errors or recursive printing - for example."
|c rec cls1 cls2|
rec := 0.
c := self sender.
[c notNil] whileTrue:[
((c selector == selector)
and:[(c receiver == receiver)]) ifTrue:[
"
stupid: the current ST/X context does not include
the method, but the class, in which the search started ...
"
(c searchClass whichClassImplements:selector) == (self searchClass whichClassImplements:selector) ifTrue:[
^ true
]
].
c := c sender.
"
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.
"
rec := rec + 1.
rec >= 100000 ifTrue:[
'bad context chain' errorPrintNL.
^ true
]
].
^ false
! !
!Context methodsFor:'accessing'!
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 == 8) ifTrue:[^ nil].
(index == 9) ifTrue:[^ nil].
^ 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 == 8) ifTrue:[^ nil].
(index == 9) ifTrue:[^ nil].
^ super instVarAt:index put:value
!
methodHome
"return the method-home - for method contexts this is the receiver"
^ self
!
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"
!
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|
c := self searchClass whichClassImplements:selector.
c notNil ifTrue:[
^ c compiledMethodAt:selector
].
^ nil
!
sender
"return the sender of the context"
"this special test is for the very first context (startup-context);
actually, its cosmetics, to avoid a visible nil>>nil context in the debugger."
"
(sender isNil or:[sender selector isNil and:[sender sender isNil]]) ifTrue:[^ nil].
"
^ sender
!
receiver
"return the receiver of the context"
^ receiver
!
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
!
nargs
"return the number of arguments to the Block/Method"
%{ /* NOCONTEXT */
RETURN ( _MKSMALLINT( (_intVal(_INST(flags)) >> __NARG_SHIFT) & __NARG_MASK) );
%}
!
nvars
"return the number of local variables of the Block/Method"
%{ /* NOCONTEXT */
RETURN ( _MKSMALLINT( (_intVal(_INST(flags)) >> __NVAR_SHIFT) & __NVAR_MASK) );
%}
!
ntemp
"return the number of temporary variables of the Block/Method.
(for debugging only)"
^ self size - self nargs - self nvars
!
args
"return an array filled with the arguments of this context"
|newArray n "{ Class: SmallInteger }" |
n := self nargs.
newArray := Array new:n.
1 to:n do:[:index |
newArray at:index put:(self at:index)
].
^ newArray
!
argsAndVars
"return an array filled with the arguments and variables of this context"
|newArray mySize "{ Class: SmallInteger }" |
mySize := self nargs + self nvars.
newArray := Array new:mySize.
1 to:mySize do:[:index |
newArray at:index put:(self at:index)
].
^ newArray
!
argAt:n
"return the n'th argument"
^ self at:n
!
argAt:n put:value
"set the n'th argument - useful when the receiver should be restarted"
^ self at:n put:value
!
varAt:n
"return the n'th local variable"
^ self at:(n + self nargs)
!
varAt:n put:value
"set the n'th local variable - useful when the receiver should be restarted
or continued"
self at:(n + self nargs) put:value
!
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)"
^ lineNr
! !
!Context methodsFor:'printing & storing'!
argsDisplayString
|fullString n "{ Class: SmallInteger }" |
fullString := ''.
n := self nargs.
1 to:n do:[:index |
fullString := fullString , (' ' , (self at:index) displayString)
].
^ fullString
!
printReceiver
"print the receiver of the context - used for MiniDebugger only"
|class implementorClass|
class := receiver class.
(class == SmallInteger) ifTrue:[
'(' print. receiver print. ') ' print
].
class name print.
selector notNil ifTrue:[
implementorClass := self searchClass whichClassImplements:selector.
implementorClass notNil ifTrue: [
(implementorClass ~= receiver class) ifTrue: [
'>>>' print.
implementorClass name print
]
] ifFalse:[
self searchClass ~~ receiver class ifTrue:[
'>>>' print. self searchClass name print
].
'>>>**NONE**' print
]
]
!
fullPrint
"print the receiver, selector and args of the context
- used for MiniDebuggers walkback print only"
self printReceiver.
' ' print.
selector print.
self size ~~ 0 ifTrue: [
' ' print.
self argsDisplayString print
].
' [' print. lineNr print. ']' printNewline
!
receiverPrintString
"return a string describing the receiver of the context"
|newString receiverClassName implementorClass|
receiverClassName := receiver class name.
(receiver class == SmallInteger) ifTrue:[
newString := '(' , receiver printString , ') ' , receiverClassName
] ifFalse:[
newString := receiverClassName
].
selector notNil ifTrue:[
implementorClass := self searchClass whichClassImplements:selector.
implementorClass notNil ifTrue: [
(implementorClass ~~ receiver class) ifTrue: [
newString := newString , '>>>',
implementorClass name printString
]
] ifFalse:[
self searchClass ~~ receiver class ifTrue:[
newString := newString , '>>>' , self searchClass name
].
newString := newString , '>>>**NONE**'
]
].
^ newString
!
printString
"return a string describing the context"
^ self receiverPrintString , ' ' , self selector printString
!
displayString
"return a string describing the context - for display in Inspector"
^ self class name , '(' , self printString , ')'
!
printOn:aStream
"append a printed description of the receiver onto aStream"
aStream nextPutAll:(self receiverPrintString).
aStream space.
self selector printOn:aStream
!
fullPrintAll
"print a full walkback starting at the receiver
- for MiniDebugger only"
|context|
context := self.
[context notNil] whileTrue: [
context fullPrint.
context := context sender
]
! !
!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;
comment out the raise to get that (old) behavior
"
" "
^ InvalidReturnSignal raiseRequestWith:returnValue.
" "
^ returnValue
! !
!Context methodsFor:'non local control flow'!
restart
"restart the receiver - i.e. the method is evaluated again.
if the context to restart already died - do nothing.
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."
sender isNil ifTrue:[^ nil].
%{
__RESUMECONTEXT__(SND_COMMA self, RESTART_VALUE, 0);
/* when we reach here, something went wrong */
%}
.
"
debugging ...
"
"
'restart: context not on calling chain' errorPrintNL.
^ self error:'restart: context not on calling chain'.
"
"
tried to restart a context which is already dead
(i.e. the method/block has already executed a return)
"
^ InvalidReturnSignal
raiseRequestWith:nil
errorString:'restart: context not on calling chain'
!
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."
^ 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."
sender isNil ifTrue:[^ nil].
%{
__RESUMECONTEXT__(SND_COMMA self, value, 0);
/* when we reach here, something went wrong */
%}
.
"
debugging ...
"
"
'return: context not on calling chain' errorPrintNL.
^ self error:'return: context not on calling chain'.
"
"
tried to return a context which is already dead
(i.e. the method/block has already executed a return)
"
^ InvalidReturnSignal
raiseRequestWith:value
errorString:'return: context not on calling chain'
!
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, do nothing.
NOTICE:
NO unwind actions are performed (see Context>>unwind).
LIMITATION:
currently a context can only be resumed by
the owning process - not from outside."
^ self resume:nil
!
resume:value
"resume the receiver - as if it got 'value' from whatever
it called.
If the context has already returned - do nothing.
NOTICE:
NO unwind actions are performed (see Context>>unwind:).
LIMITATION:
currently a context can only be resumed by
the owning process - not from outside."
|con|
"
starting with this context, find the one below and return from it
"
con := thisContext.
[con notNil and:[con sender ~~ self]] whileTrue:[
con := con sender
].
con isNil ifTrue:[
"
debugging ...
"
"
'resume: context not on calling chain' errorPrintNL.
^ self error:'resume: context not on calling chain'.
"
"
tried to continue in context which is already dead
(i.e. the method/block has already executed a return)
"
^ InvalidReturnSignal
raiseRequestWith:value
errorString:'resume: context not on calling chain'
].
^ con return:value
!
unwind
"return nil from the receiver - i.e. simulate a '^ nil'.
If the context has already retruned, do nothing.
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."
^ self unwind:nil
!
unwind:value
"return value from the receiver - i.e. simulate a '^ value'.
If the context has already returned , do nothing.
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."
|con sel|
sender isNil ifTrue:[
"
tried to return to a context which is already dead
(i.e. the method/block has already executed a return)
"
^ InvalidReturnSignal
raiseRequestWith:value
errorString:'unwind: no sender to unwind to'
].
"
start with this context, moving up, looking for unwind actions
"
con := thisContext.
[con notNil and:[con ~~ self]] whileTrue:[
con isBlockContext ifFalse:[
"
the way we find those unwind contexts seems kludgy ...
"
sel := con selector.
((sel == #valueNowOrOnUnwindDo:) or:[sel == #valueOnUnwindDo:]) ifTrue:[
"
... the way we evaluate the unwind blocks too
"
(con argAt:1) value
]
].
con := con sender
].
"oops, I am not on the calling chain
(should we check for this situation first and NOT evaluate
the unwind actions in this case ?)
"
con isNil ifTrue:[
"
debugging ...
"
"
'unwind: context not on calling chain' errorPrintNL.
^ self error:'unwind: context not on calling chain'.
"
"
tried to return to a context which is already dead
(i.e. the method/block has already executed a return)
"
^ InvalidReturnSignal
raiseRequestWith:value
errorString:'unwind: context not on calling chain'
].
"
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 - do nothing.
Evaluate all unwind-blocks as specified in Block>>valueNowOrOnUnwind:
and Block>>valueOnUnwindDo: before restarting.
LIMITATION:
currently a context can only be restarted by
the owning process - not from outside."
|con sel|
"
start with this context, moving up, looking for unwind actions
"
con := thisContext.
[con notNil and:[con ~~ self]] whileTrue:[
con isBlockContext ifFalse:[
"
the way we find those unwind contexts seems kludgy ...
"
sel := con selector.
((sel == #valueNowOrOnUnwindDo:) or:[sel == #valueOnUnwindDo:]) ifTrue:[
"
... the way we evaluate the unwind blocks too
"
(con argAt:1) value
]
].
con := con sender
].
"oops, I am not on the calling chain
(should we check for this situation first and NOT evaluate
the unwind actions in this case ?)
"
con isNil ifTrue:[
"
debugging ...
"
"
'unwindAndRestart: context not on calling chain' errorPrintNL.
^ self error:'unwindAndRestart: context not on calling chain'.
"
"
tried to return to a context which is already dead
(i.e. the method/block has already executed a return)
"
^ InvalidReturnSignal
raiseRequestWith:nil
errorString:'unwindAndRestart: context not on calling chain'
].
"
now, that all unwind-actions are done, I can use the
low-level restart ...
"
^ self restart
! !