*** empty log message ***
authorClaus Gittinger <cg@exept.de>
Mon, 05 Jan 1998 14:02:13 +0100
changeset 3143 9b94535f9026
parent 3142 4eeb61890b9b
child 3144 1da3c0700b00
*** empty log message ***
Context.st
--- a/Context.st	Mon Jan 05 14:01:41 1998 +0100
+++ b/Context.st	Mon Jan 05 14:02:13 1998 +0100
@@ -107,53 +107,53 @@
 
 
     [instance variables:]
-        flags       <SmallInteger>          used by the VM; never touch.
-                                            contains info about number of args, 
-                                            locals and temporaries.
+	flags       <SmallInteger>          used by the VM; never touch.
+					    contains info about number of args, 
+					    locals and temporaries.
 
-        sender      <Context>               the 'calling / sending' context
+	sender      <Context>               the 'calling / sending' context
 
-        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.
+	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
+	receiver    <Object>                the receiver of this message
 
-        selector    <Symbol>                the selector 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.
+	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.
+	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)
+	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
+	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.
+	<indexed>                           arguments of the send followed by
+					    locals of the method/block followed by
+					    temporaries.
 
     [class variables:]
-        InvalidReturnSignal                 signal 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)
+	InvalidReturnSignal                 signal 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
+	Claus Gittinger
 
     [see also:]
-        Block Process Method
-        ( contexts, stacks & unwinding : programming/contexts.html)
+	Block Process Method
+	( contexts, stacks & unwinding : programming/contexts.html)
 "
 ! !
 
@@ -161,13 +161,13 @@
 
 initialize
     InvalidReturnSignal isNil ifTrue:[
-        InvalidReturnSignal := ErrorSignal newSignalMayProceed:true.
-        InvalidReturnSignal nameClass:self message:#invalidReturnSignal.
-        InvalidReturnSignal notifierString:'invalid return; method cannot return twice'.
+	InvalidReturnSignal := ErrorSignal newSignalMayProceed:true.
+	InvalidReturnSignal nameClass:self message:#invalidReturnSignal.
+	InvalidReturnSignal notifierString:'invalid return; method cannot return twice'.
 
-        SingleStepInterruptRequest := QuerySignal new.
-        SingleStepInterruptRequest nameClass:self message:#singleStepInterruptRequest.
-        SingleStepInterruptRequest notifierString:'single step'.
+	SingleStepInterruptRequest := QuerySignal new.
+	SingleStepInterruptRequest nameClass:self message:#singleStepInterruptRequest.
+	SingleStepInterruptRequest notifierString:'single step'.
     ]
 
     "Modified: 6.5.1996 / 16:46:03 / cg"
@@ -207,7 +207,7 @@
     "return the n'th argument"
 
     n > self numArgs ifTrue:[
-        ^ self error:'invalid arg access'
+	^ self error:'invalid arg access'
     ].
     ^ self at:n
 
@@ -218,7 +218,7 @@
     "set the n'th argument - useful when the receiver should be restarted"
 
     n > self numArgs ifTrue:[
-        ^ self error:'invalid arg access'
+	^ self error:'invalid arg access'
     ].
     ^ self at:n put:value
 
@@ -245,7 +245,7 @@
 
     n := self numArgs + self numVars.
     n == 0 ifTrue:[
-	"/ little optimization here - avaoid creating empty containers
+	"/ little optimization here - avoid creating empty containers
 	^ #()
     ].
     ^ (Array new:n) replaceFrom:1 to:n with:self.
@@ -296,7 +296,7 @@
      To save time during normal execution, this information is not held in the
      context, but computed here on request."
 
-    |c sender|
+    |c sender sendersSelector|
 
     c := self searchClass.
     "
@@ -304,32 +304,37 @@
      (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
+	'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
+	^ c compiledMethodAt:selector
     ].
 
     "mhmh - seems to be a context for an unbound method;
      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.)
