'From Pharo3.0 of 18 March 2013 [Latest update: #30258] on 9 July 2013 at 6:08:18 pm'! !TBehavior methodsFor: '*Ring-Core-Kernel' stamp: 'SebastianTleye 7/9/2013 17:52'! protocols ^ self organization categories copy! ! !TBehavior methodsFor: '*Ring-Core-Kernel' stamp: 'SebastianTleye 7/9/2013 17:52'! methodNamed: aSelector ^ self methodDict at: aSelector! ! !TBehavior methodsFor: '*Ring-Core-Kernel' stamp: 'SebastianTleye 7/9/2013 17:52'! methodsInProtocol: aString ^ (self organization listAtCategoryNamed: aString) collect: [:each | (self methodDict at: each) ]! ! !TBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'! thoroughHasSelectorReferringTo: literal special: specialFlag byte: specialByte "Answer true if any of my methods access the argument as a literal. Dives into the compact literal notation, making it slow but thorough " self methodsDo: [ :method | ((method hasLiteralThorough: literal) or: [specialFlag and: [method scanFor: specialByte]]) ifTrue: [^true]]. ^false! ! !TBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'! isLocalAliasSelector: aSymbol "Return true if the selector aSymbol is an alias defined in my trait composition." ^(self includesLocalSelector: aSymbol) not and: [self hasTraitComposition and: [self traitComposition isLocalAliasSelector: aSymbol]]! ! !TBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'! whichSelectorsReferTo: literal special: specialFlag byte: specialByte "Answer a set of selectors whose methods access the argument as a literal." | who | who := IdentitySet new. self selectorsAndMethodsDo: [:sel :method | ((method hasLiteral: literal) or: [specialFlag and: [method scanFor: specialByte]]) ifTrue: [((literal isVariableBinding) not or: [method literals allButLast includes: literal]) ifTrue: [who add: sel]]]. ^ who! ! !TBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'! isDisabledSelector: selector ^ self classAndMethodFor: selector do: [:c :m | m isDisabled] ifAbsent: [false]! ! !TBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'! hasMethods "Answer whether the receiver has any methods in its method dictionary." ^ self methodDict notEmpty! ! !TBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'! canUnderstand: selector "Answer whether the receiver can respond to the message whose selector is the argument." ^ self classAndMethodFor: selector do: [:c :m | m isProvided] ifAbsent: [false].! ! !TBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'! thoroughWhichSelectorsReferTo: literal special: specialFlag byte: specialByte "Answer a set of selectors whose methods access the argument as a literal. Dives into the compact literal notation, making it slow but thorough " | selectors | selectors := IdentitySet new. self selectorsAndMethodsDo: [ :sel :method | ((self isTrait ifTrue: [method hasLiteralThorough: literal] ifFalse: [method refersToLiteral: literal]) or: [specialFlag and: [method scanFor: specialByte]]) ifTrue: [selectors add: sel]]. ^ selectors! ! !TBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'! includesLocalSelector: aSymbol ^self basicLocalSelectors isNil ifTrue: [self includesSelector: aSymbol] ifFalse: [self localSelectors includes: aSymbol]! ! !TBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'! whichSelectorsReferTo: literal "Answer a Set of selectors whose methods access the argument as a literal." | special byte | special := Smalltalk hasSpecialSelector: literal ifTrueSetByte: [:b | byte := b]. ^self whichSelectorsReferTo: literal special: special byte: byte "Rectangle whichSelectorsReferTo: #+."! ! !TBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'! isAliasSelector: aSymbol "Return true if the selector aSymbol is an alias defined in my or in another composition somewhere deeper in the tree of traits compositions." ^(self includesLocalSelector: aSymbol) not and: [self hasTraitComposition and: [self traitComposition isAliasSelector: aSymbol]]! ! !TBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'! includesSelector: aSymbol "Answer whether the message whose selector is the argument is in the method dictionary of the receiver's class." ^ self methodDict includesKey: aSymbol! ! !TBehavior methodsFor: 'naming' stamp: 'SebastianTleye 7/9/2013 17:52'! environment "Return the environment in which the receiver is visible" ^Smalltalk globals! ! !TBehavior methodsFor: '*Rpackage-Core' stamp: 'SebastianTleye 7/9/2013 17:52'! originalName ^self isObsolete ifTrue: [ (self name copyFrom: 'AnObsolete' size + 1 to: self name size ) asSymbol ] ifFalse: [ self name asSymbol ].! ! !TBehavior methodsFor: 'printing' stamp: 'SebastianTleye 7/9/2013 17:52'! literalScannedAs: scannedLiteral notifying: requestor "Postprocesses a literal scanned by Scanner scanToken (esp. xLitQuote). If scannedLiteral is not an association, answer it. Else, if it is of the form: nil->#NameOfMetaclass answer nil->theMetaclass, if any has that name, else report an error. Else, if it is of the form: #NameOfGlobalVariable->anythiEng answer the global, class, or pool association with that nameE, if any, else add it to Undeclared a answer the new Association." | key value | (scannedLiteral isVariableBinding) ifFalse: [^ scannedLiteral]. key := scannedLiteral key. value := scannedLiteral value. key isNil ifTrue: "###" [(self bindingOf: value) ifNotNil:[:assoc| (assoc value isKindOf: Behavior) ifTrue: [^ nil->assoc value class]]. requestor notify: 'No such metaclass'. ^false]. (key isSymbol) ifTrue: "##" [(self bindingOf: key) ifNotNil:[:assoc | ^assoc]. Undeclared at: key put: nil. ^Undeclared bindingOf: key]. requestor notify: '## must be followed by a non-local variable name'. ^false " Form literalScannedAs: 14 notifying: nil 14 Form literalScannedAs: #OneBitForm notiEfying: nil OneBitForm Form literalScannedAs: ##OneBitForm notifying: nil OneBitForm->a Form Form literalScannedAs: ##Form notifying: nil Form->Form Form literalScannedAs: ###Form notifying: nil nilE->Form class "! ! !TBehavior methodsFor: 'printing' stamp: 'SebastianTleye 7/9/2013 17:52'! storeLiteral: aCodeLiteral on: aStream "Store aCodeLiteral on aStream, changing an Association to ##GlobalName or ###MetaclassSoleInstanceName format if appropriate" | key value | (aCodeLiteral isVariableBinding) ifFalse: [aCodeLiteral storeOn: aStream. ^self]. key := aCodeLiteral key. (key isNil and: [(value := aCodeLiteral value) isMemberOf: Metaclass]) ifTrue: [aStream nextPutAll: '###'; nextPutAll: value soleInstance name. ^self]. (key isSymbol and: [(self bindingOf: key) notNil]) ifTrue: [aStream nextPutAll: '##'; nextPutAll: key. ^self]. aCodeLiteral storeOn: aStream! ! !TBehavior methodsFor: 'printing' stamp: 'SebastianTleye 7/9/2013 17:52'! longPrintOn: aStream "Append to the argument, aStream, the names and values of all of the receiver's instance variables. But, not useful for a class with a method dictionary." aStream nextPutAll: '<>'; cr.! ! !TBehavior methodsFor: 'adding/removing methods' stamp: 'SebastianTleye 7/9/2013 17:52'! removeSelector: aSelector "Assuming that the argument, selector (a Symbol), is a message selector in my method dictionary, remove it and its method. If the method to remove will be replaced by a method from my trait composition, the current method does not have to be removed because we mark it as non-local. If it is not identical to the actual method from the trait it will be replaced automatically by #noteChangedSelectors:. This is useful to avoid bootstrapping problems when moving methods to a trait (e.g., from TPureBehavior to TMethodDictionaryBehavior). Manual moving (implementing the method in the trait and then remove it from the class) does not work if the methods themselves are used for this process (such as compiledMethodAt:, includesLocalSelector: or addTraitSelector:withMethod:)" | changeFromLocalToTraitMethod | changeFromLocalToTraitMethod := (self includesLocalSelector: aSelector) and: [self hasTraitComposition and: [self traitComposition includesMethod: aSelector]]. changeFromLocalToTraitMethod ifFalse: [self basicRemoveSelector: aSelector] ifTrue: [self ensureLocalSelectors]. self deregisterLocalSelector: aSelector. self noteChangedSelectors: (Array with: aSelector) ! ! !TBehavior methodsFor: 'adding/removing methods' stamp: 'SebastianTleye 7/9/2013 17:52'! removeSelectorSilently: selector "Remove selector without sending system change notifications" ^ SystemAnnouncer uniqueInstance suspendAllWhile: [self removeSelector: selector].! ! !TBehavior methodsFor: 'adding/removing methods' stamp: 'SebastianTleye 7/9/2013 17:52'! localSelectors: aSet self basicLocalSelectors: aSet.! ! !TBehavior methodsFor: 'adding/removing methods' stamp: 'SebastianTleye 7/9/2013 17:52'! localSelectors "Return a set of selectors defined locally. The instance variable is lazily initialized. If it is nil then there are no non-local selectors" ^ self basicLocalSelectors isNil ifTrue: [self selectors asSet] ifFalse: [self basicLocalSelectors].! ! !TBehavior methodsFor: 'adding/removing methods' stamp: 'SebastianTleye 7/9/2013 17:52'! addSelectorSilently: selector withMethod: compiledMethod self methodDictAddSelectorSilently: selector withMethod: compiledMethod. self registerLocalSelector: selector! ! !TBehavior methodsFor: 'adding/removing methods' stamp: 'SebastianTleye 7/9/2013 17:52'! methodDictAddSelectorSilently: selector withMethod: compiledMethod self basicAddSelector: selector withMethod: compiledMethod! ! !TBehavior methodsFor: 'adding/removing methods' stamp: 'SebastianTleye 7/9/2013 17:52'! addSelector: selector withMethod: compiledMethod ^ self addSelector: selector withMethod: compiledMethod notifying: nil! ! !TBehavior methodsFor: 'adding/removing methods' stamp: 'SebastianTleye 7/9/2013 17:52'! basicRemoveSelector: selector "Assuming that the argument, selector (a Symbol), is a message selector in my method dictionary, remove it and its method." | oldMethod | oldMethod := self methodDict at: selector ifAbsent: [^ self]. self methodDict removeKey: selector. "Now flush the method cache" oldMethod flushCache. selector flushCache.! ! !TBehavior methodsFor: 'adding/removing methods' stamp: 'SebastianTleye 7/9/2013 17:52'! addSelector: selector withMethod: compiledMethod notifying: requestor ^ self addSelectorSilently: selector withMethod: compiledMethod! ! !TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'! compiledMethodAt: selector ifAbsent: aBlock "Answer the compiled method associated with the argument, selector (a Symbol), a message selector in the receiver's method dictionary. If the selector is not in the dictionary, return the value of aBlock" ^ self methodDict at: selector ifAbsent: [aBlock value]! ! !TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'! deregisterLocalSelector: aSymbol self basicLocalSelectors notNil ifTrue: [ self basicLocalSelectors remove: aSymbol ifAbsent: []]! ! !TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'! selectors "Answer a Set of all the message selectors specified in the receiver's method dictionary." ^ self methodDict keys! ! !TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'! methodDictionary "Convenience" ^self methodDict! ! !TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'! compress "Compact the method dictionary of the receiver." self methodDict rehash! ! !TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'! sourceCodeAt: selector ^ (self methodDict at: selector) sourceCode.! ! !TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'! registerLocalSelector: aSymbol self basicLocalSelectors notNil ifTrue: [ self basicLocalSelectors add: aSymbol]! ! !TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'! >> selector "Answer the compiled method associated with the argument, selector (a Symbol), a message selector in the receiver's method dictionary. If the selector is not in the dictionary, create an error notification." ^self compiledMethodAt: selector ! ! !TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'! methodDictionary: aDictionary self methodDict: aDictionary! ! !TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'! selectorsWithArgs: numberOfArgs "Return all selectors defined in this class that take this number of arguments" ^ self selectors select: [:selector | selector numArgs = numberOfArgs]! ! !TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'! changeRecordsAt: selector "Return a list of ChangeRecords for all versions of the method at selector. Source code can be retrieved by sending string to any one. Return nil if the method is absent." "(Pen changeRecordsAt: #go:) collect: [:cRec | cRec string]" ^ChangeSet scanVersionsOf: (self compiledMethodAt: selector ifAbsent: [^ nil]) class: self meta: self isMeta category: (self whichCategoryIncludesSelector: selector) selector: selector.! ! !TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'! methods ^ self methodDict values! ! !TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'! firstCommentAt: selector "Answer a string representing the first comment in the method associated with selector. Return an empty string if the relevant source file is not available, or if the method's source code does not contain a comment. Not smart enough to bypass quotes in string constants, but does map doubled quote into a single quote." |someComments| someComments := self commentsAt: selector. ^someComments isEmpty ifTrue: [''] ifFalse: [someComments first] "Behavior firstCommentAt: #firstCommentAt:"! ! !TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'! selectorsAndMethodsDo: selectorAndMethodBlock "Evaluate selectorAndMethodBlock with two arguments for each selector/method pair in my method dictionary." ^ self methodDict keysAndValuesDo: selectorAndMethodBlock! ! !TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'! sourceCodeAt: selector ifAbsent: aBlock ^ (self methodDict at: selector ifAbsent: [^ aBlock value]) sourceCode.! ! !TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'! compiledMethodAt: selector "Answer the compiled method associated with the argument, selector (a Symbol), a message selector in the receiver's method dictionary. If the selector is not in the dictionary, create an error notification." ^ self methodDict at: selector! ! !TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'! firstPrecodeCommentFor: selector "If there is a comment in the source code at the given selector that preceeds the body of the method, return it here, else return nil" | method | "Behavior firstPrecodeCommentFor: #firstPrecodeCommentFor:" (#(Comment Definition Hierarchy) includes: selector) ifTrue: [^ nil]. method := self compiledMethodAt: selector asSymbol ifAbsent: [^ nil]. ^method ast firstPrecodeComment. ! ! !TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'! methodsDo: aBlock "Evaluate aBlock for all the compiled methods in my method dictionary." ^ self methodDict valuesDo: aBlock! ! !TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'! selectorsDo: selectorBlock "Evaluate selectorBlock for all the message selectors in my method dictionary." ^ self methodDict keysDo: selectorBlock! ! !TBehavior methodsFor: 'private' stamp: 'SebastianTleye 7/9/2013 17:52'! spaceUsed "Answer a rough estimate of number of bytes used by this class and its metaclass. Does not include space used by class variables." | space | space := 0. self methodsDo: [:method | space := space + 16. "dict and org'n space" space := space + (method size + 6 "hdr + avg pad"). method literalsDo: [:lit | (lit isMemberOf: Array) ifTrue: [space := space + ((lit size + 1) * 4)]. (lit isMemberOf: Float) ifTrue: [space := space + 12]. (lit isMemberOf: ByteString) ifTrue: [space := space + (lit size + 6)]. (lit isMemberOf: LargeNegativeInteger) ifTrue: [space := space + ((lit size + 1) * 4)]. (lit isMemberOf: LargePositiveInteger) ifTrue: [space := space + ((lit size + 1) * 4)]]]. ^ space! ! !TBehavior methodsFor: 'copying' stamp: 'SebastianTleye 7/9/2013 17:52'! copyOfMethodDictionary "Return a copy of the receiver's method dictionary" ^ self methodDict copy! ! !TBehavior methodsFor: 'copying' stamp: 'SebastianTleye 7/9/2013 17:52'! postCopy super postCopy. self methodDict: self copyOfMethodDictionary! ! !TBehavior methodsFor: 'copying' stamp: 'SebastianTleye 7/9/2013 17:52'! deepCopy "Classes should only be shallowCopied or made anew." ^ self shallowCopy! ! !TBehavior methodsFor: 'accessing class hierarchy' stamp: 'SebastianTleye 7/9/2013 17:52'! withAllSubclasses "Answer a Set of the receiver, the receiver's descendent's, and the receiver's descendent's subclasses." ^ self allSubclasses add: self; yourself! ! !TBehavior methodsFor: 'accessing class hierarchy' stamp: 'SebastianTleye 7/9/2013 17:52'! withAllSuperclasses "Answer an OrderedCollection of the receiver and the receiver's superclasses. The first element is the receiver, followed by its superclass; the last element is Object." | temp | temp := self allSuperclasses. temp addFirst: self. ^ temp! ! !TBehavior methodsFor: 'accessing class hierarchy' stamp: 'SebastianTleye 7/9/2013 17:52'! withAllSubclassesDo: aBlock "Evaluate the argument, aBlock, for the receiver and each of its subclasses." self withAllSubclasses do: [ :subclass | aBlock value: subclass ].! ! !TBehavior methodsFor: 'initialization' stamp: 'SebastianTleye 7/9/2013 17:52'! emptyMethodDictionary ^ MethodDictionary new! ! !TBehavior methodsFor: 'initialization' stamp: 'SebastianTleye 7/9/2013 17:52'! obsolete "Invalidate and recycle local methods, e.g., zap the method dictionary if can be done safely." self canZapMethodDictionary ifTrue: [self methodDict: self emptyMethodDictionary]. self hasTraitComposition ifTrue: [ self traitComposition traits do: [:each | each removeUser: self]]! ! !TBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:52'! decompilerClass self deprecated: 'use #compilerClass' on: '02 May 2013' in: 'Pharo 3.0'. ^ self compilerClass! ! !TBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:52'! binding ^ nil -> self! ! !TBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:52'! parserClass self deprecated: 'use #compilerClass' on: '29 April 2013' in: 'Pharo 3.0'. ^self compilerClass! ! !TBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:52'! compile: code "Compile the argument, code, as source code in the context of the receiver. Create an error notification if the code can not be compiled. The argument is either a string or an object that converts to a string or a PositionableStream on an object that converts to a string." ^self compile: code notifying: nil! ! !TBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:52'! compile: code classified: category notifying: requestor trailer: bytes ifFail: aBlock "Compile code without logging the source in the changes file" | methodNode | methodNode := self compiler compile: code in: self classified: category notifying: requestor ifFail: aBlock. ^ methodNode generate: bytes! ! !TBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:52'! compiler "Answer a compiler appropriate for source methods of this class." ^self compilerClass new environment: self environment; class: self! ! !TBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:52'! defaultMethodTrailer ^ CompiledMethodTrailer empty! ! !TBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:52'! evaluatorClass "Answer an evaluator class appropriate for evaluating expressions in the context of this class." self deprecated: 'use #compilerClass' on: '02 May 2013' in: 'Pharo 3.0'. ^self compilerClass! ! !TBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:52'! compile: code notifying: requestor "Compile the argument, code, as source code in the context of the receiver and insEtall the result in the receiver's method dictionary. The second argument, requestor, is to be notified if an error occurs. The argument code is either a string or an object that converts to a string or a PositionableStream. This method also saves the source code." | method | method := self compile: code "a Text" classified: nil notifying: requestor trailer: self defaultMethodTrailer ifFail: [ ^nil ]. method putSource: code inFile: 2 withPreamble: [:f | f cr; nextPut: $!!; nextChunkPut: 'Behavior method'; cr]. self addSelector: method selector withMethod: method notifying: requestor. ^ method selector! ! !TBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:52'! compileAll ^ self compileAllFrom: self! ! !TBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:52'! evaluate: aString ^self compiler evaluate: aString! ! !TBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:52'! compileAllFrom: oldClass "Compile all the methods in the receiver's method dictionary. This validates sourceCode and variable references and forces all methods to use the current bytecode set" oldClass selectorsDo: [:sel | self recompile: sel from: oldClass]. ! ! !TBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:52'! compilerClass "Answer a compiler class appropriate for source methods of this class." ^Smalltalk compilerClass! ! !TBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:52'! recompileChanges "Compile all the methods that are in the changes file. This validates sourceCode and variable references and forces methods to use the current bytecode set" self selectorsAndMethodsDo: [:sel :meth | meth fileIndex > 1 ifTrue: [self recompile: sel from: self]]! ! !TBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:52'! sourceCodeTemplate "Answer an expression to be edited and evaluated in order to define methods in this class or trait." ^'message selector and argument names "comment stating purpose of message" | temporary variable names | statements'! ! !TBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:52'! recompile: selector from: oldClass "Compile the method associated with selector in the receiver's method dictionary." | method newMethod | method := oldClass compiledMethodAt: selector. newMethod := self compiler source: (oldClass sourceCodeAt: selector); class: self; failBlock: [^ self]; compiledMethodTrailer: method trailer; compile. "Assume OK after proceed from SyntaxError" selector == newMethod selector ifFalse: [self error: 'selector changed!!']. self basicAddSelector: selector withMethod: newMethod. ! ! !TBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:52'! recompile: selector "Compile the method associated with selector in the receiver's method dictionary." ^self recompile: selector from: self! ! !TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'! addTraitSelector: aSymbol withMethod: aCompiledMethod "Add aMethod with selector aSymbol to my methodDict. aMethod must not be defined locally." | source method | [(self includesLocalSelector: aSymbol) not] assert. self ensureLocalSelectors. source := aCompiledMethod getSourceReplacingSelectorWith: aSymbol. method := self compile: source classified: aCompiledMethod category notifying: nil trailer: self defaultMethodTrailer ifFail: [ ^nil ]. method putSource: source inFile: 2 withPreamble: [:f | f cr; nextPut: $!!; nextChunkPut: 'Trait method'; cr]. self isTrait ifFalse: [ method properties at: #traitSource put: aCompiledMethod]. self basicAddSelector: aSymbol withMethod: method! ! !TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'! flattenDownAllTraits self traitComposition allTraits do: [:each | self flattenDown: each]. [ self traitComposition isEmpty ] assert. self traitComposition: nil.! ! !TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'! traits "Returns a collection of all traits used by the receiver" ^ self traitComposition traits! ! !TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'! flattenDown: aTrait | selectors | [self hasTraitComposition and: [self traitComposition allTraits includes: aTrait]] assert. selectors := (self traitComposition transformationOfTrait: aTrait) selectors. self basicLocalSelectors: self basicLocalSelectors , selectors. self removeFromComposition: aTrait.! ! !TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'! traitsProvidingSelector: aSymbol | result | result := OrderedCollection new. self hasTraitComposition ifFalse: [^result]. (self traitComposition methodDescriptionsForSelector: aSymbol) do: [:methodDescription | methodDescription selector = aSymbol ifTrue: [ result addAll: (methodDescription locatedMethods collect: [:each | each methodClass])]]. ^result! ! !TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'! traitOrClassOfSelector: aSymbol "Return the trait or the class which originally defines the method aSymbol or return self if locally defined or if it is a conflict marker method. This is primarly used by Debugger to determin the behavior in which a recompiled method should be put. If a conflict method is recompiled it should be put into the class, thus return self. Also see TraitComposition>>traitProvidingSelector:" ((self includesLocalSelector: aSymbol) or: [ self hasTraitComposition not]) ifTrue: [^self]. ^(self traitComposition traitProvidingSelector: aSymbol) ifNil: [self]! ! !TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'! notifyUsersOfChangedSelector: aSelector self notifyUsersOfChangedSelectors: (Array with: aSelector)! ! !TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'! traitCompositionIncludes: aTrait ^self == aTrait or: [self hasTraitComposition and: [self traitComposition allTraits includes: aTrait]]! ! !TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'! updateMethodDictionarySelector: aSymbol "A method with selector aSymbol in myself or my traitComposition has been changed. Do the appropriate update to my methodDict (remove or update method) and return all affected selectors of me so that my useres get notified." | modifiedSelectors descriptions oldProtocol | modifiedSelectors := IdentitySet new. descriptions := self traitComposition methodDescriptionsForSelector: aSymbol. descriptions do: [:methodDescription | | effectiveMethod selector | selector := methodDescription selector. (self includesLocalSelector: selector) ifFalse: [ methodDescription isEmpty ifTrue: [ self removeTraitSelector: selector. modifiedSelectors add: selector] ifFalse: [ effectiveMethod := methodDescription effectiveMethod. self addTraitSelector: selector withMethod: effectiveMethod. "If the method was not categorized yet, we categorize it " oldProtocol := self organization categoryOfElement: selector. (oldProtocol isNil or: [ oldProtocol = Protocol unclassified ]) ifTrue: [ self organization classify: selector under: methodDescription effectiveMethodCategory. ]. modifiedSelectors add: selector]]]. ^modifiedSelectors! ! !TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'! purgeLocalSelectors self basicLocalSelectors: nil! ! !TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'! noteChangedSelectors: aCollection "Start update of my methodDict (after changes to traits in traitComposition or after a local method was removed from my methodDict). The argument is a collection of method selectors that may have been changed. Most of the time aCollection only holds one selector. But when there are aliases involved there may be several method changes that have to be propagated to users." | affectedSelectors | affectedSelectors := IdentitySet new. aCollection do: [:selector | affectedSelectors addAll: (self updateMethodDictionarySelector: selector)]. self notifyUsersOfChangedSelectors: affectedSelectors. ^ affectedSelectors! ! !TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'! removeFromComposition: aTrait self setTraitComposition: (self traitComposition copyTraitExpression removeFromComposition: aTrait)! ! !TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'! traitTransformations ^ self traitComposition transformations ! ! !TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'! setTraitCompositionFrom: aTraitExpression ^ self setTraitComposition: aTraitExpression asTraitComposition! ! !TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'! traitCompositionString ^self hasTraitComposition ifTrue: [self traitComposition asString] ifFalse: ['{}']! ! !TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'! setTraitComposition: aTraitComposition | oldComposition | (self hasTraitComposition not and: [aTraitComposition isEmpty]) ifTrue: [^self]. aTraitComposition assertValidUser: self. oldComposition := self traitComposition. self traitComposition: aTraitComposition. self applyChangesOfNewTraitCompositionReplacing: oldComposition. oldComposition traits do: [:each | each removeUser: self]. aTraitComposition traits do: [:each | each addUser: self]! ! !TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'! notifyUsersOfChangedSelectors: aCollection! ! !TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'! removeTraitSelector: aSymbol [(self includesLocalSelector: aSymbol) not] assert. self basicRemoveSelector: aSymbol! ! !TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'! applyChangesOfNewTraitCompositionReplacing: oldComposition | changedSelectors | changedSelectors := self traitComposition changedSelectorsComparedTo: oldComposition. changedSelectors isEmpty ifFalse: [ self noteChangedSelectors: changedSelectors]. self traitComposition isEmpty ifTrue: [ self purgeLocalSelectors]. ^changedSelectors! ! !TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'! ensureLocalSelectors "Ensures that the instance variable localSelectors is effectively used to maintain the set of local selectors. This method must be called before any non-local selectors are added to the method dictionary!!" self basicLocalSelectors isNil ifTrue: [self basicLocalSelectors: self selectors asSet]! ! !TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'! addToComposition: aTrait self setTraitComposition: (self traitComposition copyTraitExpression add: aTrait; yourself)! ! !TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'! addExclusionOf: aSymbol to: aTrait self setTraitComposition: ( self traitComposition copyWithExclusionOf: aSymbol to: aTrait)! ! !TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'! removeAlias: aSymbol of: aTrait self setTraitComposition: ( self traitComposition copyWithoutAlias: aSymbol of: aTrait)! ! !TBehavior methodsFor: 'testing' stamp: 'SebastianTleye 7/9/2013 17:52'! canZapMethodDictionary "Return true if it is safe to zap the method dictionary on #obsolete" ^true! ! !TBehavior methodsFor: '*Ring-Core-Kernel' stamp: 'SebastianTleye 7/9/2013 17:52'! protocols ^ self organization categories copy! ! !TBehavior methodsFor: '*Ring-Core-Kernel' stamp: 'SebastianTleye 7/9/2013 17:52'! methodNamed: aSelector ^ self methodDict at: aSelector! ! !TBehavior methodsFor: '*Ring-Core-Kernel' stamp: 'SebastianTleye 7/9/2013 17:52'! methodsInProtocol: aString ^ (self organization listAtCategoryNamed: aString) collect: [:each | (self methodDict at: each) ]! ! !TBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'! thoroughHasSelectorReferringTo: literal special: specialFlag byte: specialByte "Answer true if any of my methods access the argument as a literal. Dives into the compact literal notation, making it slow but thorough " self methodsDo: [ :method | ((method hasLiteralThorough: literal) or: [specialFlag and: [method scanFor: specialByte]]) ifTrue: [^true]]. ^false! ! !TBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'! isLocalAliasSelector: aSymbol "Return true if the selector aSymbol is an alias defined in my trait composition." ^(self includesLocalSelector: aSymbol) not and: [self hasTraitComposition and: [self traitComposition isLocalAliasSelector: aSymbol]]! ! !TBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'! whichSelectorsReferTo: literal special: specialFlag byte: specialByte "Answer a set of selectors whose methods access the argument as a literal." | who | who := IdentitySet new. self selectorsAndMethodsDo: [:sel :method | ((method hasLiteral: literal) or: [specialFlag and: [method scanFor: specialByte]]) ifTrue: [((literal isVariableBinding) not or: [method literals allButLast includes: literal]) ifTrue: [who add: sel]]]. ^ who! ! !TBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'! isDisabledSelector: selector ^ self classAndMethodFor: selector do: [:c :m | m isDisabled] ifAbsent: [false]! ! !TBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'! hasMethods "Answer whether the receiver has any methods in its method dictionary." ^ self methodDict notEmpty! ! !TBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'! canUnderstand: selector "Answer whether the receiver can respond to the message whose selector is the argument." ^ self classAndMethodFor: selector do: [:c :m | m isProvided] ifAbsent: [false].! ! !TBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'! thoroughWhichSelectorsReferTo: literal special: specialFlag byte: specialByte "Answer a set of selectors whose methods access the argument as a literal. Dives into the compact literal notation, making it slow but thorough " | selectors | selectors := IdentitySet new. self selectorsAndMethodsDo: [ :sel :method | ((self isTrait ifTrue: [method hasLiteralThorough: literal] ifFalse: [method refersToLiteral: literal]) or: [specialFlag and: [method scanFor: specialByte]]) ifTrue: [selectors add: sel]]. ^ selectors! ! !TBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'! includesLocalSelector: aSymbol ^self basicLocalSelectors isNil ifTrue: [self includesSelector: aSymbol] ifFalse: [self localSelectors includes: aSymbol]! ! !TBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'! whichSelectorsReferTo: literal "Answer a Set of selectors whose methods access the argument as a literal." | special byte | special := Smalltalk hasSpecialSelector: literal ifTrueSetByte: [:b | byte := b]. ^self whichSelectorsReferTo: literal special: special byte: byte "Rectangle whichSelectorsReferTo: #+."! ! !TBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'! isAliasSelector: aSymbol "Return true if the selector aSymbol is an alias defined in my or in another composition somewhere deeper in the tree of traits compositions." ^(self includesLocalSelector: aSymbol) not and: [self hasTraitComposition and: [self traitComposition isAliasSelector: aSymbol]]! ! !TBehavior methodsFor: 'testing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'! includesSelector: aSymbol "Answer whether the message whose selector is the argument is in the method dictionary of the receiver's class." ^ self methodDict includesKey: aSymbol! ! !TBehavior methodsFor: 'naming' stamp: 'SebastianTleye 7/9/2013 17:52'! environment "Return the environment in which the receiver is visible" ^Smalltalk globals! ! !TBehavior methodsFor: '*Rpackage-Core' stamp: 'SebastianTleye 7/9/2013 17:52'! originalName ^self isObsolete ifTrue: [ (self name copyFrom: 'AnObsolete' size + 1 to: self name size ) asSymbol ] ifFalse: [ self name asSymbol ].! ! !TBehavior methodsFor: 'printing' stamp: 'SebastianTleye 7/9/2013 17:52'! literalScannedAs: scannedLiteral notifying: requestor "Postprocesses a literal scanned by Scanner scanToken (esp. xLitQuote). If scannedLiteral is not an association, answer it. Else, if it is of the form: nil->#NameOfMetaclass answer nil->theMetaclass, if any has that name, else report an error. Else, if it is of the form: #NameOfGlobalVariable->anythiEng answer the global, class, or pool association with that nameE, if any, else add it to Undeclared a answer the new Association." | key value | (scannedLiteral isVariableBinding) ifFalse: [^ scannedLiteral]. key := scannedLiteral key. value := scannedLiteral value. key isNil ifTrue: "###" [(self bindingOf: value) ifNotNil:[:assoc| (assoc value isKindOf: Behavior) ifTrue: [^ nil->assoc value class]]. requestor notify: 'No such metaclass'. ^false]. (key isSymbol) ifTrue: "##" [(self bindingOf: key) ifNotNil:[:assoc | ^assoc]. Undeclared at: key put: nil. ^Undeclared bindingOf: key]. requestor notify: '## must be followed by a non-local variable name'. ^false " Form literalScannedAs: 14 notifying: nil 14 Form literalScannedAs: #OneBitForm notiEfying: nil OneBitForm Form literalScannedAs: ##OneBitForm notifying: nil OneBitForm->a Form Form literalScannedAs: ##Form notifying: nil Form->Form Form literalScannedAs: ###Form notifying: nil nilE->Form class "! ! !TBehavior methodsFor: 'printing' stamp: 'SebastianTleye 7/9/2013 17:52'! storeLiteral: aCodeLiteral on: aStream "Store aCodeLiteral on aStream, changing an Association to ##GlobalName or ###MetaclassSoleInstanceName format if appropriate" | key value | (aCodeLiteral isVariableBinding) ifFalse: [aCodeLiteral storeOn: aStream. ^self]. key := aCodeLiteral key. (key isNil and: [(value := aCodeLiteral value) isMemberOf: Metaclass]) ifTrue: [aStream nextPutAll: '###'; nextPutAll: value soleInstance name. ^self]. (key isSymbol and: [(self bindingOf: key) notNil]) ifTrue: [aStream nextPutAll: '##'; nextPutAll: key. ^self]. aCodeLiteral storeOn: aStream! ! !TBehavior methodsFor: 'printing' stamp: 'SebastianTleye 7/9/2013 17:52'! longPrintOn: aStream "Append to the argument, aStream, the names and values of all of the receiver's instance variables. But, not useful for a class with a method dictionary." aStream nextPutAll: '<>'; cr.! ! !TBehavior methodsFor: 'adding/removing methods' stamp: 'SebastianTleye 7/9/2013 17:52'! removeSelector: aSelector "Assuming that the argument, selector (a Symbol), is a message selector in my method dictionary, remove it and its method. If the method to remove will be replaced by a method from my trait composition, the current method does not have to be removed because we mark it as non-local. If it is not identical to the actual method from the trait it will be replaced automatically by #noteChangedSelectors:. This is useful to avoid bootstrapping problems when moving methods to a trait (e.g., from TPureBehavior to TMethodDictionaryBehavior). Manual moving (implementing the method in the trait and then remove it from the class) does not work if the methods themselves are used for this process (such as compiledMethodAt:, includesLocalSelector: or addTraitSelector:withMethod:)" | changeFromLocalToTraitMethod | changeFromLocalToTraitMethod := (self includesLocalSelector: aSelector) and: [self hasTraitComposition and: [self traitComposition includesMethod: aSelector]]. changeFromLocalToTraitMethod ifFalse: [self basicRemoveSelector: aSelector] ifTrue: [self ensureLocalSelectors]. self deregisterLocalSelector: aSelector. self noteChangedSelectors: (Array with: aSelector) ! ! !TBehavior methodsFor: 'adding/removing methods' stamp: 'SebastianTleye 7/9/2013 17:52'! removeSelectorSilently: selector "Remove selector without sending system change notifications" ^ SystemAnnouncer uniqueInstance suspendAllWhile: [self removeSelector: selector].! ! !TBehavior methodsFor: 'adding/removing methods' stamp: 'SebastianTleye 7/9/2013 17:52'! localSelectors: aSet self basicLocalSelectors: aSet.! ! !TBehavior methodsFor: 'adding/removing methods' stamp: 'SebastianTleye 7/9/2013 17:52'! localSelectors "Return a set of selectors defined locally. The instance variable is lazily initialized. If it is nil then there are no non-local selectors" ^ self basicLocalSelectors isNil ifTrue: [self selectors asSet] ifFalse: [self basicLocalSelectors].! ! !TBehavior methodsFor: 'adding/removing methods' stamp: 'SebastianTleye 7/9/2013 17:52'! addSelectorSilently: selector withMethod: compiledMethod self methodDictAddSelectorSilently: selector withMethod: compiledMethod. self registerLocalSelector: selector! ! !TBehavior methodsFor: 'adding/removing methods' stamp: 'SebastianTleye 7/9/2013 17:52'! methodDictAddSelectorSilently: selector withMethod: compiledMethod self basicAddSelector: selector withMethod: compiledMethod! ! !TBehavior methodsFor: 'adding/removing methods' stamp: 'SebastianTleye 7/9/2013 17:52'! addSelector: selector withMethod: compiledMethod ^ self addSelector: selector withMethod: compiledMethod notifying: nil! ! !TBehavior methodsFor: 'adding/removing methods' stamp: 'SebastianTleye 7/9/2013 17:52'! basicRemoveSelector: selector "Assuming that the argument, selector (a Symbol), is a message selector in my method dictionary, remove it and its method." | oldMethod | oldMethod := self methodDict at: selector ifAbsent: [^ self]. self methodDict removeKey: selector. "Now flush the method cache" oldMethod flushCache. selector flushCache.! ! !TBehavior methodsFor: 'adding/removing methods' stamp: 'SebastianTleye 7/9/2013 17:52'! addSelector: selector withMethod: compiledMethod notifying: requestor ^ self addSelectorSilently: selector withMethod: compiledMethod! ! !TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'! compiledMethodAt: selector ifAbsent: aBlock "Answer the compiled method associated with the argument, selector (a Symbol), a message selector in the receiver's method dictionary. If the selector is not in the dictionary, return the value of aBlock" ^ self methodDict at: selector ifAbsent: [aBlock value]! ! !TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'! deregisterLocalSelector: aSymbol self basicLocalSelectors notNil ifTrue: [ self basicLocalSelectors remove: aSymbol ifAbsent: []]! ! !TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'! selectors "Answer a Set of all the message selectors specified in the receiver's method dictionary." ^ self methodDict keys! ! !TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'! methodDictionary "Convenience" ^self methodDict! ! !TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'! compress "Compact the method dictionary of the receiver." self methodDict rehash! ! !TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'! sourceCodeAt: selector ^ (self methodDict at: selector) sourceCode.! ! !TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'! registerLocalSelector: aSymbol self basicLocalSelectors notNil ifTrue: [ self basicLocalSelectors add: aSymbol]! ! !TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'! >> selector "Answer the compiled method associated with the argument, selector (a Symbol), a message selector in the receiver's method dictionary. If the selector is not in the dictionary, create an error notification." ^self compiledMethodAt: selector ! ! !TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'! methodDictionary: aDictionary self methodDict: aDictionary! ! !TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'! selectorsWithArgs: numberOfArgs "Return all selectors defined in this class that take this number of arguments" ^ self selectors select: [:selector | selector numArgs = numberOfArgs]! ! !TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'! changeRecordsAt: selector "Return a list of ChangeRecords for all versions of the method at selector. Source code can be retrieved by sending string to any one. Return nil if the method is absent." "(Pen changeRecordsAt: #go:) collect: [:cRec | cRec string]" ^ChangeSet scanVersionsOf: (self compiledMethodAt: selector ifAbsent: [^ nil]) class: self meta: self isMeta category: (self whichCategoryIncludesSelector: selector) selector: selector.! ! !TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'! methods ^ self methodDict values! ! !TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'! firstCommentAt: selector "Answer a string representing the first comment in the method associated with selector. Return an empty string if the relevant source file is not available, or if the method's source code does not contain a comment. Not smart enough to bypass quotes in string constants, but does map doubled quote into a single quote." |someComments| someComments := self commentsAt: selector. ^someComments isEmpty ifTrue: [''] ifFalse: [someComments first] "Behavior firstCommentAt: #firstCommentAt:"! ! !TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'! selectorsAndMethodsDo: selectorAndMethodBlock "Evaluate selectorAndMethodBlock with two arguments for each selector/method pair in my method dictionary." ^ self methodDict keysAndValuesDo: selectorAndMethodBlock! ! !TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'! sourceCodeAt: selector ifAbsent: aBlock ^ (self methodDict at: selector ifAbsent: [^ aBlock value]) sourceCode.! ! !TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'! compiledMethodAt: selector "Answer the compiled method associated with the argument, selector (a Symbol), a message selector in the receiver's method dictionary. If the selector is not in the dictionary, create an error notification." ^ self methodDict at: selector! ! !TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'! firstPrecodeCommentFor: selector "If there is a comment in the source code at the given selector that preceeds the body of the method, return it here, else return nil" | method | "Behavior firstPrecodeCommentFor: #firstPrecodeCommentFor:" (#(Comment Definition Hierarchy) includes: selector) ifTrue: [^ nil]. method := self compiledMethodAt: selector asSymbol ifAbsent: [^ nil]. ^method ast firstPrecodeComment. ! ! !TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'! methodsDo: aBlock "Evaluate aBlock for all the compiled methods in my method dictionary." ^ self methodDict valuesDo: aBlock! ! !TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/9/2013 17:52'! selectorsDo: selectorBlock "Evaluate selectorBlock for all the message selectors in my method dictionary." ^ self methodDict keysDo: selectorBlock! ! !TBehavior methodsFor: 'private' stamp: 'SebastianTleye 7/9/2013 17:52'! spaceUsed "Answer a rough estimate of number of bytes used by this class and its metaclass. Does not include space used by class variables." | space | space := 0. self methodsDo: [:method | space := space + 16. "dict and org'n space" space := space + (method size + 6 "hdr + avg pad"). method literalsDo: [:lit | (lit isMemberOf: Array) ifTrue: [space := space + ((lit size + 1) * 4)]. (lit isMemberOf: Float) ifTrue: [space := space + 12]. (lit isMemberOf: ByteString) ifTrue: [space := space + (lit size + 6)]. (lit isMemberOf: LargeNegativeInteger) ifTrue: [space := space + ((lit size + 1) * 4)]. (lit isMemberOf: LargePositiveInteger) ifTrue: [space := space + ((lit size + 1) * 4)]]]. ^ space! ! !TBehavior methodsFor: 'copying' stamp: 'SebastianTleye 7/9/2013 17:52'! copyOfMethodDictionary "Return a copy of the receiver's method dictionary" ^ self methodDict copy! ! !TBehavior methodsFor: 'copying' stamp: 'SebastianTleye 7/9/2013 17:52'! postCopy super postCopy. self methodDict: self copyOfMethodDictionary! ! !TBehavior methodsFor: 'copying' stamp: 'SebastianTleye 7/9/2013 17:52'! deepCopy "Classes should only be shallowCopied or made anew." ^ self shallowCopy! ! !TBehavior methodsFor: 'accessing class hierarchy' stamp: 'SebastianTleye 7/9/2013 17:52'! withAllSubclasses "Answer a Set of the receiver, the receiver's descendent's, and the receiver's descendent's subclasses." ^ self allSubclasses add: self; yourself! ! !TBehavior methodsFor: 'accessing class hierarchy' stamp: 'SebastianTleye 7/9/2013 17:52'! withAllSuperclasses "Answer an OrderedCollection of the receiver and the receiver's superclasses. The first element is the receiver, followed by its superclass; the last element is Object." | temp | temp := self allSuperclasses. temp addFirst: self. ^ temp! ! !TBehavior methodsFor: 'accessing class hierarchy' stamp: 'SebastianTleye 7/9/2013 17:52'! withAllSubclassesDo: aBlock "Evaluate the argument, aBlock, for the receiver and each of its subclasses." self withAllSubclasses do: [ :subclass | aBlock value: subclass ].! ! !TBehavior methodsFor: 'initialization' stamp: 'SebastianTleye 7/9/2013 17:52'! emptyMethodDictionary ^ MethodDictionary new! ! !TBehavior methodsFor: 'initialization' stamp: 'SebastianTleye 7/9/2013 17:52'! obsolete "Invalidate and recycle local methods, e.g., zap the method dictionary if can be done safely." self canZapMethodDictionary ifTrue: [self methodDict: self emptyMethodDictionary]. self hasTraitComposition ifTrue: [ self traitComposition traits do: [:each | each removeUser: self]]! ! !TBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:52'! decompilerClass self deprecated: 'use #compilerClass' on: '02 May 2013' in: 'Pharo 3.0'. ^ self compilerClass! ! !TBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:52'! binding ^ nil -> self! ! !TBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:52'! parserClass self deprecated: 'use #compilerClass' on: '29 April 2013' in: 'Pharo 3.0'. ^self compilerClass! ! !TBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:52'! compile: code "Compile the argument, code, as source code in the context of the receiver. Create an error notification if the code can not be compiled. The argument is either a string or an object that converts to a string or a PositionableStream on an object that converts to a string." ^self compile: code notifying: nil! ! !TBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:52'! compile: code classified: category notifying: requestor trailer: bytes ifFail: aBlock "Compile code without logging the source in the changes file" | methodNode | methodNode := self compiler compile: code in: self classified: category notifying: requestor ifFail: aBlock. ^ methodNode generate: bytes! ! !TBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:52'! compiler "Answer a compiler appropriate for source methods of this class." ^self compilerClass new environment: self environment; class: self! ! !TBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:52'! defaultMethodTrailer ^ CompiledMethodTrailer empty! ! !TBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:52'! evaluatorClass "Answer an evaluator class appropriate for evaluating expressions in the context of this class." self deprecated: 'use #compilerClass' on: '02 May 2013' in: 'Pharo 3.0'. ^self compilerClass! ! !TBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:52'! compile: code notifying: requestor "Compile the argument, code, as source code in the context of the receiver and insEtall the result in the receiver's method dictionary. The second argument, requestor, is to be notified if an error occurs. The argument code is either a string or an object that converts to a string or a PositionableStream. This method also saves the source code." | method | method := self compile: code "a Text" classified: nil notifying: requestor trailer: self defaultMethodTrailer ifFail: [ ^nil ]. method putSource: code inFile: 2 withPreamble: [:f | f cr; nextPut: $!!; nextChunkPut: 'Behavior method'; cr]. self addSelector: method selector withMethod: method notifying: requestor. ^ method selector! ! !TBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:52'! compileAll ^ self compileAllFrom: self! ! !TBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:52'! evaluate: aString ^self compiler evaluate: aString! ! !TBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:52'! compileAllFrom: oldClass "Compile all the methods in the receiver's method dictionary. This validates sourceCode and variable references and forces all methods to use the current bytecode set" oldClass selectorsDo: [:sel | self recompile: sel from: oldClass]. ! ! !TBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:52'! compilerClass "Answer a compiler class appropriate for source methods of this class." ^Smalltalk compilerClass! ! !TBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:52'! recompileChanges "Compile all the methods that are in the changes file. This validates sourceCode and variable references and forces methods to use the current bytecode set" self selectorsAndMethodsDo: [:sel :meth | meth fileIndex > 1 ifTrue: [self recompile: sel from: self]]! ! !TBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:52'! sourceCodeTemplate "Answer an expression to be edited and evaluated in order to define methods in this class or trait." ^'message selector and argument names "comment stating purpose of message" | temporary variable names | statements'! ! !TBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:52'! recompile: selector from: oldClass "Compile the method associated with selector in the receiver's method dictionary." | method newMethod | method := oldClass compiledMethodAt: selector. newMethod := self compiler source: (oldClass sourceCodeAt: selector); class: self; failBlock: [^ self]; compiledMethodTrailer: method trailer; compile. "Assume OK after proceed from SyntaxError" selector == newMethod selector ifFalse: [self error: 'selector changed!!']. self basicAddSelector: selector withMethod: newMethod. ! ! !TBehavior methodsFor: '*Compiler-Kernel' stamp: 'SebastianTleye 7/9/2013 17:52'! recompile: selector "Compile the method associated with selector in the receiver's method dictionary." ^self recompile: selector from: self! ! !TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'! addTraitSelector: aSymbol withMethod: aCompiledMethod "Add aMethod with selector aSymbol to my methodDict. aMethod must not be defined locally." | source method | [(self includesLocalSelector: aSymbol) not] assert. self ensureLocalSelectors. source := aCompiledMethod getSourceReplacingSelectorWith: aSymbol. method := self compile: source classified: aCompiledMethod category notifying: nil trailer: self defaultMethodTrailer ifFail: [ ^nil ]. method putSource: source inFile: 2 withPreamble: [:f | f cr; nextPut: $!!; nextChunkPut: 'Trait method'; cr]. self isTrait ifFalse: [ method properties at: #traitSource put: aCompiledMethod]. self basicAddSelector: aSymbol withMethod: method! ! !TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'! flattenDownAllTraits self traitComposition allTraits do: [:each | self flattenDown: each]. [ self traitComposition isEmpty ] assert. self traitComposition: nil.! ! !TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'! traits "Returns a collection of all traits used by the receiver" ^ self traitComposition traits! ! !TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'! flattenDown: aTrait | selectors | [self hasTraitComposition and: [self traitComposition allTraits includes: aTrait]] assert. selectors := (self traitComposition transformationOfTrait: aTrait) selectors. self basicLocalSelectors: self basicLocalSelectors , selectors. self removeFromComposition: aTrait.! ! !TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'! traitsProvidingSelector: aSymbol | result | result := OrderedCollection new. self hasTraitComposition ifFalse: [^result]. (self traitComposition methodDescriptionsForSelector: aSymbol) do: [:methodDescription | methodDescription selector = aSymbol ifTrue: [ result addAll: (methodDescription locatedMethods collect: [:each | each methodClass])]]. ^result! ! !TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'! traitOrClassOfSelector: aSymbol "Return the trait or the class which originally defines the method aSymbol or return self if locally defined or if it is a conflict marker method. This is primarly used by Debugger to determin the behavior in which a recompiled method should be put. If a conflict method is recompiled it should be put into the class, thus return self. Also see TraitComposition>>traitProvidingSelector:" ((self includesLocalSelector: aSymbol) or: [ self hasTraitComposition not]) ifTrue: [^self]. ^(self traitComposition traitProvidingSelector: aSymbol) ifNil: [self]! ! !TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'! notifyUsersOfChangedSelector: aSelector self notifyUsersOfChangedSelectors: (Array with: aSelector)! ! !TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'! traitCompositionIncludes: aTrait ^self == aTrait or: [self hasTraitComposition and: [self traitComposition allTraits includes: aTrait]]! ! !TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'! updateMethodDictionarySelector: aSymbol "A method with selector aSymbol in myself or my traitComposition has been changed. Do the appropriate update to my methodDict (remove or update method) and return all affected selectors of me so that my useres get notified." | modifiedSelectors descriptions oldProtocol | modifiedSelectors := IdentitySet new. descriptions := self traitComposition methodDescriptionsForSelector: aSymbol. descriptions do: [:methodDescription | | effectiveMethod selector | selector := methodDescription selector. (self includesLocalSelector: selector) ifFalse: [ methodDescription isEmpty ifTrue: [ self removeTraitSelector: selector. modifiedSelectors add: selector] ifFalse: [ effectiveMethod := methodDescription effectiveMethod. self addTraitSelector: selector withMethod: effectiveMethod. "If the method was not categorized yet, we categorize it " oldProtocol := self organization categoryOfElement: selector. (oldProtocol isNil or: [ oldProtocol = Protocol unclassified ]) ifTrue: [ self organization classify: selector under: methodDescription effectiveMethodCategory. ]. modifiedSelectors add: selector]]]. ^modifiedSelectors! ! !TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'! purgeLocalSelectors self basicLocalSelectors: nil! ! !TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'! noteChangedSelectors: aCollection "Start update of my methodDict (after changes to traits in traitComposition or after a local method was removed from my methodDict). The argument is a collection of method selectors that may have been changed. Most of the time aCollection only holds one selector. But when there are aliases involved there may be several method changes that have to be propagated to users." | affectedSelectors | affectedSelectors := IdentitySet new. aCollection do: [:selector | affectedSelectors addAll: (self updateMethodDictionarySelector: selector)]. self notifyUsersOfChangedSelectors: affectedSelectors. ^ affectedSelectors! ! !TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'! removeFromComposition: aTrait self setTraitComposition: (self traitComposition copyTraitExpression removeFromComposition: aTrait)! ! !TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'! traitTransformations ^ self traitComposition transformations ! ! !TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'! setTraitCompositionFrom: aTraitExpression ^ self setTraitComposition: aTraitExpression asTraitComposition! ! !TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'! traitCompositionString ^self hasTraitComposition ifTrue: [self traitComposition asString] ifFalse: ['{}']! ! !TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'! setTraitComposition: aTraitComposition | oldComposition | (self hasTraitComposition not and: [aTraitComposition isEmpty]) ifTrue: [^self]. aTraitComposition assertValidUser: self. oldComposition := self traitComposition. self traitComposition: aTraitComposition. self applyChangesOfNewTraitCompositionReplacing: oldComposition. oldComposition traits do: [:each | each removeUser: self]. aTraitComposition traits do: [:each | each addUser: self]! ! !TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'! notifyUsersOfChangedSelectors: aCollection! ! !TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'! removeTraitSelector: aSymbol [(self includesLocalSelector: aSymbol) not] assert. self basicRemoveSelector: aSymbol! ! !TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'! applyChangesOfNewTraitCompositionReplacing: oldComposition | changedSelectors | changedSelectors := self traitComposition changedSelectorsComparedTo: oldComposition. changedSelectors isEmpty ifFalse: [ self noteChangedSelectors: changedSelectors]. self traitComposition isEmpty ifTrue: [ self purgeLocalSelectors]. ^changedSelectors! ! !TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'! ensureLocalSelectors "Ensures that the instance variable localSelectors is effectively used to maintain the set of local selectors. This method must be called before any non-local selectors are added to the method dictionary!!" self basicLocalSelectors isNil ifTrue: [self basicLocalSelectors: self selectors asSet]! ! !TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'! addToComposition: aTrait self setTraitComposition: (self traitComposition copyTraitExpression add: aTrait; yourself)! ! !TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'! addExclusionOf: aSymbol to: aTrait self setTraitComposition: ( self traitComposition copyWithExclusionOf: aSymbol to: aTrait)! ! !TBehavior methodsFor: 'traits' stamp: 'SebastianTleye 7/9/2013 17:52'! removeAlias: aSymbol of: aTrait self setTraitComposition: ( self traitComposition copyWithoutAlias: aSymbol of: aTrait)! ! !TBehavior methodsFor: 'testing' stamp: 'SebastianTleye 7/9/2013 17:52'! canZapMethodDictionary "Return true if it is safe to zap the method dictionary on #obsolete" ^true! ! !TBehavior reorganize! (#queries copiedMethodsFromSuperclass copiesMethodsFromSuperclass whichClassDefinesInstVar: whichSuperclassSatisfies: copiesFromSuperclass: whichSelectorsRead: whichClassDefinesClassVar: whichSelectorsAssign: copiedFromSuperclass:) (#cleanup cleanUp cleanUp:) (#compiling instVarNamesAndOffsetsDo: variablesAndOffsetsDo:) (#'user interface' withAllSubAndSuperclassesDo: unreferencedInstanceVariables) (#'testing class hierarchy' kindOfSubclass inheritsFrom: includesBehavior:) ('*Ring-Core-Kernel' protocols methodNamed: methodsInProtocol:) (#'testing method dictionary' thoroughHasSelectorReferringTo:special:byte: isLocalAliasSelector: classBindingOf: whichSelectorsStoreInto: whichClassIncludesSelector: whichSelectorsReferTo:special:byte: isDisabledSelector: hasMethods canUnderstand: thoroughWhichSelectorsReferTo:special:byte: canPerform: whichSelectorsAccess: includesLocalSelector: whichSelectorsReferTo: isAliasSelector: includesSelector:) (#'initialize-release' initialize nonObsoleteClass superclass:methodDictionary:format:) (#accessing isComposedBy: subclassDefinerClass name classDepth typeOfClass poolDictionaryNames numberOfInstanceVariables classPool) (#'obsolete subclasses' basicObsoleteSubclasses removeAllObsoleteSubclasses obsoleteSubclasses addObsoleteSubclass: allLocalCallsOn: removeObsoleteSubclass:) (#enumerating allInstancesDo: subclassesDo: selectSubclasses: withAllSuperAndSubclassesDo: allSubclassesDo: withAllSuperclassesDo: allSubInstancesDo: allSuperclassesDo: allUnreferencedInstanceVariables selectSuperclasses:) ('*ast-core' parseTreeFor:) (#'memory usage' instancesSizeInMemory) ('*Nautilus' realClass) ('naming' environment) ('*Rpackage-Core' originalName) (#printing printHierarchy literalScannedAs:notifying: storeLiteral:on: printOn: longPrintOn:) (#'adding/removing methods' removeSelector: removeSelectorSilently: adoptInstance: localSelectors: localSelectors addSelectorSilently:withMethod: basicAddSelector:withMethod: methodDictAddSelectorSilently:withMethod: addSelector:withMethod: basicRemoveSelector: addSelector:withMethod:notifying:) (#'accessing method dictionary' allMethods compiledMethodAt:ifAbsent: deregisterLocalSelector: selectors methodDict: allSelectorsAboveUntil: allSelectorsBelow: methodDictionary compress sourceCodeAt: basicLocalSelectors registerLocalSelector: >> lookupSelector: nextQuotePosIn:startingFrom: methodDict allSelectorsAbove methodDictionary: selectorsWithArgs: supermostPrecodeCommentFor: basicLocalSelectors: changeRecordsAt: zapAllMethods allSelectorsWithout: methods firstCommentAt: selectorsAndMethodsDo: sourceCodeAt:ifAbsent: compiledMethodAt: classAndMethodFor:do:ifAbsent: firstPrecodeCommentFor: precodeCommentOrInheritedCommentFor: commentsAt: commentsIn: methodsDo: selectorsDo: ultimateSourceCodeAt:ifAbsent: allSelectors) ('*Manifest-Core' isManifest) ('*Tools-Inspector' inspectAllInstances inspectSubInstances) (#private setFormat: checkCanBeUncompact becomeUncompact becomeCompactSimplyAt: becomeCompact indexIfCompact spaceUsed flushCache) ('copying' copyOfMethodDictionary postCopy deepCopy) (#'accessing class hierarchy' allSuperclasses superclass: withAllSubclasses subclasses withAllSuperclasses superclass allSuperclassesIncluding: withAllSubclassesDo: allSubclassesWithLevelDo:startingLevel: allSubclasses) ('*NativeBoost-Core' nbBindingOf: externalTypeAlias: nbFnArgument:generator:) ('initialization' emptyMethodDictionary obsolete) (#'instance creation' new: basicNew: basicNew new) (#'*Compiler-Kernel' decompilerClass binding parserClass compile: bindingOf: compile:classified:notifying:trailer:ifFail: compiler defaultMethodTrailer evaluatorClass compile:notifying: compileAll evaluate: compileAllFrom: compilerClass recompileChanges sourceCodeTemplate recompile:from: recompile:) ('*System-Support' allUnsentMessages referencedClasses allCallsOn: allCallsOnIn: allCallsOn) (#'system startup' shutDown: shutDown startUp startUp:) (#'accessing instances and variables' subclassInstVarNames includesSharedPoolNamed: allClassVarNames classVarNames instVarNames instanceCount allSharedPools allowsSubInstVars allSubInstances allInstances sharedPools someInstance allInstVarNames) (#traits addTraitSelector:withMethod: traitComposition: flattenDownAllTraits traits users flattenDown: classesComposedWithMe traitsProvidingSelector: users: traitOrClassOfSelector: removeUser: notifyUsersOfChangedSelector: traitCompositionIncludes: updateMethodDictionarySelector: purgeLocalSelectors traitComposition noteChangedSelectors: hasTraitComposition removeFromComposition: traitTransformations setTraitCompositionFrom: traitCompositionString setTraitComposition: notifyUsersOfChangedSelectors: removeTraitSelector: applyChangesOfNewTraitCompositionReplacing: ensureLocalSelectors addUser: addToComposition: addExclusionOf:to: removeAlias:of:) (#testing isWeak isAnonymous isCompact isBytes instSpec sourceMatchesBytecodeAt: isObsolete shouldNotBeRedefined canZapMethodDictionary instSize isWords isMeta hasAbstractMethods isFixed isBits isVariable isPointers) !