--- a/ObjectFileLoader.st Fri Aug 26 01:09:06 2016 +0200
+++ b/ObjectFileLoader.st Fri Aug 26 15:13:31 2016 +0200
@@ -283,18 +283,18 @@
robustness.
There are basically two totally different mechanisms to do this:
- a) if there exists some dynamic-link facility such as:
- GNU-DL, dlopen (sparc, SYS5.4), rld_open (NeXT),
- or LoadLibrary (Win32), this is used
-
- b) if no such facility exists, the normal linker is used to
- link the module to text/data address as previously malloced,
- and the object file is loaded into that space.
+ a) if there exists some dynamic-link facility such as:
+ GNU-DL, dlopen (sparc, SYS5.4), rld_open (NeXT),
+ or LoadLibrary (Win32), this is used
+
+ b) if no such facility exists, the normal linker is used to
+ link the module to text/data address as previously malloced,
+ and the object file is loaded into that space.
Not all mechanisms work fully satisfying.
- For example, the sun dl*-functions do an exit on link-errors
- (which is certainly not what we want here :-(;
- the NeXT mechanism does not allow for selective unloading
+ For example, the sun dl*-functions do an exit on link-errors
+ (which is certainly not what we want here :-(;
+ the NeXT mechanism does not allow for selective unloading
(only all or the last loaded module).
The only really useful packages are the GNU-dl package,
@@ -317,7 +317,7 @@
This will fix itself, once we do object file loading in the VM.
[author:]
- Claus Gittinger
+ Claus Gittinger
"
! !
@@ -1234,13 +1234,13 @@
handle := self handleForDynamicObject:filename.
handle notNil ifTrue:[
- "already loaded"
- ^ handle.
+ "already loaded"
+ ^ handle.
].
handle := self loadDynamicObject:filename.
handle isNil ifTrue:[
- ^ nil
+ ^ nil
].
didInit := false.
@@ -1250,23 +1250,23 @@
are to be resolved. If that's the case, load all libraries ..."
ParserFlags searchedLibraries notEmptyOrNil ifTrue:[
- (self hasUndefinedSymbolsIn:handle) ifTrue:[
- self initializeLoader.
-
- ParserFlags searchedLibraries do:[:libName |
- (self hasUndefinedSymbolsIn:handle) ifTrue:[
- Logger info:' ... trying %1 to resolve undefined symbols ...' with:libName.
- dummyHandle := Array new:4.
- dummyHandle := self primLoadDynamicObject:libName into:dummyHandle.
+ (self hasUndefinedSymbolsIn:handle) ifTrue:[
+ self initializeLoader.
+
+ ParserFlags searchedLibraries do:[:libName |
+ (self hasUndefinedSymbolsIn:handle) ifTrue:[
+ Logger info:' ... trying %1 to resolve undefined symbols ...' with:libName.
+ dummyHandle := Array new:4.
+ dummyHandle := self primLoadDynamicObject:libName into:dummyHandle.
"/ dummyHandle isNil ifTrue:[
"/ Transcript showCR:' ... load of library ' , libName , ' failed.'.
"/ ]
- ]
- ].
- (self hasUndefinedSymbolsIn:handle) isNil ifTrue:[
- Logger info:'still undefined symbols in %1.' with:pathName.
- ].
- ]
+ ]
+ ].
+ (self hasUndefinedSymbolsIn:handle) isNil ifTrue:[
+ Logger info:'still undefined symbols in %1.' with:pathName.
+ ].
+ ]
].
"
@@ -1281,205 +1281,205 @@
This is used in ST packaged classLib object files"
(initFunctionName startsWith:'lib') ifTrue:[
- definitionClassName := initFunctionName copyFrom:4.
- definitionClass := Smalltalk classNamed:definitionClassName.
+ definitionClassName := initFunctionName copyFrom:4.
+ definitionClass := Smalltalk classNamed:definitionClassName.
].
(definitionClass isNil or:[definitionClass isLoaded not]) ifTrue:[
- "the project definition class has not been loaded yet.
- initialize and load it"
-
- initDefinitionAddr := self findInitDefinitionFunction:initFunctionName in:handle.
- initDefinitionAddr isNil ifTrue:[
- ('WARNING: no init definitions for: ' , pathName) errorPrintCR.
- ] ifFalse:[
- Verbose ifTrue:[
- ('calling initDefinition at:' , (initDefinitionAddr printStringRadix:16)) errorPrintCR.
- ].
- info := self
- performModuleInitAt:initDefinitionAddr
- invokeInitializeMethods:false
- for:definitionClassName
- identifyAs:handle.
- status := info at:1.
- status == #ok ifTrue:[
- "/ now, we have only loaded and installed the projectDefinition class.
- "/ (but no containing classes or extensions, yet).
- "/ let the projectDefinition load any prereqs
- definitionClassName notNil ifTrue:[
- definitionClass := Smalltalk classNamed:definitionClassName.
- definitionClass notNil ifTrue:[
+ "the project definition class has not been loaded yet.
+ initialize and load it"
+
+ initDefinitionAddr := self findInitDefinitionFunction:initFunctionName in:handle.
+ initDefinitionAddr isNil ifTrue:[
+ ('WARNING: no init definitions for: ' , pathName) errorPrintCR.
+ ] ifFalse:[
+ Verbose ifTrue:[
+ ('calling initDefinition at:' , (initDefinitionAddr printStringRadix:16)) errorPrintCR.
+ ].
+ info := self
+ performModuleInitAt:initDefinitionAddr
+ invokeInitializeMethods:false
+ for:definitionClassName
+ identifyAs:handle.
+ status := info at:1.
+ status == #ok ifTrue:[
+ "/ now, we have only loaded and installed the projectDefinition class.
+ "/ (but no containing classes or extensions, yet).
+ "/ let the projectDefinition load any prereqs
+ definitionClassName notNil ifTrue:[
+ definitionClass := Smalltalk classNamed:definitionClassName.
+ definitionClass notNil ifTrue:[
"/ "if projectDefinition denies loading, unload"
"/ self unloadDynamicObject:handle.
-
- definitionClass
- checkForLoad; "/ raise exception if not supported on platform / not licensed
- initialize;
- preLoadAction;
- loadMandatoryPreRequisitesAsAutoloaded:false.
- ].
- ].
- ]
- ].
+
+ definitionClass
+ checkForLoad; "/ raise exception if not supported on platform / not licensed
+ initialize;
+ preLoadAction;
+ loadMandatoryPreRequisitesAsAutoloaded:false.
+ ].
+ ].
+ ]
+ ].
].
"look for explicit init (xxx_Init) function
This is used in ST object files"
initAddr := self findInitFunction:initFunctionName in:handle.
initAddr notNil ifTrue:[
- Verbose ifTrue:[
- ('calling init at:' , (initAddr printStringRadix:16)) errorPrintCR.
- ].
- info := self
- performModuleInitAt:initAddr
- invokeInitializeMethods:invokeInitializeMethods
- for:nil
- identifyAs:handle.
- status := info at:1.
- status == #ok ifTrue:[
- didInit := true.
- definitionClassName notNil ifTrue:[
- definitionClass := Smalltalk classNamed:definitionClassName.
- ]
- ]
+ Verbose ifTrue:[
+ ('calling init at:' , (initAddr printStringRadix:16)) errorPrintCR.
+ ].
+ info := self
+ performModuleInitAt:initAddr
+ invokeInitializeMethods:invokeInitializeMethods
+ for:nil
+ identifyAs:handle.
+ status := info at:1.
+ status == #ok ifTrue:[
+ didInit := true.
+ definitionClassName notNil ifTrue:[
+ definitionClass := Smalltalk classNamed:definitionClassName.
+ ]
+ ]
] ifFalse:[
- "look for explicit C-init (xxx__Init) function
- This is used in C object files"
-
- initAddr := self findFunction:initFunctionName suffix:'__Init' in:handle.
- initAddr notNil ifTrue:[
- isCModule := true.
-
- OSSignalInterrupt handle:[:ex |
- Logger error:'hard error in initFunction of class-module: %1' with:pathName.
- status := #initFailed.
- ] do:[
- cRetVal := self
- saveCallInitFunctionAt:initAddr
- in:pathNameOrFilename
- specialInit:false
- forceOld:true
- interruptable:false
- argument:0
- identifyAs:handle
- returnsObject:false.
- (cRetVal < 0) ifTrue:[
- Verbose ifTrue:[
- 'init function return failure ... unload' errorPrintCR.
- ].
- status := #initFailed.
- ] ifFalse:[
- didInit := true.
- ]
- ]
- ] ifFalse:[
- status := #noInitFunction.
-
- "look for any init-function(s); call them all"
- Verbose ifTrue:[
- 'no good init functions found; looking for candidates ...' errorPrintCR.
- ].
- initNames := self namesMatching:'*_Init' segment:'[tT?]' in:pathName.
- initNames notNil ifTrue:[
- initNames do:[:aName |
- initAddr := self getFunction:aName from:handle.
- initAddr isNil ifTrue:[
- (aName startsWith:'_') ifTrue:[
- initAddr := self getFunction:(aName copyFrom:2) from:handle.
- ].
- ].
- initAddr isNil ifTrue:[
- Transcript showCR:('no symbol: ',aName,' in ', pathName).
- ] ifFalse:[
- Verbose ifTrue:[
- ('calling init at:' , (initAddr printStringRadix:16)) errorPrintCR
- ].
- self
- performModuleInitAt:initAddr
- invokeInitializeMethods:invokeInitializeMethods
- for:nil
- identifyAs:handle.
- didInit := true.
- ]
- ].
- ].
- ]
+ "look for explicit C-init (xxx__Init) function
+ This is used in C object files"
+
+ initAddr := self findFunction:initFunctionName suffix:'__Init' in:handle.
+ initAddr notNil ifTrue:[
+ isCModule := true.
+
+ OSSignalInterrupt handle:[:ex |
+ Logger error:'hard error in initFunction of class-module: %1' with:pathName.
+ status := #initFailed.
+ ] do:[
+ cRetVal := self
+ saveCallInitFunctionAt:initAddr
+ in:pathNameOrFilename
+ specialInit:false
+ forceOld:true
+ interruptable:false
+ argument:0
+ identifyAs:handle
+ returnsObject:false.
+ (cRetVal < 0) ifTrue:[
+ Verbose ifTrue:[
+ 'init function return failure ... unload' errorPrintCR.
+ ].
+ status := #initFailed.
+ ] ifFalse:[
+ didInit := true.
+ ]
+ ]
+ ] ifFalse:[
+ status := #noInitFunction.
+
+ "look for any init-function(s); call them all"
+ Verbose ifTrue:[
+ 'no good init functions found; looking for candidates ...' errorPrintCR.
+ ].
+ initNames := self namesMatching:'*_Init' segment:'[tT?]' in:pathName.
+ initNames notNil ifTrue:[
+ initNames do:[:aName |
+ initAddr := self getFunction:aName from:handle.
+ initAddr isNil ifTrue:[
+ (aName startsWith:'_') ifTrue:[
+ initAddr := self getFunction:(aName copyFrom:2) from:handle.
+ ].
+ ].
+ initAddr isNil ifTrue:[
+ Transcript showCR:('no symbol: ',aName,' in ', pathName).
+ ] ifFalse:[
+ Verbose ifTrue:[
+ ('calling init at:' , (initAddr printStringRadix:16)) errorPrintCR
+ ].
+ self
+ performModuleInitAt:initAddr
+ invokeInitializeMethods:invokeInitializeMethods
+ for:nil
+ identifyAs:handle.
+ didInit := true.
+ ]
+ ].
+ ].
+ ]
].
(invokeInitializeMethods and:[didInit not]) ifTrue:[
- status == #noInitFunction ifTrue:[
- msg := 'no classLib init function found; assume load ok'
- ] ifFalse:[
- (status ~~ #registrationFailed
- and:[status ~~ #initFailed
- and:[status ~~ #missingClass
- and:[status ~~ #versionMismatch]]])
- ifTrue:[
- self listUndefinedSymbolsIn:handle.
- ].
-
- Verbose ifTrue:[
- 'unloading, since init failed ...' errorPrintCR.
- ].
-
- "/ give caller a chance to prevent unloading (to register later, when a prerequisite class comes)
- status == #missingClass ifTrue:[
- doNotUnload := (SuperClassMissingErrorNotification query ? false).
- ] ifFalse:[
- status == #registrationFailed ifTrue:[
- doNotUnload := (RegistrationFailedErrorNotification query ? false).
- ] ifFalse:[
- doNotUnload := false.
- ].
- ].
- doNotUnload ifFalse:[
- self unloadDynamicObject:handle.
- Verbose ifTrue:[
- 'unloaded.' errorPrintCR.
- ].
- handle := nil.
- ].
-
- status == #initFailed ifTrue:[
- msg := 'module not loaded (init function signaled failure).'
- ] ifFalse:[
- status == #missingClass ifTrue:[
- msg := 'module not loaded (superclass missing: ' , (info at:2) , ').'
- ] ifFalse:[
- status == #registrationFailed ifTrue:[
- msg := 'module registration failed (incompatible object or missing superclass)'
- ] ifFalse:[
- status == #versionMismatch ifTrue:[
- msg := 'module registration failed (class version mismatch ' , (info at:2) printString , ')'
- ] ifFalse:[
- (self namesMatching:'*__sepInitCode__*' segment:'[tT?]' in:pathName) notNil ifTrue:[
- msg := 'module not loaded (unknown error reason).'
- ] ifFalse:[
- msg := 'module not loaded (no _Init entry in object file ?).'
- ]
- ]
- ].
- ].
- ].
- ].
- Logger info:'%1: %2' with:pathNameOrFilename asFilename baseName with:msg.
+ status == #noInitFunction ifTrue:[
+ msg := 'no classLib init function found; assume load ok'
+ ] ifFalse:[
+ (status ~~ #registrationFailed
+ and:[status ~~ #initFailed
+ and:[status ~~ #missingClass
+ and:[status ~~ #versionMismatch]]])
+ ifTrue:[
+ self listUndefinedSymbolsIn:handle.
+ ].
+
+ Verbose ifTrue:[
+ 'unloading, since init failed ...' errorPrintCR.
+ ].
+
+ "/ give caller a chance to prevent unloading (to register later, when a prerequisite class comes)
+ status == #missingClass ifTrue:[
+ doNotUnload := (SuperClassMissingErrorNotification query ? false).
+ ] ifFalse:[
+ status == #registrationFailed ifTrue:[
+ doNotUnload := (RegistrationFailedErrorNotification query ? false).
+ ] ifFalse:[
+ doNotUnload := false.
+ ].
+ ].
+ doNotUnload ifFalse:[
+ self unloadDynamicObject:handle.
+ Verbose ifTrue:[
+ 'unloaded.' errorPrintCR.
+ ].
+ handle := nil.
+ ].
+
+ status == #initFailed ifTrue:[
+ msg := 'module not loaded (init function signaled failure).'
+ ] ifFalse:[
+ status == #missingClass ifTrue:[
+ msg := 'module not loaded (superclass missing: ' , (info at:2) , ').'
+ ] ifFalse:[
+ status == #registrationFailed ifTrue:[
+ msg := 'module registration failed (incompatible object or missing superclass)'
+ ] ifFalse:[
+ status == #versionMismatch ifTrue:[
+ msg := 'module registration failed (class version mismatch ' , (info at:2) printString , ')'
+ ] ifFalse:[
+ (self namesMatching:'*__sepInitCode__*' segment:'[tT?]' in:pathName) notNil ifTrue:[
+ msg := 'module not loaded (unknown error reason).'
+ ] ifFalse:[
+ msg := 'module not loaded (no _Init entry in object file ?).'
+ ]
+ ]
+ ].
+ ].
+ ].
+ ].
+ Logger info:'%1: %2' with:pathNameOrFilename asFilename baseName with:msg.
].
isCModule ifFalse:[
- Smalltalk flushCachedClasses.
- Class flushSubclassInfo.
-
- (definitionClass notNil and:[definitionClass isLoaded]) ifTrue:[
- definitionClass
- checkForLoad; "/ raise exception if not supported on platform / not licensed
- loadAllClassesAsAutoloaded:true;
- loadPreRequisitesAsAutoloaded:true; "/ load non-mandatory prerequisites
- projectIsLoaded:true. "/ this performs the postLoadAction, too.
- ].
- Smalltalk isInitialized ifTrue:[
- "really don't know, if and what has changed ...
- ... but assume, that new classes have been installed."
- Smalltalk changed:#postLoad.
- ].
+ Smalltalk flushCachedClasses.
+ Class flushSubclassInfo.
+
+ (definitionClass notNil and:[definitionClass isLoaded]) ifTrue:[
+ definitionClass
+ checkForLoad; "/ raise exception if not supported on platform / not licensed
+ loadAllClassesAsAutoloaded:true;
+ loadPreRequisitesAsAutoloaded:true; "/ load non-mandatory prerequisites
+ projectIsLoaded:true. "/ this performs the postLoadAction, too.
+ ].
+ Smalltalk isInitialized ifTrue:[
+ "really don't know, if and what has changed ...
+ ... but assume, that new classes have been installed."
+ Smalltalk changed:#postLoad.
+ ].
].
^ handle
@@ -1593,26 +1593,26 @@
initAddr notNil ifTrue:[^ initAddr].
(functionName startsWith:'lib') ifTrue:[
- className := functionName
+ className := functionName
] ifFalse:[
- "
- look for reverse abbreviation - slow, because abbrevs are recursively read
- "
- className := functionName. "/ Smalltalk classNameForFile:functionName.
+ "
+ look for reverse abbreviation - slow, because abbrevs are recursively read
+ "
+ className := functionName. "/ Smalltalk classNameForFile:functionName.
].
className notNil ifTrue:[
- initAddr := self getFunction:(className , suffix) from:handle.
- initAddr notNil ifTrue:[^ initAddr].
-
- initAddr := self getFunction:('_' , className , suffix) from:handle.
- initAddr isNil ifTrue:[
- "/
- "/ special for broken ultrix nlist
- "/ (will not find symbol with single underscore)
- "/ workaround: add another underscore and retry
- "/
- initAddr := self getFunction:('__' , className , suffix) from:handle.
- ].
+ initAddr := self getFunction:(className , suffix) from:handle.
+ initAddr notNil ifTrue:[^ initAddr].
+
+ initAddr := self getFunction:('_' , className , suffix) from:handle.
+ initAddr isNil ifTrue:[
+ "/
+ "/ special for broken ultrix nlist
+ "/ (will not find symbol with single underscore)
+ "/ workaround: add another underscore and retry
+ "/
+ initAddr := self getFunction:('__' , className , suffix) from:handle.
+ ].
].
^ initAddr
@@ -3627,94 +3627,94 @@
|key fileName functionName deInitAddr m|
Verbose ifTrue:[
- 'unload module name=' errorPrint. handle pathName errorPrintCR.
+ 'unload module name=' errorPrint. handle pathName errorPrintCR.
].
handle isUnknownHandle ifTrue:[
- Verbose ifTrue:[
- 'module type is not known - assume uninitialized classLib' errorPrintCR.
- ].
- self unregisterModule:handle.
- handle makeClassLibHandle.
+ Verbose ifTrue:[
+ 'module type is not known - assume uninitialized classLib' errorPrintCR.
+ ].
+ self unregisterModule:handle.
+ handle makeClassLibHandle.
] ifFalse:[
- handle isClassLibHandle ifTrue:[
- Verbose ifTrue:[
- 'a classLib - deinit classes' errorPrintCR.
- ].
- self deinitializeClassesFromModule:handle.
- Verbose ifTrue:[
- 'unregister' errorPrintCR.
- ].
- self unregisterModule:handle.
- ] ifFalse:[
- handle isMethodHandle ifTrue:[
- Verbose ifTrue:[
- 'a methodHandle - unregister' errorPrintCR.
- ].
- self unregisterModule:handle.
- ] ifFalse:[
- handle isFunctionObjectHandle ifTrue:[
- Verbose ifTrue:[
- 'a functionObject - fixup functionRefs' errorPrintCR.
- ].
- handle functions do:[:f |
- f notNil ifTrue:[
- f invalidate
- ]
- ].
- ].
-
- "/
- "/ call its deInit function (if present)
- "/
- Verbose ifTrue:[
- 'search for deInit function...' errorPrintCR.
- ].
- fileName := handle pathName asFilename baseName.
- functionName := self initFunctionBasenameForFile:fileName.
-
- deInitAddr := self findFunction:functionName suffix:'__deInit' in:handle.
- deInitAddr notNil ifTrue:[
- Verbose ifTrue:[
- 'invoke deInit function...' errorPrintCR.
- ].
- self
- saveCallInitFunctionAt:deInitAddr
- in:fileName
- specialInit:false
- forceOld:true
- interruptable:false
- argument:0
- identifyAs:handle
- returnsObject:false.
- ]
- ]
- ].
+ handle isClassLibHandle ifTrue:[
+ Verbose ifTrue:[
+ 'a classLib - deinit classes' errorPrintCR.
+ ].
+ self deinitializeClassesFromModule:handle.
+ Verbose ifTrue:[
+ 'unregister' errorPrintCR.
+ ].
+ self unregisterModule:handle.
+ ] ifFalse:[
+ handle isMethodHandle ifTrue:[
+ Verbose ifTrue:[
+ 'a methodHandle - unregister' errorPrintCR.
+ ].
+ self unregisterModule:handle.
+ ] ifFalse:[
+ handle isFunctionObjectHandle ifTrue:[
+ Verbose ifTrue:[
+ 'a functionObject - fixup functionRefs' errorPrintCR.
+ ].
+ handle functions do:[:f |
+ f notNil ifTrue:[
+ f invalidate
+ ]
+ ].
+ ].
+
+ "/
+ "/ call its deInit function (if present)
+ "/
+ Verbose ifTrue:[
+ 'search for deInit function...' errorPrintCR.
+ ].
+ fileName := handle pathName asFilename baseName.
+ functionName := self initFunctionBasenameForFile:fileName.
+
+ deInitAddr := self findFunction:functionName suffix:'__deInit' in:handle.
+ deInitAddr notNil ifTrue:[
+ Verbose ifTrue:[
+ 'invoke deInit function...' errorPrintCR.
+ ].
+ self
+ saveCallInitFunctionAt:deInitAddr
+ in:fileName
+ specialInit:false
+ forceOld:true
+ interruptable:false
+ argument:0
+ identifyAs:handle
+ returnsObject:false.
+ ]
+ ]
+ ].
].
Verbose ifTrue:[
- 'cleanup done - now unload...' errorPrintCR.
+ 'cleanup done - now unload...' errorPrintCR.
].
"/
"/ now, really unload
"/
(self primUnloadDynamicObject:handle) ifFalse:[
- ^ self error:'unloadDynamic failed' mayProceed:true
+ ^ self error:'unloadDynamic failed' mayProceed:true
].
Verbose ifTrue:[
- 'unload done ...' errorPrintCR.
+ 'unload done ...' errorPrintCR.
].
"/
"/ remove from loaded objects
"/
LoadedObjects notNil ifTrue:[
- key := LoadedObjects keyAtEqualValue:handle.
- key notNil ifTrue:[
- LoadedObjects removeKey:key
- ]
+ key := LoadedObjects keyAtEqualValue:handle.
+ key notNil ifTrue:[
+ LoadedObjects removeKey:key
+ ]
].
"
@@ -3722,18 +3722,18 @@
but make it unexecutable. Its still visible in the browser.
"
handle isMethodHandle ifTrue:[
- ((m := handle method) notNil
- and:[m ~~ 0]) ifTrue:[
- m makeUnloaded.
- ]
+ ((m := handle method) notNil
+ and:[m ~~ 0]) ifTrue:[
+ m makeUnloaded.
+ ]
].
handle isClassLibHandle ifTrue:[
- Smalltalk flushCachedClasses.
- Class flushSubclassInfo.
+ Smalltalk flushCachedClasses.
+ Class flushSubclassInfo.
].
handle isMethodHandle ifTrue:[
- ObjectMemory flushCaches.
+ ObjectMemory flushCaches.
].
handle moduleID:nil.
@@ -4148,41 +4148,45 @@
Answer an array with the status symbol and optionally the name of
a class with a bad status."
- |checker checkSymbol statusCode status badClassName|
+ |checker checkSymbol statusCode status badClassName1 badClassName2|
checker := self.
checkSymbol := #classPresentCheck:.
%{ /* NOREGISTER */
- char *badName = NULL;
+ char *badName1 = NULL;
+ char *badName2 = NULL;
char interestingClassName[512], *classNameP = 0;
if (__isStringLike(className)) {
- strncpy(interestingClassName, __stringVal(className), sizeof(interestingClassName));
- classNameP = interestingClassName;
+ strncpy(interestingClassName, __stringVal(className), sizeof(interestingClassName));
+ classNameP = interestingClassName;
}
statusCode = __MKSMALLINT(__check_registration__(classNameP,
- &checker, &checkSymbol,
- &badName));
- if (badName) {
- badClassName = __MKSTRING(badName);
+ &checker, &checkSymbol,
+ &badName1, &badName2));
+ if (badName1) {
+ badClassName1 = __MKSTRING(badName1);
+ }
+ if (badName2) {
+ badClassName2 = __MKSTRING(badName2);
}
%}.
statusCode == 0 ifTrue:[
- status := #ok
+ status := #ok
] ifFalse:[ statusCode == -1 ifTrue:[
- status := #missingClass
+ status := #missingClass
] ifFalse:[ statusCode == -2 ifTrue:[
- status := #versionMismatch
+ status := #versionMismatch
] ifFalse:[ statusCode == -3 ifTrue:[
- status := #unregisteredSuperclass
+ status := #unregisteredSuperclass
] ifFalse:[ statusCode == -4 ifTrue:[
- status := #tryAgain
+ status := #tryAgain
] ifFalse:[
- status := #loadFailed
+ status := #loadFailed
] ] ] ] ].
- ^ Array with:status with:badClassName.
+ ^ Array with:status with:badClassName1 with:badClassName2.
!
moduleInit:phase forceOld:forceOld interruptable:interruptable
@@ -4205,117 +4209,118 @@
performModuleInitAt:initAddr invokeInitializeMethods:invokeInitializeMethods for:className identifyAs:handle
"Initialize a loaded smalltalk module."
- |status badClassName infoCollection info classNames classes
+ |status badClassName1 badClassName2 infoCollection info classNames classes
stillTrying|
"
need 4 passes to init: 0: let module register itself & create its pools/globals
- 0b check if modules superclasses are all loaded
- 1: let it get var-refs to other pools/globals
- 2: let it install install class, methods and literals
- 3: let it send #initialize to its class object
+ 0b check if modules superclasses are all loaded
+ 1: let it get var-refs to other pools/globals
+ 2: let it install install class, methods and literals
+ 3: let it send #initialize to its class object
"
Verbose ifTrue:[
- 'start' errorPrintCR
+ 'start' errorPrintCR
].
[
- stillTrying := false.
-
- "/
- "/ let it register itself
- "/ and define its globals
- "/
- Verbose ifTrue:[
- 'phase 0 (module registration) ...' errorPrintCR
- ].
- self
- saveCallInitFunctionAt:initAddr
- in:nil
- specialInit:true
- forceOld:true
- interruptable:false
- argument:0
- identifyAs:handle
- returnsObject:false.
-
- "/
- "/ check if superclasses are present
- "/
- info := self loadStatusFor:className.
- status := info at:1.
- badClassName := info at:2.
-
- Verbose ifTrue:[
- '... info is ' errorPrint. info errorPrintCR
- ].
-
- (status ~~ #ok) ifTrue:[
- (status == #missingClass) ifTrue:[
- ('ObjectFileLoader [error]: load failed - missing class: ' , badClassName) infoPrintCR.
- ^ info
- ].
- (status == #versionMismatch) ifTrue:[
- ('ObjectFileLoader [error]: load failed - version mismatch: ' , badClassName) infoPrintCR.
- ^ info
- ].
- (status == #unregisteredSuperclass) ifTrue:[
- ('ObjectFileLoader [error]: load failed - unregistered: ' , badClassName) infoPrintCR.
- ^ info
- ].
- (status == #tryAgain) ifTrue:[
- "/ tryAgain:
- "/ must retry after initialization, to initialize
- "/ sub-subclasses of autoloaded classes
- "/ (sigh - class objects are created in phase 3,
- "/ so we must first complete the initialization cycle,
- "/ then do all again, for remaining modules)
- stillTrying := true.
- 'ObjectFileLoader [info]: retry registration of: ' infoPrint.
- (className ? 'a classLib') infoPrint. ' after init' infoPrintCR.
- ] ifFalse:[
- 'ObjectFileLoader [error]: load failed: ' infoPrint. className infoPrintCR.
- ^ #(loadFailed nil)
- ].
- ].
-
- Smalltalk flushCachedClasses.
- Class flushSubclassInfo.
- "/
- "/ remaining initialization
- "/
-
- "/ module exports: declare module-globals & symbols ...
- Verbose ifTrue:[
- 'phase 1 (resolve globals) ...' errorPrintCR
- ].
- self moduleInit:1 forceOld:true interruptable:false.
-
- "/ module-imports: resolve globals ...
- "/ create methods & install ...
- Verbose ifTrue:[
- 'phase 2 (create objects) ...' errorPrintCR
- ].
- self moduleInit:2 forceOld:true interruptable:false.
-
- Verbose ifTrue:[
- 'stillTrying is ' errorPrint. stillTrying errorPrintCR
- ].
+ stillTrying := false.
+
+ "/
+ "/ let it register itself
+ "/ and define its globals
+ "/
+ Verbose ifTrue:[
+ 'phase 0 (module registration) ...' errorPrintCR
+ ].
+ self
+ saveCallInitFunctionAt:initAddr
+ in:nil
+ specialInit:true
+ forceOld:true
+ interruptable:false
+ argument:0
+ identifyAs:handle
+ returnsObject:false.
+
+ "/
+ "/ check if superclasses are present
+ "/
+ info := self loadStatusFor:className.
+ status := info at:1.
+ badClassName1 := info at:2.
+ badClassName2 := info at:3.
+
+ Verbose ifTrue:[
+ '... info is ' errorPrint. info errorPrintCR
+ ].
+
+ (status ~~ #ok) ifTrue:[
+ (status == #missingClass) ifTrue:[
+ ('ObjectFileLoader [error]: load failed - missing class: ' , badClassName1) infoPrintCR.
+ ^ info
+ ].
+ (status == #versionMismatch) ifTrue:[
+ ('ObjectFileLoader [error]: load failed - version mismatch: ',badClassName1,' vs. ',badClassName2) infoPrintCR.
+ ^ info
+ ].
+ (status == #unregisteredSuperclass) ifTrue:[
+ ('ObjectFileLoader [error]: load failed - unregistered: ' , badClassName1) infoPrintCR.
+ ^ info
+ ].
+ (status == #tryAgain) ifTrue:[
+ "/ tryAgain:
+ "/ must retry after initialization, to initialize
+ "/ sub-subclasses of autoloaded classes
+ "/ (sigh - class objects are created in phase 3,
+ "/ so we must first complete the initialization cycle,
+ "/ then do all again, for remaining modules)
+ stillTrying := true.
+ 'ObjectFileLoader [info]: retry registration of: ' infoPrint.
+ (className ? 'a classLib') infoPrint. ' after init' infoPrintCR.
+ ] ifFalse:[
+ 'ObjectFileLoader [error]: load failed: ' infoPrint. className infoPrintCR.
+ ^ #(loadFailed nil)
+ ].
+ ].
+
+ Smalltalk flushCachedClasses.
+ Class flushSubclassInfo.
+ "/
+ "/ remaining initialization
+ "/
+
+ "/ module exports: declare module-globals & symbols ...
+ Verbose ifTrue:[
+ 'phase 1 (resolve globals) ...' errorPrintCR
+ ].
+ self moduleInit:1 forceOld:true interruptable:false.
+
+ "/ module-imports: resolve globals ...
+ "/ create methods & install ...
+ Verbose ifTrue:[
+ 'phase 2 (create objects) ...' errorPrintCR
+ ].
+ self moduleInit:2 forceOld:true interruptable:false.
+
+ Verbose ifTrue:[
+ 'stillTrying is ' errorPrint. stillTrying errorPrintCR
+ ].
] doWhile:[stillTrying].
Verbose ifTrue:[
- 'end' errorPrintCR
+ 'end' errorPrintCR
].
ObjectMemory flushCaches.
invokeInitializeMethods ifTrue:[
- Verbose ifTrue:[
- 'phase 3 (send #initialize) ...' errorPrintCR
- ].
- "/ initialize ...
- self moduleInit:3 forceOld:false interruptable:true.
+ Verbose ifTrue:[
+ 'phase 3 (send #initialize) ...' errorPrintCR
+ ].
+ "/ initialize ...
+ self moduleInit:3 forceOld:false interruptable:true.
].
"/ ask objectMemory for the classes we have just loaded
@@ -4324,25 +4329,25 @@
infoCollection := ObjectMemory binaryModuleInfo.
info := infoCollection at:handle moduleID ifAbsent:nil.
info isNil ifTrue:[
- "/ mhmh registration failed -
- 'ObjectFileLoader [error]: registration failed: ' infoPrint.
- (className ? 'some classLib') infoPrintCR.
- ^ #(registrationFailed nil)
+ "/ mhmh registration failed -
+ 'ObjectFileLoader [error]: registration failed: ' infoPrint.
+ (className ? 'some classLib') infoPrintCR.
+ ^ #(registrationFailed nil)
].
classNames := info classNames.
classNames notEmptyOrNil ifTrue:[
- classes := OrderedCollection new:classNames size.
- classNames do:[:eachClassName | |class|
- class := Smalltalk classNamed:eachClassName.
- class notNil ifTrue:[
- classes add:class.
- ].
- ].
+ classes := OrderedCollection new:classNames size.
+ classNames do:[:eachClassName | |class|
+ class := Smalltalk classNamed:eachClassName.
+ class notNil ifTrue:[
+ classes add:class.
+ ].
+ ].
].
classes notEmptyOrNil ifTrue:[
- classes := classes asArray.
- classes := classes , (classes collect:[:aClass | aClass class]).
+ classes := classes asArray.
+ classes := classes , (classes collect:[:aClass | aClass class]).
].
handle classes:classes.