# HG changeset patch # User Claus Gittinger # Date 1391512856 -3600 # Node ID 065b85487f0d30707f286aa73cff172c8799adcc # Parent 61bf45ec26c9d94a9413a9d11331d7a6d345f577 *** empty log message *** diff -r 61bf45ec26c9 -r 065b85487f0d Context.st --- a/Context.st Tue Feb 04 12:19:54 2014 +0100 +++ b/Context.st Tue Feb 04 12:20:56 2014 +0100 @@ -1,6 +1,6 @@ " COPYRIGHT (c) 1988 by Claus Gittinger - All Rights Reserved + 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 @@ -24,7 +24,7 @@ copyright " COPYRIGHT (c) 1988 by Claus Gittinger - All Rights Reserved + 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 @@ -76,11 +76,11 @@ 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 + 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 + 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. @@ -91,7 +91,7 @@ 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). + 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. @@ -105,58 +105,58 @@ [instance variables:] - flags used by the VM; never touch. - contains info about number of args, - locals and temporaries. - - sender 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 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 the receiver of this message - - selector the selector of this message - - searchClass the class, where the message lookup started - (for super sends) or nil, for regular sends. - - lineNr 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 - - arguments of the send followed by - locals of the method/block followed by - temporaries. + flags used by the VM; never touch. + contains info about number of args, + locals and temporaries. + + sender 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 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 the receiver of this message + + selector the selector of this message + + searchClass the class, where the message lookup started + (for super sends) or nil, for regular sends. + + lineNr 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 + + 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) + 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 + Claus Gittinger [see also:] - Block Process Method - ( contexts, stacks & unwinding : programming/contexts.html) + Block Process Method + ( contexts, stacks & unwinding : programming/contexts.html) " ! ! @@ -167,9 +167,9 @@ CannotResumeError notifierString:'invalid resume'. SingleStepInterruptRequest isNil ifTrue:[ - 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" @@ -219,13 +219,13 @@ con := thisContext sender sender. count := 0. [ - (' from ' , con printString) errorPrintCR. - con := con sender. - count := count + 1. + (' 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. + (' from ' , con printString) errorPrintCR. ]. " @@ -254,10 +254,10 @@ __c__ = __ContextInstPtr(__thisContext)->c_sender; if (!__isNonNilObject(__c__)) { - RETURN(nil) + RETURN(nil) } if (__isLazy(__c__)) { - __PATCHUPCONTEXT(__c__); + __PATCHUPCONTEXT(__c__); } c = __c__; %}. @@ -284,7 +284,7 @@ "return the n'th argument" n > self numArgs ifTrue:[ - ^ self error:'invalid arg access' + ^ self error:'invalid arg access' ]. ^ self at:n @@ -295,7 +295,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. ^ value @@ -310,8 +310,8 @@ n := self numArgs. n == 0 ifTrue:[ - "/ little optimization here - avaoid creating empty containers - ^ #() + "/ little optimization here - avaoid creating empty containers + ^ #() ]. ^ (Array new:n) replaceFrom:1 to:n with:self. ! @@ -323,8 +323,8 @@ n := self numArgs + self numVars. n == 0 ifTrue:[ - "/ little optimization here - avoid creating empty containers - ^ #() + "/ little optimization here - avoid creating empty containers + ^ #() ]. ^ (Array new:n) replaceFrom:1 to:n with:self. @@ -403,27 +403,27 @@ |nr pc| lineNr notNil ifTrue:[ - pc := lineNr bitAnd:16rFFFF. + 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 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 + nr := self lineNumberFromMethod. + nr notNil ifTrue:[ + ^ nr + ]. + " '-> 0 [b]' printCR. " + ^ 0 ]. "/ '-> ' print. nr printCR. ^ nr. @@ -438,14 +438,14 @@ |l| receiver isJavaObject ifTrue:[ - "/ chances are good that I am a javContext ... - self method isJavaMethod ifTrue:[ - ^ self javaLineNumber - ] + "/ chances are good that I am a javContext ... + self method isJavaMethod ifTrue:[ + ^ self javaLineNumber + ] ]. lineNr notNil ifTrue:[ - l := lineNr bitAnd:16rFFFF. + l := lineNr bitAnd:16rFFFF. ]. "/ self isJavaContext ifTrue:[ |nr m| @@ -502,17 +502,17 @@ method "return the method for which the receiver was created. Change with ST/X vsn 6: - In older versions, the method was not stored in the context, but a lookup - was simulated using selector and class. - (which occasionally returned the wrong method - especially in the debugger, - when the debugged method was changed). - This has been changed - especially to support Jan's meta-object protocol. - It is now stored in the context" + In older versions, the method was not stored in the context, but a lookup + was simulated using selector and class. + (which occasionally returned the wrong method - especially in the debugger, + when the debugged method was changed). + This has been changed - especially to support Jan's meta-object protocol. + It is now stored in the context" |c sender sendersSelector m| (method notNil and:[method isMethod]) ifTrue:[ - ^ method + ^ method ]. "mhmh - maybe I am a context for an unbound method (as generated by doIt); @@ -522,16 +522,16 @@ " sender := self sender. sender notNil ifTrue:[ - sendersSelector := sender selector. - sendersSelector notNil ifTrue:[ - (sendersSelector startsWith:'valueWithReceiver:') ifTrue:[ - m := sender receiver. - m isMethod ifTrue:[ - method := m. - ^ m - ] - ] - ] + sendersSelector := sender selector. + sendersSelector notNil ifTrue:[ + (sendersSelector startsWith:'valueWithReceiver:') ifTrue:[ + m := sender receiver. + m isMethod ifTrue:[ + method := m. + ^ m + ] + ] + ] ]. c := self searchClass. @@ -540,16 +540,16 @@ (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:[ - method := c compiledMethodAt:selector. - ^ method + method := c compiledMethodAt:selector. + ^ method ]. ^ nil @@ -564,26 +564,26 @@ |cls m| method notNil ifTrue:[ - method isMethod ifTrue:[ - ^ method mclass - ] + method isMethod ifTrue:[ + ^ method mclass + ] ]. cls := self searchClass. (cls isMeta and:[cls soleInstance isJavaClass]) ifTrue:[ - cls := cls soleInstance + cls := cls soleInstance ]. [cls notNil] whileTrue:[ - cls := cls whichClassIncludesSelector:selector. - cls isNil ifTrue:[^ nil]. - - m := cls compiledMethodAt:selector. - m notNil ifTrue:[ - m isIgnored ifFalse:[^ cls]. - ]. - cls := cls superclass + cls := cls whichClassIncludesSelector:selector. + cls isNil ifTrue:[^ nil]. + + m := cls compiledMethodAt:selector. + m notNil ifTrue:[ + m isIgnored ifFalse:[^ cls]. + ]. + cls := cls superclass ]. ^ cls @@ -651,9 +651,9 @@ programmingLanguage - ^method notNil - ifTrue:[method programmingLanguage] - ifFalse:[SmalltalkLanguage instance] + ^method notNil + ifTrue:[method programmingLanguage] + ifFalse:[SmalltalkLanguage instance] "Created: / 17-03-2011 / 10:17:14 / Jan Vrany " "Modified (format): / 02-08-2011 / 09:23:39 / cg" @@ -708,22 +708,22 @@ */ if (__isNonNilObject(theContext)) { - if (__isLazy(theContext)) { - /* - * this cannot happen - */ - __PATCHUPCONTEXT(theContext); - } - if (! __isNonLIFO(theContext)) { - /* - * to be prepared for the worst situation - * (the sender is not stored, so the trap won't catch it) - * make the writeBarrier trigger manually. - * We'll see, if this is really required. - */ - theContext->o_space |= CATCHMARK; - __markNonLIFO(theContext); - } + if (__isLazy(theContext)) { + /* + * this cannot happen + */ + __PATCHUPCONTEXT(theContext); + } + if (! __isNonLIFO(theContext)) { + /* + * to be prepared for the worst situation + * (the sender is not stored, so the trap won't catch it) + * make the writeBarrier trigger manually. + * We'll see, if this is really required. + */ + theContext->o_space |= CATCHMARK; + __markNonLIFO(theContext); + } } RETURN (theContext); %} @@ -739,7 +739,7 @@ %{ /* NOCONTEXT */ if ( __INST(sender_) == nil ) { - RETURN (true); + RETURN (true); } RETURN (false); %}. @@ -780,8 +780,8 @@ nonTemps := self numArgs + self numVars. mySize := self numTemps. mySize == 0 ifTrue:[ - "/ little optimization here - avaoid creating empty containers - ^ #() + "/ little optimization here - avaoid creating empty containers + ^ #() ]. ^ (Array new:mySize) replaceFrom:1 to:mySize with:self startingAt:nonTemps+1 @@ -809,8 +809,8 @@ nonVars := self numArgs. mySize := self numVars. mySize == 0 ifTrue:[ - "/ little optimization here - avaoid creating empty containers - ^ #() + "/ little optimization here - avaoid creating empty containers + ^ #() ]. ^ (Array new:mySize) replaceFrom:1 to:mySize with:self startingAt:nonVars+1 @@ -840,8 +840,8 @@ con := self. [ con notNil ] whileTrue:[ - aBlock value:con. - con := con sender. + aBlock value:con. + con := con sender. ] ! ! @@ -871,13 +871,13 @@ "/ use another error message. (home notNil and:[home sender notNil]) ifTrue:[ - ^ CannotReturnError - raiseRequestWith:returnValue - errorString:'cannot return from another process''s context'. + ^ CannotReturnError + raiseRequestWith:returnValue + errorString:'cannot return from another process''s context'. ]. ^ CannotReturnError - raiseRequestWith:returnValue. + raiseRequestWith:returnValue. "Modified: / 2.2.1998 / 15:19:52 / cg" ! @@ -890,29 +890,29 @@ We raise a signal here, to allow catching of that situation." ^ CannotReturnError - raiseRequestWith:returnValue - errorString:'method was compiled non-resumable' + raiseRequestWith:returnValue + errorString:'method was compiled non-resumable' ! invalidReturnOrRestartError:how with:value "common error reporter for restart/return errors" self canReturn ifTrue:[ - " - tried to return from/restart a context which is already dead - (i.e. the method/block has already executed a return) - " - ^ CannotReturnError - raiseRequestWith:value - errorString:(how , ' context not on calling chain') + " + tried to return from/restart a context which is already dead + (i.e. the method/block has already executed a return) + " + ^ CannotReturnError + raiseRequestWith:value + errorString:(how , ' context not on calling chain') ]. " tried to return from/restart a context of a method which was compiled unrestartable or of a block (which is never restartable) " ^ CannotReturnError - raiseRequestWith:value - errorString:(how , ' context cannot be restarted/returned from') + raiseRequestWith:value + errorString:(how , ' context cannot be restarted/returned from') ! ! !Context methodsFor:'fixups'! @@ -932,7 +932,7 @@ self receiverPrintString print. ' ' print. selector print. self size ~~ 0 ifTrue: [ - ' ' print. self argsDisplayString print + ' ' print. self argsDisplayString print ]. ' [' print. self lineNumber print. ']' printCR @@ -963,11 +963,11 @@ count := 0. context := self. [context notNil] whileTrue: [ - context fullPrint. - context := context sender. - nOrNil notNil ifTrue:[ - (count := count+1) > nOrNil ifTrue:[^self]. - ] + context fullPrint. + context := context sender. + nOrNil notNil ifTrue:[ + (count := count+1) > nOrNil ifTrue:[^self]. + ] ] " @@ -998,14 +998,14 @@ context := self. '--------------------------' printCR. [context notNil] whileTrue: [ - context printCR. - context := context sender. - nOrNil notNil ifTrue:[ - (count := count+1) > nOrNil ifTrue:[ - '--------------------------' printCR. - ^ self - ]. - ] + context printCR. + context := context sender. + nOrNil notNil ifTrue:[ + (count := count+1) > nOrNil ifTrue:[ + '--------------------------' printCR. + ^ self + ]. + ] ]. '--------------------------' printCR. @@ -1030,17 +1030,17 @@ " con := self findNextUnwindContextOr:aContext. [con notNil and:[con ~~ aContext]] whileTrue:[ - unwindBlock := con receiver unwindHandlerInContext:con. - con unmarkForUnwind. - unwindBlock value. - - con := con findNextUnwindContextOr:aContext. + unwindBlock := con receiver unwindHandlerInContext:con. + con unmarkForUnwind. + unwindBlock value. + + con := con findNextUnwindContextOr:aContext. ]. "/ mhmh - the just unwound context could itself be markedForUnwind (con notNil and:[con isMarkedForUnwind]) ifTrue:[ - unwindBlock := con receiver unwindHandlerInContext:con. - con unmarkForUnwind. - unwindBlock value. + unwindBlock := con receiver unwindHandlerInContext:con. + con unmarkForUnwind. + unwindBlock value. ]. ^ con ! @@ -1065,21 +1065,21 @@ This is a low level helper for unwindAndRestart. NOTICE: - NO unwind actions are performed - this is usually not - what you want (see Context>>unwindAndRestart). + 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. - Also, the compiler has an option (+optcontext) to create - non-restartable contexts (which are faster). - If such a context is restarted, a runtime error is raised." + currently a context can only be restarted by + the owning process - not from outside. + Also, the compiler has an option (+optcontext) to create + non-restartable contexts (which are faster). + If such a context is restarted, a runtime error is raised." %{ /* NOCONTEXT */ if (__INST(sender_) == nil) { - RETURN(nil); + RETURN(nil); } else { - __RESUMECONTEXT__(self, RESTART_VALUE, 0); + __RESUMECONTEXT__(self, RESTART_VALUE, 0); } %}. @@ -1096,14 +1096,14 @@ If the context has already returned, report an error. NOTICE: - NO unwind actions are performed (see Context>>unwind). + NO unwind actions are performed (see Context>>unwind). LIMITATION: - currently a context can only be resumed by - the owning process - not from outside. - Also, the compiler has an option (+optcontext) to create - non-resumable contexts (which are faster). - If such a context is restarted, a runtime error is raised." + currently a context can only be resumed by + the owning process - not from outside. + Also, the compiler has an option (+optcontext) to create + non-resumable contexts (which are faster). + If such a context is restarted, a runtime error is raised." ^ self resume:nil ! @@ -1115,14 +1115,14 @@ If the context has already returned - report an error. NOTICE: - NO unwind actions are performed (see Context>>unwind:). + NO unwind actions are performed (see Context>>unwind:). LIMITATION: - currently a context can only be resumed by - the owning process - not from outside. - Also, the compiler has an option (+optcontext) to create - non-resumable contexts (which are faster). - If such a context is restarted, a runtime error is raised." + currently a context can only be resumed by + the owning process - not from outside. + Also, the compiler has an option (+optcontext) to create + non-resumable contexts (which are faster). + If such a context is restarted, a runtime error is raised." |theContext| @@ -1136,23 +1136,23 @@ theContext = __thisContext; while (theContext != nil) { - sndr = __ContextInstPtr(theContext)->c_sender; - if (sndr == self) break; - theContext = sndr; + sndr = __ContextInstPtr(theContext)->c_sender; + if (sndr == self) break; + theContext = sndr; } if (theContext != nil) { - if (__isLazy(theContext)) { - __PATCHUPCONTEXT(theContext); - } + if (__isLazy(theContext)) { + __PATCHUPCONTEXT(theContext); + } } %}. theContext isNil ifTrue:[ - " - tried to resume in context which is already dead - (i.e. the method/block has already executed a return) - " - ^ thisContext invalidReturnOrRestartError:#'resume:' with:value + " + tried to resume in context which is already dead + (i.e. the method/block has already executed a return) + " + ^ thisContext invalidReturnOrRestartError:#'resume:' with:value ]. ^ theContext return:value ! @@ -1164,14 +1164,14 @@ If the context has already returned - simply return. NOTICE: - NO unwind actions are performed (see Context>>unwind:). + NO unwind actions are performed (see Context>>unwind:). LIMITATION: - currently a context can only be resumed by - the owning process - not from outside. - Also, the compiler has an option (+optcontext) to create - non-resumable contexts (which are faster). - If such a context is restarted, a runtime error is raised." + currently a context can only be resumed by + the owning process - not from outside. + Also, the compiler has an option (+optcontext) to create + non-resumable contexts (which are faster). + If such a context is restarted, a runtime error is raised." " starting with this context, find the one below @@ -1183,16 +1183,16 @@ theContext = __thisContext; while (theContext != nil) { - sndr = __ContextInstPtr(theContext)->c_sender; - if (sndr == self) break; - theContext = sndr; + sndr = __ContextInstPtr(theContext)->c_sender; + if (sndr == self) break; + theContext = sndr; } if (theContext != nil) { - if (__ContextInstPtr(theContext)->c_sender) { - if (!((INT)(__ContextInstPtr(theContext)->c_flags) & __MASKSMALLINT(__CANNOT_RETURN))) { - __RESUMECONTEXT__(theContext, value, 0); - } - } + if (__ContextInstPtr(theContext)->c_sender) { + if (!((INT)(__ContextInstPtr(theContext)->c_flags) & __MASKSMALLINT(__CANNOT_RETURN))) { + __RESUMECONTEXT__(theContext, value, 0); + } + } } %}. @@ -1206,14 +1206,14 @@ If the context has already returned - simply return. NOTICE: - NO unwind actions are performed (see Context>>unwind:). + NO unwind actions are performed (see Context>>unwind:). LIMITATION: - currently a context can only be resumed by - the owning process - not from outside. - Also, the compiler has an option (+optcontext) to create - non-resumable contexts (which are faster). - If such a context is restarted, a runtime error is raised." + currently a context can only be resumed by + the owning process - not from outside. + Also, the compiler has an option (+optcontext) to create + non-resumable contexts (which are faster). + If such a context is restarted, a runtime error is raised." " starting with this context, find the one below @@ -1225,14 +1225,14 @@ theContext = __thisContext; while (theContext != nil) { - sndr = __ContextInstPtr(theContext)->c_sender; - if (sndr == self) break; - theContext = sndr; + sndr = __ContextInstPtr(theContext)->c_sender; + if (sndr == self) break; + theContext = sndr; } if (theContext != nil) { - if (__ContextInstPtr(theContext)->c_sender) { - __RESUMECONTEXT__(theContext, value, 0); - } + if (__ContextInstPtr(theContext)->c_sender) { + __RESUMECONTEXT__(theContext, value, 0); + } } %}. @@ -1242,16 +1242,16 @@ 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. + 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. - Also, the compiler has an option (+optcontext) to create - non-returnable contexts (which are faster). - If such a context is restarted, a runtime error is raised." + currently a context can only be returned by + the owning process - not from outside. + Also, the compiler has an option (+optcontext) to create + non-returnable contexts (which are faster). + If such a context is restarted, a runtime error is raised." ^ self return:nil ! @@ -1259,22 +1259,22 @@ 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. + 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. - Also, the compiler has an option (+optcontext) to create - non-returnable contexts (which are faster). - If such a context is restarted, a runtime error is raised." + currently a context can only be returned by + the owning process - not from outside. + Also, the compiler has an option (+optcontext) to create + non-returnable contexts (which are faster). + If such a context is restarted, a runtime error is raised." %{ /* NOCONTEXT */ if (__INST(sender_) == nil) { - RETURN(nil); + RETURN(nil); } else { - __RESUMECONTEXT__(self, value, 0); + __RESUMECONTEXT__(self, value, 0); } %}. @@ -1290,22 +1290,22 @@ The block is evaluated as if called by the receiver context; NOT the true executing context. NOTICE: - NO unwind actions are performed - this is usually not - what you want (See Context>>unwindThenDo:). - This is a low level method - a helper for unwind. + NO unwind actions are performed - this is usually not + what you want (See Context>>unwindThenDo:). + 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. - Also, the compiler has an option (+optcontext) to create - non-returnable contexts (which are faster). - If such a context is restarted, a runtime error is raised." + currently a context can only be returned by + the owning process - not from outside. + Also, the compiler has an option (+optcontext) to create + non-returnable contexts (which are faster). + If such a context is restarted, a runtime error is raised." %{ if (__INST(sender_) == nil) { - RETURN(nil); + RETURN(nil); } else { - __RESUMECONTEXT__(self, aBlock, 2); + __RESUMECONTEXT__(self, aBlock, 2); } %}. @@ -1323,16 +1323,16 @@ and Block>>valueOnUnwindDo: on the way. LIMITATION: - currently a context can only be unwound by - the owning process - not from outside. - i.e. it is not possible for one thread to unwind - another threads context - which does not make sense anyway. - However, you can force another thread to do this in its own process - context, by giving it an interrupt action - this does make sense. - - Also, the compiler has an option (+optcontext) to create - non-returnable contexts (which are faster). - If such a context is restarted, a runtime error is raised." + currently a context can only be unwound by + the owning process - not from outside. + i.e. it is not possible for one thread to unwind + another threads context - which does not make sense anyway. + However, you can force another thread to do this in its own process + context, by giving it an interrupt action - this does make sense. + + Also, the compiler has an option (+optcontext) to create + non-returnable contexts (which are faster). + If such a context is restarted, a runtime error is raised." ^ self unwind:nil ! @@ -1344,21 +1344,21 @@ and Block>>valueOnUnwindDo: on the way. LIMITATION: - currently a context can only be unwound by - the owning process - not from outside. - i.e. it is not possible for one thread to unwind - another threads context - which does not make sense anyway. - However, you can force another thread to do this in its own process - context, by giving it an interrupt action - this does make sense. - - Also, the compiler has an option (+optcontext) to create - non-returnable contexts (which are faster). - If such a context is restarted, a runtime error is raised." + currently a context can only be unwound by + the owning process - not from outside. + i.e. it is not possible for one thread to unwind + another threads context - which does not make sense anyway. + However, you can force another thread to do this in its own process + context, by giving it an interrupt action - this does make sense. + + Also, the compiler has an option (+optcontext) to create + non-returnable contexts (which are faster). + If such a context is restarted, a runtime error is raised." |con| self senderIsNil ifFalse:[ - con := thisContext evaluateUnwindActionsUpTo:self. + con := thisContext evaluateUnwindActionsUpTo:self. ]. "oops, if nil, I am not on the calling chain; @@ -1367,11 +1367,11 @@ the unwind actions in this case ?) " con isNil ifTrue:[ - " - tried to return to a context which is already dead - (i.e. the method/block has already executed a return) - " - ^ self invalidReturnOrRestartError:#'unwind:' with:value + " + tried to return to a context which is already dead + (i.e. the method/block has already executed a return) + " + ^ self invalidReturnOrRestartError:#'unwind:' with:value ]. " now, that all unwind-actions are done, I can use the @@ -1387,21 +1387,21 @@ and Block>>valueOnUnwindDo: before restarting. LIMITATION: - a context can only be restarted by - the owning process - not from outside. - i.e. it is not possible for one thread to unwindAndRestart - another threads context - which does not make sense anyway. - However, you can force another thread to do this in its own process - context, by giving it an interrupt action - this does make sense. - - Also, the compiler has an option (+optcontext) to create - non-restartable contexts (which are faster). - If such a context is restarted, a runtime error is raised." + a context can only be restarted by + the owning process - not from outside. + i.e. it is not possible for one thread to unwindAndRestart + another threads context - which does not make sense anyway. + However, you can force another thread to do this in its own process + context, by giving it an interrupt action - this does make sense. + + Also, the compiler has an option (+optcontext) to create + non-restartable contexts (which are faster). + If such a context is restarted, a runtime error is raised." |con| self senderIsNil ifFalse:[ - con := thisContext evaluateUnwindActionsUpTo:self. + con := thisContext evaluateUnwindActionsUpTo:self. ]. "oops, if nil, I am not on the calling chain; @@ -1410,11 +1410,11 @@ the unwind actions in this case ?) " con isNil ifTrue:[ - " - tried to return to a context which is already dead - (i.e. the method/block has already executed a return) - " - ^ self invalidReturnOrRestartError:#'unwindAndRestart:' with:nil + " + tried to return to a context which is already dead + (i.e. the method/block has already executed a return) + " + ^ self invalidReturnOrRestartError:#'unwindAndRestart:' with:nil ]. " now, that all unwind-actions are done, I can use the @@ -1431,21 +1431,21 @@ and Block>>valueOnUnwindDo: on the way. LIMITATION: - currently a context can only be unwound by - the owning process - not from outside. - i.e. it is not possible for one thread to unwind - another threads context - which does not make sense anyway. - However, you can force another thread to do this in its own process - context, by giving it an interrupt action - this does make sense. - - Also, the compiler has an option (+optcontext) to create - non-returnable contexts (which are faster). - If such a context is restarted, a runtime error is raised." + currently a context can only be unwound by + the owning process - not from outside. + i.e. it is not possible for one thread to unwind + another threads context - which does not make sense anyway. + However, you can force another thread to do this in its own process + context, by giving it an interrupt action - this does make sense. + + Also, the compiler has an option (+optcontext) to create + non-returnable contexts (which are faster). + If such a context is restarted, a runtime error is raised." |con| self senderIsNil ifFalse:[ - con := thisContext evaluateUnwindActionsUpTo:self. + con := thisContext evaluateUnwindActionsUpTo:self. ]. "oops, if nil, I am not on the calling chain; @@ -1454,11 +1454,11 @@ the unwind actions in this case ?) " con isNil ifTrue:[ - " - tried to return to a context which is already dead - (i.e. the method/block has already executed a return) - " - ^ self invalidReturnOrRestartError:#'unwindAndResume:' with:value + " + tried to return to a context which is already dead + (i.e. the method/block has already executed a return) + " + ^ self invalidReturnOrRestartError:#'unwindAndResume:' with:value ]. " now, that all unwind-actions are done, I can use the @@ -1477,21 +1477,21 @@ currently executing context) LIMITATION: - currently a context can only be unwound by - the owning process - not from outside - i.e. it is not possible for one thread to unwindThenDo - another threads context - which does not make sense anyway. - However, you can force another thread to do this in its own process - context, by giving it an interrupt action - this does make sense. - - Also, the compiler has an option (+optcontext) to create - non-returnable contexts (which are faster). - If such a context is restarted, a runtime error is raised." + currently a context can only be unwound by + the owning process - not from outside + i.e. it is not possible for one thread to unwindThenDo + another threads context - which does not make sense anyway. + However, you can force another thread to do this in its own process + context, by giving it an interrupt action - this does make sense. + + Also, the compiler has an option (+optcontext) to create + non-returnable contexts (which are faster). + If such a context is restarted, a runtime error is raised." |con| self senderIsNil ifFalse:[ - con := thisContext evaluateUnwindActionsUpTo:self. + con := thisContext evaluateUnwindActionsUpTo:self. ]. "oops, if nil, I am not on the calling chain; @@ -1500,11 +1500,11 @@ the unwind actions in this case ?) " con isNil ifTrue:[ - " - tried to return to a context which is already dead - (i.e. the method/block has already executed a return) - " - ^ self invalidReturnOrRestartError:#'unwindThenDo:' with:aBlock + " + tried to return to a context which is already dead + (i.e. the method/block has already executed a return) + " + ^ self invalidReturnOrRestartError:#'unwindThenDo:' with:aBlock ]. " now, that all unwind-actions are done, I can use the @@ -1522,21 +1522,21 @@ The resend happens AFTER all unwind actions are performed LIMITATION: - currently a context can only be unwound by - the owning process - not from outside - i.e. it is not possible for one thread to unwindThenDo - another threads context - which does not make sense anyway. - However, you can force another thread to do this in its own process - context, by giving it an interrupt action - this does make sense. - - Also, the compiler has an option (+optcontext) to create - non-returnable contexts (which are faster). - If such a context is restarted, a runtime error is raised." + currently a context can only be unwound by + the owning process - not from outside + i.e. it is not possible for one thread to unwindThenDo + another threads context - which does not make sense anyway. + However, you can force another thread to do this in its own process + context, by giving it an interrupt action - this does make sense. + + Also, the compiler has an option (+optcontext) to create + non-returnable contexts (which are faster). + If such a context is restarted, a runtime error is raised." |con| self senderIsNil ifFalse:[ - con := thisContext evaluateUnwindActionsUpTo:self. + con := thisContext evaluateUnwindActionsUpTo:self. ]. "oops, if nil, I am not on the calling chain; @@ -1545,11 +1545,11 @@ the unwind actions in this case ?) " con isNil ifTrue:[ - " - tried to return to a context which is already dead - (i.e. the method/block has already executed a return) - " - ^ self invalidReturnOrRestartError:#'unwindThenResend' with:nil + " + tried to return to a context which is already dead + (i.e. the method/block has already executed a return) + " + ^ self invalidReturnOrRestartError:#'unwindThenResend' with:nil ]. "/ now, that all unwind-actions are done, I can use the low-level resend... @@ -1568,16 +1568,16 @@ * However, these print methods are also invoked for low-level pointer errors, so better be prepared... */ if (__isNonNilObject(someObject) && (__qClass(someObject)==nil)) { - s = __MKSTRING("FreeObject"); + s = __MKSTRING("FreeObject"); } %}. s isNil ifTrue:[ - s := someObject displayString. - s isNil ifTrue:[ - ^ '**************** nil displayString of ',(someObject class name ? '??') - ]. + s := someObject displayString. + s isNil ifTrue:[ + ^ '**************** nil displayString of ',(someObject class name ? '??') + ]. ]. -"/ JV@2013-04-26: Following is rubbish, the callers must handle string output correctly. +"/ JV@2013-04-26: Following is rubbish, the callers must handle string output correctly. "/ moreover storeString does not work on self-referencing structures, but that doesn't matter "/ for wide strings. "/ SV@2013-08-19: I checked/fixed the callers to use CharacterWriteStreams. @@ -1595,19 +1595,19 @@ ! displayArgsOn:aStream - | n "{ Class: SmallInteger }" + | n "{ Class: SmallInteger }" s | n := self numArgs. 1 to:n do:[:index | - Error handle:[:ex | - s := 'Error in argString'. - ] do:[ - s := self argStringFor:(self at:index). - ]. - - aStream nextPutAll:(s contractTo:100). - index ~~ n ifTrue:[ aStream space ]. + Error handle:[:ex | + s := '*Error in argString*'. + ] do:[ + s := self argStringFor:(self at:index). + ]. + + aStream nextPutAll:(s contractTo:100). + index ~~ n ifTrue:[ aStream space ]. ]. "Modified: / 07-03-2012 / 13:09:17 / cg" @@ -1619,12 +1619,12 @@ "/ what a kludge - Dolphin and Squeak mean: printOn: a stream; "/ ST/X (and some old ST80's) mean: draw-yourself on a GC. (aGCOrStream isStream) ifFalse:[ - ^ super displayOn:aGCOrStream + ^ super displayOn:aGCOrStream ]. - aGCOrStream - nextPutAll:self class name; - nextPut:$(. + aGCOrStream + nextPutAll:self class name; + nextPut:$(. self printOn:aGCOrStream. aGCOrStream nextPut:$). ! @@ -1662,8 +1662,8 @@ "/ self selector storeOn:aStream. "show as symbol" self size ~~ 0 ifTrue: [ - aStream space. - self displayArgsOn:aStream + aStream space. + self displayArgsOn:aStream ]. aStream nextPutAll:' {'. self identityHash printOn:aStream. @@ -1699,10 +1699,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. @@ -1755,7 +1755,7 @@ aStream normal. aStream space. (method notNil and:[method isWrapped]) ifTrue:[ - aStream nextPutAll:'(wrapped) ' + aStream nextPutAll:'(wrapped) ' ]. aStream nextPutAll:' ['; nextPutAll:self lineNumber printString; nextPutAll:']' . @@ -1769,19 +1769,19 @@ receiverClassName := self safeReceiverClassName. receiverClassName notNil ifTrue:[ - "if we come here, this is a context with an illegal class" - receiverClassName printOn:aStream. - ^ self. + "if we come here, this is a context with an illegal class" + receiverClassName printOn:aStream. + ^ self. ]. receiverClass := receiver class. (receiverClass == SmallInteger or:[receiverClass == Float]) ifTrue:[ - aStream nextPut:$(. receiver printOn:aStream. aStream nextPutAll:') '. + aStream nextPut:$(. receiver printOn:aStream. aStream nextPutAll:') '. ]. receiverClass isJavaClass ifTrue:[ - receiverClass displayOn:aStream + receiverClass displayOn:aStream ] ifFalse:[ "/ (receiverClass isBehavior "/ and:[receiverClass isMeta @@ -1791,64 +1791,64 @@ "/ ] ifFalse:[ "/ receiverClassName := receiverClass name. "/ ]. - (receiverClass name ? '????') printOn:aStream. + (receiverClass name ? '????') printOn:aStream. ]. (selector notNil or:[method notNil]) ifTrue:[ - "/ implementorClass := self searchClass whichClassIncludesSelector:selector. - - " - kludge to avoid slow search for containing class - " - (method notNil - or:[selector ~~ #doIt and:[selector ~~ #doIt:]]) ifTrue:[ - implementorClass := self methodClass. - implementorClass isNil ifTrue:[ - " - kludge for the frame called by a wrappedmethod; - the wrappedmethod is in the class, so its mclass is correct. - however, the originalmethod is invoked via performMethod, and its mclass - is nil. Care for this here. Think about keeping the mclass in the original method. - " - (method notNil and:[method isWrapped not]) ifTrue:[ - WrappedMethod allInstancesDo:[:wrapped | - wrapped originalMethodIfWrapped == method ifTrue:[ - implementorClass := wrapped mclass. - ]. - ]. - ] - ]. - ]. - - implementorClass notNil ifTrue: [ - (implementorClass ~~ receiverClass) ifTrue: [ - aStream nextPut:$(. - (implementorClass name ? '???') printOn:aStream. - aStream nextPut:$). - ] - ] ifFalse:[ - self searchClass ~~ receiverClass ifTrue:[ - aStream nextPut:$(. - (self searchClass name ? '???') printOn:aStream. - aStream nextPut:$). - ]. - " - kludge for doIt - these unbound methods are not - found in the classes methodDictionary - " - true "(selector ~~ #doIt and:[selector ~~ #doIt:])" ifTrue:[ - " - kludge for methods invoked explicitly via valueWithReceiver... - " - (self sender notNil - and:[ self sender receiver isMethod - and:[ self sender selector startsWith:'valueWithReceiver:' ]]) ifTrue:[ - aStream nextPutAll:'(**DIRECTED**)'. - ] ifFalse:[ - aStream nextPutAll:'(**NONE**)'. - ] - ] - ] + "/ implementorClass := self searchClass whichClassIncludesSelector:selector. + + " + kludge to avoid slow search for containing class + " + (method notNil + or:[selector ~~ #doIt and:[selector ~~ #doIt:]]) ifTrue:[ + implementorClass := self methodClass. + implementorClass isNil ifTrue:[ + " + kludge for the frame called by a wrappedmethod; + the wrappedmethod is in the class, so its mclass is correct. + however, the originalmethod is invoked via performMethod, and its mclass + is nil. Care for this here. Think about keeping the mclass in the original method. + " + (method notNil and:[method isWrapped not]) ifTrue:[ + WrappedMethod allInstancesDo:[:wrapped | + wrapped originalMethodIfWrapped == method ifTrue:[ + implementorClass := wrapped mclass. + ]. + ]. + ] + ]. + ]. + + implementorClass notNil ifTrue: [ + (implementorClass ~~ receiverClass) ifTrue: [ + aStream nextPut:$(. + (implementorClass name ? '???') printOn:aStream. + aStream nextPut:$). + ] + ] ifFalse:[ + self searchClass ~~ receiverClass ifTrue:[ + aStream nextPut:$(. + (self searchClass name ? '???') printOn:aStream. + aStream nextPut:$). + ]. + " + kludge for doIt - these unbound methods are not + found in the classes methodDictionary + " + true "(selector ~~ #doIt and:[selector ~~ #doIt:])" ifTrue:[ + " + kludge for methods invoked explicitly via valueWithReceiver... + " + (self sender notNil + and:[ self sender receiver isMethod + and:[ self sender selector startsWith:'valueWithReceiver:' ]]) ifTrue:[ + aStream nextPutAll:'(**DIRECTED**)'. + ] ifFalse:[ + aStream nextPutAll:'(**NONE**)'. + ] + ] + ] ]. "Modified: / 13-06-2012 / 14:49:33 / cg" @@ -1864,7 +1864,7 @@ ^ s contents " - thisContext receiverPrintString + thisContext receiverPrintString " ! @@ -1882,7 +1882,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 @@ -2018,26 +2018,26 @@ theContext = self; while (__isNonNilObject(theContext)) { - if ((INT)(__ContextInstPtr(theContext)->c_flags) & __MASKSMALLINT(__HANDLE_MARK|__RAISE_MARK)) { - if (__isLazy(theContext)) { - __PATCHUPCONTEXT(theContext); - } - - if (! __isNonLIFO(theContext)) { - /* - * to be prepared for the worst situation - * (the sender is not stored, so the trap won't catch it) - * make the writeBarrier trigger manually. - * We'll see, if this is really required. - */ - theContext->o_space |= CATCHMARK; + if ((INT)(__ContextInstPtr(theContext)->c_flags) & __MASKSMALLINT(__HANDLE_MARK|__RAISE_MARK)) { + if (__isLazy(theContext)) { + __PATCHUPCONTEXT(theContext); + } + + if (! __isNonLIFO(theContext)) { + /* + * to be prepared for the worst situation + * (the sender is not stored, so the trap won't catch it) + * make the writeBarrier trigger manually. + * We'll see, if this is really required. + */ + theContext->o_space |= CATCHMARK; #if 0 - __markNonLIFO(theContext); + __markNonLIFO(theContext); #endif - } - RETURN (theContext); - } - theContext = __ContextInstPtr(theContext)->c_sender; + } + RETURN (theContext); + } + theContext = __ContextInstPtr(theContext)->c_sender; } %}. ^ nil @@ -2072,38 +2072,38 @@ theContext = __INST(sender_); while (__isNonNilObject(theContext)) { - if (__isLazy(theContext)) { + if (__isLazy(theContext)) { #ifdef TRADITIONAL_STACK_FRAME - sel = __FETCHSELECTOR(theContext); + sel = __FETCHSELECTOR(theContext); #else - /* mhmh - not really needed */ - __PATCHUPCONTEXT(theContext); - sel = __ContextInstPtr(theContext)->c_selector; + /* mhmh - not really needed */ + __PATCHUPCONTEXT(theContext); + sel = __ContextInstPtr(theContext)->c_selector; #endif - } else { - sel = __ContextInstPtr(theContext)->c_selector; - } - - if ((sel == selector1) - || ((selector2 != nil) && (sel == selector2)) - || ((selector3 != nil) && (sel == selector3))) { - if (__isLazy(theContext)) { - __PATCHUPCONTEXT(theContext); - } - - if (! __isNonLIFO(theContext)) { - /* - * to be prepared for the worst situation - * (the sender is not stored, so the trap won't catch it) - * make the writeBarrier trigger manually. - * We'll see, if this is really required. - */ - theContext->o_space |= CATCHMARK; - __markNonLIFO(theContext); - } - RETURN (theContext); - } - theContext = __ContextInstPtr(theContext)->c_sender; + } else { + sel = __ContextInstPtr(theContext)->c_selector; + } + + if ((sel == selector1) + || ((selector2 != nil) && (sel == selector2)) + || ((selector3 != nil) && (sel == selector3))) { + if (__isLazy(theContext)) { + __PATCHUPCONTEXT(theContext); + } + + if (! __isNonLIFO(theContext)) { + /* + * to be prepared for the worst situation + * (the sender is not stored, so the trap won't catch it) + * make the writeBarrier trigger manually. + * We'll see, if this is really required. + */ + theContext->o_space |= CATCHMARK; + __markNonLIFO(theContext); + } + RETURN (theContext); + } + theContext = __ContextInstPtr(theContext)->c_sender; } RETURN (nil); %}. @@ -2112,11 +2112,11 @@ con := self sender. [con notNil] whileTrue:[ - sel := con selector. - sel == selector1 ifTrue:[^ con]. - (selector2 notNil and:[sel == selector2]) ifTrue:[^ con]. - (selector3 notNil and:[sel == selector3]) ifTrue:[^ con]. - con := con sender. + sel := con selector. + sel == selector1 ifTrue:[^ con]. + (selector2 notNil and:[sel == selector2]) ifTrue:[^ con]. + (selector3 notNil and:[sel == selector3]) ifTrue:[^ con]. + con := con sender. ]. ^ nil " @@ -2146,31 +2146,31 @@ OBJ theContext; if (self == aContext) { - RETURN (self); + RETURN (self); } theContext = __INST(sender_); while (__isNonNilObject(theContext)) { - if ((theContext == aContext) - || ((INT)(__ContextInstPtr(theContext)->c_flags) & __MASKSMALLINT(__UNWIND_MARK))) { - if (__isLazy(theContext)) { - __PATCHUPCONTEXT(theContext); - } - if (! __isNonLIFO(theContext)) { - /* - * to be prepared for the worst situation - * (the sender is not stored, so the trap won't catch it) - * make the writeBarrier trigger manually. - * We'll see, if this is really required. - */ - theContext->o_space |= CATCHMARK; + if ((theContext == aContext) + || ((INT)(__ContextInstPtr(theContext)->c_flags) & __MASKSMALLINT(__UNWIND_MARK))) { + if (__isLazy(theContext)) { + __PATCHUPCONTEXT(theContext); + } + if (! __isNonLIFO(theContext)) { + /* + * to be prepared for the worst situation + * (the sender is not stored, so the trap won't catch it) + * make the writeBarrier trigger manually. + * We'll see, if this is really required. + */ + theContext->o_space |= CATCHMARK; #if 0 - __markNonLIFO(theContext); + __markNonLIFO(theContext); #endif - } - RETURN (theContext); - } - theContext = __ContextInstPtr(theContext)->c_sender; + } + RETURN (theContext); + } + theContext = __ContextInstPtr(theContext)->c_sender; } %}. ^ nil @@ -2205,33 +2205,33 @@ INT mask; if (findHandleContext == true) - flagMask = __HANDLE_MARK; + flagMask = __HANDLE_MARK; if (findRaiseContext == true) - flagMask |= __RAISE_MARK; + flagMask |= __RAISE_MARK; mask = __MASKSMALLINT(flagMask); theContext = __INST(sender_); while (__isNonNilObject(theContext)) { - if ((INT)(__ContextInstPtr(theContext)->c_flags) & mask) { - if (__isLazy(theContext)) { - __PATCHUPCONTEXT(theContext); - } - - if (! __isNonLIFO(theContext)) { - /* - * to be prepared for the worst situation - * (the sender is not stored, so the trap won't catch it) - * make the writeBarrier trigger manually. - * We'll see, if this is really required. - */ - theContext->o_space |= CATCHMARK; + if ((INT)(__ContextInstPtr(theContext)->c_flags) & mask) { + if (__isLazy(theContext)) { + __PATCHUPCONTEXT(theContext); + } + + if (! __isNonLIFO(theContext)) { + /* + * to be prepared for the worst situation + * (the sender is not stored, so the trap won't catch it) + * make the writeBarrier trigger manually. + * We'll see, if this is really required. + */ + theContext->o_space |= CATCHMARK; #if 0 - __markNonLIFO(theContext); + __markNonLIFO(theContext); #endif - } - RETURN (theContext); - } - theContext = __ContextInstPtr(theContext)->c_sender; + } + RETURN (theContext); + } + theContext = __ContextInstPtr(theContext)->c_sender; } %}. ^ nil @@ -2251,105 +2251,105 @@ homeContext := self methodHome. homeContext notNil ifTrue:[ - sel := homeContext selector. - homeMethod := homeContext method. + sel := homeContext selector. + homeMethod := homeContext method. ]. extractFromBlock := - [ - |blockNode argNames varNames vars args blocksHome| - - blockNode := Compiler - blockAtLine:blocksLineNr - in:m - orSource:src - numArgs:numArgs - numVars:numVars. - - blockNode notNil ifTrue:[ - "/ a kludge - blockNode lineNumber == blocksLineNr ifTrue:[ - blocksHome := blockNode home. - (blocksHome notNil and:[blocksHome isBlockNode]) ifTrue:[ - (blocksHome numArgs == numArgs - and:[ blocksHome numVars == numVars ]) ifTrue:[ - blockNode := blocksHome - ]. - ]. - ]. - - argNames := #(). - varNames := #(). - - numArgs > 0 ifTrue:[ - vars := blockNode arguments. - vars notEmptyOrNil ifTrue:[ - argNames := vars collect:[:var | var name] - ] - ]. - numVars > 0 ifTrue:[ - vars := blockNode variablesIncludingInlined: (homeMethod code notNil and:[homeMethod byteCode isNil]). - vars notEmptyOrNil ifTrue:[ - varNames := vars collect:[:var | var name]. - ] - ]. - ^ argNames , varNames - ]. - ]. + [ + |blockNode argNames varNames vars args blocksHome| + + blockNode := Compiler + blockAtLine:blocksLineNr + in:m + orSource:src + numArgs:numArgs + numVars:numVars. + + blockNode notNil ifTrue:[ + "/ a kludge + blockNode lineNumber == blocksLineNr ifTrue:[ + blocksHome := blockNode home. + (blocksHome notNil and:[blocksHome isBlockNode]) ifTrue:[ + (blocksHome numArgs == numArgs + and:[ blocksHome numVars == numVars ]) ifTrue:[ + blockNode := blocksHome + ]. + ]. + ]. + + argNames := #(). + varNames := #(). + + numArgs > 0 ifTrue:[ + vars := blockNode arguments. + vars notEmptyOrNil ifTrue:[ + argNames := vars collect:[:var | var name] + ] + ]. + numVars > 0 ifTrue:[ + vars := blockNode variablesIncludingInlined: (homeMethod code notNil and:[homeMethod byteCode isNil]). + vars notEmptyOrNil ifTrue:[ + varNames := vars collect:[:var | var name]. + ] + ]. + ^ argNames , varNames + ]. + ]. "/ #doIt needs special handling below isDoIt := (sel == #'doIt') or:[sel == #'doIt:']. self isBlockContext ifFalse:[ - isDoIt ifTrue:[ - homeMethod notNil ifTrue:[ - "/ special for #doIt - m := nil. - src := ('[' , homeMethod source , '\]') withCRs. - "/ blocksLineNr := self lineNumber. - blocksLineNr := (self home ? self) lineNumber. - extractFromBlock value. - ] - ]. - - homeMethod notNil ifTrue:[ - ^ homeMethod methodArgAndVarNamesInContext: self. - ]. - ^ #() + isDoIt ifTrue:[ + homeMethod notNil ifTrue:[ + "/ special for #doIt + m := nil. + src := ('[' , homeMethod source , '\]') withCRs. + "/ blocksLineNr := self lineNumber. + blocksLineNr := (self home ? self) lineNumber. + extractFromBlock value. + ] + ]. + + homeMethod notNil ifTrue:[ + ^ homeMethod methodArgAndVarNamesInContext: self. + ]. + ^ #() ]. homeMethod notNil ifTrue:[ - isDoIt ifTrue:[ - "/ special for #doIt - "/ my source is found in the method. - m := nil. - src := ('[' , homeMethod source , '\]') withCRs. - ] ifFalse:[ - m := homeMethod. - src := nil. - ]. - blocksLineNr := self lineNumber. - extractFromBlock value. - blocksLineNr := self home lineNumber. - extractFromBlock value. + isDoIt ifTrue:[ + "/ special for #doIt + "/ my source is found in the method. + m := nil. + src := ('[' , homeMethod source , '\]') withCRs. + ] ifFalse:[ + m := homeMethod. + src := nil. + ]. + blocksLineNr := self lineNumber. + extractFromBlock value. + blocksLineNr := self home lineNumber. + extractFromBlock value. ]. blocksLineNr isNil ifTrue:[ - self isBlockContext ifTrue:[ - sender := self sender. - (sender notNil - and:[sender receiver isBlock - and:[sender selector startsWith:'value']]) - ifTrue:[ - block := sender receiver. - src := block source. - src isNil ifTrue:[ - self error:'no source'. - ]. - blocksLineNr := 1. - extractFromBlock value. - ]. - sender := nil. - ]. + self isBlockContext ifTrue:[ + sender := self sender. + (sender notNil + and:[sender receiver isBlock + and:[sender selector startsWith:'value']]) + ifTrue:[ + block := sender receiver. + src := block source. + src isNil ifTrue:[ + self error:'no source'. + ]. + blocksLineNr := 1. + extractFromBlock value. + ]. + sender := nil. + ]. ]. ^ #() @@ -2373,18 +2373,18 @@ theContext = __thisContext; while (theContext != nil) { - sndr = __ContextInstPtr(theContext)->c_sender; - if (sndr == self) break; - theContext = sndr; + sndr = __ContextInstPtr(theContext)->c_sender; + if (sndr == self) break; + theContext = sndr; } if (theContext != nil) { - if (__isLazy(theContext)) { - __PATCHUPCONTEXT(theContext); - } + if (__isLazy(theContext)) { + __PATCHUPCONTEXT(theContext); + } } %}. theContext isNil ifTrue:[ - ^ false + ^ false ]. ^ theContext canReturn ! @@ -2482,7 +2482,7 @@ names := self argAndVarNames. (nTemps := self numTemps) > 0 ifTrue:[ - ^ names , ((1 to:nTemps) collect:[:idx | '_tmp' , idx printString]). + ^ names , ((1 to:nTemps) collect:[:idx | '_tmp' , idx printString]). ]. ^ names. ! ! @@ -2523,30 +2523,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 ... - " - myMethodsClass isNil ifTrue:[ - myMethodsClass := self methodClass. - ]. - 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 - ] + (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. + ]. + 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 + ] ]. ^ false @@ -2556,11 +2556,11 @@ !Context class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/stx/libbasic/Context.st,v 1.192 2013-12-06 14:10:17 stefan Exp $' + ^ '$Header: /cvs/stx/stx/libbasic/Context.st,v 1.193 2014-02-04 11:20:56 cg Exp $' ! version_CVS - ^ '$Header: /cvs/stx/stx/libbasic/Context.st,v 1.192 2013-12-06 14:10:17 stefan Exp $' + ^ '$Header: /cvs/stx/stx/libbasic/Context.st,v 1.193 2014-02-04 11:20:56 cg Exp $' ! version_HG