Context.st
changeset 23224 871ea64fd5dc
parent 23133 6db5c28207d5
child 23259 4b544a108e4e
equal deleted inserted replaced
23223:ef9068ed4eae 23224:871ea64fd5dc
     1 "{ Encoding: utf8 }"
       
     2 
       
     3 "
     1 "
     4  COPYRIGHT (c) 1988 by Claus Gittinger
     2  COPYRIGHT (c) 1988 by Claus Gittinger
     5 	      All Rights Reserved
     3 	      All Rights Reserved
     6 
     4 
     7  This software is furnished under a license and may be used
     5  This software is furnished under a license and may be used
  2065 
  2063 
  2066     |receiverClass receiverClassName implementorClass|
  2064     |receiverClass receiverClassName implementorClass|
  2067 
  2065 
  2068     receiverClassName := self safeReceiverClassNameIfInvalid.
  2066     receiverClassName := self safeReceiverClassNameIfInvalid.
  2069     receiverClassName notNil ifTrue:[
  2067     receiverClassName notNil ifTrue:[
  2070 	"if we come here, this is a context with an illegal class"
  2068         "if we come here, this is a context with an illegal class"
  2071 	receiverClassName printOn:aStream.
  2069         receiverClassName printOn:aStream.
  2072 	^ self.
  2070         ^ self.
  2073     ].
  2071     ].
  2074 
  2072 
  2075     receiverClass := receiver class.
  2073     receiverClass := receiver class.
  2076 
  2074 
  2077     (receiverClass == SmallInteger or:[receiverClass == Float]) ifTrue:[
  2075     (receiverClass == SmallInteger or:[receiverClass == Float]) ifTrue:[
  2078 	aStream nextPut:$(. receiver printOn:aStream. aStream nextPutAll:') '.
  2076         aStream nextPut:$(. receiver printOn:aStream. aStream nextPutAll:') '.
  2079     ].
  2077     ].
  2080     self printClassNameOf:receiverClass on:aStream.
  2078     self printClassNameOf:receiverClass on:aStream.
  2081 
  2079 
  2082     (selector notNil or:[method notNil]) ifTrue:[
  2080     (selector notNil or:[method notNil]) ifTrue:[
  2083 	"/ implementorClass := self searchClass whichClassIncludesSelector:selector.
  2081         "/ implementorClass := self searchClass whichClassIncludesSelector:selector.
  2084 
  2082 
  2085 	"
  2083         "
  2086 	 kludge to avoid slow search for containing class
  2084          kludge to avoid slow search for containing class
  2087 	"
  2085         "
  2088 	(method notNil
  2086         (method notNil
  2089 	 or:[selector ~~ #doIt and:[selector ~~ #doIt:]]) ifTrue:[
  2087          or:[selector ~~ #doIt and:[selector ~~ #doIt:]]) ifTrue:[
  2090 	    implementorClass := self methodClass.
  2088             implementorClass := self methodClass.
  2091 	    implementorClass isNil ifTrue:[
  2089             implementorClass isNil ifTrue:[
  2092 		"
  2090                 "
  2093 		 kludge for the frame called by a wrappedmethod;
  2091                  kludge for the frame called by a wrappedmethod;
  2094 		 the wrappedmethod is in the class, so its mclass is correct.
  2092                  the wrappedmethod is in the class, so its mclass is correct.
  2095 		 however, the originalmethod is invoked via performMethod, and its mclass
  2093                  however, the originalmethod is invoked via performMethod, and its mclass
  2096 		 is nil. Care for this here. Think about keeping the mclass in the original method.
  2094                  is nil. Care for this here. Think about keeping the mclass in the original method.
  2097 		"
  2095                 "
  2098 		(method notNil and:[method isWrapped not]) ifTrue:[
  2096                 (method notNil and:[method isWrapped not]) ifTrue:[
  2099 		    WrappedMethod notNil ifTrue:[
  2097                     WrappedMethod notNil ifTrue:[
  2100 			WrappedMethod allWrappedMethodsDo:[:wrapped |
  2098                         WrappedMethod allWrappedMethodsDo:[:wrapped |
  2101 			    wrapped originalMethodIfWrapped == method ifTrue:[
  2099                             wrapped originalMethodIfWrapped == method ifTrue:[
  2102 				implementorClass := wrapped mclass.
  2100                                 implementorClass := wrapped mclass.
  2103 			    ].
  2101                             ].
  2104 			].
  2102                         ].
  2105 		    ].
  2103                     ].
  2106 		]
  2104                 ]
  2107 	    ].
  2105             ].
  2108 	].
  2106         ].
  2109 
  2107 
  2110 	implementorClass notNil ifTrue: [
  2108         implementorClass notNil ifTrue: [
  2111 	    (implementorClass ~~ receiverClass) ifTrue: [
  2109             (implementorClass ~~ receiverClass) ifTrue: [
  2112 		aStream nextPut:$(.
  2110                 aStream nextPut:$(.
  2113 		self printClassNameOf:implementorClass on:aStream.
  2111                 self printClassNameOf:implementorClass on:aStream.
  2114 		aStream nextPut:$).
  2112                 aStream nextPut:$).
  2115 	    ]
  2113             ]
  2116 	] ifFalse:[
  2114         ] ifFalse:[
  2117 	    | srchClass where |
  2115             | srchClass where |
  2118 
  2116 
  2119 	    srchClass := self searchClass.
  2117             srchClass := self searchClass.
  2120 	    srchClass ~~ receiverClass ifTrue:[
  2118             srchClass ~~ receiverClass ifTrue:[
  2121 		aStream nextPut:$(.
  2119                 aStream nextPut:$(.
  2122 		self printClassNameOf:srchClass on:aStream.
  2120                 self printClassNameOf:srchClass on:aStream.
  2123 		aStream nextPut:$).
  2121                 aStream nextPut:$).
  2124 	    ].
  2122             ].
  2125 	    "
  2123             "
  2126 	     kludge for doIt - these unbound methods are not
  2124              kludge for doIt - these unbound methods are not
  2127 	     found in the classes methodDictionary
  2125              found in the classes methodDictionary
  2128 	    "
  2126             "
  2129 	    true "(selector ~~ #doIt and:[selector ~~ #doIt:])" ifTrue:[
  2127             true "(selector ~~ #doIt and:[selector ~~ #doIt:])" ifTrue:[
  2130 		"
  2128                 "
  2131 		 kludge for methods invoked explicitly via valueWithReceiver...
  2129                  kludge for methods invoked explicitly via valueWithReceiver...
  2132 		"
  2130                 "
  2133 		(self sender notNil
  2131                 (self sender notNil
  2134 		and:[ self sender receiver isMethod
  2132                 and:[ self sender isBridgeProxy not
  2135 		and:[ self sender selector startsWith:'valueWithReceiver:' ]]) ifTrue:[
  2133                 and:[ self sender receiver isMethod
  2136 		    where := '(**DIRECTED**)'.
  2134                 and:[ self sender selector startsWith:'valueWithReceiver:' ]]]) ifTrue:[
  2137 		] ifFalse:[
  2135                     where := '(**DIRECTED**)'.
  2138 		    where := '(**NONE**)'.
  2136                 ] ifFalse:[
  2139 		].
  2137                     where := '(**NONE**)'.
  2140 		aStream nextPutAll:where
  2138                 ].
  2141 	    ]
  2139                 aStream nextPutAll:where
  2142 	]
  2140             ]
       
  2141         ]
  2143     ].
  2142     ].
  2144 
  2143 
  2145     "Created: / 23-10-2013 / 11:13:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
  2144     "Created: / 23-10-2013 / 11:13:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
  2146     "Modified: / 05-02-2014 / 17:50:33 / cg"
  2145     "Modified: / 05-02-2014 / 17:50:33 / cg"
       
  2146     "Modified: / 21-07-2018 / 17:42:04 / Claus Gittinger"
  2147 !
  2147 !
  2148 
  2148 
  2149 printWithSeparator:sep on:aStream
  2149 printWithSeparator:sep on:aStream
  2150     "append a brief description (excl. arguments) of the receiver onto aStream"
  2150     "append a brief description (excl. arguments) of the receiver onto aStream"
  2151 
  2151