"
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
Object subclass:#ObjectFileLoader
instanceVariableNames:''
classVariableNames:'MySymbolTable Verbose LastError LinkErrorMessage NextHandleID
LoadedObjects PreviouslyLoadedObjects ActuallyLoadedObjects
SearchedLibraries LibPath'
poolDictionaries:''
category:'System-Compiler'
!
!ObjectFileLoader primitiveDefinitions!
%{
/*
* by default, use whatever the system provides
*/
#ifdef sunos /* sunos (pre 5.4) dlopen interface */
# define SUN_DL
# define HAS_DL
#endif
#ifdef NeXT /* next rld interface */
# define NEXT_DL
# define HAS_DL
#endif
#if defined(SYSV4) || defined(HAS_DLOPEN) /* sys5.4 dlopen interface */
# define SYSV4_DL
# define HAS_DL
#endif
#ifdef DL1_6 /* dl1.6 COFF loader */
# define HAS_DL
#endif
#ifdef _AIX
# define AIX_DL
# define HAS_DL
#endif
/*
* but GNU_DL overwrites this - its better
*/
#ifdef GNU_DL /* dld2.3.x interface */
# define HAS_DL
# undef SYSV4_DL
# undef NEXT_DL
# undef SUN_DL
# undef DL1_6
#endif
#include <stdio.h>
#if defined(WIN32)
# undef COFF
# undef ELF
# undef A_DOT_OUT
# define HAS_DL
# define WIN_DL
#endif
/*
* if no dynamic link facilities, try it the hard way ...
*/
#if !defined(HAS_DL)
# ifdef A_DOT_OUT
# include <a.out.h>
# ifndef N_MAGIC
# if defined(sinix) && defined(BSD)
# define N_MAGIC(hdr) (hdr.a_magic & 0xFFFF)
# else
# define N_MAGIC(hdr) (hdr.a_magic)
# endif
# endif
# endif /* a.out */
# ifdef COFF
# ifdef mips
# include <sys/exec.h>
# else
# include <a.out.h>
# endif
# endif /* coff */
# ifdef ELF
# include <elf.h>
# endif /* elf */
#endif /* not HAS_DL */
#ifdef NEXT_DL
# ifndef _RLD_H_
# define _RLD_H_
# ifdef NEXT3
# include <mach-o/rld.h>
# else
# include <rld.h>
# endif
# endif
#endif /* NEXT_DL */
#ifdef SYSV4_DL
# include <dlfcn.h>
# define dlcfn_h
#endif
#ifdef GNU_DL
# ifndef dld_h
# include "dld.h"
# define dld_h
# endif
#endif
#ifdef DL1_6
# ifndef dl_h
# include "dl.h"
# define dl_h
# endif
#endif
#ifdef AIX_DL
# include <nlist.h>
# include <sys/ldr.h>
# include <errno.h>
#endif
#ifdef WIN_DL
# ifdef WIN32
# undef INT
# undef Array
# undef Number
# undef Method
# ifdef i386
# define _X86_
# endif
/* # include <windows.h> /* */
# include <windef.h> /* */
# include <winbase.h> /* */
# ifdef __DEF_Array
# define Array __DEF_Array
# endif
# ifdef __DEF_Number
# define Number __DEF_Number
# endif
# ifdef __DEF_Method
# define Method __DEF_Method
# endif
# endif
#endif
%}
! !
!ObjectFileLoader class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
!
documentation
"
This class knowns how to dynamically load in external object-modules.
WARNING:
As to date, this is completely experimental and WITHOUT ANY WARRANTY.
It is still being developed and the code below needs cleanup and more
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),
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 loaded into that space.
Currently, 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 (only all or last).
The only really useful packages are the GNU-dl package and the SGI/Unixware
sys5.4 libdl packages.
The GNU-dl package is only available for a.out file formats;
i.e. only (a subset of) linux people can use it at this time.
For the above reasons, dynamic object loading is currently only
officially released for SYS5.4 and LINUX systems.
Once stable, the functionality contained herein will be moved into
the VM.
(It is needed there, to allow reloading of objectfiles upon
image restart; i.e. before any class is reinitialilized).
[author:]
Claus Gittinger
"
! !
!ObjectFileLoader class methodsFor:'initialization'!
initialize
|systemType|
MySymbolTable isNil ifTrue:[
Verbose := false.
NextHandleID := 1.
ObjectMemory addDependent:self.
"/ name of object file, where initial symbol table is found
"/ not req'd for all architectures.
MySymbolTable := 'smalltalk'.
"/ default set of libraries to be considered when
"/ unresolved symbols are encountered during the load.
"/ Only req'd for linux and sunos non-ELF systems.
"/ Can (should) be set in the smalltalk.rc file.
SearchedLibraries := #().
((systemType := OperatingSystem getSystemType) = 'linux'
or:[systemType = 'sunos']) ifTrue:[
'/usr/lib/libc.a' asFilename isReadable ifTrue:[
SearchedLibraries := #('/usr/lib/libc.a')
] ifFalse:[
'/lib/libc.a' asFilename isReadable ifTrue:[
SearchedLibraries := #('/lib/libc.a')
]
]
].
"/ default libraryPath where shared objects are expected
"/ when a sharedObject load requires other objects to be loaded.
"/ Only req'd for aix.
"/ For more compatibility with ELF systems, look for a shell variable
"/ named LD_LIBRARY_PATH, and - if present - take that instead if a default.
"/ Can (should) be set in the smalltalk.rc file.
systemType = 'aix' ifTrue:[
LibPath := OperatingSystem getEnvironment:'LD_LIBRARY_PATH'.
LibPath isNil ifTrue:[
LibPath := '.:/usr/local/smalltalk/lib:/usr/local/lib:/usr/lib:/lib'.
]
].
]
"
ObjectFileLoader initialize
"
"Modified: 20.7.1996 / 15:07:43 / cg"
!
lastError
^ LastError
!
libPath
"see comment in #libPath:"
^ LibPath
!
libPath:aSharedLibraryPath
"set the pathnames of directories, where other shared objects
are searched, in case a loaded module requires another module shared
library object to be loaded.
Currently, this is only required to be set for AIX systems;
ELF based linux and solaris systems specify the libPath in the
LD_LIBRARY_PATH environment variable."
LibPath := aSharedLibraryPath
"
ObjectFileLoader libPath:'.:/usr/lib:/usr/local/lib'
"
!
linkErrorMessage
^ LinkErrorMessage
!
searchedLibraries
"see comment in #searchedLibraries:"
^ SearchedLibraries
!
searchedLibraries:aCollectionOfArchivePathNames
"set the pathnames of archives which are to be searched
when unresolved references occur while loading in an object
file. On systems which support shared libraries (all SYS5.4 based
systems), this is usually not required. Instead, modules which are to
be filed in (.so files) are to be prelinked with the appropriate
shared libraries. The dynamic loader then cares about loading those
modules (keeping track of which modules are already loaded).
Only systems in which the dynamic load is done 'manually' by st/x
(i.e. currently only linux and a.out-sunos) need to set this."
SearchedLibraries := aCollectionOfArchivePathNames
!
verbose:aBoolean
"turn on/off debug traces"
Verbose := aBoolean
"ObjectFileLoader verbose:true"
! !
!ObjectFileLoader class methodsFor:'change & update'!
update:something with:aParameter from:changedObject
"sent, when image is saved or restarted"
(something == #aboutToSnapshot) ifTrue:[
self invalidateAndRememberAllObjectFiles
].
(something == #finishedSnapshot) ifTrue:[
self revalidateAllObjectFiles
].
"/ (something == #restarted) ifTrue:[
"/ self reloadAllRememberedObjectFiles
"/ ].
"Modified: 5.10.1995 / 15:49:14 / claus"
"Modified: 8.3.1996 / 23:34:29 / cg"
"Created: 21.6.1996 / 19:50:01 / cg"
! !
!ObjectFileLoader class methodsFor:'defaults'!
hasValidBinaryExtension:aFilename
"return true, if aFilename looks ok for binary loading.
This checks only the extension - not its contents.
(So an attempt to load the file may fail due to format errors or unresolved symbols)
This is very machine specific."
self validBinaryExtensions do:[:ext |
(aFilename endsWith:ext) ifTrue:[^ true].
].
^ false
"
ObjectFileLoader hasValidBinaryExtension:'foo.st'
ObjectFileLoader hasValidBinaryExtension:'foo.o'
ObjectFileLoader hasValidBinaryExtension:'foo.so'
"
!
loadableBinaryObjectFormat
"return a symbol describing the expected binary format
for object files to be loadable.
This is very machine specific."
%{ /* NOCONTEXT */
#ifdef HAS_DL
# if defined(SYSV4) || defined(ELF)
RETURN ( @symbol(elf));
# endif
# if defined(GNU_DL)
RETURN ( @symbol(aout));
# endif
# if defined(AIX_DL)
RETURN ( @symbol(xcoff));
# endif
# if defined(DL1_6)
RETURN ( @symbol(coff));
# endif
# if defined(WIN_DL)
RETURN ( @symbol(dll));
# endif
#endif
%}.
^ nil
"
ObjectFileLoader loadableBinaryObjectFormat
"
!
nm:file
"this should return a string to list the namelist of file.
The output of the command should be one line for each symbol,
formatted as:
addr segment name
This is parsed and read by #namesMatching:segment:in:.
If your default nm command cannot produce this, write a little
shell or awk script, to generate this and return a corresponding command
below."
|os|
os := OperatingSystem getSystemType.
(os = 'iris') ifTrue:[
^ 'nm -B ' , file
].
(os = 'solaris') ifTrue:[
^ 'nm -p ' , file
].
^ 'nm ' , file
"Modified: 30.10.1996 / 13:34:56 / cg"
!
sharedLibraryExtension
"return a fileName extension used for dynamic loadable objects.
This is very machine specific."
|os|
os := OperatingSystem getSystemType.
(os = 'sys5_4') ifTrue:[^ '.so'].
(os = 'iris') ifTrue:[^ '.so'].
(os = 'linux') ifTrue:[
self loadableBinaryObjectFormat == #aout ifTrue:[
^ '.o'
].
^ '.so'
].
(os = 'solaris') ifTrue:[^ '.so' ].
(os = 'aix') ifTrue:[^ '.so'].
(os = 'hpux') ifTrue:[^ '.sl'].
(os = 'win32') ifTrue:[^ '.dll'].
(os = 'os2') ifTrue:[^ '.dll'].
"/ mhmh what is a useful default ?
^ '.o'
"Modified: 30.10.1996 / 14:07:50 / cg"
!
validBinaryExtensions
"return a collection of valid filename extension for binary files.
This is very machine specific."
|os|
os := OperatingSystem getSystemType.
(os = 'sys5_4') ifTrue:[^ #('.so') ].
(os = 'iris') ifTrue:[^ #('.so') ].
(os = 'solaris') ifTrue:[^ #('.so') ].
(os = 'linux') ifTrue:[^ #('.o' '.obj' '.so') ].
(os = 'aix') ifTrue:[^ #('.o' '.so') ].
(os = 'hpux') ifTrue:[^ #('.o' '.sl') ].
(os = 'win32') ifTrue:[^ #('.dll') ].
(os = 'os2') ifTrue:[^ #('.dll') ].
"/ mhmh what is a useful default ?
^ #('.o')
"
ObjectFileLoader validBinaryExtensions
"
"Modified: 30.10.1996 / 13:26:38 / cg"
! !
!ObjectFileLoader class methodsFor:'dynamic class loading'!
loadCPlusPlusObjectFile:aFileName
"load a c++ object file (.o-file) into the image"
|handle initAddr list|
handle := self loadDynamicObject:aFileName.
handle isNil ifTrue:[
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
"
"/ list := self namesMatching:'__GLOBAL_$I*' segment:'[tT]' in:aFileName.
"/ initAddr := self getFunction:'__CTOR_LIST__' from:handle.
"/ Verbose ifTrue:[
"/ ('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
].
Verbose ifTrue:[
'unknown object file' infoPrintNL
].
self unloadDynamicObject:aFileName.
^ nil
"Modified: 18.5.1996 / 15:43:50 / cg"
!
loadClass:aClassName fromObjectFile:aFileName
"load a compiled class (.o-file) into the image"
|handle initAddr symName newClass moreHandles info status
otherClass knownToBeOk|
handle := self loadDynamicObject:aFileName.
handle isNil ifTrue:[
Transcript showCR:('loadDynamic: ', aFileName,' failed.').
^ nil
].
"
get the Init-function; let the class install itself
"
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.
].
knownToBeOk := true.
"/ knownToBeOk ifFalse:[
"/ |list|
"/
"/ Verbose ifTrue:[
"/ 'looking for undefs ...' infoPrintNL.
"/ ].
"/
"/ "
"/ if there are any undefined symbols, we may have to load more
"/ files (libs, other modules)
"/ "
"/ list := self getListOfUndefinedSymbolsFrom:handle.
"/ list notNil ifTrue:[
"/ moreHandles := self loadModulesFromListOfUndefined:list.
"/
"/ "
"/ now, try again
"/ "
"/ 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.
"/ ].
"/ ]
"/ ].
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:[
('no symbol: ', symName,' in ',aFileName) infoPrintNL.
].
"
unload
"
Verbose ifTrue:[
'unloading due to init failure:' infoPrint. handle pathName infoPrintNL.
].
moreHandles notNil ifTrue:[
moreHandles do:[:aHandle |
Verbose ifTrue:[
('unloading: ', aHandle printString) infoPrintNL.
].
self unloadDynamicObject:handle.
]
].
Verbose ifTrue:[
('unloading: ', handle printString) infoPrintNL.
].
self unloadDynamicObject:handle.
^ nil
"
ObjectFileLoader loadClass:'Tetris' fromObjectFile:'../clients/Tetris/Tetris.o'
ObjectFileLoader loadClass:'TetrisBlock' fromObjectFile:'../clients/Tetris/TBlock.o'
ObjectFileLoader loadClass:'Foo' fromObjectFile:'classList.o'
"
"Modified: 18.5.1996 / 15:45:35 / cg"
!
loadMethodObjectFile:aFileName
"load an object file (.o-file) for a single method into the image;
This does a slightly different initialization.
Return an object handle; nil on error"
|handle initAddr initName m|
"/
"/ load the objectfile
"/
handle := self loadDynamicObject:aFileName.
handle isNil ifTrue:[
^ nil
].
"/
"/ find the entry function
"/
initName := aFileName asFilename withoutSuffix baseName.
initAddr := self getFunction:'__' , initName , '_Init' from:handle.
initAddr isNil ifTrue:[
initAddr := ObjectFileLoader getFunction:'_' , initName , '_Init' from:handle.
initAddr isNil ifTrue:[
(self getListOfUndefinedSymbolsFrom:handle) size > 0 ifTrue:[
self listUndefinedSymbolsIn:handle.
'LOADER: undefined symbols in primitive code' infoPrintNL.
] ifFalse:[
('LOADER: ' , initName , '_Init() lookup failed') errorPrintNL
].
"/
"/ not found - unload
"/
self unloadDynamicObject:handle.
^ nil
]
].
"/
"/ call it - it returns the new method object
"/
m := self
callInitFunctionAt:initAddr
specialInit:true
forceOld:true
interruptable:false
argument:2
identifyAs:handle
returnsObject:true.
handle method:m.
^ handle
"Created: 5.12.1995 / 20:59:46 / cg"
"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."
|handle initAddr className initNames didInit info status
dummyHandle msg|
handle := self loadDynamicObject:aFileName.
handle isNil ifTrue:[
Transcript showCR:('loadDynamic: ',aFileName,' failed.').
^ false
].
didInit := 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.
"/ dummyHandle isNil ifTrue:[
"/ Transcript showCR:' ... load of library ' , libName , ' failed.'.
"/ ]
]
].
(self hasUndefinedSymbolsIn:handle) isNil ifTrue:[
Transcript showCR:('loadDynamic: still undefined symbols in ',aFileName,'.').
].
]
].
"
first, expect the classes-name to be the fileNames-baseName
(if its not, it may be a method or function module;
in this case, the Init function is supposed to use that naming
scheme as well)
"
className := self initFunctionBasenameForFile:aFileName.
"/
"/ look for explicit init (xxx_Init) function
"/ This is used in ST object files
"/
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.
]
] 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.
]
].
].
]
].
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
].
Smalltalk isInitialized ifTrue:[
"
really dont know, if it has changed ...
"
Smalltalk changed.
].
^ true
"Modified: 24.10.1996 / 10:19:25 / cg"
!
unloadAllObsoleteObjectFiles
"unload all dynamically loaded object files for which the classes/method
has been already garbage collected."
LoadedObjects notNil ifTrue:[
LoadedObjects keys copy do:[:name |
|handle|
handle := LoadedObjects at:name ifAbsent:nil.
(handle notNil and:[handle isObsolete]) ifTrue:[
self unloadObjectFile:name
]
]
].
"
ObjectFileLoader unloadAllObsoleteObjectFiles
"
"Modified: 5.12.1995 / 18:16:52 / cg"
!
unloadObjectFile:aFileName
"unload an object file (.o-file) from the image.
DANGER ALERT: currently, you have to make sure that no references to
objects of this module exist - in future versions, the system will keep
track of these. For now, use at your own risk.
(especially critical are blocks-functions)."
|handle|
LoadedObjects notNil ifTrue:[
handle := LoadedObjects at:aFileName ifAbsent:nil
].
handle isNil ifTrue:[
'OBJFLOADER: oops file to be unloaded was not loaded dynamically (', aFileName , ')'.
^ self
].
"/ call the modules deInit-function ...
"/ unload ...
self unloadDynamicObject:handle
! !
!ObjectFileLoader class methodsFor:'dynamic object access'!
findFunction:functionName suffix:suffix in:handle
"look for the init function and returns its address"
|initAddr className|
"
look for explicit init function
"
initAddr := self getFunction:(functionName , suffix) from:handle.
initAddr notNil ifTrue:[^ initAddr].
initAddr := self getFunction:('_' , functionName , suffix) from:handle.
initAddr notNil ifTrue:[^ initAddr].
"/
"/ special for broken ultrix nlist
"/ (will not find symbol with single underscore)
"/ workaround: add another underscore and retry
"/
initAddr := self getFunction:('__' , functionName , suffix) from:handle.
initAddr notNil ifTrue:[^ initAddr].
"
look for reverse abbreviation
"
className := 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
"Created: 13.7.1996 / 00:38:01 / cg"
!
findInitFunction:functionName in:handle
"look for the init function and returns its address"
^ self findFunction:functionName suffix:'_Init' in:handle
"Modified: 13.7.1996 / 00:38:33 / cg"
!
getFunction:aString from:handle
"return the address of a function from a dynamically loaded object file.
Handle must be the one returned previously from loadDynamicObject.
Return the address of the function, or nil on any error."
^ self getSymbol:aString function:true from:handle
!
getListOfUndefinedSymbolsFrom:aHandle
"return a collection of undefined symbols in a dynamically loaded object file.
Handle must be the one returned previously from loadDynamicObject.
Not all systems allow an object with undefined symbols to be
loaded (actually, only dld does)."
|list|
%{ /* STACK: 20000 */
#ifdef GNU_DL
void (*func)();
unsigned long addr;
char *name;
int nMax;
char **undefNames;
undefNames = dld_list_undefined_sym();
if (dld_undefined_sym_count > 0) {
char **nm;
int index;
int count = dld_undefined_sym_count;
if (count > 100) count = 100;
list = __ARRAY_NEW_INT(count);
if (list) {
nm = undefNames;
for (index = 0; index < count; index++) {
OBJ s;
s = __MKSTRING(*nm);
__ArrayInstPtr(list)->a_element[index] = s;
__STORE(list, s);
nm++;
}
free(undefNames);
}
}
#endif
#ifdef DL1_6
/*
* dont know how to do it
*/
#endif
#ifdef SYSV4_DL
/*
* dont know how to do it
*/
#endif
#ifdef SUN_DL
/*
* dont know how to do it
*/
#endif
#ifdef NEXT_DL
/*
* dont know how to do it
*/
#endif
#ifdef WIN_DL
/*
* dont know how to do it
*/
#endif
%}.
^ list
!
getSymbol:aString function:isFunction from:aHandle
"return the address of a symbol/function from a dynamically loaded object file.
Handle must be the one returned previously from loadDynamicObject.
Return the address of the symbol, or nil on any error."
|sysHandle1 sysHandle2 pathName address|
sysHandle1 := aHandle sysHandle1.
sysHandle2 := aHandle sysHandle2.
pathName := aHandle pathName.
%{ /* STACK: 20000 */
#ifdef GNU_DL
{
void (*func)();
unsigned long addr;
char *name;
if (__isString(aString)) {
name = (char *) __stringVal(aString);
if (isFunction == false) {
addr = dld_get_symbol(name);
if (addr) {
if (ObjectFileLoader_Verbose == true) {
printf("addr of %s = %x\n", name, addr);
}
address = __MKUINT( addr );
}
} else {
func = (void (*) ()) dld_get_func(name);
if (func) {
if (ObjectFileLoader_Verbose == true) {
printf("addr of %s = %x\n", name, (INT)func);
}
if (dld_function_executable_p(name)) {
address = __MKUINT( (INT)func );
} else {
char **undefNames;
char **nm;
int i;
if (ObjectFileLoader_Verbose == true) {
printf ("function %s not executable\n", name);
dld_perror("not executable");
printf("undefined:\n");
nm = undefNames = dld_list_undefined_sym();
for (i=dld_undefined_sym_count; i; i--) {
printf(" %s\n", *nm++);
}
free(undefNames);
}
}
} else {
if (ObjectFileLoader_Verbose == true) {
printf ("function %s not found\n", name);
dld_perror("get_func");
}
}
}
}
}
#endif /* GNU_DL */
#ifdef WIN_DL
{
void *h;
void *addr;
int val;
FARPROC entry;
HMODULE handle;
if (__bothSmallInteger(sysHandle1, sysHandle2)) {
val = (_intVal(sysHandle2) << 16) + _intVal(sysHandle1);
handle = (HMODULE)(val);
if (__isString(aString)) {
if (ObjectFileLoader_Verbose == true)
printf("get sym <%s> handle = %x\n", __stringVal(aString), (int)handle);
entry = GetProcAddress(handle, (char *) __stringVal(aString));
if (entry != NULL) {
addr = (void *)entry;
if (ObjectFileLoader_Verbose == true) {
printf("GetProcAddr %s ok; addr = %x\n", __stringVal(aString), addr);
}
address = __MKUINT( (int)addr );
} else {
if (ObjectFileLoader_Verbose == true) {
printf("GetProcAddr %s error: %x\n", __stringVal(aString), GetLastError());
}
}
}
}
}
#endif
#ifdef DL1_6
{
void *h;
void *addr;
int val;
if (__isString(aString)) {
if (__isString(sysHandle1)) {
if (ObjectFileLoader_Verbose == true)
printf("get sym <%s> handle = %x\n",
__stringVal(aString), __stringVal(sysHandle1));
addr = dl_getsymbol(__stringVal(sysHandle1), __stringVal(aString));
if (addr) {
if (ObjectFileLoader_Verbose == true)
printf("addr = %x\n", addr);
address = __MKUINT( (int)addr );
} else {
if (ObjectFileLoader_Verbose == true)
printf("dl_getsymbol %s failed\n", __stringVal(aString));
}
}
}
}
#endif
#ifdef SYSV4_DL
{
void *h;
void *addr;
int val;
OBJ low = sysHandle1, hi = sysHandle2;
if (__bothSmallInteger(low, hi)) {
val = (_intVal(hi) << 16) + _intVal(low);
h = (void *)(val);
if (__isString(aString)) {
if (ObjectFileLoader_Verbose == true) {
printf("get sym <%s> handle = %x\n", __stringVal(aString), h);
}
addr = dlsym(h, (char *) __stringVal(aString));
if (addr) {
if (ObjectFileLoader_Verbose == true) {
printf("dlsym %s ok; addr = %x\n", __stringVal(aString), addr);
}
address = __MKUINT( (int)addr );
} else {
if (ObjectFileLoader_Verbose == true) {
printf("dlsym %s error: %s\n", __stringVal(aString), dlerror());
}
}
}
}
}
#endif
#ifdef AIX_DL
{
void *h;
void *addr;
int val;
struct nlist nl[2];
OBJ low = sysHandle1, hi = sysHandle2;
char nameBuffer[256];
static struct funcDescriptor {
unsigned vaddr;
unsigned long2;
unsigned long3;
} descriptor;
if (__bothSmallInteger(low, hi)
&& __isString(aString) && __isString(pathName)) {
val = (__intVal(hi) << 16) + __intVal(low);
h = (void *)(val);
if (ObjectFileLoader_Verbose == true) {
printf("get sym <%s> handle = %x path= %s\n",
__stringVal(aString), h, __stringVal(pathName));
}
#define USE_ENTRY
#ifdef USE_ENTRY
/*
* only works, if the entry-function is the Init function
* (i.e. linked with -e _xxx_Init)
*/
if (ObjectFileLoader_Verbose == true) {
printf("return handle as addr = %x\n", h);
}
address = __MKUINT( (int)(h) );
#else
# ifdef USE_DESCRIPTOR
if (isFunction == true) {
# else
if (0) {
# endif
nameBuffer[0] = '.';
strcpy(nameBuffer+1, aString);
nl[0].n_name = nameBuffer;
} else {
nl[0].n_name = __stringVal(aString);
}
nl[1].n_name = "";
if (nlist(__stringVal(pathName), &nl) == -1) {
if (ObjectFileLoader_Verbose == true) {
printf("nlist error\n");
}
} else {
addr = (void *)((unsigned)nl[0].n_value + (unsigned)h);
if (isFunction == true) {
# ifdef USE_DESCRIPTOR
printf("daddr = %x\n", addr);
printf("daddr[0] = %x\n", ((long *)addr)[0]);
printf("daddr[1] = %x\n", ((long *)addr)[1]);
printf("daddr[2] = %x\n", ((long *)addr)[2]);
# endif
}
if (ObjectFileLoader_Verbose == true) {
printf("value=%x section=%d type=%x sclass=%d\n",
nl[0].n_value, nl[0].n_scnum, nl[0].n_type, nl[0].n_sclass);
printf("vaddr = %x\n", addr);
}
# ifdef DOES_NOT_WORK
address = __MKUINT( (int)addr );
# else
descriptor.vaddr = (unsigned) addr;
descriptor.long2 = 0;
descriptor.long3 = 0;
address = __MKUINT( (int)(&descriptor) );
# endif
}
#endif /* dont USE_ENTRY */
}
}
#endif /* AIX_DL */
#ifdef SUN_DL
{
void *h;
void *addr;
int val;
OBJ low = sysHandle1, hi = sysHandle2;
if (__bothSmallInteger(low, hi)) {
val = (_intVal(hi) << 16) + _intVal(low);
h = (void *)(val);
if (__isString(aString)) {
if (ObjectFileLoader_Verbose == true) {
printf("get sym <%s> handle = %x\n", __stringVal(aString), h);
}
addr = dlsym(h, __stringVal(aString));
if (addr) {
if (ObjectFileLoader_Verbose == true) {
printf("addr = %x\n", addr);
}
address = __MKUINT( (int)addr );
} else {
if (ObjectFileLoader_Verbose == true) {
printf("dlsym %s error: %s\n", __stringVal(aString), dlerror());
}
}
}
}
}
#endif
#ifdef NEXT_DL
{
unsigned long addr;
long result;
NXStream *errOut;
if (__isString(aString)) {
if (ObjectFileLoader_Verbose == true) {
printf("get sym <%s>\n", __stringVal(aString));
}
errOut = NXOpenFile(2, 2);
result = rld_lookup(errOut,
(char *) __stringVal(aString),
&addr);
NXClose(errOut);
if (result) {
if (ObjectFileLoader_Verbose == true) {
printf("addr = %x\n", addr);
}
address = __MKUINT( (int)addr );
}
}
}
#endif
%}.
^ address
!
hasUndefinedSymbolsIn:handle
"return true, if a module has undefined symbols in it.
This is only possible if the system supports loading
modules with undefined things in it - most do not"
^ (self getListOfUndefinedSymbolsFrom:handle) size > 0
"Modified: 25.4.1996 / 09:47:27 / cg"
!
initFunctionBasenameForFile:aFileName
"return the expected initFunctions name, given a fileName"
|name suffixLen|
"
first, expect the classes-name to be the fileName-base
"
name := OperatingSystem baseNameOf:aFileName.
suffixLen := 0.
self validBinaryExtensions do:[:suffix |
suffixLen == 0 ifTrue:[
(name endsWith:suffix) ifTrue:[
suffixLen := suffix size
]
]
].
suffixLen ~~ 0 ifTrue:[
name := name copyWithoutLast:suffixLen
].
^ name.
"
ObjectFileLoader initFunctionNameForFile:'libbasic.so'
ObjectFileLoader initFunctionNameForFile:'demo.so'
ObjectFileLoader initFunctionNameForFile:'demo.o'
"
"Created: 13.7.1996 / 00:01:54 / cg"
"Modified: 30.10.1996 / 13:28:22 / cg"
!
isCPlusPlusObject:handle
"return true, if the loaded object is a c++ object module.
This is not yet fully implemented/supported."
(self getSymbol:'__gnu_compiled_cplusplus' function:true from:handle) notNil ifTrue:[^ true].
(self getSymbol:'__CTOR_LIST__' function:true from:handle) notNil ifTrue:[^ true].
(self getSymbol:'__CTOR_LIST__' function:false from:handle) notNil ifTrue:[^ true].
(self getSymbol:'__gnu_compiled_cplusplus' function:false from:handle) notNil ifTrue:[^ true].
^ false
"Modified: 25.4.1996 / 09:48:19 / cg"
!
isObjectiveCObject:handle
"return true, if the loaded object is an objective-C object module.
This is not yet implemented/supported"
^ false
"Modified: 25.4.1996 / 09:47:59 / cg"
!
isSmalltalkObject:handle
"return true, if the loaded object is a smalltalk object module"
"not yet implemented - stc_compiled_smalltalk is a static symbol,
not found in list - need nm-interface, or nlist-walker
"
^ true.
"/ (self getSymbol:'__stc_compiled_smalltalk' function:true from:handle) notNil ifTrue:[^ true].
"/ (self getSymbol:'__stc_compiled_smalltalk' function:false from:handle) notNil ifTrue:[^ true].
"/ ^ false
!
listUndefinedSymbolsIn:handle
"list undefined objects in a module on the transcript"
|undefinedNames|
undefinedNames := self getListOfUndefinedSymbolsFrom:handle.
undefinedNames size > 0 ifTrue:[
Transcript showCR:'undefined:'.
undefinedNames do:[:aName |
Transcript showCR:' ' , aName
]
].
"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"
|p l s addr segment name entry|
OperatingSystem getSystemType = 'aix' ifTrue:[
^ nil
].
l := OrderedCollection new.
p := PipeStream readingFrom:(self nm:aFileName).
p isNil ifTrue:[
('LOADER: cannot read names from ' , aFileName) infoPrintNL.
^ nil
].
[p atEnd] whileFalse:[
entry := p nextLine.
Verbose ifTrue:[
entry infoPrintNL.
].
entry notNil ifTrue:[
s := ReadStream on:entry.
addr := s nextAlphaNumericWord.
segment := s nextAlphaNumericWord.
name := s upToEnd withoutSeparators.
(addr notNil and:[segment notNil and:[name notNil]]) ifTrue:[
(aPattern match:name) ifTrue:[
(segmentPattern isNil or:[segmentPattern match:segment]) ifTrue:[
l add:name.
Verbose ifTrue:[
('found name: ' , name) infoPrintNL.
]
] ifFalse:[
Verbose ifTrue:[
name infoPrint. ' segment mismatch ' infoPrint.
segmentPattern infoPrint. ' ' infoPrint. segment infoPrintNL.
]
]
]
]
]
].
p close.
^ l
"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 = 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.
On other architectures, this is not needed and therefore a noop."
%{
#ifdef NEXT_DL
NXStream *errOut;
errOut = NXOpenFile(2, 2);
rld_unload_all(errOut, (long)0);
rld_load_basefile(errOut, "smalltalk");
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'!
invalidateAndRememberAllObjectFiles
"invalidate code refs into all dynamically loaded object files.
Required before writing a snapshot image."
LoadedObjects notNil ifTrue:[
ActuallyLoadedObjects := LoadedObjects.
self rememberAllObjectFiles.
ActuallyLoadedObjects keys do:[:aFileName |
|handle|
handle := ActuallyLoadedObjects at:aFileName.
handle isNil ifTrue:[
self error:'oops, no handle'.
] ifFalse:[
(handle isClassLibHandle or:[handle isMethodHandle]) ifTrue:[
self invalidateModule:handle
]
]
].
LoadedObjects := nil.
].
"Created: 5.10.1995 / 15:48:56 / claus"
"Modified: 5.10.1995 / 16:48:51 / claus"
"Modified: 12.7.1996 / 17:13:45 / cg"
!
reloadAllRememberedObjectFiles
"reload all object modules as were loaded when the image was saved.
Some care has to be taken, if files are missing or otherwise corrupted."
|oldDummyMethod who m newHandle
savedOldClasses savedByteCodeMethods savedMethods
functions newFunction|
PreviouslyLoadedObjects notNil ifTrue:[
PreviouslyLoadedObjects do:[:entry |
|fileName handle cls sel|
fileName := entry key.
handle := entry value.
handle moduleID:nil.
handle isClassLibHandle ifTrue:[
('OBJFLOADER: reloading classes in ' , fileName , ' ...') infoPrintNL.
"/
"/ remember all byteCode methods (as added in the session)
"/
savedByteCodeMethods := IdentityDictionary new.
savedOldClasses := IdentitySet new.
handle classes do:[:aClass |
savedMethods := IdentityDictionary new.
savedOldClasses add:aClass.
aClass methodDictionary keysAndValuesDo:[:sel :m |
m byteCode notNil ifTrue:[
"/ an interpreted method - must be preserved
savedMethods at:sel put:m
]
].
savedMethods notEmpty ifTrue:[
savedByteCodeMethods at:(aClass name) put:savedMethods
].
].
"/
"/ load the class binary
"/
self loadObjectFile:fileName.
"/
"/ reinstall the byteCode methods
"/
savedByteCodeMethods keysAndValuesDo:[:nm :savedMethods |
|cls|
cls := Smalltalk classNamed:nm.
savedMethods keysAndValuesDo:[:sel :m |
cls primAddSelector:sel withMethod:m.
"/ ('preserved ' , cls name , '>>' , sel) printNL.
]
].
"/
"/ validate old-classes vs. new classes.
"/ and if things look ok, get rid of old stuff
"/ and make instances become instances of the new class
"/
savedOldClasses do:[:oldClass |
|newClass|
newClass := Smalltalk classNamed:(oldClass name).
newClass == oldClass ifTrue:[
"/ ('OBJFLOADER: class ' , oldClass name , ' reloaded.') errorPrintCR.
] ifFalse:[
(newClass isNil or:[newClass == oldClass]) ifTrue:[
('OBJFLOADER: reload of ' , oldClass name , ' seemed to fail.') errorPrintCR.
] ifFalse:[
"/'oldSize: ' print. oldClass instSize print. ' (' print. oldClass instSize class name print. ') ' print.
"/'newSize: ' print. newClass instSize print. ' (' print. oldClass instSize class name print. ') ' printCR.
oldClass instSize ~~ newClass instSize ifTrue:[
('OBJFLOADER: ' , oldClass name , ' has changed its size.') errorPrintCR.
] ifFalse:[
oldClass class instSize ~~ newClass class instSize ifTrue:[
('OBJFLOADER: ' , oldClass name , ' class has changed its size.') errorPrintCR.
] ifFalse:[
('OBJFLOADER: migrating ' , oldClass name) errorPrintCR.
oldClass becomeSameAs:newClass
]
]
]
]
]
] ifFalse:[
handle isMethodHandle ifTrue:[
oldDummyMethod := handle method.
(oldDummyMethod isKindOf:Method) ifFalse:[
('OBJFLOADER: ignore obsolete (already collected) method in ' , fileName) infoPrintNL
] ifTrue:[
('OBJFLOADER: reloading method in ' , fileName , ' ...') infoPrintNL.
who := oldDummyMethod who.
newHandle := self loadMethodObjectFile:fileName.
newHandle isNil ifTrue:[
('OBJFLOADER: failed to reload method in ' , fileName , ' ...') errorPrintNL.
handle moduleID:nil.
] ifFalse:[
m := newHandle method.
m source:(oldDummyMethod source).
m package:(oldDummyMethod package).
who notNil ifTrue:[
cls := who methodClass.
sel := who methodSelector.
m == (cls compiledMethodAt:sel) ifFalse:[
'LOADER: oops - loaded method installed wrong' errorPrintNL.
] ifTrue:[
"/ cls changed:#methodDictionary with:(Array with:sel with:oldDummyMethod).
]
].
]
]
] ifFalse:[
handle isFunctionObjectHandle ifTrue:[
functions := handle functions.
functions isEmpty ifTrue:[
('OBJFLOADER: ignore obsolete (unreferenced) functions in ' , fileName) infoPrintNL
] ifFalse:[
newHandle := self loadDynamicObject:fileName.
newHandle isNil ifTrue:[
('OBJFLOADER: failed to reload ' , fileName , ' ...') errorPrintNL.
handle moduleID:nil.
] ifFalse:[
('OBJFLOADER: reloading ' , fileName , ' ...') infoPrintNL.
functions do:[:oldFunction |
newFunction := newHandle getFunction:(oldFunction name).
newFunction isNil ifTrue:[
('OBJFLOADER: function: ''' , oldFunction name , ''' no longer present.') errorPrintNL.
oldFunction code:nil.
oldFunction setName:oldFunction name moduleHandle:nil.
] ifFalse:[
oldFunction code:(newFunction code).
oldFunction setName:oldFunction name moduleHandle:newHandle.
('OBJFLOADER: rebound function: ''' , oldFunction name , '''.') infoPrintNL.
]
].
handle becomeSameAs:newHandle. "/ the old handle is now void
]
]
] ifFalse:[
('OBJFLOADER: ignored invalid (obsolete) objectFile handle: ' , handle printString) infoPrintNL.
]
]
]
].
PreviouslyLoadedObjects := nil
]
"Modified: 1.11.1996 / 16:28:50 / cg"
!
rememberAllObjectFiles
"remember all loaded objectModules in the
PreviouslyLoadedObjects classVariable.
Called when an image is restarted to reload all modules which
were loaded in the previous life"
LoadedObjects notNil ifTrue:[
PreviouslyLoadedObjects := OrderedCollection new.
LoadedObjects keysAndValuesDo:[:name :handle |
handle isForCollectedObject ifTrue:[
('OBJFLOADER: ignore object for already collected objects in ' , name) infoPrintNL
] ifFalse:[
PreviouslyLoadedObjects add:(name -> handle)
]
].
PreviouslyLoadedObjects sort:[:a :b | a value moduleID < b value moduleID].
]
"Created: 5.12.1995 / 20:51:07 / cg"
"Modified: 25.4.1996 / 09:46:08 / cg"
!
revalidateAllObjectFiles
"revalidate code refs into all dynamically loaded object files.
Required after writing a snapshot image."
ActuallyLoadedObjects notNil ifTrue:[
ActuallyLoadedObjects keys do:[:aFileName |
|handle|
handle := ActuallyLoadedObjects at:aFileName.
handle isNil ifTrue:[
self error:'oops, no handle'.
] ifFalse:[
(handle isClassLibHandle or:[handle isMethodHandle]) ifTrue:[
self revalidateModule:handle
]
]
].
LoadedObjects := ActuallyLoadedObjects.
ActuallyLoadedObjects := PreviouslyLoadedObjects := nil.
].
"Created: 5.10.1995 / 15:49:08 / claus"
"Modified: 5.10.1995 / 16:49:18 / claus"
"Modified: 12.7.1996 / 17:14:48 / cg"
!
unloadAllObjectFiles
"unload all dynamically loaded object files from the image.
see DANGER ALERT in ObjectFileLoader>>unloadObjectFile:"
LoadedObjects notNil ifTrue:[
LoadedObjects keys copy do:[:aFileName |
self unloadObjectFile:aFileName
]
].
"
ObjectFileLoader unloadAllObjectFiles
"
!
unloadAndRememberAllObjectFiles
"remember all modules and unload them"
LoadedObjects notNil ifTrue:[
self rememberAllObjectFiles.
self unloadAllObjectFiles
]
"Modified: 25.4.1996 / 09:46:27 / cg"
! !
!ObjectFileLoader class methodsFor:'linking objects'!
createLoadableObjectFor:baseFileName
"given an oFile, arrange for it to be loadable.
On ELF systems, this means that it has to be linked with the
-shared option into a .so file;
DLD based loaders (linux a.out) can directly load a .o file;
Other systems may require more ..."
|oFileName soFileName expFileName librunExpFileName
needSharedObject ld ldArg expFile|
ld := 'ld'.
needSharedObject := false.
OperatingSystem getOSType = 'irix' ifTrue:[
"
link it to a shared object with 'ld -shared'
"
needSharedObject := true.
ldArg := '-shared'.
].
OperatingSystem getOSType = 'sys5_4' ifTrue:[
"
link it to a shared object with 'ld -G'
"
needSharedObject := true.
ldArg := '-G'.
].
OperatingSystem getOSType = 'linux' ifTrue:[
ObjectFileLoader loadableBinaryObjectFormat == #elf ifTrue:[
"
link it to a shared object with 'ld -shared'
"
needSharedObject := true.
ldArg := '-shared'.
]
].
OperatingSystem getOSType = 'aix' ifTrue:[
"/ create an exports file.
expFileName := './' , baseFileName , '.exp'.
expFile := expFileName asFilename writeStream.
expFile notNil ifTrue:[
expFile nextPutAll:'#!! ./' , baseFileName , '.so'.
expFile cr.
expFile nextPutAll:'_' , baseFileName , '_Init'.
expFile close.
].
"
link it to a shared object with 'cc -bI:...librun.exp -bE -bMSRE'
"
needSharedObject := true.
ld := 'cc'.
librunExpFileName := Smalltalk getSystemFileName:'lib/librun_aix.exp'.
librunExpFileName isNil ifTrue:[
LastError := 'missing exports file: ''lib/librun_aix.exp'' - cannot link'.
^ nil
].
ldArg := '-bI:' , librunExpFileName ,
' -bE:' , baseFileName , '.exp' ,
' -bM:SRE -e _' , baseFileName , '_Init'.
].
oFileName := './' , baseFileName , '.o'.
needSharedObject ifTrue:[
soFileName := './' , baseFileName , '.so'.
OperatingSystem executeCommand:'rm -f ' , soFileName.
Verbose ifTrue:[
'linking with:' infoPrintCR.
' ' infoPrint.
(ld , ' ' , ldArg , ' -o ' , soFileName , ' ' , oFileName) infoPrintCR.
].
OperatingSystem executeCommand:ld , ' ' , ldArg , ' -o ' , soFileName , ' ' , oFileName.
OperatingSystem removeFile:oFileName.
expFileName notNil ifTrue:[
OperatingSystem removeFile:expFileName
].
^ soFileName.
].
"
assume we can load an ordinary binary
"
^ oFileName
"Created: 3.1.1996 / 16:04:45 / cg"
"Modified: 29.7.1996 / 13:20:30 / 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."
self primCanLoadObjectFiles ifTrue:[^true].
"/ can add a return true here, if I ever get manual loading to work
"/ for some specific machine
^ false
"Modified: 25.4.1996 / 09:51:39 / cg"
!
loadedObjectFiles
"return a collection containing the names of all
dynamically loaded objects."
LoadedObjects isNil ifTrue:[^ #()].
^ LoadedObjects keys copy
"
ObjectFileLoader loadedObjectFiles
"
!
loadedObjectHandles
"return a collection of all handles"
LoadedObjects isNil ifTrue:[^ #()].
^ LoadedObjects
"
ObjectFileLoader loadedObjectHandles
"
"Created: 17.9.1995 / 14:28:55 / claus"
"Modified: 17.9.1995 / 16:13:48 / claus"
!
loadedObjectHandlesDo:aBlock
"enumerate all handles"
LoadedObjects notNil ifTrue:[
LoadedObjects copy do:aBlock.
].
"
ObjectFileLoader loadedObjectHandlesDo:[:h | h pathName printNL]
"
"Created: 14.9.1995 / 22:03:13 / claus"
"Modified: 14.9.1995 / 22:32:48 / claus"
!
pathNameFromID:id
"given an id, return the pathName, or nil for static modules"
LoadedObjects notNil ifTrue:[
LoadedObjects keysAndValuesDo:[:name :handle |
handle moduleID == id ifTrue:[
^ handle pathName
]
].
].
^ nil
"
ObjectFileLoader pathNameFromID:1
"
"Modified: 28.8.1995 / 18:08:28 / claus"
!
primCanLoadObjectFiles
"return true, if loading is possible using a standard mechanism"
%{ /* NOCONTEXT */
#ifdef HAS_DL
# if !defined(OS_DEFINE) || defined(unknownOS)
fprintf(stderr, "*** OS_DEFINE not correct\n");
# else
# if !defined(CPU_DEFINE) || defined(unknownCPU)
fprintf(stderr, "*** CPU_DEFINE not correct\n");
# else
RETURN (true);
# endif
# endif
#endif
%}.
^ false
! !
!ObjectFileLoader class methodsFor:'st object file handling'!
callInitFunctionAt:address specialInit:special forceOld:forceOld interruptable:interruptable argument:argument identifyAs:handle returnsObject:returnsObject
"call a function at address - a very dangerous operation.
This is needed to call the classes init-function after loading in a
class-object file or to call the CTORS when c++ modules are loaded.
ForceOld (if true) will have the memory manager
allocate things in oldSpace instead of newSpace.
If special is true, this is a smalltalk moduleInit (i.e. pass the vm-entries table);
otherwise, its called without arguments.
If its a smalltalk-moduleInit, it may be either for a classPackage (which should
install all of its classes) or for a single incrementally compiled methdod
(it should then NOT install it, but return the method object instead).
DANGER: Internal & highly specialized. Dont use in your programs.
This interface may change without notice."
|moduleID retVal|
handle notNil ifTrue:[
moduleID := handle moduleID
].
%{ /* CALLSSTACK: 32000 */
OBJ (*addr)();
unsigned val;
int savInt;
int prevSpace, force;
int arg = 0, ret = 0;
int wasBlocked = 1;
extern int __oldSpaceSize(), __oldSpaceUsed();
if (__isInteger(address)) {
if (_isSmallInteger(argument)) {
arg = __intVal(argument);
val = (unsigned)(__longIntVal(address));
addr = (OBJFUNC) val;
/*
* allow function to be interrupted
*/
if (interruptable != true) {
wasBlocked = (__BLOCKINTERRUPTS() == true);
}
force = (forceOld == true);
if (force) {
if ((__oldSpaceSize() - __oldSpaceUsed()) < (256*1024)) {
__moreOldSpace(__thisContext, 256*1024);
}
prevSpace = __allocForceSpace(OLDSPACE);
}
if (special == true) {
if (__isSmallInteger(moduleID)) {
__SET_MODULE_ID(__intVal(moduleID));
}
retVal = (*addr)(arg, __pRT__);
__SET_MODULE_ID(0);
if (returnsObject != true) {
retVal = nil;
}
} else {
if (returnsObject == true) {
retVal = (*addr)(arg);
} else {
ret = (int) ((*addr)(arg));
retVal = __MKSMALLINT(ret);
}
}
if (force) {
__allocForceSpace(prevSpace);
}
if (! wasBlocked) {
__UNBLOCKINTERRUPTS();
}
RETURN (retVal);
}
}
%}.
self primitiveFailed
!
deinitializeClassesFromModule:handle
"send #deinitialize and an #aboutToUnload notification
to all classes of a module."
|classes|
classes := handle classes.
classes notNil ifTrue:[
classes do:[:aClass |
aClass notNil ifTrue:[
aClass isMeta ifFalse:[
Verbose ifTrue:[
'send #deinitialize to:' infoPrint. aClass name infoPrintNL.
].
aClass deinitialize.
aClass update:#aboutToUnload with:nil from:self
]
]
]
]
"Modified: 12.9.1996 / 08:07:28 / cg"
!
invalidateModule:handle
"invalidate all of the classes code objects ..."
|id|
Verbose ifTrue:[
'invalidate module; name=' infoPrint. handle pathName infoPrint.
' id=' infoPrint. handle moduleID infoPrintNL.
].
id := handle moduleID.
%{
__INVALIDATE_BY_ID(__intVal(id));
%}
!
loadStatusFor:className
"ask VM if class-hierarchy has been completely loaded, and return the status."
|checker checkSymbol statusCode status badClassName|
checker := self.
checkSymbol := #'superClassCheck:'.
%{ /* NOREGISTER */
char *badName;
char *interestingClassName;
if (__isString(className) || __isSymbol(className)) {
interestingClassName = __stringVal(className);
} else {
interestingClassName = (char *)0;
}
statusCode = __MKSMALLINT(__check_registration__(interestingClassName,
&checker, &checkSymbol, &badName));
if (badName) {
badClassName = __MKSTRING(badName);
}
%}.
statusCode == 0 ifTrue:[
status := #ok
] ifFalse:[
statusCode == -1 ifTrue:[
status := #missingClass
] ifFalse:[
statusCode == -2 ifTrue:[
status := #versionMismatch
] ifFalse:[
statusCode == -3 ifTrue:[
status := #unregisteredSuperclass
] ifFalse:[
status := #loadFailed
]
]
]
].
^ Array with:status with:badClassName.
!
moduleInit:phase forceOld:forceOld interruptable:interruptable
"initialization phases after registration.
DANGER: Pure magic; internal only -> dont use in your programs."
%{
int savInt;
int prevSpace, force;
int arg = 0;
int wasBlocked = 1;
if (_isSmallInteger(phase)) {
if (interruptable != true) {
wasBlocked = (__BLOCKINTERRUPTS() == true);
}
force = (forceOld == true);
if (force) {
prevSpace = __allocForceSpace(OLDSPACE);
}
__init_registered_modules__(__intVal(phase));
if (force) {
__allocForceSpace(prevSpace);
}
if (! wasBlocked) {
__UNBLOCKINTERRUPTS();
}
RETURN (self);
}
%}.
self primitiveFailed
!
performModuleInitAt:initAddr for:className identifyAs:handle
"Initialize a loaded smalltalk module."
|status badClassName infoCollection info classNames classes|
"
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
"
"/
"/ let it register itself
"/ and define its globals
"/
Verbose ifTrue:[
'phase 0 ...' infoPrintNL
].
self callInitFunctionAt:initAddr
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:[
'... status is ' infoPrint. info infoPrintNL
].
(status ~~ #ok) ifTrue:[
(status == #missingClass) ifTrue:[
Transcript showCR:'load failed - missing class: ' , badClassName.
^ info
].
(status == #versionMismatch) ifTrue:[
Transcript showCR:'load failed - version mismatch: ' , badClassName.
^ info
].
(status == #unregisteredSuperclass) ifTrue:[
Transcript showCR:'load failed - unregistered: ' , badClassName.
^ info
].
Transcript showCR:'load failed'.
^ Array with:#loadFailed with:nil
].
"/
"/ remaining initialization
"/
Verbose ifTrue:[
'phase 1 ...' infoPrintNL
].
self moduleInit:1 forceOld:true interruptable:false.
Verbose ifTrue:[
'phase 2 ...' infoPrintNL
].
self moduleInit:2 forceOld:true interruptable:false.
Verbose ifTrue:[
'phase 3 ...' infoPrintNL
].
ObjectMemory flushCaches.
self moduleInit:3 forceOld:false interruptable:true.
"/ ask objectMemory for the classes we have just loaded
"/ and register them in the handle
infoCollection := ObjectMemory binaryModuleInfo.
info := infoCollection at:handle moduleID ifAbsent:nil.
info isNil ifTrue:[
"/ mhmh registration failed -
^ Array with:#registrationFailed with:nil
].
classNames := info classNames.
classNames size > 0 ifTrue:[
classes := classNames collect:[:nm | Smalltalk classNamed:nm].
].
classes size > 0 ifTrue:[
classes := classes asArray.
classes := classes , (classes collect:[:aClass | aClass class]).
].
handle classes:classes.
^ Array with:#ok with:nil
"Modified: 31.10.1996 / 14:02:35 / cg"
!
revalidateModule:handle
"revalidate all of the classes code objects ..."
|id|
Verbose ifTrue:[
'revalidate module; name=' infoPrint. handle pathName infoPrint.
' id=' infoPrint. handle moduleID infoPrintNL.
].
id := handle moduleID.
%{
__REVALIDATE_BY_ID(__intVal(id));
%}
!
superClassCheck:aClass
"callBack from class registration code in VM:
make certain, that aClass is loaded too ...
(req'd if a subclass of an autoloaded class has been loaded)"
Verbose ifTrue:[
'checkCall for:' infoPrint. aClass name infoPrint. ' -> ' infoPrint.
].
aClass isBehavior ifFalse:[
Verbose ifTrue:[
'false' infoPrintNL.
].
'LOADER: check failed - no behavior' infoPrintNL.
^ false
].
Verbose ifTrue:[
'true' infoPrintNL.
].
('LOADER: check for ' , aClass name , ' being loaded') infoPrintNL.
aClass autoload.
(aClass isBehavior and:[aClass isLoaded]) ifTrue:[
('LOADER: ok, loaded. continue registration of actual class') infoPrintNL.
aClass signature. "/ req'd in VM for validation
^ true
].
('LOADER: nope - not loaded. fail registration of actual class') infoPrintNL.
^ false
!
unregisterModule:handle
"unregister classes in the VM.
This invalidates all of the classes code objects ..."
|id|
Verbose ifTrue:[
'unregister module; name=' infoPrint. handle pathName infoPrint.
' id=' infoPrint. handle moduleID infoPrintNL.
].
id := handle moduleID.
%{
__UNREGISTER_BY_ID(__intVal(id));
%}
! !
!ObjectFileLoader class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libcomp/ObjectFileLoader.st,v 1.121 1996-11-04 23:14:30 cg Exp $'
! !
ObjectFileLoader initialize!