+     (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 and:[sender selector startsWith:'valueWithReceiver:']) ifTrue:[
-        ^ sender receiver
+    sender notNil ifTrue:[
+	sendersSelector := sender selector.
+	sendersSelector notNil ifTrue:[
+	    (sendersSelector startsWith:'valueWithReceiver:') ifTrue:[
+		^ sender receiver
+	    ]
+	]
     ].
 
     ^ nil
 
-    "Modified: 10.1.1997 / 17:34:48 / cg"
+    "Modified: / 4.1.1998 / 21:15:32 / cg"
 !
 
 methodClass
@@ -339,14 +344,14 @@
 
     cls := self searchClass.
     [cls notNil] whileTrue:[
-        cls := cls whichClassIncludesSelector:selector.
-        cls isNil ifTrue:[^ nil].
+	cls := cls whichClassIncludesSelector:selector.
+	cls isNil ifTrue:[^ nil].
 
-        m := cls compiledMethodAt:selector.
-        m notNil ifTrue:[
-            m isIgnored ifFalse:[^ cls].
-        ].
-        cls := cls superclass
+	m := cls compiledMethodAt:selector.
+	m notNil ifTrue:[
+	    m isIgnored ifFalse:[^ cls].
+	].
+	cls := cls superclass
     ].
     ^ cls
 
@@ -596,14 +601,14 @@
 
     "/ this could have been (actually: was) implemented as:
     "/
-    "/	|con|
+    "/  |con|
     "/
     "/  con := self sender.
     "/  [con notNil] whileTrue:[
-    "/	    con selector == aSelector ifTrue:[^ con].
+    "/      con selector == aSelector ifTrue:[^ con].
     "/      con := con sender.
     "/  ].
-    "/	^ nil
+    "/  ^ nil
     "/
     "/ and the code below does exactly this (somewhat faster, though).
     "/
@@ -618,15 +623,15 @@
 
     theContext = __INST(sender_);
     while (__isNonNilObject(theContext)) {
-        if (__isLazy(theContext)) {
+	if (__isLazy(theContext)) {
 #ifdef TRADITIONAL_STACK_FRAME
 	    sel = __FETCHSELECTOR(theContext);
 #else
 	    /* mhmh - not really needed */
-            __PATCHUPCONTEXT(theContext);
+	    __PATCHUPCONTEXT(theContext);
 	    sel = __ContextInstPtr(theContext)->c_selector;
 #endif
-        } else {
+	} else {
 	    sel = __ContextInstPtr(theContext)->c_selector;
 	}
 
@@ -638,14 +643,14 @@
 	    }
 
 	    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);
+		/* 
+		 * 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);
 	}
@@ -715,7 +720,7 @@
 
     self receiverPrintString print. ' ' print. selector print.
     self size ~~ 0 ifTrue: [
-        ' ' print. self argsDisplayString print
+	' ' print. self argsDisplayString print
     ].
     ' [' print. self lineNumber print. ']' printCR
 
@@ -751,8 +756,8 @@
 
     context := self.
     [context notNil] whileTrue: [
-        context fullPrintOn:aStream.
-        context := context sender
+	context fullPrintOn:aStream.
+	context := context sender
     ]
 
     "
@@ -768,7 +773,7 @@
 
     self receiverPrintString printOn:aStream. ' ' printOn:aStream. selector printOn:aStream.
     self size ~~ 0 ifTrue: [
-        ' ' printOn:aStream. self argsDisplayString printOn:aStream
+	' ' printOn:aStream. self argsDisplayString printOn:aStream
     ].
     ' [' printOn:aStream. self lineNumber printOn:aStream. ']' printOn:aStream.
     aStream cr
@@ -801,7 +806,7 @@
 
 %{  /* NOCONTEXT */
     if (__INST(sender_) != nil) {
-        __RESUMECONTEXT__(self, RESTART_VALUE, 0);
+	__RESUMECONTEXT__(self, RESTART_VALUE, 0);
     }
 %}.
     self sender isNil ifTrue:[^ nil].
@@ -857,7 +862,7 @@
 %{
     theContext = __thisContext;
     while ((theContext != nil) 
-           && (__ContextInstPtr(theContext)->c_sender != self)) {
+	   && (__ContextInstPtr(theContext)->c_sender != self)) {
 	theContext = __ContextInstPtr(theContext)->c_sender;
     }
     if (theContext) {
@@ -910,7 +915,7 @@
 
 %{  /* NOCONTEXT */
     if (__INST(sender_) != nil) {
-        __RESUMECONTEXT__(self, value, 0);
+	__RESUMECONTEXT__(self, value, 0);
     }
 %}.
     self sender isNil ifTrue:[^ nil].
@@ -940,7 +945,7 @@
 
 %{  /* NOCONTEXT */
     if (__INST(sender_) != nil) {
-        __RESUMECONTEXT__(self, aBlock, 2);
+	__RESUMECONTEXT__(self, aBlock, 2);
     }
 %}.
     self sender isNil ifTrue:[^ nil].
@@ -1194,10 +1199,10 @@
 
     mthd := self method.
     mthd notNil ifTrue:[
-        who := mthd who.
-        who notNil ifTrue:[
-            ^ who methodClass name , '>>' , who methodSelector
-        ]
+	who := mthd who.
+	who notNil ifTrue:[
+	    ^ who methodClass name , '>>' , who methodSelector
+	]
     ].
     ^ mthd displayString.
 
@@ -1235,7 +1240,7 @@
      * 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 = __MKSTRING("FreeObject");
     }
 %}.
     receiverClassName notNil ifTrue:[^ receiverClassName].
@@ -1243,37 +1248,37 @@
     receiverClass := receiver class.
     receiverClassName := receiverClass name.
     (receiverClass == SmallInteger) ifTrue:[
-        newString := '(' , receiver printString , ') ' , receiverClassName
+	newString := '(' , receiver printString , ') ' , receiverClassName
     ] ifFalse:[
-        newString := receiverClassName
+	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**'
-            ]
-        ]
+	"
+	 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
@@ -1299,7 +1304,7 @@
 
 %{  /* NOCONTEXT */
      __INST(flags) = (OBJ)((INT)__INST(flags) 
-                     | __MASKSMALLINT(__IRQ_ON_UNWIND));
+		     | __MASKSMALLINT(__IRQ_ON_UNWIND));
 %}
 !
 
@@ -1423,30 +1428,30 @@
 
     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 ...
-            "
+	(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.
+		myMethodsClass := self methodClass.
 	    ].
-            c methodClass == myMethodsClass ifTrue:[
-                ^ true
-            ]
-        ].
-        c := c findNextContextWithSelector:selector or:nil or:nil.
+	    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
-        ]
+	"
+	 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
 
@@ -1456,6 +1461,6 @@
 !Context class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/Context.st,v 1.81 1997-12-15 18:28:07 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/Context.st,v 1.82 1998-01-05 13:02:13 cg Exp $'
 ! !
 Context initialize!