--- a/Context.st Wed Mar 30 11:38:21 1994 +0200
+++ b/Context.st Wed Mar 30 11:41:04 1994 +0200
@@ -23,45 +23,45 @@
COPYRIGHT (c) 1988 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Context.st,v 1.12 1994-02-25 12:56:25 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Context.st,v 1.13 1994-03-30 09:40:52 claus Exp $
'!
!Context class methodsFor:'documentation'!
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).
+ 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 method.
+ 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 method.
-Contexts of cheap blocks do not have a home context - their home field is also nil.
+ Contexts of cheap blocks do not have a home context - their home field is also nil.
-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
- handle *noObject* - used by the VM; not accessable
+ 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
+ handle *noObject* - used by the VM; not accessable, not an object
- <indexed> - arguments of the send
- locals of the method/block
- temporaries
+ <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.
+ WARNING: layout and size known by the compiler and runtime system - do not change.
"
! !
@@ -92,14 +92,37 @@
selector to the same receiver before.
Used to detect recursive errors - for example."
- |c|
+ |c rec|
+ rec := 0.
c := self sender.
[c notNil] whileTrue:[
- ((c selector == selector) and:[c receiver == receiver]) ifTrue:[
+
+"/ it should be:
+"/ ((c selector == selector)
+"/ and:[(c receiver == receiver)
+"/ and:[(c searchClass whichClassImplements:selector) == (searchClass whichClassImplements:selector)]]) ifTrue:[
+"/ ^ true
+"/ ].
+
+"/ for now, use a version with less overhead,
+"/ (but, which gives incorrect return for supersends)
+"/
+ ((c selector == selector)
+ and:[c receiver == receiver]) ifTrue:[
^ true
].
- c := c sender
+ 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' errorPrintNewline.
+ ^ true
+ ]
].
^ false
! !
@@ -107,7 +130,9 @@
!Context methodsFor:'accessing'!
instVarAt:index
- "have to catch instVar access to retVal and handle - they are invalid"
+ "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].
@@ -115,7 +140,9 @@
!
instVarAt:index put:value
- "have to catch instVar access to retVal and handle - they are invalid"
+ "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].
@@ -154,9 +181,12 @@
sender
"return the sender of the context"
- "this special test is for the very first context (startup-context)"
- (sender isNil or:[sender selector isNil]) ifTrue:[^ nil].
+ "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
!
@@ -167,7 +197,10 @@
!
searchClass
- "this is the class where the method-lookup started"
+ "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
@@ -279,12 +312,13 @@
printReceiver
"print the receiver of the context - used for MiniDebugger only"
- |implementorClass|
+ |class implementorClass|
- (receiver class == SmallInteger "isKindOf:Number") ifTrue:[
+ class := receiver class.
+ (class == SmallInteger) ifTrue:[
'(' print. receiver print. ') ' print
].
- receiver class name print.
+ class name print.
selector notNil ifTrue:[
implementorClass := self searchClass whichClassImplements:selector.
@@ -382,56 +416,109 @@
restart
"restart the receiver - i.e. the method is evaluated again.
- if the context to restart already died - do nothing"
+ if the context to restart already died - do nothing.
+ 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);
/* when we reach here, something went wrong */
- printf("restart failed\n");
%}
.
+ 'restart: context not on calling chain' errorPrintNewline.
+ "
+ debugging ...
+ "
+ self error:'restart: context not on calling chain'.
^ nil
!
-resume
- "resume the receiver with nil - i.e. return nil from the receiver.
- if the context to resume already died - do nothing"
+return
+ "return from this context with nil.
+ NO unwind actions are performed.
+ LIMITATION: currently a context can only be returned by
+ the owning process - not from outside."
- self resume:nil
+ self return:nil
!
-resume:value
- "resume the receiver - i.e. return value from the receiver.
- if the context to resume already died - do nothing.
- No unwind blocks are evaluated (see unwind: in this class)."
+return:value
+ "return from this context as if it did a '^ value'.
+ NO unwind actions are performed.
+ LIMITATION: currently a context can only be returned by
+ the owning process - not from outside."
sender isNil ifTrue:[^ nil].
%{
__RESUMECONTEXT(SND_COMMA self, value);
/* when we reach here, something went wrong */
- printf("resume failed\n");
%}
.
+ 'return: context not on calling chain' errorPrintNewline.
+ "
+ debugging ...
+ "
+ self error:'restart: context not on calling chain'.
^ nil
!
+resume
+ "resume execution in this context.
+ NO unwind actions are performed.
+ If the context has already returned, do nothing.
+ 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 died - do nothing.
+ NO unwind actions are performed (see unwind: in this class).
+ LIMITATION: currently a context can only be resumed by
+ the owning process - not from outside."
+
+ |con|
+
+ "start 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:[
+ 'resume: context not on calling chain' errorPrintNewline.
+ "
+ debugging ...
+ "
+ self error:'resume: context not on calling chain'.
+ ^ nil
+ ].
+ con return:value
+!
+
unwind
- "resume the receiver - i.e. return nil from the receiver.
- if the context to resume already died - do nothing.
+ "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."
+ 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
- "resume the receiver - i.e. return value from the receiver.
- if the context to resume already died - do nothing.
+ "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."
+ and Block>>valueOnUnwindDo: on the way.
+ LIMITATION: currently a context can only be unwound by
+ the owning process - not from outside."
|con sel|
@@ -439,7 +526,7 @@
"start with this context, moving up"
con := thisContext.
- [con ~~ self] whileTrue:[
+ [con notNil and:[con ~~ self]] whileTrue:[
con isBlockContext ifFalse:[
"the way we find those unwind contexts seems kludgy ..."
@@ -451,5 +538,15 @@
].
con := con sender
].
- self resume:value
+
+ "this should be avoided"
+ con isNil ifTrue:[
+ 'unwind: context not on calling chain' errorPrintNewline.
+ "
+ debugging ...
+ "
+ self error:'unwind: context not on calling chain'.
+ ^ nil
+ ].
+ self return:value
! !