[Modules][Fix] Reloading VMConstruction + othersHenrik Gedenryd h.gedenryd at open.ac.ukSun May 12 20:59:25 UTC 2002
Some module updates, tested with Squeak3.3a-4857. Please test these and give
some feedback before rolling them into the updates:
plugin-rename has Stephen Pair's class renamings, and must be loaded before
makeVMConstrReloadable, which refactors VMConstruction to be reloadable
after being unloaded.
dependencyFix strengthens the dependency mechanism to detect the fatal
dependencies that weren't found before (for VMConstruction) and handle them
when possible.
refactoringToolsRefactoring.cs incorporates Daniel V's analysis tools along
with some other improvements.
poolsFix is a small fix for name lookup.
fasterModuleSaving removes an unexpected source of slowness during module
storage.
fixChessPool converts the chess pool to a module to remove various problems.
--
These are all meant to be loaded together but except for the first two above
they should all be independent.
Fortunately it seems the fatal circularities aren't that common, besides the
one fixed, there are only two more that remain in the image it seems:
Fatal circular dependencies:
#(Squeak Morphic Library Windows)->#(#(Squeak Morphic Demo Components))
#(Squeak EToy Protocols Kernel)->#(#(Squeak EToy Protocols Type
Vocabularies))
I haven't had time to look at Daniel's Celeste code yet.
Henrik
-------------- next part --------------
'From Squeak3.3alpha of 30 January 2002 [latest update: #4843] on 12 May 2002 at 6:05:37 pm'!
"Change Set: plugin-rename
Date: 2 May 2002
Author: Stephen Pair
Rename classes related to 'modern' plugins using Andy Greenberg's enhanced slang syntax. Now called Smartxxx instead of Testxxx"!
Smalltalk renameClassNamed: #TestCodeGenerator as: #SmartCodeGenerator!
Smalltalk renameClassNamed: #TestInterpreterPlugin as: #SmartInterpreterPlugin!
!SmartInterpreterPlugin commentStamp: '<historical>' prior: 0!
Subclass of InterpreterPlugin, used in connection with SmartCodeGenerator for named primitives with type coercion specifications!
Smalltalk renameClassNamed: #TestTMethod as: #SmartTMethod!
!SmartCodeGenerator methodsFor: 'as yet unclassified' stamp: 'hg 5/12/2002 14:56'!
translationMethodClass
"return the class used to produce C translation methods from MethodNodes"
^SmartTMethod! !
!SmartInterpreterPlugin class methodsFor: 'private' stamp: 'svp 5/6/2002 14:19'!
codeGeneratorClass
"return the appropriate class of code generator for this kind ofplugin"
^SmartCodeGenerator! !
!SmartInterpreterPlugin class methodsFor: 'private' stamp: 'svp 5/6/2002 14:19'!
generateVMProxyOn: fileName
| cg proxyClass catList |
proxyClass _ InterpreterProxy.
cg _ SmartCodeGenerator new initialize.
cg addClass: proxyClass.
catList _ proxyClass organization categories copy asOrderedCollection.
catList remove: 'initialize' ifAbsent:[].
catList remove: 'private' ifAbsent:[].
catList _ catList collect:[:cat| cat -> (proxyClass organization listAtCategoryNamed: cat)].
cg storeVirtualMachineProxyHeader: catList on: (fileName,'.h').
cg storeVirtualMachineProxyImplementation: catList on: (fileName,'.c').
"InterpreterProxy generateVMProxyOn:'sqVirtualMachine'"
! !
!SmartTMethod methodsFor: 'specifying primitives' stamp: 'svp 5/6/2002 14:19'!
handlePrimitiveDirective: aStmt on: sStream
isPrimitive _ true.
fullArgs _ args.
locals addAll: args.
args _ OrderedCollection new.
fullArgs with: parmSpecs do:
[:argName :spec |
declarations
at: argName
put: (spec ccgDeclareCForVar: argName)].
aStmt isAssignment ifTrue:
[declarations
at: aStmt variable name
put: (rcvrSpec ccgDeclareCForVar: aStmt variable name).
sStream nextPutAll: (self
statementsFor:
(rcvrSpec
ccg: SmartCodeGenerator new
prolog: [:expr | aStmt variable name, ' _ ', expr]
expr: aStmt variable name
index: (fullArgs size))
varName: '')].
"only add the failure guard if there are args or it is an assignment"
(fullArgs isEmpty not or:[aStmt isAssignment]) ifTrue:[self generateFailureGuardOn: sStream].
^true.
! !
!SmartTMethod methodsFor: 'specifying primitives' stamp: 'svp 5/6/2002 14:19'!
namedPrimitiveProlog
| cg |
cg _ SmartCodeGenerator new.
^Array streamContents: [:sStream |
1 to: fullArgs size do:
[:i |
sStream nextPutAll:
(self
statementsFor:
((parmSpecs at: i)
ccg: cg
prolog: [:expr | (fullArgs at: i), ' _ ', expr]
expr: (fullArgs at: i)
index: (fullArgs size - i))
varName: '')]]! !
!SmartTMethod methodsFor: 'specifying primitives' stamp: 'svp 5/6/2002 14:19'!
simulatePrologInContext: aContext
|cg instructions |
cg _ SmartCodeGenerator new.
parmSpecs keysAndValuesDo:
[:index :each |
instructions _ ((parmSpecs at: index)
ccg: cg
prolog: (cg ccgTVarBlock: index)
expr: '<foo>'
index: args size - index).
Compiler new
evaluate: instructions
in: aContext
to: aContext receiver
notifying: nil
ifFail: nil].
instructions _ (rcvrSpec
ccg: cg
prolog: [:expr | '^', expr]
expr: '<foo>'
index: args size).
^Compiler new
evaluate: instructions
in: aContext
to: aContext receiver
notifying: nil
ifFail: nil! !
-------------- next part --------------
'From Squeak3.3alpha of 30 January 2002 [latest update: #4843] on 12 May 2002 at 9:05:10 pm'!
"Change Set: makeVMConstrReloadable
Date: 12 May 2002
Author: Henrik Gedenryd
Refactor dependencies within the VMConstruction module so it stores *and* loads properly."!
Smalltalk renameClassNamed: #RefactorVMConstructionPlugins as: #MakeVMConstructionReloadable!
ModuleRefactorer subclass: #MakeVMConstructionReloadable
instanceVariableNames: ''
classVariableNames: ''
module: #(Squeak Language Modules Refactorings)!
!MakeVMConstructionReloadable commentStamp: 'hg 5/12/2002 17:52' prior: 0!
Refactorings to make VMConstruction not only unlodable but now also possible to be reloaded again.!
!Object methodsFor: 'translation support' stamp: 'hg 5/12/2002 14:56'!
primitive: primID parameters: parmSpecs receiver: rcvrSpec
| tMethod |
tMethod _ SmartTMethod new
fromContext: thisContext sender
primitive: primID
parameters: parmSpecs
receiver: rcvrSpec.
^tMethod simulatePrologInContext: thisContext sender! !
!FXBltSimulator class methodsFor: 'translation' stamp: 'NS 5/6/2002 18:06'!
translate: fileName doInlining: inlineFlag
"Time millisecondsToRun: [
Interpreter translate: 'interp.c' doInlining: true.
Smalltalk beep] 164760 167543 171826 174510"
| cg items class |
cg _ CCodeGenerator new initialize.
items _ #(FXBltSimulation Interpreter ObjectMemory).
items do: [:className | class _ (Module root modulesDefining: className) first value.
class initialize.
cg addClass: class.
class declareCVarsIn: cg].
cg storeCodeOnFile: fileName doInlining: inlineFlag.! !
!InterpreterSupportCode class methodsFor: 'compiler-j3' stamp: 'NS 5/6/2002 18:27'!
externalPrimitives
"InterpreterSupportCode externalPrimitives"
| unexported |
self interpreter initialize.
unexported _ self unexportedPrimitives.
^(self interpreter primitiveTable asSet reject: [:sel | self interpreter includesSelector: sel])
asSortedCollection
reject: [:prim | unexported includes: prim]! !
!InterpreterSupportCode class methodsFor: 'compiler-j3' stamp: 'NS 5/6/2002 18:23'!
gcReachableFrom: selector
"Answer whether the given selector can trigger a garbage collection."
"InterpreterSupportCode gcReachableFrom: #primitiveClass"
"InterpreterSupportCode gcReachableFrom: #primitiveFullGC"
"InterpreterSupportCode gcReachableFrom: #primitiveAt"
"InterpreterSupportCode gcReachableFrom: #primitiveArrayBecome"
"InterpreterSupportCode gcReachableFrom: #primitiveStoreImageSegment"
| method messages prevSize |
method _ self interpreter compiledMethodAt: selector ifAbsent: [^false].
messages _ (method literals select: [:sel |
(self interpreter includesSelector: sel) or: [self objectMemory includesSelector: sel]]) asSet.
prevSize _ 0.
[messages size > prevSize] whileTrue:
[prevSize _ messages size.
messages copy do: [:sel |
method _ self interpreter compiledMethodAt: sel ifAbsent: [self objectMemory compiledMethodAt: sel].
messages addAll: (method literals select: [:sel2 |
(self interpreter includesSelector: sel2) or: [self objectMemory includesSelector: sel2]])].
((messages includes: #mapPointersInObjectsFrom:to:)
or: [messages includes: #markAndTraceInterpreterOops]) ifTrue: [^true]].
^false! !
!InterpreterSupportCode class methodsFor: 'compiler-j3' stamp: 'NS 5/6/2002 18:23'!
internalPrimitives
"InterpreterSupportCode internalPrimitives"
| unexported |
self interpreter initialize.
unexported _ self unexportedPrimitives.
^(self interpreter primitiveTable asSet select: [:sel | self interpreter includesSelector: sel])
asSortedCollection reject: [:prim | unexported includes: prim].! !
!InterpreterSupportCode class methodsFor: 'compiler-j3' stamp: 'NS 5/6/2002 18:21'!
interpreter
^Module @ #(Squeak VMConstruction Interpreter) definitionFor: #Interpreter ifAbsent: [nil]! !
!InterpreterSupportCode class methodsFor: 'compiler-j3' stamp: 'NS 5/6/2002 18:24'!
nextPutFlagsDefinition: tricky on: file
| ivars primitives prim |
ivars _ #(activeFrame argumentCount stackPointer successFlag).
"Sanity check"
self assertVars: ivars subsumeAll: tricky.
primitives _ self interpreter primitiveTable.
file nextPutAll: 'unsigned char primitiveFlags['; print: primitives size + 1; nextPutAll: ']= {'; cr.
'scanning for GC reachability...'
displayProgressAt: Sensor cursorPoint
from: 0 to: primitives size - 1
during: [:bar |
0 to: primitives size - 1 do: [:index |
bar value: index.
prim _ primitives at: index + 1.
file nextPutAll: ' 0'.
prim == #primitiveFail
ifTrue: [file nextPutAll: ' | PrimitiveFailBit']
ifFalse:
[(tricky includesKey: prim)
ifTrue: [(tricky at: prim) do:
[:var | file nextPutAll: ' | '; nextPutAll: var capitalized; nextPutAll: 'Bit']]
ifFalse: [file nextPutAll: ' | IntrinsicPrimBit'].
(self gcReachableFrom: prim) ifTrue: [file nextPutAll: ' | ActiveFrameBit']].
file nextPutAll: ', // '; nextPutAll: prim; cr]].
file nextPutAll: ' 0
};'; cr.! !
!InterpreterSupportCode class methodsFor: 'compiler-j3' stamp: 'NS 5/6/2002 18:24'!
nextPutPrimitiveTable: tricky on: file
| prims |
prims _ self interpreter primitiveTable.
file nextPutAll: 'primitive_t primitiveTable['; print: (prims size + 1); nextPutAll: ']= {'; cr.
prims do: [:prim |
file nextPutAll: ' '.
(tricky includesKey: prim) ifFalse: [file nextPutAll: '(primitive_t)j_'].
file nextPutAll: prim; nextPut: $,; cr].
file nextPutAll: ' 0'; cr; nextPutAll: '};'; cr.! !
!InterpreterSupportCode class methodsFor: 'compiler-j3' stamp: 'NS 5/6/2002 18:23'!
objectMemory
^Module @ #(Squeak VMConstruction ObjectMemory) definitionFor: #ObjectMemory ifAbsent: [nil]! !
!InterpreterSupportCode class methodsFor: 'compiler-j3' stamp: 'NS 5/6/2002 18:24'!
selectorsReachableFrom: selector
"Answer the Set of selectors reachable transitively in Interpreter starting at selector"
"InterpreterSupportCode selectorsReachableFrom: #primitiveAdd"
| method messages prevSize |
method _ self interpreter compiledMethodAt: selector.
messages _ (method literals select: [:sel | self interpreter includesSelector: sel]) asSet.
prevSize _ 0.
[messages size > prevSize] whileTrue:
[prevSize _ messages size.
messages copy do: [:sel |
method _ self interpreter compiledMethodAt: sel.
messages addAll: (method literals select: [:sel2 | self interpreter includesSelector: sel2])]].
^messages add: selector; yourself! !
!InterpreterSupportCode class methodsFor: 'compiler-j3' stamp: 'NS 5/6/2002 18:25'!
trickyPrimitiveList
"InterpreterSupportCode trickyPrimitiveList"
| primitives internal method index ivars |
"Instance variables of Interpreter that we might have to setup before running a primitive"
ivars _ #(activeContext argumentCount instructionPointer lkupClass messageSelector
method newMethod primitiveIndex receiver stackPointer successFlag theHomeContext).
self interpreter initialize.
primitives _ self internalPrimitives asArray.
primitives _ IdentityDictionary withAll: ('scanning for reachable methods...' withCRs
displayProgressAt: Sensor cursorPoint
from: 1 to: primitives size
during: [:bar |
primitives withIndexCollect: [:sel :seq |
bar value: seq.
sel -> (self selectorsReachableFrom: sel)]]).
internal _ Dictionary new.
('scanning for inst var refs...' withCRs
displayProgressAt: Sensor cursorPoint
from: 1 to: ivars size
during: [:bar |
ivars withIndexCollect: [:ivar :seq |
bar value: seq.
index _ self interpreter allInstVarNames indexOf: ivar.
ivar -> (primitives select: [:sels |
nil ~~ (sels detect: [:sel |
method _ (self interpreter compiledMethodAt: sel).
(method readsField: index) or: [method writesField: index]]
ifNone: [nil])]) keys]])
associationsDo: [:assoc |
assoc value do: [:sel |
(internal at: sel ifAbsent: [internal at: sel put: Set new])
add: assoc key]].
primitives keysDo: [:sel | (internal includesKey: sel) ifFalse: [internal at: sel put: Set new]].
internal addAll: (self externalPrimitives collect: [:prim | prim -> #(argumentCount stackPointer successFlag)]).
(internal at: #primitiveStoreImageSegment) removeAll:
#(activeContext lkupClass messageSelector method newMethod receiver).
(internal at: #primitiveSnapshotEmbedded) removeAll:
#(activeContext instructionPointer method).
internal at: #primitiveFlushCache put:
#(stackPointer activeFrame).
^(internal associationsDo: [:assoc | assoc value: assoc value asSortedCollection])! !
!InterpreterSupportCode class methodsFor: 'compiler-j3' stamp: 'NS 5/6/2002 18:25'!
unexportedPrimitives
"Answer an Array containing the names of the primitives that are not exported to j3."
"InterpreterSupportCode unexportedPrimitives"
| prims missing |
prims _ #(primitiveAt primitiveAtPut primitiveBlockCopy primitiveClone
primitiveDoPrimitiveWithArgs primitiveExternalCall primitiveInstVarAt
primitiveInstVarAtPut primitiveInstVarsPutFromStack primitiveLoadInstVar
primitivePerform primitivePerformInSuperclass primitivePerformWithArgs
primitiveResume primitiveSignal primitiveSize primitiveSnapshot
primitiveStoreStackp primitiveStringAt primitiveStringAtPut primitiveSuspend
primitiveValue primitiveValueWithArgs primitiveWait
primitiveObsoleteIndexedPrimitive).
missing _ prims reject: [:prim | self interpreter primitiveTable includes: prim].
missing isEmpty ifFalse: [self error: 'missing primitives: ' , missing printString].
^prims! !
!LargeIntegersPlugin methodsFor: 'C core util' stamp: 'NS 5/6/2002 18:10'!
cBytesCopyFrom: pFrom to: pTo len: len
""
| limit |
self returnTypeC: 'int'.
self var: #pFrom declareC: 'unsigned char * pFrom'.
self var: #pTo declareC: 'unsigned char * pTo'.
self var: #len declareC: 'int len'.
self var: #limit declareC: 'int limit'.
self cCode: '' inSmalltalk: [
interpreterProxy isInterpreterProxy ifFalse: [
"called from InterpreterSimulator"
limit _ len - 1.
0 to: limit do: [:i |
interpreterProxy byteAt: pTo + i
put: (interpreterProxy byteAt: pFrom + i)
].
^ 0
].
].
limit _ len - 1.
0 to: limit do: [:i | pTo at: i put: (pFrom at: i)].
^ 0! !
!ModuleRefactorer methodsFor: 'public' stamp: 'hg 5/12/2002 17:44'!
runRefactorings
"Trigger the whole set of refactorings in this class."
self ensurePrerequisiteVersions.
self class module repository useChangeSetNamed: self class name, ' Reorganization' during: [
self
putAwayUnknownModules;
moveModules;
reorderModules.
self moveGlobalsToModules.
self installModuleDeclarations.
self refactorClasses.
self convertPools.
self createDeltaModules.
self removeModules.
self installRepositories.
self incrementVersions.
Preferences strongModules
ifTrue: [Module root rewriteIndirectRefs].
]
! !
!ModuleRefactorer methodsFor: 'module dependencies' stamp: 'hg 5/6/2002 15:56'!
clearDeclaredModules
"remove all module declarations everywhere"
"ModuleRefactorer new clearDeclaredModules"
self deepClearDeclaredModules: Module root! !
!ModuleRefactorer methodsFor: 'module dependencies' stamp: 'hg 5/6/2002 15:55'!
deepClearDeclaredModules: module
"remove all module declarations"
module deepSubmodulesDo: [:mod | mod clearDeclaredModules]! !
!ModuleRefactorer methodsFor: 'deltas' stamp: 'hg 5/12/2002 17:45'!
createDeltaModules
"do nothing by default"! !
!ModuleRefactorer methodsFor: 'utilities' stamp: 'hg 5/12/2002 20:41'!
installRepositories
^self! !
!MakeVMConstructionReloadable methodsFor: 'moving definitions' stamp: 'NS 5/6/2002 16:54'!
refactorVMConstructionAppleScriptClasses
self transferBindingsNamedIn:
#(TestOSAPlugin)
from: Module @ #(Squeak VMConstruction Plugins)
to: Module @ #(Squeak VMConstruction Plugins AppleScript).
self transferBindingsNamedIn:
#( Unsigned)
from: Module @ #(Squeak VMConstruction Plugins Test)
to: Module @ #(Squeak VMConstruction Plugins AppleScript).
! !
!MakeVMConstructionReloadable methodsFor: 'moving definitions' stamp: 'hg 5/12/2002 17:39'!
refactorVMConstructionBalloon3DClasses
self transferBindingsNamedIn:
#(B3DAcceleratorPlugin )
from: Module @ #(Squeak Media Balloon3D Acceleration)
to: Module @ #(Squeak VMConstruction Plugins Balloon3D).
! !
!MakeVMConstructionReloadable methodsFor: 'moving definitions' stamp: 'hg 5/12/2002 17:43'!
refactorVMConstructionPluginsClasses
"move all defs from #(Squeak VMConstruction Plugins) to Module @ #(Squeak VMConstruction Plugins Various)"
"RefactorVMConstructionPlugins new refactorVMConstructionPlugins"
self transferBindingsNamedIn:
#(Mpeg3Plugin DropPlugin FFIPlugin InternetConfigPlugin InflatePlugin SecurityPlugin DeflatePlugin DSAPlugin UUIDPlugin JPEGReadWriter2Plugin JPEGReaderPlugin MiscPrimitivePlugin)
from: Module @ #(Squeak VMConstruction Plugins)
to: (Module fromPath: #(Squeak VMConstruction Plugins Various) forceCreate: true).
"Also move Genie & StarSqueak there"
self transferBindingsNamedIn:
#(GeniePlugin)
from: Module @ #(Squeak Morphic Library Genie Engine)
to: Module @ #(Squeak VMConstruction Plugins Various).
self transferBindingsNamedIn:
#(StarSqueakPlugin)
from: Module @ #(Squeak Media StarSqueak Kernel)
to: Module @ #(Squeak VMConstruction Plugins Various).
! !
!MakeVMConstructionReloadable methodsFor: 'moving definitions' stamp: 'hg 5/12/2002 18:38'!
refactorVMConstructionSupportClasses
self transferBindingsNamedIn:
#( CArrayAccessor SmartInterpreterPlugin SmartCodeGenerator SmartTMethod Oop)
from: Module @ #(Squeak VMConstruction Plugins Test)
to: (Module fromPath: #(Squeak VMConstruction Support) forceCreate: true).
self transferBindingsNamedIn:
#( CObjectAccessor CPluggableAccessor InterpreterPlugin InterpreterProxy)
from: Module @ #(Squeak VMConstruction Plugins)
to: Module @ #(Squeak VMConstruction Support).
self transferBindingsNamedIn:
#(InterpreterSupportCode )
from: Module @ #(Squeak VMConstruction Interpreter)
to: Module @ #(Squeak VMConstruction Support).
! !
!MakeVMConstructionReloadable methodsFor: 'module dependencies' stamp: 'NS 5/6/2002 18:07'!
installModuleDeclarations
self deepClearDeclaredModules: Module @ #(Squeak VMConstruction).
! !
!MakeVMConstructionReloadable methodsFor: 'deltas' stamp: 'hg 5/12/2002 19:20'!
createDeltaModules
"collect extensions that convert regular parse nodes to translator nodes + a hack extension for Smart plugins"
| transl support |
transl _ Module @ #(Squeak VMConstruction TranslationToC).
transl defineClassExtensionsOutside: transl parentModule.
support _ Module @ #(Squeak VMConstruction Support).
support defineClassExtensionsOutside: support parentModule.! !
!MakeVMConstructionReloadable methodsFor: 'repositories' stamp: 'NS 5/6/2002 16:53'!
installRepositories
(Module @ #(Squeak VMConstruction Support)) repository beStandalone ! !
!MakeVMConstructionReloadable methodsFor: 'versions' stamp: 'NS 5/6/2002 16:50'!
fromVersion
^0.0004! !
!SystemDictionary methodsFor: 'housekeeping' stamp: 'hg 5/12/2002 18:02'!
macroBenchmark2 "Smalltalk macroBenchmark2"
"Copied from Interpreter class>>translate:doInlining:forBrowserPlugin:"
| doInlining cg fileName items |
fileName _ 'benchmark2.out'.
doInlining _ true.
cg _ (Module root modulesDefining: #CCodeGenerator) first value ifNotNilDo: [:cgclass |
cgclass new initialize].
cg ifNil: [
Transcript cr; show: 'CCodeGenerator not available. Benchark cannot be run.'.
^nil].
items _ #(Interpreter ObjectMemory).
items do: [:className |
(Module root modulesDefining: className) first value ifNotNilDo: [:class |
cg addClass: class.
class declareCVarsIn: cg]].
FileDirectory default deleteFileNamed: fileName.
cg storeCodeOnFile: fileName doInlining: doInlining.
FileDirectory default deleteFileNamed: fileName.
! !
String removeSelector: #primGetInteger32:!
String removeSelector: #primPutInteger32:at:!
MakeVMConstructionReloadable removeSelector: #refactorVMConstructionAppleScript!
MakeVMConstructionReloadable removeSelector: #refactorVMConstructionPluginSupport!
MakeVMConstructionReloadable removeSelector: #refactorVMConstructionPlugins!
!ModuleRefactorer reorganize!
('versions' ensurePrerequisiteVersions fromVersion incrementVersions toVersion)
('test setup' createTopLevels)
('public' runRefactorings)
('moving modules' knownSqueakSubmodules modulesToRemove moveDeltaModule:toParent: moveModule:toPath: moveModules newPlacesForModules putAwayUnknownModules removeModules reorderModules)
('moving definitions' modulesForGlobals moveGlobalsToModules refactorClasses)
('module dependencies' clearDeclaredModules copyDeclarationsFromParent: declarationsByDefault: deepClearDeclaredModules: installModuleDeclarations installModuleDeclarationsFromMethods)
('deltas' createDeltaModules)
('converting pools' convertPoolNamed:inModule:toPoolModule: convertPools newModulesForPools)
('utilities' installRepositories testRecompileClass: testRecompileClasses: transferBindingsNamedIn:from:to:)
!
InterpreterSupportCode class removeSelector: #intepreter!
"Postscript:"
MakeVMConstructionReloadable run!
-------------- next part --------------
'From Squeak3.3alpha of 30 January 2002 [latest update: #4843] on 12 May 2002 at 8:59:46 pm'!
"Change Set: dependencyFix
Date: 12 May 2002
Author: Henrik Gedenryd
- A bug caused dependencies from a submodule to a parent module to go unnoticed.
- Introduce a new check for whether sub/superclass relations cause module circularities; these causes are especially bad.
Note that the scheme now handles sub/superclass dependencies when it can, but only within compositely stored modules (see the standalone test cases that fail). A larger change involving 'UndeclardClasses' is required to handle this for the general case."!
!ModuleInstaller methodsFor: 'graph computation' stamp: 'NS 5/7/2002 00:19'!
allModulesNeededBy: module exceptForNeedsOf: excludedModules
"Answer all modules needed by the given module, applied recursively, not considering the needs of excludedModules. This means all modules that are (indirectly) reachable from the given module. This is a basic breadth-first graph traversal algorithm."
| all remaining current newRemaining neighbors excludedSet |
all _ Set new.
excludedSet _ excludedModules asSet.
remaining _ OrderedCollection with: module.
[remaining isEmpty] whileFalse: [
current _ remaining removeFirst.
neighbors _ self directlyNeededModulesFor: current.
newRemaining _ (neighbors difference: excludedSet) difference: all.
all addAll: neighbors.
remaining addAll: newRemaining].
^all! !
!ModuleInstaller methodsFor: 'graph computation' stamp: 'hg 5/11/2002 18:44'!
checkForCircularDependencies: dependencies
"Need to allow circular dependencies or virtually no part of the existing class library will (un)load. References to undefined names during loading, which result from circular dependencies, are handled via Undeclared, so dual definitions of the same name will be confused, also a subclass loaded before superclass will be bad."
| circularities circular usedModules |
circularities _ dependencies keys
collect: [:usingModule |
usedModules _ dependencies at: usingModule.
circular _ usedModules select: [:usedModule |
usingModule ~~usedModule and: [
self module: usedModule dependsOn: usingModule says: dependencies]].
usingModule -> circular asArray]
thenSelect: [:ass | ass value isEmpty not].
circularities isEmpty ifFalse: [
self note: 'Circular dependencies: '.
circularities do: [:circ | self note: String tab, circ printString].
"self notify: 'Some modules have circular dependencies. Module contents may not load correctly.'."]! !
!ModuleInstaller methodsFor: 'graph computation' stamp: 'hg 5/12/2002 20:59'!
checkForFatalCircularDependencies: dependencies
"A subclass loaded before superclass will be fatal--loading will fail."
| circularities circular stronglyUsed fatallyCircular fatalCircularities problematicCircularities |
circularities _ dependencies keys
collect: [:usingModule |
stronglyUsed _ (dependencies at: usingModule) select: [:usedModule |
usingModule ~~usedModule and: [
self module: usingModule stronglyDependsOn: usedModule says: dependencies]].
circular _ stronglyUsed select: [:usedModule |
self module: usedModule dependsOn: usingModule says: dependencies].
fatallyCircular _ stronglyUsed select: [:usedModule |
self module: usedModule stronglyDependsOn: usingModule says: dependencies].
usingModule -> (Array
with: fatallyCircular asArray
with: (circular difference: fatallyCircular) asArray)].
fatalCircularities _ circularities
collect: [:ass | ass key -> ass value first] thenSelect: [:ass | ass value isEmpty not].
problematicCircularities _ circularities
collect: [:ass | ass key -> ass value second] thenSelect: [:ass | ass value isEmpty not].
fatalCircularities isEmpty ifFalse: [
self note: 'Fatal circular dependencies: '.
fatalCircularities do: [:circ | self note: String tab, circ printString].
self note: 'Some modules have fatal circular dependencies--at least one class cannot be defined after its superclass. Module loading WILL FAIL.'.].
problematicCircularities isEmpty ifFalse: [
self note: 'Potentially problematic circular dependencies: '.
problematicCircularities do: [:circ | self note: String tab, circ printString].
fatalCircularities isEmpty ifFalse: [
self note: 'Some modules have problematic circular dependencies--at least one class may be loaded before its superclass. Module loading MAY fail.']]! !
!ModuleInstaller methodsFor: 'graph computation' stamp: 'NS 5/6/2002 21:36'!
compositeLoadingDependenciesFor: module except: excludedModules
"compute dependencies, taking into account that both ends of dependencies may reside in composite repositories"
| allNeeded compositesNeeded |
allNeeded _ IdentitySet new.
module repository compositeModules do: [:mod |
allNeeded addAll:
(self allModulesNeededBy: mod exceptForNeedsOf: excludedModules)].
compositesNeeded _ allNeeded collect: [:mod | mod repository standaloneRepository module].
compositesNeeded remove: module ifAbsent: [].
^compositesNeeded! !
!ModuleInstaller methodsFor: 'graph computation' stamp: 'hg 5/11/2002 18:22'!
loadingOrderFor: modules
| dependencies |
dependencies _ modules collect: [:mod |
mod -> (self compositeLoadingDependenciesFor: mod except: modules)].
^self modules: modules inDependencyOrderFrom: dependencies! !
!ModuleInstaller methodsFor: 'graph computation' stamp: 'NS 5/6/2002 20:59'!
module: module1 dependsOn: module2 says: dependencies
^(dependencies at: module1 ifAbsent: [^false]) includes: module2! !
!ModuleInstaller methodsFor: 'graph computation' stamp: 'NS 5/6/2002 20:42'!
module: module1 stronglyDependsOn: module2 says: dependencies
"Strong dependency: Any class in one inherits from any class in the other. Such a sub-to-superclass dependency cannot be resolved by Undeclared. "
^(self module: module1 dependsOn: module2 says: dependencies) and: [
module1 allClasses anySatisfy: [:class | class superclass module == module2]]! !
!ModuleInstaller methodsFor: 'graph computation' stamp: 'hg 5/11/2002 20:17'!
modules: modules inStrongDependencyOrderFrom: dependencies
"a module may load before another if it doesn't depend on the other, OR if they have a circular dependency.
STRONG dependency: Any class in one module inherits from any class in the other. This to handle legacy dependencies that Undeclared cannot handle, namely sub-to-superclass dep:s .
Let regular circularities pass (they are handled now) but flag strong circularities."
| dependencyDictionary |
dependencyDictionary _ Dictionary newFrom: dependencies.
self checkForFatalCircularDependencies: dependencyDictionary.
^modules topologicallySortedUsing: [:module1 :module2 |
(self module: module1 stronglyDependsOn: module2 says: dependencyDictionary) ==>
[self module: module2 stronglyDependsOn: module1 says: dependencyDictionary]]! !
!ModuleInstaller methodsFor: 'graph computation' stamp: 'NS 5/6/2002 20:45'!
orderWithinCompositeFor: modules
^self strongDependencyOrderFor: modules! !
!ModuleInstaller methodsFor: 'graph computation' stamp: 'NS 5/6/2002 20:47'!
pureDependencyOrderFor: modules
| dependencies |
dependencies _
modules asSet collect: [:mod |
mod -> (self allModulesNeededBy: mod exceptForNeedsOf: modules)].
^self modules: modules inDependencyOrderFrom: dependencies! !
!ModuleInstaller methodsFor: 'graph computation' stamp: 'NS 5/6/2002 20:45'!
strongDependencyOrderFor: modules
| dependencies |
dependencies _
modules asSet collect: [:mod |
mod -> (self allModulesNeededBy: mod exceptForNeedsOf: modules)].
^self modules: modules inStrongDependencyOrderFrom: dependencies! !
!ModuleInstaller methodsFor: '(de)activating' stamp: 'NS 5/6/2002 20:45'!
activationOrderFor: modules
^self strongDependencyOrderFor: modules! !
!ModuleStorageTests methodsFor: 'dependency tests' stamp: 'hg 5/11/2002 18:26'!
correctLoadingOrder
^{self homeModule. self betaModule. self alphaModule. }! !
!ModuleStorageTests methodsFor: 'dependency tests' stamp: 'hg 5/11/2002 18:37'!
testLoadingOrder
| sorted |
self cleanOut.
self testCreateAllModuleContents.
self homeModule deepDeclareExternalRefs.
sorted _ ModuleInstaller new loadingOrderFor: self allModules.
self should: [sorted asArray = self correctLoadingOrder]! !
!ModuleStorageTests methodsFor: 'dependency tests' stamp: 'hg 5/11/2002 18:37'!
testOrderWithinComposite
| sorted |
self cleanOut.
self testCreateAllModuleContents.
self homeModule deepDeclareExternalRefs.
sorted _ ModuleInstaller new orderWithinCompositeFor: self allModules.
self should: [sorted asArray = self correctLoadingOrder]! !
!ModuleStorageTests methodsFor: 'sample repositories' stamp: 'NS 5/11/2002 17:36'!
verifyRepositoryContents
"NB: If this fails, it could be because the storage tests fail before it. To save time the storage tests are run before the others, which dependend on stores having succeeded. See class comment."
self allRepositories do: [:rep | self verifyRepository: rep contentsOK: true].
! !
ModuleInstaller removeSelector: #checkForMalignCircularDependencies:!
ModuleInstaller removeSelector: #module:fatallyDependsOn:says:!
ModuleInstaller removeSelector: #safeLoadingOrder:!
-------------- next part --------------
'From Squeak3.3alpha of 30 January 2002 [latest update: #4843] on 12 May 2002 at 3:37:53 pm'!
"Change Set: poolsFix
Date: 12 May 2002
Author: Henrik Gedenryd
Remove an obsolete check for pools' contents that could cause a walkback."!
!Class methodsFor: 'compiling' stamp: 'hg 2/23/2002 18:04'!
definesName: varName lookInSuper: lookInSuper ifTrue: assocBlock
"Look up the first argument, varName, in the the receiver. If it is there,
pass the association to the second argument, assocBlock, and answer true."
| assoc |
"First look in classVar dictionary."
(assoc _ self classPool associationAt: varName ifAbsent: []) == nil
ifFalse: [assocBlock value: assoc.
^ true].
"Next look in shared pools."
"self sharedPools do:
[:pool |
assoc _ pool associationAt: varName ifAbsent: [].
assoc ifNotNil: [
assocBlock value: assoc.
^true]]."
"Finally look higher up the superclass chain if appropriate, and fail at the end."
(lookInSuper and: [superclass notNil])
ifTrue: [^ superclass definesName: varName lookInSuper: true ifTrue: assocBlock].
^false! !
-------------- next part --------------
'From Squeak3.3alpha of 30 January 2002 [latest update: #4843] on 12 May 2002 at 3:36:41 pm'!
"Change Set: fasterModuleSaving-hg
Date: 12 May 2002
Author: Henrik Gedenryd
Eliminate a long pause before storing a module on disk. A very unintuitive source for the problem."!
!Repository methodsFor: 'accessing' stamp: 'hg 2/21/2002 11:16'!
directory
^directory ifNil: [
self parentRepository directory
directoryNamed: self localName]! !
!Repository methodsFor: 'up- and downloading' stamp: 'hg 2/21/2002 11:40'!
defineCompositeModulesFromFile
self ensureDefinitionOK.
self fileInModuleDefinitionFile: self module.
^self compositeModules! !
!RemoteRepository methodsFor: 'accessing' stamp: 'hg 2/21/2002 11:45'!
cache
^localCache ifNil: [
(self cacheSpecies newFrom: self)
directory: nil;
yourself]! !
!RemoteRepository methodsFor: 'installer support' stamp: 'hg 2/21/2002 11:39'!
defineCompositeModulesFromFile
self ensureDefinitionInCache.
^self cache defineCompositeModulesFromFile.
! !
!RemoteRepository methodsFor: 'nil' stamp: 'hg 2/21/2002 11:15'!
directory
"compute directory from my parent if not explicitly stored. Share any open session."
^directory ifNil: [
self parentRepository directory
directoryNamed: self localName
usingSameSession: true]! !
!VirtualRootRepository methodsFor: 'initializing' stamp: 'hg 2/21/2002 11:12'!
cache
^super cache
directory: self defaultCacheDirectory;
yourself! !
RemoteRepository removeSelector: #cacheForChild:!
FileRepository removeSelector: #cacheOn:directory:!
-------------- next part --------------
'From Squeak3.3alpha of 30 January 2002 [latest update: #4843] on 12 May 2002 at 9:12:36 pm'!
"Change Set: fixChessPool
Date: 12 May 2002
Author: Henrik Gedenryd
This converts the Chess pool to a module. Pools were removed since they were well known to cause problems for clean loading. Anyone who wonders why can look at the old initialization code. How much of the internals of the compiler should you have to know to be able to file something in correctly? Now, modules do what pools used to do, and their loading is handled automatically."!
ModuleRefactorer subclass: #FixChessPool
instanceVariableNames: ''
classVariableNames: ''
module: #(Squeak Language Modules Refactorings)!
!FixChessPool commentStamp: 'hg 5/12/2002 20:51' prior: 0!
This converts the Chess pool to a module. Pools were removed since they were well known to cause problems for clean loading. Anyone who wonders why can look at the old initialization code. How much of the internals of the compiler should you have to know to be able to file something in correctly? Now, modules do what pools used to do, and their loading is handled automatically.!
!ChessPlayer class methodsFor: 'class initialization' stamp: 'hg 5/12/2002 20:30'!
initialize
"ChessPlayer initialize"
self initializeConstants.
self initializeCastlingConstants.
self initializePieceValues.
self initializeMoves.
self initializeCenterScores.! !
!ChessPlayer class methodsFor: 'class initialization' stamp: 'hg 5/12/2002 20:47'!
initializeBishopMoves
"ChessPlayer initialize"
| index moveList1 moveList2 moveList3 moveList4 px py |
BishopMoves _ Array new: 64 withAll: #().
0 to: 7 do:[:j|
0 to: 7 do:[:i|
index _ (j * 8) + i + 1.
moveList1 _ moveList2 _ moveList3 _ moveList4 _ #().
1 to: 7 do:[:k|
px _ i + k. py _ j - k.
((px between: 0 and: 7) and:[py between: 0 and: 7]) ifTrue:[
moveList1 _ moveList1 copyWith: (py * 8) + px + 1].
px _ i - k. py _ j - k.
((px between: 0 and: 7) and:[py between: 0 and: 7]) ifTrue:[
moveList2 _ moveList2 copyWith: (py * 8) + px + 1].
px _ i + k. py _ j + k.
((px between: 0 and: 7) and:[py between: 0 and: 7]) ifTrue:[
moveList3 _ moveList3 copyWith: (py * 8) + px + 1].
px _ i - k. py _ j + k.
((px between: 0 and: 7) and:[py between: 0 and: 7]) ifTrue:[
moveList4 _ moveList4 copyWith: (py * 8) + px + 1].
].
BishopMoves at: index put: {moveList1. moveList2. moveList3. moveList4}.
].
].! !
!ChessPlayer class methodsFor: 'class initialization' stamp: 'hg 5/12/2002 20:48'!
initializeCastlingConstants
"ChessPlayer initialize"
CastlingDone _ 1.
CastlingDisableKingSide _ 2.
CastlingDisableQueenSide _ 4.
CastlingDisableAll _ CastlingDisableQueenSide bitOr: CastlingDisableKingSide.
CastlingEnableKingSide _ CastlingDone bitOr: CastlingDisableKingSide.
CastlingEnableQueenSide _ CastlingDone bitOr: CastlingDisableQueenSide.
! !
!ChessPlayer class methodsFor: 'class initialization' stamp: 'hg 5/12/2002 20:48'!
initializeCenterScores
"ChessPlayer initialize"
PieceCenterScores _ Array new: 6.
1 to: 6 do:[:i| PieceCenterScores at: i put: (ByteArray new: 64)].
PieceCenterScores at: Knight put:
#(
-4 0 0 0 0 0 0 -4
-4 0 2 2 2 2 0 -4
-4 2 3 2 2 3 2 -4
-4 1 2 5 5 2 2 -4
-4 1 2 5 5 2 2 -4
-4 2 3 2 2 3 2 -4
-4 0 2 2 2 2 0 -4
-4 0 0 0 0 0 0 -4
).
PieceCenterScores at: Bishop put:
#(
-2 -2 -2 -2 -2 -2 -2 -2
-2 0 0 0 0 0 0 -2
-2 0 1 1 1 1 0 -2
-2 0 1 2 2 1 0 -2
-2 0 1 2 2 1 0 -2
-2 0 1 1 1 1 0 -2
-2 0 0 0 0 0 0 -2
-2 -2 -2 -2 -2 -2 -2 -2
).
PieceCenterScores at: Queen put:
#(
-3 0 0 0 0 0 0 -3
-2 0 0 0 0 0 0 -2
-2 0 1 1 1 1 0 -2
-2 0 1 2 2 1 0 -2
-2 0 1 2 2 1 0 -2
-2 0 1 1 1 1 0 -2
-2 0 0 0 0 0 0 -2
-3 0 0 0 0 0 0 -3
).! !
!ChessPlayer class methodsFor: 'class initialization' stamp: 'hg 5/12/2002 21:10'!
initializeConstants
"ChessPlayer initialize"
#(
(EmptySquare 0)
(Pawn 1)
(Knight 2)
(Bishop 3)
(Rook 4)
(Queen 5)
(King 6)
) do:[:spec|
ChessConstants redefineName: spec first as: spec last export: true.
].! !
!ChessPlayer class methodsFor: 'class initialization' stamp: 'hg 5/12/2002 20:48'!
initializeKingMoves
"ChessPlayer initialize"
| index px py moveList |
KingMoves _ Array new: 64 withAll: #().
0 to: 7 do:[:j|
0 to: 7 do:[:i|
index _ (j * 8) + i + 1.
moveList _ #().
#( (-1 -1) (0 -1) (1 -1) (-1 0) (1 0) (-1 1) (0 1) (1 1)) do:[:spec|
px _ i + spec first.
py _ j + spec last.
((px between: 0 and: 7) and:[py between: 0 and: 7]) ifTrue:[
moveList _ moveList copyWith: (py * 8) + px + 1]].
KingMoves at: index put: moveList
].
].! !
!ChessPlayer class methodsFor: 'class initialization' stamp: 'hg 5/12/2002 20:49'!
initializeKnightMoves
"ChessPlayer initialize"
| index px py moveList |
KnightMoves _ Array new: 64 withAll: #().
0 to: 7 do:[:j|
0 to: 7 do:[:i|
index _ (j * 8) + i + 1.
moveList _ #().
#( (-2 -1) (-1 -2) (1 -2) (2 -1) (-2 1) (-1 2) (1 2) (2 1)) do:[:spec|
px _ i + spec first.
py _ j + spec last.
((px between: 0 and: 7) and:[py between: 0 and: 7]) ifTrue:[
moveList _ moveList copyWith: (py * 8) + px + 1]].
KnightMoves at: index put: moveList
].
].! !
!ChessPlayer class methodsFor: 'class initialization' stamp: 'hg 5/12/2002 20:49'!
initializePieceValues
PieceValues _ Array new: 6.
PieceValues at: Pawn put: 100.
PieceValues at: Knight put: 300.
PieceValues at: Bishop put: 350.
PieceValues at: Rook put: 500.
PieceValues at: Queen put: 900.
PieceValues at: King put: 2000.
! !
!ChessPlayer class methodsFor: 'class initialization' stamp: 'hg 5/12/2002 20:49'!
initializeRookMoves
"ChessPlayer initialize"
| index moveList1 moveList2 moveList3 moveList4 px py |
RookMoves _ Array new: 64 withAll: #().
0 to: 7 do:[:j|
0 to: 7 do:[:i|
index _ (j * 8) + i + 1.
moveList1 _ moveList2 _ moveList3 _ moveList4 _ #().
1 to: 7 do:[:k|
px _ i + k. py _ j.
((px between: 0 and: 7) and:[py between: 0 and: 7]) ifTrue:[
moveList1 _ moveList1 copyWith: (py * 8) + px + 1].
px _ i. py _ j + k.
((px between: 0 and: 7) and:[py between: 0 and: 7]) ifTrue:[
moveList2 _ moveList2 copyWith: (py * 8) + px + 1].
px _ i - k. py _ j.
((px between: 0 and: 7) and:[py between: 0 and: 7]) ifTrue:[
moveList3 _ moveList3 copyWith: (py * 8) + px + 1].
px _ i. py _ j - k.
((px between: 0 and: 7) and:[py between: 0 and: 7]) ifTrue:[
moveList4 _ moveList4 copyWith: (py * 8) + px + 1].
].
RookMoves at: index put: {moveList1. moveList2. moveList3. moveList4}.
].
].! !
!FixChessPool methodsFor: 'converting pools' stamp: 'hg 5/12/2002 20:33'!
fromVersion
^0.0005! !
!FixChessPool methodsFor: 'converting pools' stamp: 'hg 5/12/2002 20:39'!
modulesForGlobals
"modules to move Smalltalk globals to"
^#(
ChessConstants #(Squeak Morphic Demo Games Chess)
)! !
!FixChessPool methodsFor: 'converting pools' stamp: 'hg 5/12/2002 20:18'!
newModulesForPools
"For each pool, list triplets of its name, home module and name of pool module."
^#(
(ChessConstants #(Squeak Morphic Demo Games Chess) ChessConstants)
)! !
"Postscript:"
FixChessPool run.
ChessConstants removeName: #. .
ChessPlayer initialize.!
-------------- next part --------------
'From Squeak3.3alpha of 30 January 2002 [latest update: #4843] on 12 May 2002 at 9:41:10 pm'!
"Change Set: refactoringToolsRefactoring
Date: 12 May 2002
Author: Henrik Gedenryd
Incorporates Daniel V's suggested improvements to the dependency analysis tools.
+ various other small improvements"!
!Module methodsFor: 'testing' stamp: 'hg 5/12/2002 19:58'!
importCreatesCircularity: module
^module = self | (module parentModule = self) or: [
module importedModules anySatisfy: [:mod |
self importCreatesCircularity: mod]]! !
!Module methodsFor: 'code analysis' stamp: 'NS 5/6/2002 17:49'!
deepIncomingRefsFromOutside: module
"(Module fromPath: #(EToy Experimental)) localUniqueMessagesToOutside: (Module fromPath: #(EToy))"
| refs insideModules n total |
refs _ IdentityDictionary new.
insideModules _ IdentitySet new.
module deepSubmodulesDo: [:mod |
insideModules add: mod].
self deepSubmodulesDo: [:mod |
mod definedNames associationsDo: [:assoc |
(assoc value isKindOf: Module)
ifTrue: [
"Transcript show: 'References to Module name ', key, ' ignored.';cr"]
ifFalse: [refs at: assoc put: Set new]]].
total _ 0.
self class root deepSubmodulesDo: [:cl | total _ total + 1].
'Locating outside references to global definitions ...'
displayProgressAt: Sensor cursorPoint
from: 0 to: total
during:
[:bar | n _ 0.
self class root deepSubmodulesDo: [:mod |
bar value: (n_ n+1).
(insideModules includes: mod) ifFalse: [
mod localGlobalReferencesDo: [:assoc :class :selector |
refs at: assoc ifPresent: [:set |
set add: (MethodReference new
setStandardClass: class
methodSymbol: selector)]]]]].
refs copy keysAndValuesDo: [:key :value |
value isEmpty ifTrue: [refs removeKey: key]].
^refs! !
!Module methodsFor: 'code analysis' stamp: 'NS 5/6/2002 15:34'!
deepUnresolvedRefsWithScheme: bindingScheme
| n localList dict |
dict _ Dictionary new.
'Detecting undeclared dependencies from global references...'
displayProgressAt: Sensor cursorPoint
from: 0 to: self deepSubAndDeltaModules size
during:
[:bar | n _ 0.
self deepSubAndDeltaModules do: [:mod |
bar value: (n_ n+1).
localList _ mod localUnresolvedRefsWithScheme: bindingScheme.
localList isEmpty ifFalse: [dict at: mod put: localList].
"mod setUnresolvedCount: localList size."]].
self zeroOutOfScopeCache.
^dict! !
!Module methodsFor: 'code analysis' stamp: 'NS 5/5/2002 16:27'!
localGlobalReferencesDo: aBlock
"iterate over all global references from this module, i.e. literals in CompiledMethods + superclasses of my classes. block takes global assoc, and referring class and message selector"
| isUninterestingClass classAndMeta theSuperClass assocForSuperClassName isGlobal |
self allClassesDo: [:c |
classAndMeta _ {c. (c isKindOf: DeltaClass)
ifFalse: [c class]
ifTrue: [c deltaForMetaclass] }.
classAndMeta do: [:class |
class methodDict keysAndValuesDo: [:selector :cm |
cm ~~ DeltaModule valueForUndefined ifTrue: [
cm literals do: [:lit |
isGlobal _ lit isVariableBinding and: [lit key notNil] and: [
(class theNonMetaClass definesName: lit key lookInSuper: true ifTrue: [:a |]) not].
isGlobal ifTrue: [aBlock value: lit value: class value: selector]]]]]].
self allClassesDo: [:class |
theSuperClass _ class superclass.
isUninterestingClass _ class isObsolete | theSuperClass isNil.
isUninterestingClass ifFalse: [
assocForSuperClassName _
theSuperClass module localAssocFor: theSuperClass name ifAbsent: [nil].
aBlock value: assocForSuperClassName value: class value: #'<classCreation>']].
! !
!Module methodsFor: 'code analysis' stamp: 'NS 5/6/2002 17:14'!
localUnresolvedRefsPerModule
| col |
col _ OrderedCollection new.
(self localUnresolvedRefsWithScheme: self weakOrStrongBindingScheme)
associationsDo: [:assoc | col add: assoc].
^col groupBy: [:ass | Module root moduleForAssoc: ass key] having: [:set | true].
! !
!Module methodsFor: 'code analysis' stamp: 'NS 5/5/2002 16:11'!
localUnresolvedRefsWithScheme: bindingScheme
"check that all used globals will be bound to the exact same association object if recompiled (this is stronger than just the same name or value). Return the bad ones as MethodReferences, grouped per global name."
| badRefs isDeclared badRefsToThisName |
badRefs _ Dictionary new.
self resetOutOfScopeCache.
self localGlobalReferencesDo: [:assoc :referringClass :selector |
isDeclared _
self doesLookupOf: assoc key withScheme: bindingScheme
giveTheAssoc: assoc useCache: OutOfScopeCache.
isDeclared ifFalse: [
badRefsToThisName _ badRefs at: assoc ifAbsentPut: [Set new].
badRefsToThisName add:
(MethodReference new
setStandardClass: referringClass
methodSymbol: selector)]].
^badRefs
! !
!Module methodsFor: 'code analysis' stamp: 'hg 5/12/2002 18:47'!
viewDeepUnresolvedRefs
"Root viewDeepUnresolvedRefs"
| mrefs |
mrefs _ self deepUnresolvedRefs values inject: #() into: [:all :refsDict | all,
(refsDict values inject: all into: [:all2 :refs | all2, refs asOrderedCollection])].
Smalltalk
browseMessageList: mrefs
name: 'Deep Unresolved Global References from ', self pathAsMessages
autoSelect: nil! !
!Module methodsFor: 'system conversion' stamp: 'hg 5/12/2002 21:32'!
declareDefaultExternalModules
| mod |
#(#(Squeak Language Collections) #(Squeak Language Core)) do: [:path |
mod _ Module @ path.
((self hasNeighborModule: mod) or: [self importCreatesCircularity: mod]) ifFalse: [
self externalModule: mod alias: nil version: nil importNames: true]]! !
!Module methodsFor: 'system conversion' stamp: 'NS 5/4/2002 17:06'!
declareExternalRefsForSelector: selector inClass: aClass
"for all unresolved globals in the method of the given selector and class, declare the global's defining module as one of my external modules"
(self externalRefsForSelector: selector inClass: aClass)
keysAndValuesDo: [:varName :definingModule |
self ensureExternalModule: definingModule]
! !
!Module methodsFor: 'system conversion' stamp: 'NS 5/4/2002 17:58'!
deepDeclareExternalRefs
"Root deepDeclareExternalRefs"
| n |
'Declaring all external references...'
displayProgressAt: Sensor cursorPoint
from: 0 to: self deepSubAndDeltaModules size
during:
[:bar | n _ 0.
self deepSubAndDeltaModules do: [:mod |
mod localDeclareUsedModules: mod localUndeclaredUsedModules.
bar value: (n_ n+1)]].
! !
!Module methodsFor: 'system conversion' stamp: 'NS 5/5/2002 17:37'!
deepUndeclaredUsedModules
^Dictionary newFrom:
(self deepSubmodules collect: [:module |
module -> module localUndeclaredUsedModules])! !
!Module methodsFor: 'system conversion' stamp: 'NS 5/10/2002 20:05'!
defineClassExtensionsOutside: homeModule
"Collect class extensions from this module as DeltaModules of this module. Class extensions are here detected as methods outside this module that contain references to global names defined by this module (note that this finds far from all eligible methods). Find all such methods in all classes outside homeModule, then add to this module DeltaModules with classes referring to those methods. This does not at all affect the actual classes or methods."
| incoming deltaModule deltaClass method n upstreamMethodRefs |
incoming _ self deepIncomingRefsFromOutside: homeModule.
self repository
useChangeSetNamed: self name, 'Reorganization', Time now printString
during: [
'Collecting extension methods ...'
displayProgressAt: Sensor cursorPoint
from: 0 to: incoming size
during:
[:bar | n _ 0.
incoming keysAndValuesDo: [:key :upstreamRefs |
bar value: (n _ n + 1).
upstreamMethodRefs _ upstreamRefs reject: [:mref |
mref methodSymbol == #'<classCreation>'].
upstreamMethodRefs do: [:mref |
deltaModule _ self deltaModuleForBase: mref actualClass module
forceCreate: true asActive: true.
deltaClass _ deltaModule deltaClassFor: mref actualClass forceCreate: true.
method _ mref actualClass compiledMethodAt: mref methodSymbol.
deltaClass addSelector: mref methodSymbol withMethod: method]]]].
^incoming! !
!Module methodsFor: 'system conversion' stamp: 'NS 5/5/2002 16:40'!
externalRefsForSelector: selector inClass: aClass
"for all unresolved globals in the method of the given selector and class, declare the global's defining module as one of my external modules"
| varName cm lits isDefined refs |
cm _ aClass compiledMethodAt: selector.
lits _ cm literals.
refs _ Dictionary new.
lits do: [:lit |
lit isVariableBinding ifTrue: [
varName _ lit key
ifNil: [lit value isBehavior ifTrue: [lit value theNonMetaClass name]].
isDefined _
self definesName: varName
usingScheme: self weakOrStrongBindingScheme
withCache: OutOfScopeCache ifTrue: [:a | ].
(isDefined or: [lit value == aClass]) ifFalse: [
(Module root moduleForAssoc: lit) ifNotNilDo: [:mod |.
refs at: varName put: mod]]]].
^refs
! !
!Module methodsFor: 'system conversion' stamp: 'NS 5/5/2002 17:30'!
localDeclareExternalRefsFor: refsDict
self declareDefaultExternalModules.
refsDict keysDo: [:assoc |
self ensureExternalModule: (Module root moduleForAssoc: assoc)].
^refsDict size! !
!Module methodsFor: 'system conversion' stamp: 'NS 5/4/2002 17:56'!
localDeclareUsedModules: mods
self declareDefaultExternalModules.
mods do: [:usedModule | self ensureExternalModule: usedModule].
! !
!Module methodsFor: 'system conversion' stamp: 'NS 5/5/2002 17:27'!
localUndeclaredUsedModules
| refsDict mods |
refsDict _ self localUnresolvedRefs.
mods _ refsDict keys collect: [:assoc | Module root moduleForAssoc: assoc].
^mods! !
!ModuleInstaller methodsFor: 'graph computation' stamp: 'NS 5/5/2002 17:13'!
ensureModuleDependenciesDeclared
| badOnes stillBadOnes |
self
phase: 'Verifyifying dependencies for all uploaded modules.'
progressTotal: 0.
badOnes _ self startModule deepUnresolvedRefs.
badOnes isEmpty ifTrue: [^self].
self notify: 'At least one module does not completely declare its module dependencies, which are needed to load the module properly. (There may be Undeclared references.) Proceed to attempt declaring the dependecies automatically from referenced global names, or cancel to do it manually.'.
self note: 'Declaring dependencies...'.
badOnes keysAndValuesDo: [:mod :refs | mod localDeclareExternalRefsFor: refs].
stillBadOnes _ badOnes keys select: [:mod |
mod localUnresolvedRefs notEmpty].
stillBadOnes isEmpty ifTrue: [^self noteDone].
stillBadOnes do: [:mod |
self note: '>> Module ', mod printString, ' has undeclared dependencies.'].
self notify: 'The attempt to declare used modules from referenced global names did not completely succeed. (There may be Undeclared references.) Proceed to go ahead anyway, otherwise cancel.'.
! !
!TransitionalSmalltalkModule methodsFor: 'code analysis' stamp: 'hg 5/12/2002 20:06'!
localUnresolvedRefs
"Don't do this for Smalltalk"
^Dictionary new! !
!VirtualRootModule methodsFor: 'lookups' stamp: 'NS 5/5/2002 16:38'!
moduleForAssoc: assoc
| mod |
^(assoc value isBehavior ifTrue: [assoc value module]) ifNil: [
self allDefinitionsFor: assoc key onlyExported: false detect:
[:value :module | value == assoc value ifTrue: [mod _ module. true]].
mod]! !
VirtualRootModule removeSelector: #externalModulesFor:!
VirtualRootModule removeSelector: #moduleFor:!
VirtualRootModule removeSelector: #modulesFor:!
Module removeSelector: #externalModulesFor:!
Module removeSelector: #groupedLocalUnresolvedRefsPerGlobal!
Module removeSelector: #localUnresolvedRefsPerGlobalWithScheme:!
More information about the Squeak-dev mailing list |