'From Squeak3.7alpha of ''11 September 2003'' [latest update: #5595] on 12 December 2003 at 3:51:34 pm'! "Change Set: KCP-0112-FixCanUnderstand Date: 12 December 2003 Author: Nathanael Schaerli Fixes canUnderstand so that it deals with abstract methods (i.e., subclassResponsibility and shouldNotImplement) in the right way."! !Behavior methodsFor: 'testing method dictionary' stamp: 'NS 12/12/2003 15:45'! canUnderstand: selector "Answer whether the receiver can respond to the message whose selector is the argument. The selector can be in the method dictionary of the receiver's class or any of its superclasses." | m | self withAllSuperclassesDo: [:each | m _ each compiledMethodAt: selector ifAbsent: [nil]. m ifNotNil: [^ m isAbstract not]]. ^ false.! ! !CompiledMethod methodsFor: 'testing' stamp: 'NS 12/12/2003 15:18'! isAbstract | marker | marker _ self markerOrNil. ^ marker notNil and: [self class abstractMarkers includes: marker].! ! !CompiledMethod methodsFor: 'private' stamp: 'NS 12/12/2003 14:22'! markerOrNil "If I am a marker method, answer the symbol used to mark me. Otherwise answer nil. What is a marker method? It is method with body like 'self subclassResponsibility' or '^ self subclassResponsibility' used to indicate ('mark') a special property. Marker methods compile to bytecode like: 9 <70> self 10 send: 11 <87> pop 12 <78> returnSelf for the first form, or 9 <70> self 10 send: 11 <7C> returnTop for the second form." | e | ((e _ self endPC) = 11 or: [e = 12]) ifFalse: [^ nil]. (self numLiterals = 1) ifFalse:[^ nil]. (self at: 9) = 16r70 ifFalse:[^ nil]. "push self" (self at: 10) = 16rD0 ifFalse:[^ nil]. "send " "If we reach this point, we have a marker method that sends self " ^ self literalAt: 1 ! ! !CompiledMethod class methodsFor: 'instance creation' stamp: 'NS 12/12/2003 15:03'! newFrom: aCompiledMethod | inst | inst _ super basicNew: aCompiledMethod size. 1 to: aCompiledMethod size do: [:index | inst at: index put: (aCompiledMethod at: index)]. ^ inst.! ! !CompiledMethod class methodsFor: 'instance creation' stamp: 'NS 12/12/2003 15:08'! newInstanceFrom: oldInstance variable: variable size: instSize map: map "Create a new instance of the receiver based on the given old instance. The supplied map contains a mapping of the old instVar names into the receiver's instVars" | new | new _ self newFrom: oldInstance. 1 to: instSize do: [:offset | (map at: offset) > 0 ifTrue: [new instVarAt: offset put: (oldInstance instVarAt: (map at: offset))]]. ^new! ! !CompiledMethod class methodsFor: 'constants' stamp: 'NS 12/12/2003 15:17'! abstractMarkers ^ #(subclassResponsibility shouldNotImplement)! !