--- a/Context.st Tue Jun 01 12:09:10 2021 +0100
+++ b/Context.st Tue Jun 01 20:19:13 2021 +0100
@@ -18,7 +18,7 @@
Object variableSubclass:#Context
instanceVariableNames:'flags sender* home receiver selector searchClass method lineNr
retvalTemp handle*'
- classVariableNames:'SingleStepInterruptRequest'
+ classVariableNames:'SingleStepInterruptRequest MaxRecursion PrintWithHashes'
poolDictionaries:''
category:'Kernel-Methods'
!
@@ -48,15 +48,15 @@
Every message send adds a context to a chain, which can be traced back via
the sender field. The context of the currently active method is always
accessible via the pseuodoVariable called 'thisContext'.
- The actual implementation uses the machines stack for this, building real
- contexts on demand only, whenever a contexts is needed. Also, initially these are
+ The actual implementation uses the machine's stack for this, building real
+ contexts on demand only, whenever a context is needed. Also, initially these are
allocated on the stack and only moved to the heap, when a context outlives its
activation.
For both method- and block-contexts, the layout is the same.
For method contexts, the home-field is nil, while for block contexts the home-
field is either the context of its surrounding block (i.e. the context of the
- block, in which the receiving block was created, if its a nested block) or of
+ block, in which the receiving block was created, if it's a nested block) or of
its home method.
Cheap blocks are blocks which do not refer to any locals or the receiver (currently),
@@ -111,58 +111,58 @@
[instance variables:]
- flags <SmallInteger> used by the VM; never touch.
- contains info about number of args,
- locals and temporaries.
-
- sender <Context> the 'calling / sending' context
- This is not directly accessible, since it may
- be a lazy context (i.e. an empty frame).
- The #sender method cares for this.
-
- home <Context> the context, where this block was
- created, or nil if its a method context
- There are also cheap blocks, which do
- not need a reference to the home context,
- for those, its nil too.
-
- receiver <Object> the receiver of this message
-
- selector <Symbol> the selector of this message
-
- searchClass <Class> the class, where the message lookup started
- (for super sends) or nil, for regular sends.
-
- lineNr <SmallInteger> the position where the context left off
- (kind of p-counter). Only the low 16bits
- are valid.
-
- retValTemp nil temporary - always nil, when you see the context
- (used in the VM as temporary)
-
- handle *noObject* used by the VM; not accessible, not an object
-
- method the corresponding method
-
- <indexed> arguments of the send followed by
- locals of the method/block followed by
- temporaries.
+ flags <SmallInteger> used by the VM; never touch.
+ contains info about number of args,
+ locals and temporaries.
+
+ sender <Context> the 'calling / sending' context
+ This is not directly accessible, since it may
+ be a lazy context (i.e. an empty frame).
+ The #sender method cares for this.
+
+ home <Context> the context, where this block was
+ created, or nil if its a method context
+ There are also cheap blocks, which do
+ not need a reference to the home context,
+ for those, its nil too.
+
+ receiver <Object> the receiver of this message
+
+ selector <Symbol> the selector of this message
+
+ searchClass <Class> the class, where the message lookup started
+ (for super sends) or nil, for regular sends.
+
+ lineNr <SmallInteger> the position where the context left off
+ (kind of p-counter). Only the low 16bits
+ are valid.
+
+ retValTemp nil temporary - always nil, when you see the context
+ (used in the VM as temporary)
+
+ handle *noObject* used by the VM; not accessible, not an object
+
+ method the corresponding method
+
+ <indexed> arguments of the send followed by
+ locals of the method/block followed by
+ temporaries.
[errors:]
- CannotReturnError raised when a block tries
- to return ('^') from a method context
- which itself has already returned
- (i.e. there is no place to return to)
+ 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)
"
! !
@@ -176,9 +176,14 @@
SingleStepInterruptRequest := QuerySignal new.
SingleStepInterruptRequest nameClass:self message:#singleStepInterruptRequest.
SingleStepInterruptRequest notifierString:'single step'.
- ]
-
- "Modified: 6.5.1996 / 16:46:03 / cg"
+ ].
+
+ "/ context searchers (eg. isRecursive) will stop searching after
+ "/ this many call levels and assume, that something is wrong with the
+ "/ calling chain.
+ MaxRecursion := 10000.
+
+ "Modified: / 17-09-2017 / 10:00:19 / cg"
! !
!Context class methodsFor:'Signal constants'!
@@ -228,7 +233,7 @@
(' from ' , con printString) errorPrintCR.
con := con sender.
count := count + 1.
- ] doWhile:[con notNil and:[count < 5 or:[con receiver isCollection]]].
+ ] doWhile:[con notNil and:[count < 10 or:[con receiver isCollection]]].
"/ one more
con notNil ifTrue:[
(' from ' , con printString) errorPrintCR.
@@ -237,6 +242,8 @@
"
#() asSet add:nil
"
+
+ "Modified: / 15-05-2020 / 00:58:01 / cg"
! !
!Context class methodsFor:'queries'!
@@ -423,7 +430,7 @@
} else if (index == __MKSMALLINT(__SLOT_CONTEXT_RETVAL)) { // retvalTemp - invisible
RETURN (nil);
} else if (index == __MKSMALLINT(__SLOT_CONTEXT_HANDLE)) { // handle to machine stack - invisible
- RETURN ( __MKUINT ( (unsigned INT)(__ContextInstPtr(self)->c_pSelf) ) );
+ RETURN (nil);
}
#endif
%}.
@@ -464,53 +471,22 @@
^ value
!
-javaLineNumber
- |nr pc|
-
- lineNr notNil ifTrue:[
- pc := lineNr bitAnd:16rFFFF.
- ].
-
-"/ 'ask line for pc:' print. pc printCR.
- pc isNil ifTrue:[
- nr := self lineNumberFromMethod.
- nr notNil ifTrue:[
- ^ nr
- ].
- " '-> 0 [a]' printCR. "
- ^0
- ].
-
- nr := self method lineNumberForPC:pc.
- nr isNil ifTrue:[
- nr := self lineNumberFromMethod.
- nr notNil ifTrue:[
- ^ nr
- ].
- " '-> 0 [b]' printCR. "
- ^ 0
- ].
-"/ '-> ' print. nr printCR.
- ^ nr.
-
-!
-
lineNumber
- "this returns the lineNumber within the methods source, where the context was
+ "this returns the lineNumber within the method's source, where the context was
interrupted or called another method. (currently, sometimes this information
is not available - in this case 0 is returned)"
|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 javaContext ...
+ self method isJavaMethod ifTrue:[
+ ^ self javaLineNumber
+ ]
].
lineNr notNil ifTrue:[
- l := lineNr bitAnd:16rFFFF.
+ l := lineNr bitAnd:16rFFFF.
].
"/ self isJavaContext ifTrue:[ |nr m|
@@ -539,13 +515,36 @@
^ l
- "Modified: / 10.11.1998 / 13:19:48 / cg"
+ "Modified: / 10-11-1998 / 13:19:48 / cg"
+ "Modified (comment): / 21-11-2017 / 13:00:40 / cg"
!
lineNumberFromMethod
^ 1
!
+logFacility
+ "the 'log facility';
+ this is used by the Logger both as a prefix to the log message,
+ and maybe (later) used to filter and/or control per-facility log thresholds.
+ The default here is to base the facility on the package:
+ if the class is anywhere in the base ST/X system, 'STX' is returned as facility.
+ Otherwise, the last component of the package name is returned."
+
+ |cls|
+
+ method isNil ifTrue:[^ '???'].
+ (cls := method mclass) isNil ifTrue:[^ 'DOIT'].
+ ^ cls logFacility
+
+ "
+ thisContext logFacility
+ thisContext sender logFacility
+ "
+
+ "Created: / 18-05-2019 / 10:12:21 / Claus Gittinger"
+!
+
message
^ Message selector:selector arguments:self args
@@ -582,8 +581,7 @@
"mhmh - maybe I am a context for an unbound method (as generated by doIt);
look in the sender's context. Consider this a kludge.
- Future versions of ST/X's message lookup may store the method in
- the context.
+ Future versions of ST/X's message lookup may store the method in the context.
"
sender := self sender.
sender notNil ifTrue:[
@@ -621,6 +619,7 @@
"Modified: / 28-06-2011 / 20:23:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 20-07-2012 / 14:46:37 / cg"
+ "Modified (comment): / 18-05-2019 / 10:04:17 / Claus Gittinger"
!
methodClass
@@ -678,7 +677,8 @@
!
numArgs
- "return the number of arguments to the Block/Method"
+ "return the number of arguments to the Block/Method.
+ Please use argumentCount for ANSI compatibility"
%{ /* NOCONTEXT */
#ifdef __SCHTEAM__
@@ -1044,6 +1044,29 @@
%}
! !
+!Context methodsFor:'internationalization support'!
+
+resources
+ "try to provide the resourcePack for internationalization
+ from:
+ the receiver
+ the class of the receiver"
+
+ |resources|
+
+ (resources := receiver perform:#resources ifNotUnderstood:nil) isNil ifTrue:[
+ (resources := receiver class theNonMetaclass classResources) isNil ifTrue:[
+ "/ TODO: resourcePack must be moved to libbasic
+ 'oops - no resources' errorPrintCR.
+ ].
+ ].
+ ^ resources
+
+ "
+ thisContext resources
+ "
+! !
+
!Context methodsFor:'minidebugger printing'!
fullPrint
@@ -1132,6 +1155,21 @@
"
thisContext printAllLevels:5
"
+!
+
+savePrint
+ "print the receiver-class and selector only
+ - used when there is a danger that printing results in errors"
+
+ self receiver class name _errorPrint. ' ' _errorPrint. selector _errorPrint.
+ ' [' _errorPrint. self lineNumber _errorPrint. ']' _errorPrintCR
+
+ "
+ thisContext fullPrint
+ thisContext savePrint
+ "
+
+ "Created: / 05-06-2019 / 20:25:05 / Claus Gittinger"
! !
!Context methodsFor:'non local control flow'!
@@ -1170,13 +1208,21 @@
if the method's implementation has been changed in the meanwhile (for example, in the debugger),
the new code is executed. Otherwise the same code is reexecuted from the start."
- self returnDoing:[ receiver perform:selector withArguments:(self args) ].
+ self returnDoing:[
+ selector == #doIt ifTrue:[
+ method valueWithReceiver:receiver arguments:(self args) selector:selector
+ ] ifFalse:[
+ receiver perform:selector withArguments:(self args)
+ ].
+ ].
"
when we arrive here, something went wrong.
debugging ...
"
^ self invalidReturnOrRestartError:#'resend' with:nil
+
+ "Modified: / 26-01-2019 / 19:58:25 / Claus Gittinger"
!
restart
@@ -1718,59 +1764,106 @@
* 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");
+ RETURN(@symbol(FreeObject));
}
#endif /* not SCHTEAM */
%}.
- s isNil ifTrue:[
+ someObject isProtoObject ifTrue:[
+ "take care, do not evaluate lazy or do sends to
+ a bridge when showing backtrace. Especially not after
+ timeout of a bridge call!!"
+ s := someObject class nameWithArticle.
+ ] ifFalse:[
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.
-"/ 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.
-"/ s isWideString ifTrue:[
-"/ "make sure that the object really returns something we can stream into a string"
-"/ s := someObject storeString.
-"/ ].
- ^ s
+ s isNil ifTrue:[
+ ^ '**************** nil displayString of ',(someObject class name ? '??').
+ ].
+ ^ s string.
+
+ "Modified: / 23-11-2018 / 15:07:34 / Stefan Vogel"
!
argsDisplayString
- ^ String streamContents:[:s | self displayArgsOn:s ].
+ ^ String streamContents:[:s |
+ self displayArgsOn:s withCRs:false indent:0 contractEachTo:100
+ ].
+
+ "Modified (format): / 07-03-2012 / 13:11:17 / cg"
+ "Modified: / 23-11-2018 / 14:41:51 / Stefan Vogel"
+!
+
+argsDisplayStringShort
+ ^ String streamContents:[:s |
+ self displayArgsOn:s withCRs:false indent:0 contractEachTo:20.
+ ]
"Modified (format): / 07-03-2012 / 13:11:17 / cg"
!
-displayArgsOn:aStream
+displayArgsOn:aStream withCRs:withCRs indent:i
+ self displayArgsOn:aStream withCRs:withCRs indent:i contractEachTo:100
+!
+
+displayArgsOn:aStream withCRs:withCRs indent:i contractEachTo:limitOrNil
| n "{ Class: SmallInteger }"
s |
n := self argumentCount.
1 to:n do:[:index |
- Error handle:[:ex |
- s := '*Error in argString*'.
- ] do:[
- s := self argStringFor:(self at:index).
- s := s contractTo:100.
- ].
-
- aStream nextPutAll:s asString string.
- index ~~ n ifTrue:[ aStream space ].
+ Error handle:[:ex |
+ s := '*Error in argString*'.
+ ] do:[
+ s := self argStringFor:(self at:index).
+ limitOrNil notNil ifTrue:[
+ s := s contractTo:limitOrNil.
+ ].
+ ].
+
+ aStream spaces:i.
+ aStream nextPutAll:s.
+ withCRs ifTrue:[
+ aStream cr.
+ ] ifFalse:[
+ index ~~ n ifTrue:[ aStream space ].
+ ].
].
- "Modified: / 07-03-2012 / 13:09:17 / cg"
+ "Created: / 15-03-2017 / 14:13:33 / cg"
+ "Modified: / 23-11-2018 / 12:27:43 / Stefan Vogel"
+!
+
+displayLocalsOn:aStream withCRs:withCRs indent:i
+ | n "{ Class: SmallInteger }"
+ s |
+
+ n := self argumentCount.
+ n+1 to:self size do:[:index |
+ Error handle:[:ex |
+ s := '*Error in localString*'.
+ ] do:[
+ s := self argStringFor:(self at:index).
+ s := s contractTo:100.
+ ].
+ aStream spaces:i.
+ aStream nextPutAll:s.
+ withCRs ifTrue:[
+ aStream cr
+ ] ifFalse:[
+ index ~~ n ifTrue:[ aStream space ].
+ ].
+ ].
+
+ "Created: / 15-03-2017 / 14:13:23 / cg"
+ "Modified: / 23-11-2018 / 12:27:28 / Stefan Vogel"
!
displayOn:aGCOrStream
"return a string to display the receiver - for display in Inspector"
- "/ 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:[
+ "/ what a kludge - Dolphin and Squeak mean: printOn: a stream;
+ "/ old ST80 means: draw-yourself on a GC.
^ super displayOn:aGCOrStream
].
@@ -1779,42 +1872,111 @@
nextPut:$(.
self printOn:aGCOrStream.
aGCOrStream nextPut:$).
+
+ "Modified (comment): / 22-02-2017 / 16:47:42 / cg"
+ "Modified (comment): / 23-11-2018 / 14:46:56 / Stefan Vogel"
!
fullPrintAllOn:aStream
- "print a full walkback (incl arguments) starting at the receiver"
-
- self withAllSendersDo:[:con | con fullPrintOn:aStream. aStream cr].
+ "print a full walkback (incl. arguments) starting at the receiver"
+
+ self fullPrintAllOn:aStream withVariables:false
"
thisContext fullPrintAllOn:Transcript
"
- "Created: 15.1.1997 / 18:09:05 / cg"
+ "Created: / 15-01-1997 / 18:09:05 / cg"
+ "Modified: / 15-03-2017 / 14:16:12 / cg"
+ "Modified (comment): / 11-05-2020 / 10:46:42 / cg"
+!
+
+fullPrintAllOn:aStream levels:numLevels
+ "print a full walkback (incl. arguments) starting at the receiver"
+
+ self fullPrintAllOn:aStream levels:numLevels indent:0
+
+ "
+ thisContext fullPrintAllOn:Transcript levels:10
+ "
+
+ "Created: / 18-08-2017 / 15:12:17 / cg"
+ "Modified: / 21-08-2017 / 19:14:58 / cg"
+ "Modified (comment): / 11-05-2020 / 10:46:45 / cg"
+!
+
+fullPrintAllOn:aStream levels:numLevels indent:indent
+ "print a full walkback (incl. arguments) starting at the receiver"
+
+ |count|
+
+ count := 0.
+ self
+ withSendersThroughContextForWhich:[:c | false]
+ do:[:con |
+ aStream spaces:indent.
+ con fullPrintOn:aStream. aStream cr.
+ count := count + 1.
+ count >= numLevels ifTrue:[^ self].
+ ].
+
+ "
+ thisContext fullPrintAllOn:Transcript levels:10
+ "
+
+ "Created: / 21-08-2017 / 19:14:46 / cg"
+ "Modified (comment): / 11-05-2020 / 10:46:49 / cg"
+!
+
+fullPrintAllOn:aStream throughContext:topContextToPrint
+ "print a full walkback (incl. arguments) starting at the receiver,
+ and ending at topContextToPrint"
+
+ self fullPrintAllOn:aStream throughContextForWhich:[:c | c == topContextToPrint].
+
+ "Created: / 11-05-2020 / 10:45:19 / cg"
!
fullPrintAllOn:aStream throughContextForWhich:aBlock
- "print a full walkback (incl arguments) starting at the receiver"
+ "print a full walkback (incl. arguments) starting at the receiver"
self withSendersThroughContextForWhich:aBlock do:[:con |
- con fullPrintOn:aStream. aStream cr.
+ con fullPrintOn:aStream withVariables:false. aStream cr.
].
"
thisContext fullPrintAllOn:Transcript throughContextForWhich:[:con | con selector == #doIt].
"
+
+ "Modified (comment): / 23-11-2018 / 12:21:11 / Stefan Vogel"
+ "Modified (comment): / 11-05-2020 / 10:47:10 / cg"
!
fullPrintAllOn:aStream upToContextForWhich:aBlock
- "print a full walkback (incl arguments) starting at the receiver"
+ "print a full walkback (incl. arguments) starting at the receiver"
self withSendersUpToContextForWhich:aBlock do:[:con |
- con fullPrintOn:aStream. aStream cr.
+ con fullPrintOn:aStream. aStream cr.
].
"
thisContext fullPrintAllOn:Transcript upToContextForWhich:[:con | con selector == #doIt].
"
+
+ "Modified (comment): / 11-05-2020 / 10:47:18 / cg"
+!
+
+fullPrintAllOn:aStream withVariables:withVariables
+ "print a full walkback (incl. arguments) starting at the receiver"
+
+ self withAllSendersDo:[:con | con fullPrintOn:aStream withVariables:withVariables. aStream cr].
+
+ "
+ thisContext fullPrintAllOn:Transcript withVariables:true
+ "
+
+ "Created: / 15-03-2017 / 14:14:41 / cg"
+ "Modified (comment): / 11-05-2020 / 10:47:24 / cg"
!
fullPrintAllString
@@ -1822,7 +1984,7 @@
|s|
- s := WriteStream on:''.
+ s := '' writeStream.
self fullPrintAllOn:s.
^ s contents
@@ -1836,29 +1998,69 @@
fullPrintOn:aStream
"append a verbose description (incl. arguments) of the receiver onto aStream"
+ self fullPrintOn:aStream withVariables:false
+
+ "
+ thisContext fullPrintOn:Transcript
+ thisContext sender fullPrintOn:Transcript
+ "
+
+ "Created: / 15-01-1997 / 18:09:06 / cg"
+ "Modified (comment): / 15-03-2017 / 14:08:51 / cg"
+!
+
+fullPrintOn:aStream withVariables:withVariables
+ "append a verbose description (incl. arguments) of the receiver onto aStream"
+
+ |sel|
+
self printReceiverOn:aStream.
aStream nextPutAll:' >> '.
- self selector printOn:aStream. "show as string (as symbol looks too ugly in browser ...)"
- "/ self selector storeOn:aStream. "show as symbol"
-
- self size ~~ 0 ifTrue: [
- aStream space.
- self displayArgsOn:aStream
+ sel := self selector.
+ receiver isBlock ifTrue:[
+ "/ self selector storeOn:aStream. "show as symbol"
+ sel printOn:aStream. "show with prrint instead of store (symbol looks too ugly in browser...)"
+ ] ifFalse:[
+ aStream bold.
+ "/ self selector storeOn:aStream. "show as symbol"
+ sel printOn:aStream. "show with prrint instead of store (symbol looks too ugly in browser...)"
+ aStream normal.
].
- aStream nextPutAll:' {'.
- self identityHash printOn:aStream.
- aStream nextPut:$}.
-
+
+ withVariables ifFalse:[
+ self size ~~ 0 ifTrue: [
+ aStream space.
+ self displayArgsOn:aStream withCRs:false indent:0.
+ ].
+ ].
+ (PrintWithHashes ? false) ifTrue:[
+ aStream nextPutAll:' {'.
+ self identityHash printOn:aStream.
+ aStream nextPut:$}.
+ ].
aStream nextPutAll:' ['.
self lineNumber printOn:aStream.
aStream nextPut:$].
- "
- thisContext fullPrintOn:Transcript
+ withVariables ifTrue:[
+ self size ~~ 0 ifTrue: [
+ self argumentCount ~~ 0 ifTrue:[
+ aStream cr; nextPutAll:' Args:'; cr.
+ self displayArgsOn:aStream withCRs:true indent:4.
+ ].
+ self size > self argumentCount ifTrue:[
+ aStream cr; nextPutAll:' Locals:'; cr.
+ self displayLocalsOn:aStream withCRs:true indent:4.
+ ].
+ ].
+ ].
+
"
-
- "Modified: 20.5.1996 / 10:27:14 / cg"
- "Created: 15.1.1997 / 18:09:06 / cg"
+ thisContext fullPrintOn:Transcript withVariables:true
+ "
+
+ "Created: / 15-03-2017 / 13:24:16 / cg"
+ "Modified: / 23-11-2018 / 14:44:28 / Stefan Vogel"
!
fullPrintString
@@ -1906,36 +2108,49 @@
"Created: 15.1.1997 / 18:09:05 / cg"
!
+printAllOn:aStream throughContext:topContextToPrint
+ "print a brief walkback (excl. arguments) starting at the receiver,
+ and ending at topContextToPrint"
+
+ self printAllOn:aStream throughContextForWhich:[:c | c == topContextToPrint].
+
+ "Created: / 11-05-2020 / 10:45:45 / cg"
+!
+
printAllOn:aStream throughContextForWhich:aBlock
- "print a short walkback (excl. arguments) starting at the receiver"
+ "print a brief walkback (excl. arguments) starting at the receiver"
self withSendersThroughContextForWhich:aBlock do:[:con |
- con printOn:aStream. aStream cr.
+ con printOn:aStream. aStream cr.
].
"
thisContext printAllOn:Transcript throughContextForWhich:[:con | con selector == #doIt].
"
+
+ "Modified (comment): / 11-05-2020 / 10:46:18 / cg"
!
printAllOn:aStream upToContextForWhich:aBlock
- "print a short walkback (excl. arguments) starting at the receiver"
+ "print a brief walkback (excl. arguments) starting at the receiver"
self withSendersUpToContextForWhich:aBlock do:[:con |
- con printOn:aStream. aStream cr.
+ con printOn:aStream. aStream cr.
].
"
thisContext printAllOn:Transcript upToContextForWhich:[:con | con selector == #withCursor:do:].
"
+
+ "Modified (comment): / 11-05-2020 / 10:46:21 / cg"
!
printAllString
- "return a string containing the walkback (excl. arguments)"
+ "return a string containing the brief walkback (excl. arguments)"
|s|
- s := WriteStream on:''.
+ s := '' writeStream.
self printAllOn:s.
^ s contents
@@ -1944,6 +2159,7 @@
"
"Created: / 21-08-2011 / 07:38:05 / cg"
+ "Modified (comment): / 11-05-2020 / 10:46:29 / cg"
!
printClassNameOf:aClass on:aStream
@@ -1951,8 +2167,9 @@
| nonMeta |
- (nonMeta := aClass theNonMetaclass) isJavaClass ifTrue:[
- nonMeta javaName printOn: aStream
+ nonMeta := aClass theNonMetaclass.
+ nonMeta isJavaClass ifTrue:[
+ nonMeta javaName printOn: aStream
] ifFalse:[
(aClass name ? '????') printOn:aStream.
].
@@ -1963,46 +2180,18 @@
printOn:aStream
"append a brief description (excl. arguments) of the receiver onto aStream"
- | m |
-
- self printReceiverOn:aStream.
- "/ aStream nextPutAll:' '.
- aStream nextPutAll:' >> '.
-
- aStream bold.
- m := self method.
- m isJavaMethod ifTrue:[
- aStream nextPutAll: (m printStringForBrowserWithSelector: self selector).
- ] ifFalse:[
- self selector printOn:aStream. "show as string (as symbol looks too ugly in browser ...)"
- "/ self selector storeOn:aStream. "show as symbol"
- ].
- aStream normal.
-
- (method notNil and:[method isWrapped]) ifTrue:[
- aStream nextPutAll:' (wrapped) '
- ].
- aStream nextPutAll:' ['.
- m isJavaMethod ifTrue:[
- aStream nextPutAll: self method mclass sourceFile ? '???' .
- m isNative ifTrue:[
- aStream nextPutAll: ':in native code'
- ] ifFalse:[
- aStream nextPut: $:.
- (m lineNumberForPC0: lineNr) ? '???' printOn: aStream.
- ].
- ] ifFalse:[
- self lineNumber printOn: aStream
- ].
- aStream nextPut:$].
-
- "Modified: / 05-08-2012 / 12:00:00 / cg"
- "Modified: / 08-08-2014 / 07:37:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ self printWithSeparator:' >> ' on:aStream
!
printReceiverOn:aStream
"print description of the receiver of the context to aStream"
+ self printReceiverWithSeparator:'>>' on:aStream
+!
+
+printReceiverWithSeparator:sep on:aStream
+ "print description of the receiver of the context to aStream"
+
|receiverClass receiverClassName implementorClass|
receiverClassName := self safeReceiverClassNameIfInvalid.
@@ -2054,7 +2243,7 @@
aStream nextPut:$).
]
] ifFalse:[
- | srchClass where |
+ | srchClass where sender |
srchClass := self searchClass.
srchClass ~~ receiverClass ifTrue:[
@@ -2070,9 +2259,11 @@
"
kludge for methods invoked explicitly via valueWithReceiver...
"
- (self sender notNil
- and:[ self sender receiver isMethod
- and:[ self sender selector startsWith:'valueWithReceiver:' ]]) ifTrue:[
+ ((sender := self sender) notNil
+ and:[ sender isBridgeProxy not
+ and:[ sender receiver isBridgeProxy not
+ and:[ sender receiver isMethod
+ and:[ sender selector startsWith:'valueWithReceiver:' ]]]]) ifTrue:[
where := '(**DIRECTED**)'.
] ifFalse:[
where := '(**NONE**)'.
@@ -2084,6 +2275,52 @@
"Created: / 23-10-2013 / 11:13:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 05-02-2014 / 17:50:33 / cg"
+ "Modified: / 03-08-2018 / 08:44:19 / Claus Gittinger"
+!
+
+printWithSeparator:sep on:aStream
+ "append a brief description (excl. arguments) of the receiver onto aStream"
+
+ | m |
+
+ self printReceiverWithSeparator:sep on:aStream.
+
+ (self isBlockContext and:[self selector == #value]) ifFalse:[
+
+ "/ aStream nextPutAll:' '.
+ aStream nextPutAll:sep.
+
+ aStream bold.
+ m := self method.
+ m isJavaMethod ifTrue:[
+ aStream nextPutAll: (m printStringForBrowserWithSelector: self selector).
+ ] ifFalse:[
+ self selector printOn:aStream. "show as string (as symbol looks too ugly in browser ...)"
+ "/ self selector storeOn:aStream. "show as symbol"
+ ].
+ aStream normal.
+ ].
+
+ (method notNil and:[method isWrapped]) ifTrue:[
+ aStream nextPutAll:' (wrapped) '
+ ].
+ aStream nextPutAll:' ['.
+ m isJavaMethod ifTrue:[
+ aStream nextPutAll: self method mclass sourceFile ? '???' .
+ m isNative ifTrue:[
+ aStream nextPutAll: ':in native code'
+ ] ifFalse:[
+ aStream nextPut: $:.
+ (m lineNumberForPC0: lineNr) ? '???' printOn: aStream.
+ ].
+ ] ifFalse:[
+ self lineNumber printOn: aStream
+ ].
+ aStream nextPut:$].
+
+ "Modified: / 05-08-2012 / 12:00:00 / cg"
+ "Modified: / 08-08-2014 / 07:37:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 26-06-2018 / 19:22:56 / Claus Gittinger"
!
receiverPrintString
@@ -2091,7 +2328,7 @@
|s|
- s := WriteStream on:''.
+ s := '' writeStream.
self printReceiverOn:s.
^ s contents
@@ -2559,110 +2796,110 @@
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 isBlock]) 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 hasCode and:[homeMethod isDynamic not]).
- vars notEmptyOrNil ifTrue:[
- varNames := vars collect:[:var | var name].
- ]
- ].
- ^ argNames , varNames
- ].
- ].
+ [
+ |blockNode argNames varNames vars 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 isBlock]) 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.
+ ].
].
^ #()
- "Modified: / 26-12-2015 / 08:20:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 19-08-2013 / 12:13:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
canResume
@@ -2865,33 +3102,37 @@
count := 0.
- c := self findNextContextWithSelector:selector or:nil or:nil.
- [c notNil] whileTrue:[
- (c receiver == receiver) ifTrue:[
- c method == self method ifTrue:[
- sameArgs := true.
- 1 to:self argumentCount do:[:i |
- (c argAt:1) ~~ (self argAt:i)ifTrue:[
- sameArgs := false
- ]
- ].
- sameArgs 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 := self.
+ [
+ c := c findNextContextWithSelector:selector or:nil or:nil.
+ c notNil
+ ] whileTrue:[
+ (c receiver == receiver) ifTrue:[
+ c method == self method ifTrue:[
+ sameArgs := true.
+ 1 to:self argumentCount do:[:i |
+ (c argAt:1) ~= (self argAt:i) ifTrue:[
+ sameArgs := false
+ ]
+ ].
+ sameArgs ifTrue:[^ 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 >= MaxRecursion ifTrue:[
+ 'Context [warning]: long context chain' errorPrintCR.
+ ^ true
+ ]
].
^ false
+
+ "Modified: / 17-09-2017 / 10:00:34 / cg"
!
isRecursive
@@ -2905,23 +3146,14 @@
count := 0.
- c := self findNextContextWithSelector:selector or:nil or:nil.
- [c notNil] whileTrue:[
+ c := self.
+ [
+ c := c 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
-"/ ].
- "/ now it does!!
c method == self method ifTrue:[^ true].
].
- c := c findNextContextWithSelector:selector or:nil or:nil.
"
this special test was added to get out after a while
@@ -2929,14 +3161,14 @@
a chance to find those errors.
"
count := count + 1.
- count >= 100000 ifTrue:[
- 'Context [warning]: bad context chain' errorPrintCR.
+ count >= MaxRecursion ifTrue:[
+ 'Context [warning]: long context chain' errorPrintCR.
^ true
]
].
^ false
- "Modified: 10.1.1997 / 17:34:26 / cg"
+ "Modified (format): / 17-09-2017 / 10:02:04 / cg"
! !
!Context class methodsFor:'documentation'!