--- a/ObjectFileLoader.st Tue Jan 07 21:19:39 1997 +0100
+++ b/ObjectFileLoader.st Wed Jan 08 18:16:05 1997 +0100
@@ -492,32 +492,34 @@
"Modified: 30.10.1996 / 13:26:38 / cg"
! !
-!ObjectFileLoader class methodsFor:'dynamic class loading'!
+!ObjectFileLoader class methodsFor:'dynamic object loading'!
loadCPlusPlusObjectFile:aFileName
- "load a c++ object file (.o-file) into the image"
+ "load a c++ object file (.o-file) into the image.
+ This method is not maintained (name mangling and static
+ initialization is so different among systems ...)"
|handle initAddr list|
handle := self loadDynamicObject:aFileName.
handle isNil ifTrue:[
- Transcript showCR:('loadDynamic: ',aFileName,' failed.').
- ^ nil
+ Transcript showCR:('loadDynamic: ',aFileName,' failed.').
+ ^ nil
].
list := self namesMatching:'__GLOBAL_$I*' segment:'[tT]' in:aFileName.
list size == 1 ifTrue:[
"/ (self isCPlusPlusObject:handle) ifTrue:[
- Verbose ifTrue:[
- 'a c++ object file' infoPrintNL.
- ].
- "
- what I would like to get is the CTOR_LIST,
- and call each function.
- But dld cannot (currently) handle SET-type symbols, therefore
- we search (using nm) for all __GLOBAL_$I* syms, get their values
- and call them each
- "
+ Verbose ifTrue:[
+ 'a c++ object file' infoPrintNL.
+ ].
+ "
+ what I would like to get is the CTOR_LIST,
+ and call each function.
+ But dld cannot (currently) handle SET-type symbols, therefore
+ we search (using nm) for all __GLOBAL_$I* syms, get their values
+ and call them each
+ "
"/ list := self namesMatching:'__GLOBAL_$I*' segment:'[tT]' in:aFileName.
"/ initAddr := self getFunction:'__CTOR_LIST__' from:handle.
@@ -525,68 +527,69 @@
"/ ('calling CTORs at:' , (initAddr printStringRadix:16)) infoPrintNL
"/ ].
- initAddr := self getFunction:list first from:handle.
- initAddr isNil ifTrue:[
- "
- try with added underscore
- "
- initAddr := self getFunction:('_' , list first) from:handle.
- ].
- (initAddr isNil and:[list first startsWith:'_']) ifTrue:[
- "
- try with removed underscore
- "
- initAddr := self getFunction:(list first copyFrom:2) from:handle.
- ].
- initAddr isNil ifTrue:[
- Verbose ifTrue:[
- ('no CTOR-func found (' , list first , ')') infoPrintNL.
- ].
- self unloadDynamicObject:aFileName.
- ^ nil
- ].
- Verbose ifTrue:[
- ('calling CTORs at:' , (initAddr printStringRadix:16)) infoPrintNL
- ].
- self callInitFunctionAt:initAddr
- specialInit:false
- forceOld:false
- interruptable:false
- argument:0
- identifyAs:nil
- returnsObject:false.
-
- Verbose ifTrue:[
- 'done with CTORs.' infoPrintNL
- ].
-
- "
- cannot create a CPlusPlus class automatically (there could be more than
- one classes in it too ...)
- "
- ^ handle
+ initAddr := self getFunction:list first from:handle.
+ initAddr isNil ifTrue:[
+ "
+ try with added underscore
+ "
+ initAddr := self getFunction:('_' , list first) from:handle.
+ ].
+ (initAddr isNil and:[list first startsWith:'_']) ifTrue:[
+ "
+ try with removed underscore
+ "
+ initAddr := self getFunction:(list first copyFrom:2) from:handle.
+ ].
+ initAddr isNil ifTrue:[
+ Verbose ifTrue:[
+ ('no CTOR-func found (' , list first , ')') infoPrintNL.
+ ].
+ self unloadDynamicObject:aFileName.
+ ^ nil
+ ].
+ Verbose ifTrue:[
+ ('calling CTORs at:' , (initAddr printStringRadix:16)) infoPrintNL
+ ].
+ self callInitFunctionAt:initAddr
+ specialInit:false
+ forceOld:false
+ interruptable:false
+ argument:0
+ identifyAs:nil
+ returnsObject:false.
+
+ Verbose ifTrue:[
+ 'done with CTORs.' infoPrintNL
+ ].
+
+ "
+ cannot create a CPlusPlus class automatically (there could be more than
+ one classes in it too ...)
+ "
+ ^ handle
].
Verbose ifTrue:[
- 'unknown object file' infoPrintNL
+ 'unknown object file' infoPrintNL
].
self unloadDynamicObject:aFileName.
^ nil
- "Modified: 18.5.1996 / 15:43:50 / cg"
+ "Modified: 8.1.1997 / 18:09:10 / cg"
!
loadClass:aClassName fromObjectFile:aFileName
- "load a compiled class (.o-file) into the image"
+ "load a compiled class (.o-file) into the image.
+ Returns the class or nil."
|handle initAddr symName newClass moreHandles info status
otherClass knownToBeOk|
handle := self loadDynamicObject:aFileName.
handle isNil ifTrue:[
- Transcript showCR:('loadDynamic: ', aFileName,' failed.').
- ^ nil
+ Transcript showCR:('loadDynamic: ', aFileName,' failed.').
+ ^ nil
].
"
@@ -595,9 +598,9 @@
symName := '_' , aClassName , '_Init'.
initAddr := self getFunction:symName from:handle.
initAddr isNil ifTrue:[
- "try with added underscore"
- symName := '__' , aClassName , '_Init'.
- initAddr := self getFunction:symName from:handle.
+ "try with added underscore"
+ symName := '__' , aClassName , '_Init'.
+ initAddr := self getFunction:symName from:handle.
].
knownToBeOk := true.
@@ -631,88 +634,88 @@
"/ ].
initAddr notNil ifTrue:[
- Verbose ifTrue:[
- ('calling init at: ' , (initAddr printStringRadix:16)) infoPrintNL.
- ].
- info := self performModuleInitAt:initAddr for:aClassName identifyAs:handle.
- status := info at:1.
- "
- if any classes are missing ...
- "
- (status == #missingClass) ifTrue:[
- "
- ... and we are loading a module ...
- "
- Transcript showCR:'try for missing class in same object ...'.
- Verbose ifTrue:[
- 'try for missing class:' infoPrint. (info at:2) infoPrintNL.
- ].
- otherClass := self loadClass:(info at:2) fromObjectFile:aFileName.
- otherClass notNil ifTrue:[
- "
- try again ...
- "
- Transcript showCR:'missing class is here; try again ...'.
- info := self performModuleInitAt:initAddr for:aClassName identifyAs:handle.
- status := info at:1.
- ]
- ].
-
- Verbose ifTrue:[
- 'done init status=' infoPrint. info infoPrintNL.
- ].
- (status == #unregisteredSuperclass) ifTrue:[
- Transcript showCR:'superclass is not registered'.
- ].
-
- (Symbol hasInterned:aClassName) ifTrue:[
- newClass := Smalltalk at:aClassName asSymbol ifAbsent:[nil].
- Verbose ifTrue:[
- 'newClass is: ' infoPrint. newClass infoPrintNL
- ].
- newClass notNil ifTrue:[
- Verbose ifTrue:[
- 'initialize newClass ...' infoPrintNL
- ].
- newClass initialize.
- "force cache flush"
- Smalltalk at:aClassName asSymbol put:newClass.
- Smalltalk isInitialized ifTrue:[
- Smalltalk changed.
- ]
- ].
- ] ifFalse:[
- 'LOADER: class ' errorPrint. aClassName errorPrint.
- ' did not define itself' errorPrintNL
- "
- do not unload - could have installed other classes/methods ...
- "
- ].
- ^ newClass
+ Verbose ifTrue:[
+ ('calling init at: ' , (initAddr printStringRadix:16)) infoPrintNL.
+ ].
+ info := self performModuleInitAt:initAddr for:aClassName identifyAs:handle.
+ status := info at:1.
+ "
+ if any classes are missing ...
+ "
+ (status == #missingClass) ifTrue:[
+ "
+ ... and we are loading a module ...
+ "
+ Transcript showCR:'try for missing class in same object ...'.
+ Verbose ifTrue:[
+ 'try for missing class:' infoPrint. (info at:2) infoPrintNL.
+ ].
+ otherClass := self loadClass:(info at:2) fromObjectFile:aFileName.
+ otherClass notNil ifTrue:[
+ "
+ try again ...
+ "
+ Transcript showCR:'missing class is here; try again ...'.
+ info := self performModuleInitAt:initAddr for:aClassName identifyAs:handle.
+ status := info at:1.
+ ]
+ ].
+
+ Verbose ifTrue:[
+ 'done init status=' infoPrint. info infoPrintNL.
+ ].
+ (status == #unregisteredSuperclass) ifTrue:[
+ Transcript showCR:'superclass is not registered'.
+ ].
+
+ (Symbol hasInterned:aClassName) ifTrue:[
+ newClass := Smalltalk at:aClassName asSymbol ifAbsent:[nil].
+ Verbose ifTrue:[
+ 'newClass is: ' infoPrint. newClass infoPrintNL
+ ].
+ newClass notNil ifTrue:[
+ Verbose ifTrue:[
+ 'initialize newClass ...' infoPrintNL
+ ].
+ newClass initialize.
+ "force cache flush"
+ Smalltalk at:aClassName asSymbol put:newClass.
+ Smalltalk isInitialized ifTrue:[
+ Smalltalk changed.
+ ]
+ ].
+ ] ifFalse:[
+ 'LOADER: class ' errorPrint. aClassName errorPrint.
+ ' did not define itself' errorPrintNL
+ "
+ do not unload - could have installed other classes/methods ...
+ "
+ ].
+ ^ newClass
].
Verbose ifTrue:[
- ('no symbol: ', symName,' in ',aFileName) infoPrintNL.
+ ('no symbol: ', symName,' in ',aFileName) infoPrintNL.
].
"
unload
"
Verbose ifTrue:[
- 'unloading due to init failure:' infoPrint. handle pathName infoPrintNL.
+ 'unloading due to init failure:' infoPrint. handle pathName infoPrintNL.
].
moreHandles notNil ifTrue:[
- moreHandles do:[:aHandle |
- Verbose ifTrue:[
- ('unloading: ', aHandle printString) infoPrintNL.
- ].
- self unloadDynamicObject:handle.
- ]
+ moreHandles do:[:aHandle |
+ Verbose ifTrue:[
+ ('unloading: ', aHandle printString) infoPrintNL.
+ ].
+ self unloadDynamicObject:handle.
+ ]
].
Verbose ifTrue:[
- ('unloading: ', handle printString) infoPrintNL.
+ ('unloading: ', handle printString) infoPrintNL.
].
self unloadDynamicObject:handle.
^ nil
@@ -723,7 +726,7 @@
ObjectFileLoader loadClass:'Foo' fromObjectFile:'classList.o'
"
- "Modified: 18.5.1996 / 15:45:35 / cg"
+ "Modified: 8.1.1997 / 18:09:45 / cg"
!
loadMethodObjectFile:aFileName
@@ -784,81 +787,43 @@
"Modified: 12.7.1996 / 13:26:41 / cg"
!
-loadModulesFromListOfUndefined:list
- "try to figure out what has to be loaded to resolve symbols from list.
- return a list of handles of loaded objects
- "
- |inits classNames|
-
- inits := list select:[:symbol | symbol notNil and:[symbol endsWith:'_Init']].
- inits notNil ifTrue:[
- classNames := inits collect:[:symbol |
- (symbol startsWith:'___') ifTrue:[
- symbol copyFrom:4 to:(symbol size - 5)
- ] ifFalse:[
- (symbol startsWith:'__') ifTrue:[
- symbol copyFrom:3 to:(symbol size - 5)
- ] ifFalse:[
- (symbol startsWith:'_') ifTrue:[
- symbol copyFrom:2 to:(symbol size - 5)
- ] ifFalse:[
- symbol
- ]
- ]
- ]
- ].
- "
- autoload those classes
- "
- classNames do:[:aClassName |
- |cls|
-
- (cls := Smalltalk classNamed:aClassName) notNil ifTrue:[
- 'autoloading ' infoPrint. aClassName infoPrintNL.
- cls autoload
- ]
- ]
- ].
- ^ nil
-
- "Modified: 17.12.1995 / 16:00:27 / cg"
-!
-
loadObjectFile:aFileName
"load an object file (.o-file) into the image;
the class name is not needed (multiple definitions may be in the file).
- Return false on error, true if ok."
+ This may be either a smalltalk object or a C-object file.
+ Return nil on error, an objectFile handle if ok."
|handle initAddr className initNames didInit info status
- dummyHandle msg|
+ dummyHandle msg isCModule|
handle := self loadDynamicObject:aFileName.
handle isNil ifTrue:[
- Transcript showCR:('loadDynamic: ',aFileName,' failed.').
- ^ false
+ Transcript showCR:('loadDynamic: ',aFileName,' failed.').
+ ^ nil
].
didInit := false.
+ isCModule := false.
"/ with dld, load may have worked, even if undefined symbols
"/ are to be resolved. If thats the case, load all libraries ...
SearchedLibraries notNil ifTrue:[
- (self hasUndefinedSymbolsIn:handle) ifTrue:[
- SearchedLibraries do:[:libName |
- (self hasUndefinedSymbolsIn:handle) ifTrue:[
- Transcript showCR:' ... trying ' , libName , ' to resolve undefined symbols ...'.
- dummyHandle := Array new:4.
- dummyHandle := self primLoadDynamicObject:libName into:dummyHandle.
+ (self hasUndefinedSymbolsIn:handle) ifTrue:[
+ SearchedLibraries do:[:libName |
+ (self hasUndefinedSymbolsIn:handle) ifTrue:[
+ Transcript showCR:' ... trying ' , libName , ' to resolve undefined symbols ...'.
+ 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:[
- Transcript showCR:('loadDynamic: still undefined symbols in ',aFileName,'.').
- ].
- ]
+ ]
+ ].
+ (self hasUndefinedSymbolsIn:handle) isNil ifTrue:[
+ Transcript showCR:('loadDynamic: still undefined symbols in ',aFileName,'.').
+ ].
+ ]
].
"
@@ -876,97 +841,107 @@
initAddr := self findInitFunction:className in:handle.
initAddr notNil ifTrue:[
- Verbose ifTrue:[
- ('calling init at:' , (initAddr printStringRadix:16)) infoPrintNL.
- ].
- info := self performModuleInitAt:initAddr for:nil identifyAs:handle.
- status := info at:1.
- status == #ok ifTrue:[
- didInit := true.
- ]
+ Verbose ifTrue:[
+ ('calling init at:' , (initAddr printStringRadix:16)) infoPrintCR.
+ ].
+ info := self performModuleInitAt:initAddr for:nil identifyAs:handle.
+ status := info at:1.
+ status == #ok ifTrue:[
+ didInit := true.
+ ]
] ifFalse:[
- "/
- "/ look for explicit C-init (xxx__Init) function
- "/ This is used in C object files
- "/
- initAddr := self findFunction:className suffix:'__Init' in:handle.
- initAddr notNil ifTrue:[
- (self callInitFunctionAt:initAddr
- specialInit:false
- forceOld:true
- interruptable:false
- argument:0
- identifyAs:handle
- returnsObject:false) < 0 ifTrue:[
-
- Verbose ifTrue:[
- 'init function return failure ... unload' infoPrintNL.
- ].
- status := #initFailed.
- ] ifFalse:[
- didInit := true
- ]
- ] ifFalse:[
- "
- look for any init-function(s); call them all
- "
- Verbose ifTrue:[
- 'no good init functions found; looking for candidates ...' infoPrintNL.
- ].
- initNames := self namesMatching:'*_Init' segment:'[tT]' in:aFileName.
- 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 ',aFileName).
- ] ifFalse:[
- Verbose ifTrue:[
- ('calling init at:' , (initAddr printStringRadix:16)) infoPrintNL
- ].
- self performModuleInitAt:initAddr for:nil identifyAs:handle.
- didInit := true.
- ]
- ].
- ].
- ]
+ "/
+ "/ look for explicit C-init (xxx__Init) function
+ "/ This is used in C object files
+ "/
+ initAddr := self findFunction:className suffix:'__Init' in:handle.
+ initAddr notNil ifTrue:[
+ isCModule := true.
+ (self callInitFunctionAt:initAddr
+ specialInit:false
+ forceOld:true
+ interruptable:false
+ argument:0
+ identifyAs:handle
+ returnsObject:false) < 0 ifTrue:[
+
+ Verbose ifTrue:[
+ 'init function return failure ... unload' infoPrintCR.
+ ].
+ status := #initFailed.
+ ] ifFalse:[
+ didInit := true.
+ ]
+ ] ifFalse:[
+ "
+ look for any init-function(s); call them all
+ "
+ Verbose ifTrue:[
+ 'no good init functions found; looking for candidates ...' infoPrintCR.
+ ].
+ initNames := self namesMatching:'*_Init' segment:'[tT]' in:aFileName.
+ 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 ',aFileName).
+ ] ifFalse:[
+ Verbose ifTrue:[
+ ('calling init at:' , (initAddr printStringRadix:16)) infoPrintCR
+ ].
+ self performModuleInitAt:initAddr for:nil identifyAs:handle.
+ didInit := true.
+ ]
+ ].
+ ].
+ ]
].
didInit ifFalse:[
- status == #registrationFailed ifTrue:[
- Transcript showCR:'incompatible object (recompile without commonSymbols ?)'
- ].
- status ~~ #initFailed ifTrue:[
- self listUndefinedSymbolsIn:handle.
- ].
-
- self unloadDynamicObject:handle.
-
- status == #initFailed ifTrue:[
- msg := 'module not loaded (init function signalled failure).'
- ] ifFalse:[
- (self namesMatching:'*__sepInitCode__*' segment:'[tT]' in:aFileName) notNil ifTrue:[
- msg := 'module not loaded (no _Init entry - looks like an incomplete sepInitCode object).'
- ] ifFalse:[
- msg := 'module not loaded (no _Init entry in object file ?).'
- ].
- ].
- Transcript showCR:msg
+ status == #registrationFailed ifTrue:[
+ Transcript showCR:'incompatible object (recompile without commonSymbols ?)'
+ ].
+ status ~~ #initFailed ifTrue:[
+ self listUndefinedSymbolsIn:handle.
+ ].
+
+ Verbose ifTrue:[
+ 'unloading, since init failed ...' infoPrintCR.
+ ].
+ self unloadDynamicObject:handle.
+
+ status == #initFailed ifTrue:[
+ msg := 'module not loaded (init function signalled failure).'
+ ] ifFalse:[
+ (self namesMatching:'*__sepInitCode__*' segment:'[tT]' in:aFileName) notNil ifTrue:[
+ msg := 'module not loaded (no _Init entry - looks like an incomplete sepInitCode object).'
+ ] ifFalse:[
+ msg := 'module not loaded (no _Init entry in object file ?).'
+ ].
+ ].
+ Transcript showCR:msg
].
- Smalltalk isInitialized ifTrue:[
- "
- really dont know, if it has changed ...
- "
- Smalltalk changed.
+ isCModule ifTrue:[
+ didInit ifFalse:[
+ ^ nil
+ ]
+ ] ifFalse:[
+ Smalltalk isInitialized ifTrue:[
+ "
+ really dont know, if it has changed ...
+ "
+ Smalltalk changed.
+ ]
].
- ^ true
-
- "Modified: 24.10.1996 / 10:19:25 / cg"
+ ^ handle
+
+ "Modified: 8.1.1997 / 18:14:12 / cg"
!
unloadAllObsoleteObjectFiles
@@ -1015,7 +990,7 @@
self unloadDynamicObject:handle
! !
-!ObjectFileLoader class methodsFor:'dynamic object access'!
+!ObjectFileLoader class methodsFor:'dynamic object queries'!
findFunction:functionName suffix:suffix in:handle
"look for the init function and returns its address"
@@ -1531,97 +1506,6 @@
"Modified: 18.5.1996 / 15:43:45 / cg"
!
-loadDynamicObject:pathName
- "load an object-file (load/map into my address space).
- Return a non-nil handle if ok, nil otherwise.
- No bindings are done - only a pure load is performed.
- This function is not supported on all architectures.
- "
-
- |handle buffer|
-
- Verbose ifTrue:[
- ('loadDynamic: ' , pathName , ' ...') infoPrintNL
- ].
-
- "/ already loaded ?
-
- LoadedObjects notNil ifTrue:[
- handle := LoadedObjects at:pathName ifAbsent:nil.
- handle notNil ifTrue:[
- Verbose ifTrue:[
- ('... ' , pathName , ' already loaded.') infoPrintNL.
- ].
- ^ handle
- ].
- ].
-
- "/
- "/ the 1st two entries are system dependent;
- "/ entry 3 is the pathName
- "/ entry 4 is a unique ID
- "/
- buffer := Array new:4.
- buffer at:3 put:pathName.
- buffer at:4 put:NextHandleID. NextHandleID := NextHandleID + 1.
-
- buffer := self primLoadDynamicObject:pathName into:buffer.
- buffer isNil ifTrue:[
- LastError == #notImplemented ifTrue:[
- Verbose ifTrue:[
- 'no dynamic load facility or load failed.' infoPrintNL.
- ].
- ].
- buffer isNil ifTrue:[
- LastError == #linkError ifTrue:[
- LinkErrorMessage notNil ifTrue:[
- Transcript showCR:'Load error:' , LinkErrorMessage
- ].
- ].
- ^ nil
- ]
- ].
-
- "
- remember loaded object for later unloading
- "
- handle := ObjectFileHandle new.
- handle sysHandle1:(buffer at:1).
- handle sysHandle2:(buffer at:2).
- handle pathName:(buffer at:3).
- handle moduleID:(buffer at:4).
-
- LoadedObjects isNil ifTrue:[
- LoadedObjects := Dictionary new.
- ].
- LoadedObjects at:pathName put:handle.
- Smalltalk flushCachedClasses.
-
- Verbose ifTrue:[
- ('loadDynamic ok; handle is: ' , handle printString) infoPrintNL.
- ].
-
- ^ handle
-
- "sys5.4:
- |handle|
- handle := ObjectFileLoader loadDynamicObject:'../stc/mod1.so'.
- ObjectFileLoader getFunction:'module1' from:handle
- "
- "next:
- |handle|
- handle := ObjectFileLoader loadDynamicObject:'../goodies/Path/AbstrPath.o'.
- ObjectFileLoader getFunction:'__AbstractPath_Init' from:handle
- "
- "GLD:
- |handle|
- handle := ObjectFileLoader loadDynamicObject:'../clients/Tetris/Tetris.o'.
- ObjectFileLoader getFunction:'__TetrisBlock_Init' from:handle
- "
-
- "Modified: 18.5.1996 / 15:43:56 / cg"
-!
-
namesMatching:aPattern segment:segmentPattern in:aFileName
"this is rubbish - it will vanish soon"
@@ -1670,347 +1554,6 @@
"Modified: 7.3.1996 / 19:20:01 / cg"
!
-primLoadDynamicObject:pathName into:anInfoBuffer
- "load an object-file (map into my address space).
- Return an OS-handle (whatever that is) - where some space
- (a 3-element array) has to be passed in for this.
- The first two entries are used in a machine dependent way,
- and callers may not depend on what is found there
- (instead, only pass around handles transparently).
- This function is not supported on all architectures."
-
-%{ /* CALLSUNLIMITEDSTACK */
-
- if (! __isArray(anInfoBuffer)
- || (_arraySize(anInfoBuffer) < 3)) {
- return nil;
- }
-
-#ifdef GNU_DL
- {
- static firstCall = 1;
- extern char *__myName__;
- extern dld_ignore_redefinitions;
-
- if (firstCall) {
- firstCall = 0;
- (void) dld_init (__myName__);
- dld_ignore_redefinitions = 1;
- }
-
- if (__isString(pathName)) {
- if (dld_link(__stringVal(pathName))) {
- if (ObjectFileLoader_Verbose == true) {
- printf ("link file %s failed\n", __stringVal(pathName));
- dld_perror("cant link");
- }
- ObjectFileLoader_LastError = @symbol(linkError);
- RETURN ( nil );
- }
- __ArrayInstPtr(anInfoBuffer)->a_element[0] = pathName;
- __STORE(anInfoBuffer, pathName);
- RETURN ( anInfoBuffer );
- }
- RETURN ( nil );
- }
-#endif
-
-#ifdef WIN_DL
- {
- HINSTANCE handle;
- int err;
-
- if (__isString(pathName)) {
- if ((handle = LoadLibrary(__stringVal(pathName))) == NULL) {
- err = GetLastError();
- if (ObjectFileLoader_Verbose == true) {
- printf ("LoadLibrary %s failed; error: %x\n",
- __stringVal(pathName), err);
- }
- ObjectFileLoader_LastError = __MKINT(err);
- RETURN ( nil );
- }
- __ArrayInstPtr(anInfoBuffer)->a_element[0] = __MKSMALLINT( (int)handle & 0xFFFF );
- __ArrayInstPtr(anInfoBuffer)->a_element[1] = __MKSMALLINT( ((int)handle >> 16) & 0xFFFF );
- RETURN ( anInfoBuffer );
- }
- RETURN ( nil );
- }
-#endif
-
-#ifdef DL1_6
- {
- extern char *__myName__;
- char *ldname;
- OBJ tmpName;
-
- if (__isString(pathName)) {
- if ( dl_loadmod_only(__myName__, __stringVal(pathName), &ldname) == 0 ) {
- if (ObjectFileLoader_Verbose == true) {
- printf ("link file %s failed\n", __stringVal(pathName));
- }
- RETURN ( nil );
- }
- /*
- * returns the name of the temporary ld-file
- * use that as handle ...
- */
- tmpName = __MKSTRING(ldname);
- __ArrayInstPtr(anInfoBuffer)->a_element[0] = tmpName;
- __STORE(anInfoBuffer, tmpName);
- RETURN ( anInfoBuffer );
- }
- RETURN ( nil );
- }
-#endif
-
-#ifdef AIX_DL
- {
- extern char *__myName__;
- char *objName, *libPath;
- int *handle;
- extern errno;
-
- if (__isString(pathName)) {
- objName = __stringVal(pathName);
-
- if (__isString(@global(LibPath))) {
- libPath = __stringVal(@global(LibPath));
- } else {
- libPath = (char *)0;
- }
- if ( (handle = (int *) load(objName, 0, libPath)) == 0 ) {
- if (ObjectFileLoader_Verbose == true) {
- char *messages[64];
- int i;
-
- printf ("load file %s failed errno=%d\n",
- objName, errno);
- switch (errno) {
- case ENOEXEC:
- printf(" load messages:\n");
- loadquery(L_GETMESSAGES, messages, sizeof(messages));
- for (i=0; messages[i]; i++) {
- printf(" %s\n", messages[i]);
- }
- break;
- }
- }
- RETURN ( nil );
- }
- if (ObjectFileLoader_Verbose == true) {
- printf("load %s handle = %x\n", objName, handle);
- }
-
- __ArrayInstPtr(anInfoBuffer)->a_element[0] = __MKSMALLINT( (int)handle & 0xFFFF );
- __ArrayInstPtr(anInfoBuffer)->a_element[1] = __MKSMALLINT( ((int)handle >> 16) & 0xFFFF );
- RETURN (anInfoBuffer);
- }
- RETURN ( nil );
- }
-#endif
-
-#ifdef SYSV4_DL
- {
- void *handle;
- char *nm;
- char *errMsg;
-
- if ((pathName == nil) || __isString(pathName)) {
- handle = (void *)dlopen(pathName == nil ? 0 : __stringVal(pathName), RTLD_NOW);
-
- if (! handle) {
- errMsg = (char *) dlerror();
- fprintf(stderr, "dlopen %s error:\n", __stringVal(pathName));
- fprintf(stderr, " <%s>\n", errMsg);
- ObjectFileLoader_LastError = @symbol(linkError);
- ObjectFileLoader_LinkErrorMessage = __MKSTRING(errMsg);
- RETURN (nil);
- }
-
- if (ObjectFileLoader_Verbose == true) {
- printf("open %s handle = %x\n", __stringVal(pathName), handle);
- }
-
- __ArrayInstPtr(anInfoBuffer)->a_element[0] = __MKSMALLINT( (int)handle & 0xFFFF );
- __ArrayInstPtr(anInfoBuffer)->a_element[1] = __MKSMALLINT( ((int)handle >> 16) & 0xFFFF );
- RETURN (anInfoBuffer);
- }
- }
-#endif
-
-#ifdef SUN_DL
- {
- void *handle;
-
- if ((pathName == nil) || __isString(pathName)) {
- if (pathName == nil)
- handle = dlopen((char *)0, 1);
- else
- handle = dlopen(__stringVal(pathName), 1);
-
- if (! handle) {
- fprintf(stderr, "dlopen %s error: <%s>\n",
- __stringVal(pathName), dlerror());
- ObjectFileLoader_LastError = @symbol(linkError);
- RETURN (nil);
- }
-
- if (ObjectFileLoader_Verbose == true) {
- printf("open %s handle = %x\n", __stringVal(pathName), handle);
- }
-
- __ArrayInstPtr(anInfoBuffer)->a_element[0] = __MKSMALLINT( (int)handle & 0xFFFF );
- __ArrayInstPtr(anInfoBuffer)->a_element[1] = __MKSMALLINT( ((int)handle >> 16) & 0xFFFF );
- RETURN (anInfoBuffer);
- }
- }
-#endif
-
-#ifdef NEXT_DL
- {
- long result;
- char *files[2];
- NXStream *errOut;
-
- if (__isString(pathName)) {
- files[0] = (char *) __stringVal(pathName);
- files[1] = (char *) 0;
- errOut = NXOpenFile(2, 2);
- result = rld_load(errOut,
- (struct mach_header **)0,
- files,
- (char *)0);
- NXClose(errOut);
- if (! result) {
- ObjectFileLoader_LastError = @symbol(linkError);
- fprintf(stderr, "rld_load %s failed\n", __stringVal(pathName));
- RETURN (nil);
- }
-
- if (ObjectFileLoader_Verbose == true)
- printf("rld_load %s ok\n", __stringVal(pathName));
-
- __ArrayInstPtr(anInfoBuffer)->a_element[0] = pathName;
- __STORE(anInfoBuffer, pathName);
- RETURN ( anInfoBuffer );
- }
- }
-#endif
-%}.
- LastError := #notImplemented.
- ^ nil
-!
-
-primUnloadDynamicObject:aHandle
- "unload an object-file (unmap from my address space).
- This is a low-level entry, which does not care if there are
- still any code references (from blocks or methods) to this
- module. Calling it for still living classes will definitely
- lead to some fatal conditions to occur later."
-
- |sysHandle1 sysHandle2|
-
- sysHandle1 := aHandle sysHandle1.
- sysHandle2 := aHandle sysHandle2.
-
-%{
-#ifdef GNU_DL
- if (__isString(sysHandle1)) {
- if (dld_unlink_by_file(__stringVal(sysHandle1), 1)) {
- if (ObjectFileLoader_Verbose == true) {
- printf ("unlink file %s failed\n", __stringVal(sysHandle1));
- dld_perror("cant unlink");
- }
- RETURN (false);
- }
- RETURN (true);
- }
- RETURN (false);
-#endif
-
-#ifdef WIN_DL
- int val;
- HINSTANCE handle;
- int err;
-
- if (__bothSmallInteger(sysHandle1, sysHandle2)) {
- val = (_intVal(sysHandle2) << 16) + _intVal(sysHandle1);
- handle = (HINSTANCE)(val);
-
- if (FreeLibrary(handle) != TRUE) {
- err = GetLastError();
- if (ObjectFileLoader_Verbose == true) {
- printf ("unlink file %s failed; error: %x\n",
- __stringVal(sysHandle1), err);
- }
- RETURN (false);
- }
- RETURN (true);
- }
- RETURN (false);
-#endif
-
-#ifdef SYSV4_DL
- {
- void *h;
- int val;
- OBJ low = sysHandle1, hi = sysHandle2;
-
- if (__bothSmallInteger(low, hi)) {
- val = (_intVal(hi) << 16) + _intVal(low);
- h = (void *)(val);
- if (ObjectFileLoader_Verbose == true)
- printf("close handle = %x\n", h);
- if (dlclose(h) != 0) {
- fprintf(stderr, "dlclose failed with:<%s>\n", dlerror());
- RETURN (false);
- }
- RETURN (true);
- }
- }
-#endif
-
-#ifdef SUN_DL
- {
- void *h;
- int val;
- OBJ low = sysHandle1, hi = sysHandle2;
-
- if (__bothSmallInteger(low, hi)) {
- val = (_intVal(hi) << 16) + _intVal(low);
- h = (void *)(val);
- if (ObjectFileLoader_Verbose == true)
- printf("close handle = %x\n", h);
- dlclose(h);
- RETURN (true);
- }
- }
-#endif
-
-#ifdef AIX_DL
- {
- int *h;
- int val;
- OBJ low = sysHandle1, hi = sysHandle2;
-
- if (__bothSmallInteger(low, hi)) {
- val = (_intVal(hi) << 16) + _intVal(low);
- h = (int *)(val);
- if (ObjectFileLoader_Verbose == true)
- printf("unload handle = %x\n", h);
- if ( unload(h) != 0) {
- fprintf(stderr, "unload failed\n");
- RETURN (false);
- }
- RETURN (true);
- }
- }
-#endif
-%}.
- ^ false
-!
-
releaseSymbolTable
"this is needed on NeXT to forget loaded names. If this wasnt done,
the same class could not be loaded in again due to multiple defines.
@@ -2026,85 +1569,6 @@
NXClose(errOut);
#endif
%}
-!
-
-unloadDynamicObject:handle
- "close an object-file (unmap from my address space)
- and remove the entry from the remembered object file set.
- This is a low-level entry, which does not care if there are
- still any code references (from blocks or methods) to this
- module. Calling it for still living classes will definitely
- lead to some fatal conditions to occur later."
-
- |key fileName functionName deInitAddr m|
-
- Verbose ifTrue:[
- 'unload module name=' infoPrint. handle pathName infoPrintNL.
- ].
-
- "/
- "/ fixup
- "/
-
- handle isFunctionObjectHandle ifTrue:[
- handle functions do:[:f |
- f notNil ifTrue:[
- f code:0
- ]
- ].
- ].
-
- (handle isClassLibHandle
- or:[handle isMethodHandle]) ifTrue:[
- self deinitializeClassesFromModule:handle.
- self unregisterModule:handle.
- ] ifFalse:[
- fileName := handle pathName asFilename baseName.
- functionName := self initFunctionBasenameForFile:fileName.
-
- deInitAddr := self findFunction:functionName suffix:'__deInit' in:handle.
- deInitAddr notNil ifTrue:[
- self callInitFunctionAt:deInitAddr
- specialInit:false
- forceOld:true
- interruptable:false
- argument:0
- identifyAs:handle
- returnsObject:false.
- ]
- ].
-
- "/
- "/ now, really unload
- "/
- (self primUnloadDynamicObject:handle) ifFalse:[
- ^ self error:'unloadDynamic failed'
- ].
-
- "/
- "/ remove from loaded objects
- "/
- LoadedObjects notNil ifTrue:[
- key := LoadedObjects keyAtEqualValue:handle.
- key notNil ifTrue:[
- LoadedObjects removeKey:key
- ]
- ].
- Smalltalk flushCachedClasses.
-
- "
- for individual methods, we keep the methodObject,
- but make it unexecutable. Its still visible in the browser.
- "
- handle isMethodHandle ifTrue:[
- ((m := handle method) notNil
- and:[m ~~ 0]) ifTrue:[
- m makeUnloaded.
- ObjectMemory flushCaches.
- ]
- ]
-
- "Modified: 4.11.1996 / 23:05:20 / cg"
! !
!ObjectFileLoader class methodsFor:'image save/restart'!
@@ -2459,11 +1923,564 @@
"Modified: 7.1.1997 / 20:16:28 / stefan"
! !
+!ObjectFileLoader class methodsFor:'lowlevel object loading'!
+
+loadDynamicObject:pathName
+ "load an object-file (load/map into my address space).
+ Return a non-nil handle if ok, nil otherwise.
+ No bindings are done - only a pure load is performed.
+ This function is not supported on all architectures.
+ "
+
+ |handle buffer|
+
+ Verbose ifTrue:[
+ ('loadDynamic: ' , pathName , ' ...') infoPrintNL
+ ].
+
+ "/ already loaded ?
+
+ LoadedObjects notNil ifTrue:[
+ handle := LoadedObjects at:pathName ifAbsent:nil.
+ handle notNil ifTrue:[
+ Verbose ifTrue:[
+ ('... ' , pathName , ' already loaded.') infoPrintNL.
+ ].
+ ^ handle
+ ].
+ ].
+
+ "/
+ "/ the 1st two entries are system dependent;
+ "/ entry 3 is the pathName
+ "/ entry 4 is a unique ID
+ "/
+ buffer := Array new:4.
+ buffer at:3 put:pathName.
+ buffer at:4 put:NextHandleID. NextHandleID := NextHandleID + 1.
+
+ buffer := self primLoadDynamicObject:pathName into:buffer.
+ buffer isNil ifTrue:[
+ LastError == #notImplemented ifTrue:[
+ Verbose ifTrue:[
+ 'no dynamic load facility or load failed.' infoPrintNL.
+ ].
+ ].
+ buffer isNil ifTrue:[
+ LastError == #linkError ifTrue:[
+ LinkErrorMessage notNil ifTrue:[
+ Transcript showCR:'Load error:' , LinkErrorMessage
+ ].
+ ].
+ ^ nil
+ ]
+ ].
+
+ "
+ remember loaded object for later unloading
+ "
+ handle := ObjectFileHandle new.
+ handle sysHandle1:(buffer at:1).
+ handle sysHandle2:(buffer at:2).
+ handle pathName:(buffer at:3).
+ handle moduleID:(buffer at:4).
+
+ LoadedObjects isNil ifTrue:[
+ LoadedObjects := Dictionary new.
+ ].
+ LoadedObjects at:pathName put:handle.
+ Smalltalk flushCachedClasses.
+
+ Verbose ifTrue:[
+ ('loadDynamic ok; handle is: ' , handle printString) infoPrintNL.
+ ].
+
+ ^ handle
+
+ "sys5.4:
+ |handle|
+ handle := ObjectFileLoader loadDynamicObject:'../stc/mod1.so'.
+ ObjectFileLoader getFunction:'module1' from:handle
+ "
+ "next:
+ |handle|
+ handle := ObjectFileLoader loadDynamicObject:'../goodies/Path/AbstrPath.o'.
+ ObjectFileLoader getFunction:'__AbstractPath_Init' from:handle
+ "
+ "GLD:
+ |handle|
+ handle := ObjectFileLoader loadDynamicObject:'../clients/Tetris/Tetris.o'.
+ ObjectFileLoader getFunction:'__TetrisBlock_Init' from:handle
+ "
+
+ "Modified: 18.5.1996 / 15:43:56 / cg"
+!
+
+loadModulesFromListOfUndefined:list
+ "try to figure out what has to be loaded to resolve symbols from list.
+ return a list of handles of loaded objects
+ "
+ |inits classNames|
+
+ inits := list select:[:symbol | symbol notNil and:[symbol endsWith:'_Init']].
+ inits notNil ifTrue:[
+ classNames := inits collect:[:symbol |
+ (symbol startsWith:'___') ifTrue:[
+ symbol copyFrom:4 to:(symbol size - 5)
+ ] ifFalse:[
+ (symbol startsWith:'__') ifTrue:[
+ symbol copyFrom:3 to:(symbol size - 5)
+ ] ifFalse:[
+ (symbol startsWith:'_') ifTrue:[
+ symbol copyFrom:2 to:(symbol size - 5)
+ ] ifFalse:[
+ symbol
+ ]
+ ]
+ ]
+ ].
+ "
+ autoload those classes
+ "
+ classNames do:[:aClassName |
+ |cls|
+
+ (cls := Smalltalk classNamed:aClassName) notNil ifTrue:[
+ 'autoloading ' infoPrint. aClassName infoPrintNL.
+ cls autoload
+ ]
+ ]
+ ].
+ ^ nil
+
+ "Modified: 17.12.1995 / 16:00:27 / cg"
+!
+
+primLoadDynamicObject:pathName into:anInfoBuffer
+ "load an object-file (map into my address space).
+ Return an OS-handle (whatever that is) - where some space
+ (a 3-element array) has to be passed in for this.
+ The first two entries are used in a machine dependent way,
+ and callers may not depend on what is found there
+ (instead, only pass around handles transparently).
+ This function is not supported on all architectures."
+
+%{ /* CALLSUNLIMITEDSTACK */
+
+ if (! __isArray(anInfoBuffer)
+ || (_arraySize(anInfoBuffer) < 3)) {
+ return nil;
+ }
+
+#ifdef GNU_DL
+ {
+ static firstCall = 1;
+ extern char *__myName__;
+ extern dld_ignore_redefinitions;
+
+ if (firstCall) {
+ firstCall = 0;
+ (void) dld_init (__myName__);
+ dld_ignore_redefinitions = 1;
+ }
+
+ if (__isString(pathName)) {
+ if (dld_link(__stringVal(pathName))) {
+ if (ObjectFileLoader_Verbose == true) {
+ printf ("link file %s failed\n", __stringVal(pathName));
+ dld_perror("cant link");
+ }
+ ObjectFileLoader_LastError = @symbol(linkError);
+ RETURN ( nil );
+ }
+ __ArrayInstPtr(anInfoBuffer)->a_element[0] = pathName;
+ __STORE(anInfoBuffer, pathName);
+ RETURN ( anInfoBuffer );
+ }
+ RETURN ( nil );
+ }
+#endif
+
+#ifdef WIN_DL
+ {
+ HINSTANCE handle;
+ int err;
+
+ if (__isString(pathName)) {
+ if ((handle = LoadLibrary(__stringVal(pathName))) == NULL) {
+ err = GetLastError();
+ if (ObjectFileLoader_Verbose == true) {
+ printf ("LoadLibrary %s failed; error: %x\n",
+ __stringVal(pathName), err);
+ }
+ ObjectFileLoader_LastError = __MKINT(err);
+ RETURN ( nil );
+ }
+ __ArrayInstPtr(anInfoBuffer)->a_element[0] = __MKSMALLINT( (int)handle & 0xFFFF );
+ __ArrayInstPtr(anInfoBuffer)->a_element[1] = __MKSMALLINT( ((int)handle >> 16) & 0xFFFF );
+ RETURN ( anInfoBuffer );
+ }
+ RETURN ( nil );
+ }
+#endif
+
+#ifdef DL1_6
+ {
+ extern char *__myName__;
+ char *ldname;
+ OBJ tmpName;
+
+ if (__isString(pathName)) {
+ if ( dl_loadmod_only(__myName__, __stringVal(pathName), &ldname) == 0 ) {
+ if (ObjectFileLoader_Verbose == true) {
+ printf ("link file %s failed\n", __stringVal(pathName));
+ }
+ RETURN ( nil );
+ }
+ /*
+ * returns the name of the temporary ld-file
+ * use that as handle ...
+ */
+ tmpName = __MKSTRING(ldname);
+ __ArrayInstPtr(anInfoBuffer)->a_element[0] = tmpName;
+ __STORE(anInfoBuffer, tmpName);
+ RETURN ( anInfoBuffer );
+ }
+ RETURN ( nil );
+ }
+#endif
+
+#ifdef AIX_DL
+ {
+ extern char *__myName__;
+ char *objName, *libPath;
+ int *handle;
+ extern errno;
+
+ if (__isString(pathName)) {
+ objName = __stringVal(pathName);
+
+ if (__isString(@global(LibPath))) {
+ libPath = __stringVal(@global(LibPath));
+ } else {
+ libPath = (char *)0;
+ }
+ if ( (handle = (int *) load(objName, 0, libPath)) == 0 ) {
+ if (ObjectFileLoader_Verbose == true) {
+ char *messages[64];
+ int i;
+
+ printf ("load file %s failed errno=%d\n",
+ objName, errno);
+ switch (errno) {
+ case ENOEXEC:
+ printf(" load messages:\n");
+ loadquery(L_GETMESSAGES, messages, sizeof(messages));
+ for (i=0; messages[i]; i++) {
+ printf(" %s\n", messages[i]);
+ }
+ break;
+ }
+ }
+ RETURN ( nil );
+ }
+ if (ObjectFileLoader_Verbose == true) {
+ printf("load %s handle = %x\n", objName, handle);
+ }
+
+ __ArrayInstPtr(anInfoBuffer)->a_element[0] = __MKSMALLINT( (int)handle & 0xFFFF );
+ __ArrayInstPtr(anInfoBuffer)->a_element[1] = __MKSMALLINT( ((int)handle >> 16) & 0xFFFF );
+ RETURN (anInfoBuffer);
+ }
+ RETURN ( nil );
+ }
+#endif
+
+#ifdef SYSV4_DL
+ {
+ void *handle;
+ char *nm;
+ char *errMsg;
+
+ if ((pathName == nil) || __isString(pathName)) {
+ handle = (void *)dlopen(pathName == nil ? 0 : __stringVal(pathName), RTLD_NOW);
+
+ if (! handle) {
+ errMsg = (char *) dlerror();
+ fprintf(stderr, "dlopen %s error:\n", __stringVal(pathName));
+ fprintf(stderr, " <%s>\n", errMsg);
+ ObjectFileLoader_LastError = @symbol(linkError);
+ ObjectFileLoader_LinkErrorMessage = __MKSTRING(errMsg);
+ RETURN (nil);
+ }
+
+ if (ObjectFileLoader_Verbose == true) {
+ printf("open %s handle = %x\n", __stringVal(pathName), handle);
+ }
+
+ __ArrayInstPtr(anInfoBuffer)->a_element[0] = __MKSMALLINT( (int)handle & 0xFFFF );
+ __ArrayInstPtr(anInfoBuffer)->a_element[1] = __MKSMALLINT( ((int)handle >> 16) & 0xFFFF );
+ RETURN (anInfoBuffer);
+ }
+ }
+#endif
+
+#ifdef SUN_DL
+ {
+ void *handle;
+
+ if ((pathName == nil) || __isString(pathName)) {
+ if (pathName == nil)
+ handle = dlopen((char *)0, 1);
+ else
+ handle = dlopen(__stringVal(pathName), 1);
+
+ if (! handle) {
+ fprintf(stderr, "dlopen %s error: <%s>\n",
+ __stringVal(pathName), dlerror());
+ ObjectFileLoader_LastError = @symbol(linkError);
+ RETURN (nil);
+ }
+
+ if (ObjectFileLoader_Verbose == true) {
+ printf("open %s handle = %x\n", __stringVal(pathName), handle);
+ }
+
+ __ArrayInstPtr(anInfoBuffer)->a_element[0] = __MKSMALLINT( (int)handle & 0xFFFF );
+ __ArrayInstPtr(anInfoBuffer)->a_element[1] = __MKSMALLINT( ((int)handle >> 16) & 0xFFFF );
+ RETURN (anInfoBuffer);
+ }
+ }
+#endif
+
+#ifdef NEXT_DL
+ {
+ long result;
+ char *files[2];
+ NXStream *errOut;
+
+ if (__isString(pathName)) {
+ files[0] = (char *) __stringVal(pathName);
+ files[1] = (char *) 0;
+ errOut = NXOpenFile(2, 2);
+ result = rld_load(errOut,
+ (struct mach_header **)0,
+ files,
+ (char *)0);
+ NXClose(errOut);
+ if (! result) {
+ ObjectFileLoader_LastError = @symbol(linkError);
+ fprintf(stderr, "rld_load %s failed\n", __stringVal(pathName));
+ RETURN (nil);
+ }
+
+ if (ObjectFileLoader_Verbose == true)
+ printf("rld_load %s ok\n", __stringVal(pathName));
+
+ __ArrayInstPtr(anInfoBuffer)->a_element[0] = pathName;
+ __STORE(anInfoBuffer, pathName);
+ RETURN ( anInfoBuffer );
+ }
+ }
+#endif
+%}.
+ LastError := #notImplemented.
+ ^ nil
+!
+
+primUnloadDynamicObject:aHandle
+ "unload an object-file (unmap from my address space).
+ This is a low-level entry, which does not care if there are
+ still any code references (from blocks or methods) to this
+ module. Calling it for still living classes will definitely
+ lead to some fatal conditions to occur later."
+
+ |sysHandle1 sysHandle2|
+
+ sysHandle1 := aHandle sysHandle1.
+ sysHandle2 := aHandle sysHandle2.
+
+%{
+#ifdef GNU_DL
+ if (__isString(sysHandle1)) {
+ if (dld_unlink_by_file(__stringVal(sysHandle1), 1)) {
+ if (ObjectFileLoader_Verbose == true) {
+ printf ("unlink file %s failed\n", __stringVal(sysHandle1));
+ dld_perror("cant unlink");
+ }
+ RETURN (false);
+ }
+ RETURN (true);
+ }
+ RETURN (false);
+#endif
+
+#ifdef WIN_DL
+ int val;
+ HINSTANCE handle;
+ int err;
+
+ if (__bothSmallInteger(sysHandle1, sysHandle2)) {
+ val = (_intVal(sysHandle2) << 16) + _intVal(sysHandle1);
+ handle = (HINSTANCE)(val);
+
+ if (FreeLibrary(handle) != TRUE) {
+ err = GetLastError();
+ if (ObjectFileLoader_Verbose == true) {
+ printf ("unlink file %s failed; error: %x\n",
+ __stringVal(sysHandle1), err);
+ }
+ RETURN (false);
+ }
+ RETURN (true);
+ }
+ RETURN (false);
+#endif
+
+#ifdef SYSV4_DL
+ {
+ void *h;
+ int val;
+ OBJ low = sysHandle1, hi = sysHandle2;
+
+ if (__bothSmallInteger(low, hi)) {
+ val = (_intVal(hi) << 16) + _intVal(low);
+ h = (void *)(val);
+ if (ObjectFileLoader_Verbose == true)
+ printf("close handle = %x\n", h);
+ if (dlclose(h) != 0) {
+ fprintf(stderr, "dlclose failed with:<%s>\n", dlerror());
+ RETURN (false);
+ }
+ RETURN (true);
+ }
+ }
+#endif
+
+#ifdef SUN_DL
+ {
+ void *h;
+ int val;
+ OBJ low = sysHandle1, hi = sysHandle2;
+
+ if (__bothSmallInteger(low, hi)) {
+ val = (_intVal(hi) << 16) + _intVal(low);
+ h = (void *)(val);
+ if (ObjectFileLoader_Verbose == true)
+ printf("close handle = %x\n", h);
+ dlclose(h);
+ RETURN (true);
+ }
+ }
+#endif
+
+#ifdef AIX_DL
+ {
+ int *h;
+ int val;
+ OBJ low = sysHandle1, hi = sysHandle2;
+
+ if (__bothSmallInteger(low, hi)) {
+ val = (_intVal(hi) << 16) + _intVal(low);
+ h = (int *)(val);
+ if (ObjectFileLoader_Verbose == true)
+ printf("unload handle = %x\n", h);
+ if ( unload(h) != 0) {
+ fprintf(stderr, "unload failed\n");
+ RETURN (false);
+ }
+ RETURN (true);
+ }
+ }
+#endif
+%}.
+ ^ false
+!
+
+unloadDynamicObject:handle
+ "close an object-file (unmap from my address space)
+ and remove the entry from the remembered object file set.
+ This is a low-level entry, which does not care if there are
+ still any code references (from blocks or methods) to this
+ module. Calling it for still living classes will definitely
+ lead to some fatal conditions to occur later."
+
+ |key fileName functionName deInitAddr m|
+
+ Verbose ifTrue:[
+ 'unload module name=' infoPrint. handle pathName infoPrintNL.
+ ].
+
+ "/
+ "/ fixup
+ "/
+
+ handle isFunctionObjectHandle ifTrue:[
+ handle functions do:[:f |
+ f notNil ifTrue:[
+ f code:0
+ ]
+ ].
+ ].
+
+ (handle isClassLibHandle
+ or:[handle isMethodHandle]) ifTrue:[
+ self deinitializeClassesFromModule:handle.
+ self unregisterModule:handle.
+ ] ifFalse:[
+ fileName := handle pathName asFilename baseName.
+ functionName := self initFunctionBasenameForFile:fileName.
+
+ deInitAddr := self findFunction:functionName suffix:'__deInit' in:handle.
+ deInitAddr notNil ifTrue:[
+ self callInitFunctionAt:deInitAddr
+ specialInit:false
+ forceOld:true
+ interruptable:false
+ argument:0
+ identifyAs:handle
+ returnsObject:false.
+ ]
+ ].
+
+ "/
+ "/ now, really unload
+ "/
+ (self primUnloadDynamicObject:handle) ifFalse:[
+ ^ self error:'unloadDynamic failed'
+ ].
+
+ "/
+ "/ remove from loaded objects
+ "/
+ LoadedObjects notNil ifTrue:[
+ key := LoadedObjects keyAtEqualValue:handle.
+ key notNil ifTrue:[
+ LoadedObjects removeKey:key
+ ]
+ ].
+ Smalltalk flushCachedClasses.
+
+ "
+ for individual methods, we keep the methodObject,
+ but make it unexecutable. Its still visible in the browser.
+ "
+ handle isMethodHandle ifTrue:[
+ ((m := handle method) notNil
+ and:[m ~~ 0]) ifTrue:[
+ m makeUnloaded.
+ ObjectMemory flushCaches.
+ ]
+ ]
+
+ "Modified: 4.11.1996 / 23:05:20 / cg"
+! !
+
!ObjectFileLoader class methodsFor:'queries'!
canLoadObjectFiles
"return true, if dynamic loading is possible.
- Currently, only ELF based systems and linux a.out can do this."
+ Currently, only ELF based systems, AIX and linux a.out can do this."
self primCanLoadObjectFiles ifTrue:[^true].
@@ -2471,7 +2488,11 @@
"/ for some specific machine
^ false
- "Modified: 25.4.1996 / 09:51:39 / cg"
+ "
+ ObjectFileLoader canLoadObjectFiles
+ "
+
+ "Modified: 8.1.1997 / 18:13:01 / cg"
!
loadedObjectFiles
@@ -2536,6 +2557,7 @@
primCanLoadObjectFiles
"return true, if loading is possible using a standard mechanism"
+
%{ /* NOCONTEXT */
#ifdef HAS_DL
# if !defined(OS_DEFINE) || defined(unknownOS)
@@ -2550,6 +2572,10 @@
#endif
%}.
^ false
+
+ "
+ ObjectFileLoader primCanLoadObjectFiles
+ "
! !
!ObjectFileLoader class methodsFor:'st object file handling'!
@@ -2921,6 +2947,6 @@
!ObjectFileLoader class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libcomp/ObjectFileLoader.st,v 1.124 1997-01-07 20:19:39 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libcomp/ObjectFileLoader.st,v 1.125 1997-01-08 17:16:05 cg Exp $'
! !
ObjectFileLoader initialize!