'From Squeak3.5 of ''11 April 2003'' [latest update: #5180] on 18 May 2003 at 8:53:19 pm'! "Change Set: BindingOf-Cleanup Date: 17 May 2003 Author: Andreas Raab Cleanup phase for #bindingOf: changing all the refs to use #bindingOf:. (merged more recent changes to two methods -dew)"! !Behavior methodsFor: 'printing' stamp: 'ar 5/17/2003 14:11'! 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) ifNotNilDo:[:assoc| (assoc value isKindOf: Behavior) ifTrue: [^ nil->assoc value class]]. requestor notify: 'No such metaclass'. ^false]. (key isMemberOf: Symbol) ifTrue: "##" [(self bindingOf: key) ifNotNilDo:[: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 "! ! !Behavior methodsFor: 'printing' stamp: 'ar 5/17/2003 14:11'! 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 isMemberOf: Symbol) and: [(self bindingOf: key) notNil]) ifTrue: [aStream nextPutAll: '##'; nextPutAll: key. ^self]. aCodeLiteral storeOn: aStream! ! !Behavior methodsFor: 'testing method dictionary' stamp: 'ar 5/17/2003 14:20'! scopeHas: varName ifTrue: aBlock "Obsolete. Kept around for possible spurios senders which we don't know about" (self bindingOf: varName) ifNotNilDo:[:binding| aBlock value: binding. ^true]. ^false! ! !Class methodsFor: 'initialize-release' stamp: 'ar 5/17/2003 14:14'! declare: varString "Declare class variables common to all instances. Answer whether recompilation is advisable." | newVars conflicts | newVars _ (Scanner new scanFieldNames: varString) collect: [:x | x asSymbol]. newVars do: [:var | var first isLowercase ifTrue: [self error: var, ' class variable name should be capitalized; proceed to include anyway.']]. conflicts _ false. classPool == nil ifFalse: [(classPool keys reject: [:x | newVars includes: x]) do: [:var | self removeClassVarName: var]]. (newVars reject: [:var | self classPool includesKey: var]) do: [:var | "adding" "check if new vars defined elsewhere" (self bindingOf: var) notNil ifTrue: [self error: var , ' is defined elsewhere'. conflicts _ true]]. newVars size > 0 ifTrue: [classPool _ self classPool. "in case it was nil" newVars do: [:var | classPool declare: var from: Undeclared]]. ^conflicts! ! !Class methodsFor: 'class variables' stamp: 'ar 5/17/2003 14:12'! addClassVarName: aString "Add the argument, aString, as a class variable of the receiver. Signal an error if the first character of aString is not capitalized, or if it is already a variable named in the class." | symbol | aString first isLowercase ifTrue: [^self error: aString, ' class variable name should be capitalized; proceed to include anyway.']. symbol _ aString asSymbol. self withAllSubclasses do: [:subclass | (subclass bindingOf: symbol) ifNotNil:[ ^ self error: aString , ' is already used as a variable name in class ' , subclass name]]. classPool == nil ifTrue: [classPool _ Dictionary new]. (classPool includesKey: symbol) ifFalse: ["Pick up any refs in Undeclared" ChangeSet current changeClass: self from: self. classPool declare: symbol from: Undeclared]! ! !Class methodsFor: 'compiling' stamp: 'ar 5/17/2003 14:13'! canFindWithoutEnvironment: varName "This method is used for analysis of system structure -- see senders." "Look up varName, in the context of the receiver. Return true if it can be found without using the declared environment." "First look in classVar dictionary." (self classPool bindingOf: varName) ifNotNil:[^true]. "Next look in shared pools." self sharedPools do:[:pool | (pool bindingOf: varName) ifNotNil:[^true]. ]. "Finally look higher up the superclass chain and fail at the end." superclass == nil ifTrue: [^ false] ifFalse: [^ (superclass bindingOf: varName) notNil]. ! ! !Encoder methodsFor: 'private' stamp: 'ar 5/17/2003 14:16'! lookupInPools: varName ifFound: assocBlock Symbol hasInterned: varName ifTrue:[:sym| (class bindingOf: sym) ifNotNilDo:[:assoc| assocBlock value: assoc. ^true]. (Preferences valueOfFlag: #lenientScopeForGlobals) "**Temporary**" ifTrue: [^ Smalltalk lenientScopeHas: sym ifTrue: assocBlock] ifFalse: [^ false]]. (class bindingOf: varName) ifNotNilDo:[:assoc| assocBlock value: assoc. ^true]. ^false! ! !Environment methodsFor: 'system conversion' stamp: 'ar 5/17/2003 14:16'! browseIndirectRefs "Smalltalk browseIndirectRefs" | cm lits browseList foundOne allClasses n | self flag: #mref. "no senders at the moment. also no Environments at the moment" browseList _ OrderedCollection new. allClasses _ OrderedCollection new. Smalltalk allClassesAnywhereDo: [:cls | allClasses addLast: cls]. 'Locating methods with indirect global references...' displayProgressAt: Sensor cursorPoint from: 0 to: allClasses size during: [:bar | n _ 0. allClasses do: [:cls | bar value: (n_ n+1). { cls. cls class } do: [:cl | cl selectors do: [:sel | cm _ cl compiledMethodAt: sel. lits _ cm literals. foundOne _ false. lits do: [:lit | lit isVariableBinding ifTrue: [(lit value == cl or: [(cl bindingOf: lit key) notNil]) ifFalse: [foundOne _ true]]]. foundOne ifTrue: [ browseList add: ( MethodReference new setStandardClass: cl methodSymbol: sel ) ]]]]]. self systemNavigation browseMessageList: browseList asSortedCollection name: 'Indirect Global References' autoSelect: nil! ! !Environment methodsFor: 'system conversion' stamp: 'ar 5/17/2003 14:17'! rewriteIndirectRefs "Smalltalk rewriteIndirectRefs" "For all classes, identify all methods with references to globals outside their direct access path. For each of these, call another method to rewrite the source with proper references." | cm lits envtForVar envt foundOne allClasses n | envtForVar _ Dictionary new. "Dict of varName -> envt name" Smalltalk associationsDo: [:assn | (((envt _ assn value) isKindOf: Environment) and: [envt size < 500]) ifTrue: [envt associationsDo: [:a | envtForVar at: a key put: assn key]]]. "Allow compiler to compile refs to globals out of the direct reference path" Preferences enable: #lenientScopeForGlobals. allClasses _ OrderedCollection new. Smalltalk allClassesAnywhereDo: [:cls | allClasses addLast: cls]. 'Updating indirect global references in source code...' displayProgressAt: Sensor cursorPoint from: 0 to: allClasses size during: [:bar | n _ 0. allClasses do: [:cls | bar value: (n_ n+1). { cls. cls class } do: [:cl | cl selectors do: [:sel | cm _ cl compiledMethodAt: sel. lits _ cm literals. foundOne _ false. lits do: [:lit | lit isVariableBinding ifTrue: [(lit value == cl or: [(cl bindingOf: lit key) notNil]) ifFalse: [foundOne _ true]]]. foundOne ifTrue: [self rewriteSourceForSelector: sel inClass: cl using: envtForVar]]]. ]]. Preferences disable: #lenientScopeForGlobals. ! ! !Environment methodsFor: 'system conversion' stamp: 'ar 5/17/2003 14:17'! rewriteSourceForSelector: selector inClass: aClass using: envtForVar "Rewrite the source code for the method in question so that all global references out of the direct access path are converted to indirect global references. This is done by parsing the source with a lenient parser able to find variables in any environment. Then the parse tree is consulted for the source code ranges of each reference that needs to be rewritten and the pattern to which it should be rewritten. Note that assignments, which will take the form envt setValueOf: #GlobalName to: ... may generate spurious message due to agglutination of keywords with the value expression." | code methodNode edits varName eName envt | code _ aClass sourceCodeAt: selector. methodNode _ Compiler new parse: code in: aClass notifying: nil. edits _ OrderedCollection new. methodNode encoder globalSourceRanges do: [:tuple | "{ varName. srcRange. store }" (aClass bindingOf: (varName _ tuple first asSymbol)) notNil ifFalse: ["This is a remote global. Add it as reference to be edited." edits addLast: { varName. tuple at: 2. tuple at: 3 }]]. "Sort the edits by source position." edits _ edits asSortedCollection: [:a :b | a second first < b second first]. edits reverseDo: [:edit | varName _ edit first. (eName _ envtForVar at: varName ifAbsent: [nil]) ifNotNil: ["If varName is not already exported, define an export method" envt _ self at: eName. (envt class includesSelector: varName) ifFalse: [envt class compile: (self exportMethodFor: varName) classified: 'exports']. "Replace each access out of scope with a proper remote reference" code _ code copyReplaceFrom: edit second first to: edit second last with: eName , ' ' , varName]]. aClass compile: code classified: (aClass organization categoryOfElement: selector)! ! PseudoClass removeSelector: #scopeHas:ifTrue:! Metaclass removeSelector: #scopeHas:ifTrue:! Class removeSelector: #scopeHas:ifTrue:!