"Change Set: naughtyCode-ls Date: 19 January 2001 Author: Lex Spoon Fix some out-of-scope variable references."! !DeepCopier methodsFor: 'like fullCopy' stamp: 'di 2/3/2001 16:52'! mapUniClasses "For new Uniclasses, map their class vars to the new objects. And their additional class instance vars. (scripts slotInfo) and cross references like (player321)." "Players also refer to each other using associations in the References dictionary. Search the methods of our Players for those. Make new entries in References and point to them." | pp oldPlayer newKey newAssoc oldSelList newSelList | "Uniclasses use class vars to hold onto siblings who are referred to in code" pp _ Object class instSize + 1. uniClasses do: [:playersClass | "values = new ones" playersClass classPool associationsDo: [:assoc | assoc value: (assoc value veryDeepCopyWith: self)]. playersClass scripts: (playersClass privateScripts veryDeepCopyWith: self). "pp+0" "(pp+1) slotInfo was deepCopied in copyUniClass and that's all it needs" pp+2 to: playersClass class instSize do: [:i | playersClass instVarAt: i put: ((playersClass instVarAt: i) veryDeepCopyWith: self)]. ]. "Make new entries in References and point to them." References keys "copy" do: [:playerName | oldPlayer _ References at: playerName. (references includesKey: oldPlayer) ifTrue: [ newKey _ (references at: oldPlayer) "new player" uniqueNameForReference. "now installed in References" (references at: oldPlayer) renameTo: newKey]]. uniClasses "values" do: [:newClass | oldSelList _ OrderedCollection new. newSelList _ OrderedCollection new. newClass selectorsDo: [:sel | (newClass compiledMethodAt: sel) literals do: [:assoc | assoc class == Association ifTrue: [ (References associationAt: assoc key ifAbsent: [nil]) == assoc ifTrue: [ newKey _ (references at: assoc value ifAbsent: [assoc value]) externalName asSymbol. (assoc key ~= newKey) & (References includesKey: newKey) ifTrue: [ newAssoc _ References associationAt: newKey. newClass methodDictionary at: sel put: (newClass compiledMethodAt: sel) clone. "were sharing it" (newClass compiledMethodAt: sel) literalAt: ((newClass compiledMethodAt: sel) literals indexOf: assoc) put: newAssoc. (oldSelList includes: assoc key) ifFalse: [ oldSelList add: assoc key. newSelList add: newKey]]]]]]. oldSelList with: newSelList do: [:old :new | newClass replaceSilently: old to: new]]. "This is text replacement and can be wrong"! ! !Environment methodsFor: 'system conversion' stamp: 'ls 1/19/2001 13:15'! tallyIndirectRefs "Smalltalk tallyIndirectRefs" "For all classes, tally the number of references to globals outside their inherited environment. Then determine the 'closest' environment that resolves most of them. If the closest environment is different from the one in whick the class currently resides, then enter the class name with the tallies of its references to all other environments. Return a triplet: A dictionary of all classes for which this is so, with those tallies, A dictionary giving the classes that would be happier in each of the other categories, A list of the variable names sorted by number of occurrences." | tallies refs cm lits envtForVar envt envtRefs allRefs newCategories cat allClasses n | envtForVar _ Dictionary new. "Dict of varName -> envt name" allRefs _ Bag new. Smalltalk associationsDo: [:assn | (((envt _ assn value) isKindOf: Environment) and: [envt size < 500]) ifTrue: [envt associationsDo: [:a | envtForVar at: a key put: assn key]]]. tallies _ Dictionary new. allClasses _ OrderedCollection new. Smalltalk allClassesAnywhereDo: [:cls | allClasses addLast: cls]. 'Scanning 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). refs _ Set new. { cls. cls class } do: [:cl | cl selectors do: [:sel | cm _ cl compiledMethodAt: sel. lits _ cm literals. lits do: [:lit | lit class == Association ifTrue: [(lit value == cl or: [cls canFindWithoutEnvironment: lit key]) ifFalse: [refs add: lit key]]]]]. envtRefs _ Bag new. refs asSet do: [:varName | envtRefs add: (envtForVar at: varName) withOccurrences: (refs occurrencesOf: varName). (envtRefs sortedCounts isEmpty or: [envtRefs sortedCounts first value == (Smalltalk keyAtValue: cls environment)]) ifFalse: [allRefs add: varName withOccurrences: (refs occurrencesOf: varName). tallies at: cls name put: envtRefs sortedCounts. Transcript cr; print: envtRefs sortedCounts; endEntry]]]]. newCategories _ Dictionary new. tallies associationsDo: [:assn | cat _ assn value first value. (newCategories includesKey: cat) ifFalse: [newCategories at: cat put: Array new]. newCategories at: cat put: ((newCategories at: cat) copyWith: assn key)]. ^ { tallies. newCategories. allRefs sortedCounts }! ! !WeakSet methodsFor: 'public' stamp: 'di 2/3/2001 16:46'! printElementsOn: aStream | oldPos | aStream nextPut: $(. oldPos _ aStream position. self do: [:element | aStream print: element; space]. aStream position > oldPos ifTrue: [aStream skip: -1 "remove the extra space"]. aStream nextPut: $)! ! !X11Display class methodsFor: 'examples' stamp: 'ls 1/19/2001 13:45'! coloredRectangles "X11Display coloredRectangles" | display window gc colors rnd w h pt1 pt2 r nPixels time n | display _ X11Display XOpenDisplay: nil. window _ display getInputFocus. gc _ X11GC on: window. colors _ Color colorNames collect:[:cn| (Color perform: cn) pixelWordForDepth: 32]. rnd _ Random new. w _ Display width. h _ Display height. n _ 0. nPixels _ 0. time _ Time millisecondClockValue. [Sensor anyButtonPressed] whileFalse:[ pt1 _ (rnd next * w) asInteger @ (rnd next * h) asInteger. pt2 _ (rnd next * w) asInteger @ (rnd next * h) asInteger. r _ Rectangle encompassing: (Array with: pt1 with: pt2). gc foreground: colors atRandom. gc fillRectangle: r. gc foreground: 0. gc drawRectangle: r. display sync. n _ n + 1. nPixels _ nPixels + ((r right - r left) * (r bottom - r top)). (n \\ 100) = 0 ifTrue:[ 'Pixel fillRate: ', (nPixels * 1000 // (Time millisecondClockValue - time)) asStringWithCommas displayAt: 0@0]. ]. gc free. display closeDisplay. Display forceToScreen.! !