"
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.
"
"{ Package: 'stx:libcomp' }"
Object subclass:#ObjectFileLoader
instanceVariableNames:''
classVariableNames:'MySymbolTable Verbose LastError LinkErrorMessage NextHandleID
LoadedObjects PreviouslyLoadedObjects ActuallyLoadedObjects
SearchedLibraries LibPath LoadLibraryPath ErrorPrinting
LinkCommand LinkArgs LastErrorNumber OldSpaceReserve'
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
#if defined(hpux10)
# undef SYSV4_DL
# define HPUX10_DL
# define HAS_DL
#endif
#if defined(alpha) && defined(__osf__)
# define SYSV4_DL
# define HAS_DL
#endif
#ifdef __VMS__
# undef __new
# define VMS_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 defined(BEOS)
# undef COFF
# undef ELF
# undef A_DOT_OUT
# define HAS_DL
# define BEOS_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 HPUX10_DL
# include <dl.h>
# include <errno.h>
#endif
#ifdef BEOS_DL
# include <be/kernel/image.h>
#endif
#ifdef WIN_DL
# ifdef WIN32
# undef INT
# undef Array
# undef Number
# undef Method
# undef Block
# undef Time
# undef Date
# undef Set
# undef Delay
# undef Signal
# undef Context
# ifdef i386
# ifndef _X86_
# define _X86_
# endif
# endif
# ifdef __BORLANDC__
# define NOATOM
# define NOUSER
# define NOGDI
# define NOGDICAPMASKS
# define NOMETAFILE
# define NOMINMAX
# define NOMSG
# define NOOPENFILE
# define NORASTEROPS
# define NOSCROLL
# define NOSOUND
# define NOSYSMETRICS
# define NOTEXTMETRIC
# define NOWH
# define NOCOMM
# define NOKANJI
# define NOCRYPT
# define NOMCX
# define WIN32_LEAN_AND_MEAN
# include <windows.h> /* */
# else
/* # include <windows.h> /* */
# endif
# 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
# ifdef __DEF_Block
# define Block __DEF_Block
# endif
# ifdef __DEF_Time
# define Time __DEF_Time
# endif
# ifdef __DEF_Date
# define Date __DEF_Date
# endif
# ifdef __DEF_Set
# define Set __DEF_Set
# endif
# ifdef __DEF_Signal
# define Signal __DEF_Signal
# endif
# ifdef __DEF_Delay
# define Delay __DEF_Delay
# endif
# ifdef __DEF_Context
# define Context __DEF_Context
# endif
# endif
#endif /* WIN_DL */
%}
! !
!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 still experimental and WITHOUT ANY WARRANTY.
It is still being developed and the code may need some 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),
or LoadLibrary (Win32), this is used
b) if no such facility exists, the normal linker is used to
link the module to text/data address as previously malloced,
and the object file 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 the last loaded module).
The only really useful packages are the GNU-dl package,
the SGI/Unixware/sys5.4/linux libdl packages and the win32 dll's.
The GNU-dl package is only available for a.out file formats
(which is more or less obsolete);
For the above reasons, dynamic object loading is currently only
officially released for SYS5.4-based, LINUX and win32 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).
Right now, reloading of object files is done by smalltalk code,
which fails, if code is to be loaded which is required before the
load takes place, or which is used by the loader itself.
(i.e. for now, many primitives from libbasic cannot be dynamically
loaded at image restart time).
[author:]
Claus Gittinger
"
! !
!ObjectFileLoader class methodsFor:'initialization'!
initialize
|systemType libDir|
OperatingSystem isMSDOSlike ifTrue:[
"/ default setup for msc
OperatingSystem getCCDefine ='__BORLANDC__' ifTrue:[
libDir := '..\libbc'.
libDir asFilename exists ifFalse:[
libDir := '..\lib\libbc'.
libDir asFilename exists ifFalse:[
libDir := '..\lib'.
]
].
LinkCommand isNil ifTrue:[
LinkCommand := 'tlink32'.
LinkCommand := 'ilink32'.
].
LinkArgs isNil ifTrue:[
LinkArgs := '-L',libDir,' -L\Programme\Borland\CBuilder3\lib -c -ap -Tpd -s -Gi -v -w-dup ',libDir,'\librun.lib'.
LinkArgs := '-L',libDir,' -L\Programme\Borland\CBuilder3\lib -r -c -ap -Tpd -Gi -w-dup'.
].
SearchedLibraries := #(
'import32.lib'
).
] ifFalse:[
LinkCommand isNil ifTrue:[
LinkCommand := 'link'
].
LinkArgs isNil ifTrue:[
LinkArgs := '/NOPACK /NOLOGO /DEBUG /MACHINE:I386 /DLL /OUT:%1.dll /DEF:%1.def'
].
].
].
MySymbolTable isNil ifTrue:[
Verbose := false.
NextHandleID := 1.
ObjectMemory addDependent:self.
OperatingSystem isMSDOSlike ifTrue:[
SearchedLibraries := #(
'import32.lib'
).
].
OperatingSystem isUNIXlike ifTrue:[
systemType := OperatingSystem getOSType.
"/ name of object file, where initial symbol table is found
"/ not req'd for all architectures.
MySymbolTable := 'stx'.
"/ 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 = '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 searched for
"/ when a dynamic library is loaded without an explicit path.
LoadLibraryPath := OperatingSystem getEnvironment:'LD_LIBRARY_PATH'.
LoadLibraryPath isNil ifTrue:[
LoadLibraryPath := #('.'
'lib'
'/usr/local/smalltalk/lib'
'/usr/local/lib'
'/usr/lib'
'/lib'
) asOrderedCollection.
].
"/ 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'.
]
].
]
]
"
LinkArgs := LinkCommand := nil.
ObjectFileLoader initialize
"
"Modified: / 10.11.2001 / 01:45:01 / cg"
!
lastError
^ LastError ? 'unknown error'
"Modified: / 30.9.1998 / 17:21:23 / cg"
!
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
"return true, if debug traces are turned on"
^ Verbose
!
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."
|fn|
fn := aFilename asFilename.
self validBinaryExtensions do:[:ext |
(fn hasSuffix:ext) ifTrue:[^ true].
].
^ false
"
ObjectFileLoader hasValidBinaryExtension:'foo.st'
ObjectFileLoader hasValidBinaryExtension:'foo.o'
ObjectFileLoader hasValidBinaryExtension:'foo.so'
ObjectFileLoader hasValidBinaryExtension:'foo.dll'
ObjectFileLoader hasValidBinaryExtension:'foo.DLL'
ObjectFileLoader hasValidBinaryExtension:'foo.obj'
ObjectFileLoader hasValidBinaryExtension:'foo.sl'
"
"Modified: / 1.10.1998 / 12:47:01 / cg"
!
linkArgs
^ LinkArgs ? '' "/ that default is ok for Unix
"Created: / 12.8.1998 / 21:41:16 / cg"
"Modified: / 12.8.1998 / 21:42:50 / cg"
!
linkArgs:anArgString
LinkArgs := anArgString
"
MSC:
LinkCommand := 'link32'.
LinkArgs := ' /NOPACK /NOLOGO /DEBUG /MACHINE:I386 /DLL /OUT:%1.dll /DEF:%1.def'
Borland:
LinkCommand := 'ilink32'.
LinkArgs := '-ap -E0 -Tpd -s -c -L\Programme\Borland\CBuilder3\lib -L..\libbc librun.lib import32.lib'
'
'/NOPACK /NOLOGO /DEBUG /MACHINE:I386 /DLL /OUT:%1.dll /DEF:%1.def'
Unix:
LinkCommand := 'ld'
LinkArgs := '-shared'
"
"Created: / 12.8.1998 / 21:43:16 / cg"
"Modified: / 4.9.1998 / 00:33:46 / cg"
!
linkCommand
^ LinkCommand ? 'ld' "/ that default is ok for Unix
"Created: / 12.8.1998 / 21:41:16 / cg"
!
linkCommand:aCommand
LinkCommand := aCommand
"Created: / 12.8.1998 / 21:40:44 / cg"
!
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(alpha) && defined(__osf__)
RETURN ( @symbol(coff));
# endif
# if defined(GNU_DL)
RETURN ( @symbol(aout));
# endif
# if defined(AIX_DL)
RETURN ( @symbol(xcoff));
# endif
# if defined(HPUX10_DL)
RETURN ( @symbol(hpcoff));
# endif
# if defined(DL1_6)
RETURN ( @symbol(coff));
# endif
# if defined(WIN_DL)
RETURN ( @symbol(dll));
# endif
# if defined(BEOS_DL)
RETURN ( @symbol(beobj));
# endif
# if defined(__VMS__)
RETURN ( @symbol(exe));
# 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.
This entry is obsolete (no longer req'd) and will vanish."
|os|
os := OperatingSystem getOSType.
(os = 'irix' or:[os = 'osf']) ifTrue:[
^ 'nm -B ' , file
].
(os = 'solaris') ifTrue:[
^ 'nm -p ' , file
].
^ 'nm ' , file
"Modified: / 4.5.1998 / 12:18:47 / cg"
!
objectFileExtension
"return the fileName extension used for objects,
as generated by myself (output of cc).
This is very machine specific."
|os|
OperatingSystem isMSDOSlike ifTrue:[
"/ includes all of win32s, win95, winNT & os/2
^ '.obj'
].
OperatingSystem isVMSlike ifTrue:[
^ '.obj'
].
^ '.o'
"
ObjectFileLoader objectFileExtension
"
"Modified: / 4.5.1998 / 12:17:34 / cg"
!
sharedLibraryExtension
"return the fileName extension used for dynamic loadable objects,
as generated by myself (output of linker).
This is very machine specific."
|suff|
suff := self sharedLibrarySuffix.
suff notNil ifTrue:[^ '.' , suff].
^ suff
"
ObjectFileLoader sharedLibraryExtension
"
"Modified: / 4.5.1998 / 12:17:34 / cg"
!
sharedLibrarySuffix
"return the fileName suffix used for dynamic loadable objects,
as generated by myself (output of linker).
This is very machine specific."
|os|
OperatingSystem isMSDOSlike ifTrue:[
"/ includes all of win32s, win95, winNT & os/2
^ 'dll'
].
OperatingSystem isVMSlike ifTrue:[
^ 'exe'
].
os := OperatingSystem getSystemType.
(os = 'linux') ifTrue:[
self loadableBinaryObjectFormat == #aout ifTrue:[
"/ not really shared, but loadable
^ 'o'
].
].
(os = 'hpux') ifTrue:[^ 'sl'].
"/ mhmh what is a useful default ?
^ 'so'
"
ObjectFileLoader sharedLibrarySuffix
"
"Modified: / 4.5.1998 / 12:17:34 / cg"
!
validBinaryExtensions
"return a collection of valid filename extension for binary files.
This is very machine specific."
|os|
OperatingSystem isMSDOSlike ifTrue:[
"/ includes all of win32s, win95, winNT & os/2
^ #('dll')
].
OperatingSystem isVMSlike ifTrue:[
^ #('exe')
].
os := OperatingSystem getSystemType.
(os = 'sunos') ifTrue:[^ #('o' 'obj' 'a') ].
(os = 'ultrix') ifTrue:[^ #('o' 'obj' 'ld' 'obj.ld') ].
(os = 'linux') ifTrue:[
self loadableBinaryObjectFormat == #aout ifTrue:[
^ #('o' 'obj' 'a')
].
^ #('so' 'o' 'obj' )
].
(os = 'aix') ifTrue:[^ #('so' 'o') ].
(os = 'hpux') ifTrue:[^ #('sl') ].
"/ mhmh what is a useful default ?
^ #('so')
"
ObjectFileLoader validBinaryExtensions
"
"Modified: / 1.10.1998 / 12:46:03 / cg"
! !
!ObjectFileLoader class methodsFor:'dynamic object loading'!
loadCPlusPlusObjectFile:aFileName
"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:[
^ nil
].
list := self namesMatching:'__GLOBAL_$I*' segment:'[tT?]' in:aFileName.
list size == 1 ifTrue:[
"/ (self isCPlusPlusObject:handle) ifTrue:[
Verbose ifTrue:[
'a c++ object file' infoPrintCR.
].
"
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)) infoPrintCR
"/ ].
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 , ')') infoPrintCR.
].
self unloadDynamicObject:aFileName.
^ nil
].
Verbose ifTrue:[
('calling CTORs at:' , (initAddr printStringRadix:16)) infoPrintCR
].
self callInitFunctionAt:initAddr
specialInit:false
forceOld:false
interruptable:false
argument:0
identifyAs:nil
returnsObject:false.
Verbose ifTrue:[
'done with CTORs.' infoPrintCR
].
"
cannot create a CPlusPlus class automatically (there could be more than
one classes in it too ...)
"
^ handle
].
Verbose ifTrue:[
'unknown object file' infoPrintCR
].
self unloadDynamicObject:aFileName.
^ nil
"Modified: 10.1.1997 / 19:11:57 / cg"
!
loadClass:aClassName fromObjectFile:aFileName
"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:[
^ 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 ...' infoPrintCR.
"/ ].
"/
"/ "
"/ 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)) infoPrintCR.
].
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) infoPrintCR.
].
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 infoPrintCR.
].
(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 infoPrintCR
].
newClass notNil ifTrue:[
Smalltalk at:aClassName asSymbol put:newClass.
(newClass includesSelector:#initialize) ifTrue:[
Verbose ifTrue:[
'initialize newClass ...' infoPrintCR
].
newClass initialize.
].
"force cache flush"
Smalltalk isInitialized ifTrue:[
Smalltalk changed.
]
].
] ifFalse:[
'ObjectFileLoader [warning]: class ' errorPrint. aClassName errorPrint.
' did not define itself' errorPrintCR
"
do not unload - could have installed other classes/methods ...
"
].
Smalltalk flushCachedClasses.
^ newClass
].
Verbose ifTrue:[
('no symbol: ', symName,' in ',aFileName) infoPrintCR.
].
"
unload
"
Verbose ifTrue:[
'unloading due to init failure:' infoPrint. handle pathName infoPrintCR.
].
moreHandles notNil ifTrue:[
moreHandles do:[:aHandle |
Verbose ifTrue:[
('unloading: ', aHandle printString) infoPrintCR.
].
self unloadDynamicObject:handle.
]
].
Verbose ifTrue:[
('unloading: ', handle printString) infoPrintCR.
].
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: 6.7.1997 / 12:34:48 / cg"
!
loadLibrary:aLibraryFileName
"load a library; search in some standard places and using
standard suffixes (i.e. no suffix should be given in the arg).
Returns a handle or nil.
Use this to attach C-libraries."
|s suffixes handle libFilename|
libFilename := aLibraryFileName asFilename.
(s := libFilename suffix) isEmpty ifTrue:[
suffixes := self validBinaryExtensions
] ifFalse:[
suffixes := #('')
].
"/ try each suffix ...
suffixes do:[:aSuffix |
|fn f|
fn := aLibraryFileName , '.' , aSuffix.
(libFilename isAbsolute
or:[(aLibraryFileName startsWith:'./')
or:[(aLibraryFileName startsWith:'../')]]) ifTrue:[
f := fn asFilename.
f exists ifTrue:[
handle := self loadObjectFile:fn.
handle notNil ifTrue:[^ handle].
]
] ifFalse:[
"/ try each directory
LoadLibraryPath size > 0 ifTrue:[
(LoadLibraryPath asCollectionOfSubstringsSeparatedBy:$:)
do:[:aDir |
f := aDir asFilename construct:fn.
f exists ifTrue:[
handle := self loadObjectFile:f pathName.
handle notNil ifTrue:[^ handle].
]
]
].
"/ try to load it by name - maybe someone else knows
"/ how to find it (the system itself)
handle := self loadObjectFile:fn.
handle notNil ifTrue:[^ handle].
]
].
^ nil
"
ObjectFileLoader loadLibrary:'libjpeg'
ObjectFileLoader loadLibrary:'odbc32'
"
"Modified: / 4.5.1999 / 17:01:47 / 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.
'ObjectFileLoader [info]: undefined symbols in primitive code' infoPrintCR.
] ifFalse:[
('ObjectFileLoader [info]: ' , initName , '_Init() lookup failed') errorPrintCR
].
"/
"/ not found - unload
"/
self unloadDynamicObject:handle.
^ nil
]
].
Object osSignalInterruptSignal handle:[:ex |
('ObjectFileLoader [warning]: hard error in initFunction: ' , initName , ' of method-module ' , aFileName) errorPrintCR.
self unloadDynamicObject:handle.
^ nil
] do:[
"/
"/ call it - it returns the new method object
"/
self "/ registration
callInitFunctionAt:initAddr
specialInit:true
forceOld:true
interruptable:false
argument:0
identifyAs:handle
returnsObject:false.
m := self
callInitFunctionAt:initAddr "/ initialization
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: / 21.10.1998 / 15:17:31 / 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).
This may be either a smalltalk object or a C-object file.
The object files init function (if any) is called, and the module
is unloaded if it returns failure (use lowLevel load, to load a file
without automatic initialization).
Return nil on error, an objectFile handle if ok."
^ self
loadObjectFile:aFileName
invokeInitializeMethods:true
!
loadObjectFile:aFileName invokeInitializeMethods:invokeInitializeMethods
"load an object file (.o-file) into the image;
the class name is not needed (multiple definitions may be in the file).
This may be either a smalltalk object or a C-object file.
The object files init function (if any) is called, and the module
is unloaded if it returns failure (use lowLevel load, to load a file
without automatic initialization).
Return nil on error, an objectFile handle if ok."
|handle initAddr className initNames didInit info status
dummyHandle msg isCModule|
handle := self loadDynamicObject:aFileName.
handle isNil ifTrue:[
^ 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:[
self initializeLoader.
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:('LOADER: 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)) infoPrintCR.
].
info := self
performModuleInitAt:initAddr
invokeInitializeMethods:invokeInitializeMethods
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:[
isCModule := true.
Object osSignalInterruptSignal handle:[:ex |
('ObjectFileLoader [warning]: hard error in initFunction of class-module: ' , aFileName) errorPrintCR.
status := #initFailed.
] do:[
(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:[
status := #noInitFunction.
"
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
invokeInitializeMethods:invokeInitializeMethods
for:nil
identifyAs:handle.
didInit := true.
]
].
].
]
].
didInit ifFalse:[
status == #noInitFunction ifTrue:[
msg := 'LOADER: no init function; assume load ok'
] ifFalse:[
(status ~~ #registrationFailed
and:[status ~~ #initFailed
and:[status ~~ #missingClass
and:[status ~~ #versionMismatch]]])
ifTrue:[
self listUndefinedSymbolsIn:handle.
].
Verbose ifTrue:[
'unloading, since init failed ...' infoPrintCR.
].
self unloadDynamicObject:handle.
Verbose ifTrue:[
'unloaded.' infoPrintCR.
].
handle := nil.
status == #initFailed ifTrue:[
msg := 'LOADER: module not loaded (init function signalled failure).'
] ifFalse:[
status == #missingClass ifTrue:[
msg := 'LOADER: module not loaded (superclass missing: ' , (info at:2) , ').'
] ifFalse:[
status == #registrationFailed ifTrue:[
msg := 'LOADER: module registration failed (incompatible object or missing superclass)'
] ifFalse:[
status == #versionMismatch ifTrue:[
msg := 'LOADER: module registration failed (class version mismatch ' , (info at:2) printString , ')'
] ifFalse:[
(self namesMatching:'*__sepInitCode__*' segment:'[tT?]' in:aFileName) notNil ifTrue:[
msg := 'LOADER: module not loaded (unknown error reason).'
] ifFalse:[
msg := 'LOADER: module not loaded (no _Init entry in object file ?).'
]
]
].
].
].
].
Transcript showCR:msg
].
isCModule ifFalse:[
Smalltalk isInitialized ifTrue:[
"
really dont know, if it has changed ...
... but assume, that new classes have been installed.
"
Smalltalk changed.
]
].
^ handle
"Modified: / 21.10.1998 / 15:19:10 / 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 , ')') infoPrintCR.
^ self
].
"/ call the modules deInit-function ...
"/ unload ...
self unloadDynamicObject:handle
!
unloadObjectFileAndRemoveClasses:aFileName
"unload an object file (.o-file) from the image and remove all
corresponding classes from the system.
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 ? 'unknown-file') , ')') infoPrintCR.
^ self
].
handle isClassLibHandle ifFalse:[
self warn:'module is not a classLib module'.
^ self
].
"/ remove the classes ...
Class withoutUpdatingChangesDo:[
handle classes do:[:aClass |
aClass notNil ifTrue:[
aClass isMeta ifFalse:[
aClass removeFromSystem
]
]
]
].
"/ call the modules deInit-function ...
"/ unload ...
self unloadDynamicObject:handle
"Modified: / 12.12.1997 / 22:12:28 / cg"
! !
!ObjectFileLoader class methodsFor:'dynamic object queries'!
findFunction:functionName suffix:suffix in:handle
"look for the init function and returns its address"
|initAddr className nm|
"/ care for colons, as found in nameSpace classes ...
nm := functionName asString copyReplaceAll:$: with:$_.
"
look for explicit init function
"
initAddr := self getFunction:(nm , suffix) from:handle.
initAddr notNil ifTrue:[^ initAddr].
initAddr := self getFunction:('_' , nm , 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:('__' , nm , 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 isNil ifTrue:[
"/
"/ special for broken ultrix nlist
"/ (will not find symbol with single underscore)
"/ workaround: add another underscore and retry
"/
initAddr := self getFunction:('__' , className , suffix) from:handle.
].
].
^ initAddr
"Created: / 13.7.1996 / 00:38:01 / cg"
"Modified: / 18.7.1998 / 22:59:12 / 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
#ifdef BEOS_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 (@global(Verbose) == true) {
printf("addr of %s = %x\n", name, addr);
}
address = __MKUINT( addr );
}
} else {
func = (void (*) ()) dld_get_func(name);
if (func) {
if (@global(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 (@global(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 (@global(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 (@global(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 (@global(Verbose) == true) {
printf("GetProcAddr %s ok; addr = %x\n", __stringVal(aString), addr);
}
address = __MKUINT( (int)addr );
} else {
if (@global(Verbose) == true) {
printf("GetProcAddr %s error: %x\n", __stringVal(aString), GetLastError());
}
}
}
}
}
#endif
#ifdef BEOS_DL
{
void *h;
void *addr;
INT val;
void *handle;
if (__bothSmallInteger(sysHandle1, sysHandle2)) {
val = (_intVal(sysHandle2) << 16) + _intVal(sysHandle1);
handle = (void *)(val);
if (__isString(aString)) {
if (@global(Verbose) == true)
printf("get sym <%s> handle = %x\n", __stringVal(aString), (int)handle);
entry = NULL;
get_image_symbol((image_id) handle, (char *) __stringVal(aString), B_SYMBOL_TYPE_TEXT, &entry);
if (entry != NULL) {
addr = (void *)entry;
if (@global(Verbose) == true) {
printf("get_image_symbol %s ok; addr = %x\n", __stringVal(aString), addr);
}
address = __MKUINT( (int)addr );
} else {
if (@global(Verbose) == true) {
printf("get_image_symbol %s error\n", __stringVal(aString));
}
}
}
}
}
#endif
#ifdef DL1_6
{
void *h;
void *addr;
INT val;
if (__isString(aString)) {
if (__isString(sysHandle1)) {
if (@global(Verbose) == true)
printf("get sym <%s> handle = %x\n",
__stringVal(aString), __stringVal(sysHandle1));
addr = dl_getsymbol(__stringVal(sysHandle1), __stringVal(aString));
if (addr) {
if (@global(Verbose) == true)
printf("addr = %x\n", addr);
address = __MKUINT( (int)addr );
} else {
if (@global(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;
extern void *dlsym();
if (__bothSmallInteger(low, hi)) {
#ifdef alpha64
val = (__intVal(hi) << 32) + __intVal(low);
#else
val = (__intVal(hi) << 16) + __intVal(low);
#endif
h = (void *)(val);
if (__isString(aString)) {
if (@global(Verbose) == true) {
printf("get sym <%s> handle = %x\n", __stringVal(aString), h);
}
addr = dlsym(h, (char *) __stringVal(aString));
if (addr) {
if (@global(Verbose) == true) {
printf("dlsym %s ok; addr = %x\n", __stringVal(aString), addr);
}
address = __MKUINT( (INT)addr );
} else {
if (@global(Verbose) == true) {
printf("dlsym %s error: %s\n", __stringVal(aString), dlerror());
}
}
}
}
}
#endif
#ifdef HPUX10_DL
{
void *h;
void *addr;
INT val, ret;
OBJ low = sysHandle1, hi = sysHandle2;
if (__bothSmallInteger(low, hi)) {
val = (_intVal(hi) << 16) + _intVal(low);
h = (void *)(val);
if (__isString(aString)) {
if (@global(Verbose) == true) {
printf("get sym <%s> handle = %x\n", __stringVal(aString), h);
}
ret = shl_findsym(h, __stringVal(aString), TYPE_UNDEFINED, &addr);
if (ret != 0) {
if (@global(Verbose) == true) {
printf("dlsym %s error; errno=%d\n", __stringVal(aString), errno);
}
} else {
if (@global(Verbose) == true) {
printf("dlsym %s ok; addr = %x\n", __stringVal(aString), addr);
}
address = __MKUINT( (INT)addr );
}
}
}
}
#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 (@global(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 (@global(Verbose) == true) {
printf("returned 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 (@global(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 (@global(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 (@global(Verbose) == true) {
printf("get sym <%s> handle = %x\n", __stringVal(aString), h);
}
addr = dlsym(h, __stringVal(aString));
if (addr) {
if (@global(Verbose) == true) {
printf("addr = %x\n", addr);
}
address = __MKUINT( (int)addr );
} else {
if (@global(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 (@global(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 (@global(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 := aFileName asFilename.
suffixLen := 0.
self validBinaryExtensions do:[:suffix |
suffixLen == 0 ifTrue:[
(name hasSuffix:suffix) ifTrue:[
suffixLen := suffix size + 1
]
]
].
name := name baseName.
suffixLen ~~ 0 ifTrue:[
name := name copyWithoutLast:suffixLen
].
^ name.
"
ObjectFileLoader initFunctionBasenameForFile:'libbasic.so'
ObjectFileLoader initFunctionBasenameForFile:'demo.so'
ObjectFileLoader initFunctionBasenameForFile:'demo.o'
"
"Created: / 13.7.1996 / 00:01:54 / cg"
"Modified: / 1.10.1998 / 12:47:50 / 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"
!
namesMatching:aPattern segment:segmentPattern in:aFileName
"search for entries which match a pattern.
This is obsolete & rubbish - it will vanish soon"
|p l s addr segment name entry|
OperatingSystem isVMSlike ifTrue:[
"/ no nm command
^ nil
].
OperatingSystem isMSDOSlike ifTrue:[
"/ no nm command
^ nil
].
OperatingSystem getOSType = 'aix' ifTrue:[
"/ no useful nm info
^ nil
].
l := OrderedCollection new.
p := PipeStream readingFrom:(self nm:aFileName).
p isNil ifTrue:[
('ObjectFileLoader [info]: cannot read names from ' , aFileName) infoPrintCR.
^ nil
].
[p atEnd] whileFalse:[
entry := p nextLine.
Verbose ifTrue:[
entry infoPrintCR.
].
entry notNil ifTrue:[
s := ReadStream on:entry.
addr := s nextAlphaNumericWord.
s skipSeparators.
segment := s upToSeparator.
s skipSeparators.
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) infoPrintCR.
]
] ifFalse:[
Verbose ifTrue:[
name infoPrint. ' segment mismatch ' infoPrint.
segmentPattern infoPrint. ' ' infoPrint. segment infoPrintCR.
]
]
]
]
]
].
p close.
^ l
"Modified: / 27.7.1998 / 20:10:57 / cg"
!
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
%}
! !
!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
saveOldMethodsPerClass anyModulesToInitialize|
PreviouslyLoadedObjects notNil ifTrue:[
anyModulesToInitialize := false.
PreviouslyLoadedObjects do:[:entry |
|fileName handle cls sel|
fileName := entry key.
handle := entry value.
handle moduleID:nil.
handle isClassLibHandle ifTrue:[
('ObjectFileLoader [info]: reloading classes in ' , fileName , ' ...') infoPrintCR.
"/
"/ remember all byteCode methods (as added in the session)
"/
savedByteCodeMethods := Dictionary new.
savedOldClasses := IdentitySet new.
saveOldMethodsPerClass := Dictionary new.
handle classes do:[:aClass |
|clsName mthdDict|
(aClass notNil and:[aClass ~~ 0]) ifTrue:[
clsName := aClass name.
mthdDict := aClass methodDictionary.
saveOldMethodsPerClass at:clsName put:mthdDict copy.
savedMethods := IdentityDictionary new.
savedOldClasses add:aClass.
mthdDict keysAndValuesDo:[:sel :m |
m byteCode notNil ifTrue:[
"/ an interpreted method - must be preserved
savedMethods at:sel put:m
]
].
savedMethods notEmpty ifTrue:[
savedByteCodeMethods at:clsName put:savedMethods
].
]
].
"/
"/ load the class binary
"/
handle := self loadObjectFile:fileName invokeInitializeMethods:false.
handle notNil ifTrue:[
anyModulesToInitialize := true
].
"/ after reloading of the objectFile,
"/ some of the changes made in the previous life have to be
"/ redone here - otherwise, we will be left with the
"/ state contained in the loaded objectModule - instead of
"/ what we had when saving the image ...
"/
"/ 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) printCR.
]
].
"/
"/ re-remove removed methods
"/ and re-change method categories
"/
savedOldClasses do:[:oldClass |
|newClass oldMethods newMethodDict oldMthd newMthd
oldCat oldClassVarString oldClassCategory|
newClass := Smalltalk classNamed:(oldClass name).
newClass notNil ifTrue:[
oldClassVarString := oldClass classVariableString.
newClass classVariableString ~= oldClassVarString ifTrue:[
"/ there is no need to recreate the variable
"/ (its in the smalltalk dictionary)
newClass setClassVariableString:oldClassVarString
].
newClass isMeta ifFalse:[
oldClassCategory := oldClass category.
newClass category ~= oldClassCategory ifTrue:[
newClass setCategory:oldClassCategory
]
].
oldMethods := saveOldMethodsPerClass at:oldClass name.
newMethodDict := newClass methodDictionary.
newMethodDict keys copy do:[:newSelector |
(oldMethods includesKey:newSelector) ifFalse:[
"/ ('ObjectFileLoader [info]: remove method #' , newSelector , ' from reloaded ' , oldClass name , '.') infoPrintCR.
newMethodDict removeKey:newSelector
] ifTrue:[
oldMthd := oldMethods at:newSelector.
newMthd := newMethodDict at:newSelector.
newMthd category:oldMthd category
]
]
]
].
"/
"/ 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
"/
"/ ('ObjectFileLoader [info]: migrating classes ...') infoPrintCR.
savedOldClasses do:[:oldClass |
|newClass oldCat oldCVars|
newClass := Smalltalk classNamed:(oldClass name).
newClass == oldClass ifTrue:[
"/ ('ObjectFileLoader [info]: class ' , oldClass name , ' reloaded.') infoPrintCR.
] ifFalse:[
(newClass isNil or:[newClass == oldClass]) ifTrue:[
('ObjectFileLoader [warning]: 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:[
('ObjectFileLoader [warning]: ' , oldClass name , ' has changed its size.') errorPrintCR.
] ifFalse:[
oldClass class instSize ~~ newClass class instSize ifTrue:[
('ObjectFileLoader [warning]: ' , oldClass name , ' class has changed its size.') errorPrintCR.
] ifFalse:[
"/ ('ObjectFileLoader [info]: migrating ' , oldClass name) infoPrintCR.
(oldCat := oldClass category) ~= newClass category ifTrue:[
newClass setCategory:oldCat.
].
(oldCVars := oldClass classVariableString) ~= newClass classVariableString ifTrue:[
newClass setClassVariableString:oldCVars
].
"/ copy over the oldClasses class-instVars
(Class instSize + 1) to:(oldClass class instSize) do:[:idx |
newClass instVarAt:idx put:(oldClass instVarAt:idx)
].
oldClass becomeSameAs:newClass
"/ oldClass become:newClass
]
]
]
]
]
] ifFalse:[
handle isMethodHandle ifTrue:[
oldDummyMethod := handle method.
(oldDummyMethod isKindOf:Method) ifFalse:[
('ObjectFileLoader [info]: ignore obsolete (already collected) method in ' , fileName) infoPrintCR
] ifTrue:[
('ObjectFileLoader [info]: reloading method in ' , fileName , ' ...') infoPrintCR.
who := oldDummyMethod who.
newHandle := self loadMethodObjectFile:fileName.
newHandle isNil ifTrue:[
('ObjectFileLoader [warning]: failed to reload method in ' , fileName , ' ...') errorPrintCR.
handle moduleID:nil.
] ifFalse:[
m := newHandle method.
oldDummyMethod sourceFilename notNil ifTrue:[
m sourceFilename:(oldDummyMethod sourceFilename)
position:(oldDummyMethod sourcePosition).
] ifFalse:[
m source:(oldDummyMethod source).
].
m setPackage:(oldDummyMethod package).
who notNil ifTrue:[
cls := who methodClass.
sel := who methodSelector.
m == (cls compiledMethodAt:sel) ifFalse:[
'ObjectFileLoader [warning]: oops - loaded method installed wrong' errorPrintCR.
] ifTrue:[
"/ cls changed:#methodDictionary with:(Array with:sel with:oldDummyMethod).
]
].
]
]
] ifFalse:[
handle isFunctionObjectHandle ifTrue:[
functions := handle functions.
functions isEmpty ifTrue:[
('ObjectFileLoader [info]: ignore obsolete (unreferenced) functions in ' , fileName) infoPrintCR
] ifFalse:[
newHandle := self loadDynamicObject:fileName.
newHandle isNil ifTrue:[
('ObjectFileLoader [warning]: failed to reload ' , fileName , ' ...') errorPrintCR.
handle moduleID:nil.
] ifFalse:[
('ObjectFileLoader [info]: reloading ' , fileName , ' ...') infoPrintCR.
functions do:[:oldFunction |
newFunction := newHandle getFunction:(oldFunction name).
newFunction isNil ifTrue:[
('ObjectFileLoader [info]: function: ''' , oldFunction name , ''' no longer present.') errorPrintCR.
oldFunction code:nil.
oldFunction setName:oldFunction name moduleHandle:nil.
] ifFalse:[
oldFunction code:(newFunction code).
oldFunction setName:oldFunction name moduleHandle:newHandle.
('ObjectFileLoader [info]: rebound function: ''' , oldFunction name , '''.') infoPrintCR.
]
].
handle becomeSameAs:newHandle. "/ the old handle is now void
]
]
] ifFalse:[
('ObjectFileLoader [info]: ignored invalid (obsolete) objectFile handle: ' , handle printString) infoPrintCR.
]
]
]
].
PreviouslyLoadedObjects := nil.
"/ now, as we hopefully have all loaded,
"/ send #reinitializeAfterLoad to each of them
anyModulesToInitialize ifTrue:[
AbortSignal catch:[
self moduleInit:4 forceOld:false interruptable:true.
]
]
]
"Modified: / 16.5.1998 / 14:23:12 / 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:[
('ObjectFileLoader [info]: ignore object for already collected objects in ' , name) infoPrintCR
] ifFalse:[
PreviouslyLoadedObjects add:(name -> handle)
]
].
PreviouslyLoadedObjects sort:[:a :b |
|h1 h2|
h1 := a value moduleID.
h2 := b value moduleID.
h1 isNil
ifTrue:[true]
ifFalse:[
h2 isNil
ifTrue:[false]
ifFalse:[
h1 < h2
]
]
].
]
"Created: 5.12.1995 / 20:51:07 / cg"
"Modified: 10.1.1997 / 15:06:25 / 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 ..."
|osType oFileName soFileName expFileName librunExpFileName
needSharedObject ld ldArg expFile ok outfile output libDir|
osType := OperatingSystem getOSType.
osType = 'win32' ifTrue:[
self activityNotification:'create def file'.
"/ create a .def file.
expFileName := '.\' , baseFileName , '.def'.
[
expFile := expFileName asFilename writeStream.
OperatingSystem getCCDefine ='__BORLANDC__' ifTrue:[
expFile nextPutLine:'LIBRARY ' , baseFileName.
expFile nextPutLine:'SEGMENTS'.
expFile nextPutLine:' INITCODE PRELOAD SHARED'.
"/ expFile nextPutLine:' INITDATA READ WRITE'.
expFile nextPutLine:'EXPORTS'.
expFile nextPutLine:' __' , baseFileName , '_Init'.
] ifFalse:[
expFile nextPutLine:'LIBRARY ' , baseFileName.
expFile nextPutLine:'CODE EXECUTE READ SHARED'.
expFile nextPutLine:'DATA READ WRITE'.
expFile nextPutLine:'SECTIONS'.
expFile nextPutLine:' INITCODE READ EXECUTE SHARED'.
expFile nextPutLine:' INITDATA READ WRITE'.
expFile nextPutLine:' RODATA READ SHARED'.
expFile nextPutLine:'EXPORTS'.
expFile nextPutLine:' _' , baseFileName , '_Init'.
expFile nextPutLine:'IMPORTS'.
].
expFile close.
] on:FileStream openErrorSignal do:[:ex| "do nothing"].
self activityNotification:'generating shared object'.
LinkArgs isNil ifTrue:[
ld := LinkCommand , ' ' , baseFileName , '.obj'.
ld := ld
, ' /NOPACK /NOLOGO /DEBUG /MACHINE:I386 /DLL'
, ' /OUT:' , baseFileName , '.dll '
, ' /DEF:' , baseFileName , '.def'.
] ifFalse:[
libDir := '..\libbc'.
libDir asFilename exists ifFalse:[
libDir := '..\lib\libbc'.
libDir asFilename exists ifFalse:[
libDir := '..\lib'.
libDir asFilename exists ifFalse:[
libDir := '..\..\libbc'.
libDir asFilename exists ifFalse:[
self halt:'oops - need dir where .lib files are'
]
]
]
].
OperatingSystem getCCDefine ='__BORLANDC__' ifTrue:[
ld := LinkCommand , ' ' , (LinkArgs bindWith:baseFileName).
ld := ld , ' c0d32.obj ' , baseFileName , '.obj '.
ld := ld , ',' , baseFileName , '.dll,,',libDir,'\librun.lib '.
ld := ld , (SearchedLibraries asStringCollection asStringWith: $ ).
ld := ld , ' ',libDir,'\cs32i.lib,,'.
] ifFalse:[
LastError := 'currently only support borlandC'.
self halt:'currently only support borlandC'.
^ nil
]
].
outfile := (baseFileName , '.out').
OperatingSystem isMSWINDOWSNTlike ifTrue:[
ok := OperatingSystem executeCommand:ld
] ifFalse:[
ok := OperatingSystem executeCommand:(ld , ' >' , outfile).
ok ifFalse:[
output := (baseFileName , '.out') asFilename contents asString.
Transcript showCR:output; endEntry.
]
].
(baseFileName , '.out') asFilename delete.
(baseFileName , '.tds') asFilename delete.
(baseFileName , '.ilc') asFilename delete.
(baseFileName , '.ild') asFilename delete.
(baseFileName , '.ilf') asFilename delete.
(baseFileName , '.ils') asFilename delete.
(baseFileName , '.lib') asFilename delete.
(baseFileName , '.map') asFilename delete.
(baseFileName , '.def') asFilename delete.
(baseFileName , '.obj') asFilename delete.
ok ifFalse:[
"/ self halt.
LastError := output.
^ nil
].
oFileName := (Filename currentDirectory construct:(baseFileName , self sharedLibraryExtension)) name.
^ oFileName
].
"/ UNIX systems
ld := 'ld'.
needSharedObject := false.
ObjectFileLoader loadableBinaryObjectFormat == #elf ifTrue:[
"
link it to a shared object with 'ld -shared'
"
needSharedObject := true.
ldArg := '-shared'.
].
osType = 'irix' ifTrue:[
"
link it to a shared object with 'ld -shared'
"
needSharedObject := true.
ldArg := '-shared'.
].
osType = 'sys5_4' ifTrue:[
"
link it to a shared object with 'ld -G'
"
needSharedObject := true.
ldArg := '-G'.
].
osType = 'osf' ifTrue:[
"
link it to a shared object with 'ld -shared'
"
needSharedObject := true.
ldArg := '-shared'.
].
osType = 'solaris' ifTrue:[
"
link it to a shared object with 'ld -G -B dynamic'
"
needSharedObject := true.
"/ ldArg := '-G -B dynamic'.
ldArg := '-G -Bdynamic'.
].
osType = 'hpux' ifTrue:[
"
link it to a shared object with 'ld -b -B immediate'
"
needSharedObject := true.
ldArg := '-b -B immediate'.
].
osType = 'aix' ifTrue:[
self activityNotification:'create export file'.
"/ create an exports file.
expFileName := './' , baseFileName , '.exp'.
[
expFile := expFileName asFilename writeStream.
expFile nextPutAll:'#!! ./' , baseFileName , (self sharedLibraryExtension).
expFile cr.
expFile nextPutAll:'_' , baseFileName , '_Init'.
expFile close.
] on:FileStream openErrorSignal do:[:ex| "do nothing"].
self activityNotification:'generating shared object'.
"
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 , (self objectFileExtension).
needSharedObject ifTrue:[
self activityNotification:'generating shared object'.
soFileName := './' , baseFileName , (self sharedLibraryExtension).
OperatingSystem removeFile:soFileName.
ld := ld , ' ' , ldArg , ' ',
(SearchedLibraries asStringCollection asStringWith: $ ),
' -o ' , soFileName , ' ' , oFileName.
Verbose ifTrue:[
'linking with:' infoPrintCR.
' ' infoPrint. ld infoPrintCR.
].
ok := OperatingSystem
executeCommand:(ld , ' >errorOutput 2>&1').
ok ifFalse:[
output := 'errorOutput' asFilename contents asString.
Transcript showCR:'linker error message:'.
Transcript showCR:output; endEntry.
].
OperatingSystem removeFile:oFileName.
expFileName notNil ifTrue:[
OperatingSystem removeFile:expFileName
].
^ soFileName.
].
"
assume we can load an ordinary binary
"
^ oFileName
"Modified: / 10.11.2001 / 02:01:43 / cg"
! !
!ObjectFileLoader class methodsFor:'lowlevel object loading'!
initializeLoader
"initialize dynamic loader if required"
|stxName stxPathName|
stxPathName := OperatingSystem pathOfSTXExecutable.
%{
#ifdef GNU_DL
{
static alreadyInitialized = 0;
extern dld_ignore_redefinitions;
if (! alreadyInitialized) {
alreadyInitialized = 1;
if (@global(Verbose) == true) {
printf ("dld_init(%s)\n", __stringVal(stxPathName));
}
/*
* dld requires the running executables name,
* to resolve symbols.
*/
(void) dld_init (__stringVal(stxPathName));
dld_ignore_redefinitions = 1;
}
}
#endif
%}.
!
loadDynamicObject:pathName
"load an object-file (load/map into my address space).
Return a non-nil handle if ok, nil otherwise.
No bindings or automatic initializations are done
- only a pure (low-level) load is performed.
For class-files or C-objects to be loaded with this method,
it is your responsibility to fetch any init-functions and
call them as appropriate.
This function is not supported on all architectures.
"
|handle buffer|
Verbose ifTrue:[
('loadDynamic: ' , pathName , ' ...') infoPrintCR
].
"/ already loaded ?
LoadedObjects notNil ifTrue:[
handle := LoadedObjects at:pathName ifAbsent:nil.
handle notNil ifTrue:[
Verbose ifTrue:[
('... ' , pathName , ' already loaded.') infoPrintCR.
].
^ handle
].
].
Verbose ifTrue:[
('initializeLoader...') infoPrintCR
].
self initializeLoader.
"/
"/ 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.
Verbose ifTrue:[
('primLoadDynamicObject...') infoPrintCR
].
buffer := self primLoadDynamicObject:pathName into:buffer.
Verbose ifTrue:[
('done') infoPrintCR
].
buffer isNil ifTrue:[
LastError == #notImplemented ifTrue:[
'ObjectFileLoader [warning]: no dynamic load facility present.' infoPrintCR.
] ifFalse:[
LastError == #linkError ifTrue:[
LinkErrorMessage notNil ifTrue:[
('ObjectFileLoader [warning]: load error:' , LinkErrorMessage) infoPrintCR.
] ifFalse:[
('ObjectFileLoader [warning]: load error') infoPrintCR.
].
].
].
('ObjectFileLoader [warning]: failed to load: ' , pathName) infoPrintCR.
Transcript showCR:('ObjectFileLoader [warning]: failed to load: ' , pathName).
^ 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) infoPrintCR.
].
^ 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: 16.5.1997 / 12:56:33 / 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:[
'ObjectFileLoader [info]: autoloading ' infoPrint. aClassName infoPrintCR.
cls autoload
]
]
].
^ nil
"Modified: 10.1.1997 / 17:58:23 / 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(noWIN32) */
if (! __isArray(anInfoBuffer)
|| (__arraySize(anInfoBuffer) < 3)) {
RETURN(nil);
}
#ifdef GNU_DL
{
if (__isString(pathName)) {
if (dld_link(__stringVal(pathName))) {
if (@global(Verbose) == true) {
printf ("link file %s failed\n", __stringVal(pathName));
}
if (@global(ErrorPrinting) == true) {
dld_perror("ObjectFileLoader - DLD error cant link");
}
@global(LastError) = @symbol(linkError);
@global(LinkErrorMessage) = __MKSTRING("DLD error");
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 (@global(Verbose) == true) {
fprintf(stderr, "ObjectFileLoader [info]: loading dll: %s...\n", __stringVal(pathName));
fflush(stderr);
}
handle = LoadLibrary(__stringVal(pathName));
if (@global(Verbose) == true) {
fprintf(stderr, "ObjectFileLoader [info]: handle: %x\n", handle);
fflush(stderr);
}
if (handle == NULL) {
char *msg;
err = GetLastError();
if ((@global(ErrorPrinting) == true)
|| (@global(Verbose) == true)) {
fprintf (stderr,
"ObjectFileLoader [warning]: LoadLibrary %s failed; error: %x\n",
__stringVal(pathName), err);
}
@global(LastError) = @symbol(loadError);;
@global(LastErrorNumber) = __MKINT(__WIN32_ERR(err));
switch (err) {
case ERROR_BAD_FORMAT:
msg = "LoadLibrary error - bad format";
default:
msg = "LoadLibrary error";
break;
}
@global(LinkErrorMessage) = __MKSTRING(msg);
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 BEOS_DL
{
void *handle;
int err;
if (__isString(pathName)) {
if (@global(Verbose) == true) {
fprintf(stderr, "ObjectFileLoader [info]: loading : %s...\n", __stringVal(pathName));
fflush(stderr);
}
handle = load_add_on(__stringVal(pathName));
if (@global(Verbose) == true) {
fprintf(stderr, "ObjectFileLoader [info]: handle: %x\n", handle);
fflush(stderr);
}
if (handle == NULL) {
char *msg;
@global(LastError) = @symbol(linkError);
@global(LinkErrorMessage) = __MKSTRING("unknown error");
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 (@global(Verbose) == true) {
printf ("link file %s failed\n", __stringVal(pathName));
}
@global(LinkErrorMessage) = __MKSTRING("dl_load error");
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
{
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 (@global(Verbose) == true) {
char *messages[64];
int i;
fprintf (stderr,
"ObjectFileLoader [info]: load file %s failed errno=%d\n",
objName, errno);
switch (errno) {
case ENOEXEC:
fprintf(stderr, " load messages:\n");
loadquery(L_GETMESSAGES, messages, sizeof(messages));
for (i=0; messages[i]; i++) {
fprintf(stderr, " %s\n", messages[i]);
}
break;
}
} else {
if (@global(ErrorPrinting) == true) {
fprintf (stderr,
"ObjectFileLoader [warning]: load file %s failed errno=%d\n",
objName, errno);
}
}
@global(LinkErrorMessage) = __MKSTRING("load error");
RETURN ( nil );
}
if (@global(Verbose) == true) {
fprintf(stderr, "ObjectFIleLoader [info]: 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)) {
INT lowHandle, hiHandle;
handle = (void *)dlopen(pathName == nil ? 0 : __stringVal(pathName), RTLD_NOW);
if (! handle) {
errMsg = (char *) dlerror();
if (@global(ErrorPrinting) == true) {
fprintf(stderr, "ObjectFileLoader [warning]: dlopen %s error:\n", __stringVal(pathName));
fprintf(stderr, " <%s>\n", errMsg);
}
@global(LastError) = @symbol(linkError);
@global(LinkErrorMessage) = __MKSTRING(errMsg);
RETURN (nil);
}
if (@global(Verbose) == true) {
fprintf(stderr, "ObjectFileLoader [info]: open %s handle = %x\n", __stringVal(pathName), handle);
}
#ifdef alpha64
lowHandle = (INT)handle & 0xFFFFFFFFL;
hiHandle = ((INT)handle >> 32) & 0xFFFFFFFFL;
#else
lowHandle = (INT)handle & 0xFFFF;
hiHandle = ((INT)handle >> 16) & 0xFFFF;
#endif
__ArrayInstPtr(anInfoBuffer)->a_element[0] = __MKSMALLINT(lowHandle);
__ArrayInstPtr(anInfoBuffer)->a_element[1] = __MKSMALLINT(hiHandle);
RETURN (anInfoBuffer);
}
}
#endif
#ifdef HPUX10_DL
{
void *handle;
char *nm;
char *errMsg;
if (__isString(pathName)) {
handle = (void *)shl_load(__stringVal(pathName),
BIND_IMMEDIATE, 0L /* address */);
if (! handle) {
if (@global(ErrorPrinting) == true) {
fprintf(stderr, "shl_load %s error:\n", __stringVal(pathName));
}
@global(LastError) = @symbol(linkError);
switch (errno) {
case ENOEXEC:
errMsg = "not a shared library";
break;
case ENOSYM:
errMsg = "undefined symbols";
break;
case ENOMEM:
errMsg = "out of memory";
break;
case ENOENT:
errMsg = "non existing library";
break;
case EACCES:
errMsg = "permission denied";
break;
default:
errMsg = "unspecified error";
break;
}
@global(LinkErrorMessage) = __MKSTRING(errMsg);
RETURN (nil);
}
if (@global(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) {
if (@global(ErrorPrinting) == true) {
fprintf(stderr, "dlopen %s error: <%s>\n",
__stringVal(pathName), dlerror());
}
@global(LastError) = @symbol(linkError);
@global(LinkErrorMessage) = __MKSTRING("dlopen error");
RETURN (nil);
}
if (@global(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) {
@global(LinkErrorMessage) = __MKSTRING("rld_load error");
@global(LastError) = @symbol(linkError);
if (@global(ErrorPrinting) == true) {
fprintf(stderr, "rld_load %s failed\n", __stringVal(pathName));
}
RETURN (nil);
}
if (@global(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 (@global(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;
jmp_buf exitJmpBuf;
if (__bothSmallInteger(sysHandle1, sysHandle2)) {
val = (_intVal(sysHandle2) << 16) + _intVal(sysHandle1);
handle = (HINSTANCE)(val);
if (setjmp(exitJmpBuf)) {
__setAtExitLongJmp(exitJmpBuf);
if (FreeLibrary(handle) != TRUE) {
__setAtExitLongJmp(0);
err = GetLastError();
if (@global(Verbose) == true) {
fprintf (stderr,
"ObjectFileLoader [warning]: FreeLibrary %s failed; error: %x\n",
__stringVal(sysHandle1), err);
}
@global(LastErrorNumber) = __WIN32_ERR(err);
RETURN (false);
}
} else {
__setAtExitLongJmp(0);
fprintf(stderr, "ObjectFileLoader [warning]: FreeLibrary called exit() - ignored\n");
}
RETURN (true);
}
RETURN (false);
#endif
#ifdef BEOS_DL
int val;
void *handle;
int ok, err;
jmp_buf exitJmpBuf;
if (__bothSmallInteger(sysHandle1, sysHandle2)) {
val = (_intVal(sysHandle2) << 16) + _intVal(sysHandle1);
handle = (HINSTANCE)(val);
if (setjmp(exitJmpBuf)) {
__setAtExitLongJmp(exitJmpBuf);
ok = unload_add_on((image_id) handle);
__setAtExitLongJmp(0);
if (ok != 0) {
@global(LastErrorNumber) = __MKSMALLINT(ok);
RETURN (false);
}
} else {
__setAtExitLongJmp(0);
fprintf(stderr, "ObjectFileLoader [warning]: FreeLibrary called exit() - ignored\n");
}
RETURN (true);
}
RETURN (false);
#endif
#ifdef SYSV4_DL
{
void *h;
INT val;
OBJ low = sysHandle1, hi = sysHandle2;
if (__bothSmallInteger(low, hi)) {
#ifdef alpha64
val = (__intVal(hi) << 32) + __intVal(low);
#else
val = (_intVal(hi) << 16) + _intVal(low);
#endif
h = (void *)(val);
if (@global(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 (@global(Verbose) == true) {
printf("close handle = %x\n", h);
}
dlclose(h);
RETURN (true);
}
}
#endif
#ifdef HPUX10_DL
{
int *h;
int val;
OBJ low = sysHandle1, hi = sysHandle2;
if (__bothSmallInteger(low, hi)) {
val = (_intVal(hi) << 16) + _intVal(low);
h = (void *)(val);
if (@global(Verbose) == true) {
printf("unload handle = %x\n", h);
}
shl_unload(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 (@global(Verbose) == true) {
printf("unload handle = %x\n", h);
}
if ( unload(h) != 0) {
fprintf(stderr, "unload failed\n");
RETURN (false);
}
RETURN (true);
}
}
#endif
#ifdef NEXT_DL
{
fprintf(stderr, "ObjectFileLoader [warning]: Sorry, NeXTStep does not support selective unloading\n");
}
#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 infoPrintCR.
].
handle isUnknownHandle ifTrue:[
Verbose ifTrue:[
'module type is not known - assume uninitialized classLib'
].
self unregisterModule:handle.
handle makeClassLibHandle.
] ifFalse:[
handle isClassLibHandle ifTrue:[
Verbose ifTrue:[
'a classLib - deinit classes' infoPrintCR.
].
self deinitializeClassesFromModule:handle.
Verbose ifTrue:[
'unregister' infoPrintCR.
].
self unregisterModule:handle.
] ifFalse:[
handle isMethodHandle ifTrue:[
Verbose ifTrue:[
'a methodHandle - unregister' infoPrintCR.
].
self unregisterModule:handle.
] ifFalse:[
handle isFunctionObjectHandle ifTrue:[
Verbose ifTrue:[
'a functionObject - fixup functionRefs' infoPrintCR.
].
handle functions do:[:f |
f notNil ifTrue:[
f code:0
]
].
].
"/
"/ call its deInit function (if present)
"/
Verbose ifTrue:[
'search for deInit function...' infoPrintCR.
].
fileName := handle pathName asFilename baseName.
functionName := self initFunctionBasenameForFile:fileName.
deInitAddr := self findFunction:functionName suffix:'__deInit' in:handle.
deInitAddr notNil ifTrue:[
Verbose ifTrue:[
'invoke deInit function...' infoPrintCR.
].
self callInitFunctionAt:deInitAddr
specialInit:false
forceOld:true
interruptable:false
argument:0
identifyAs:handle
returnsObject:false.
]
]
].
].
Verbose ifTrue:[
'cleanup done - now unload...' infoPrintCR.
].
"/
"/ now, really unload
"/
(self primUnloadDynamicObject:handle) ifFalse:[
^ self error:'unloadDynamic failed' mayProceed:true
].
Verbose ifTrue:[
'unload done ...' infoPrintCR.
].
"/
"/ remove from loaded objects
"/
LoadedObjects notNil ifTrue:[
key := LoadedObjects keyAtEqualValue:handle.
key notNil ifTrue:[
LoadedObjects removeKey:key
]
].
"
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.
]
].
handle isClassLibHandle ifTrue:[
Smalltalk flushCachedClasses.
].
handle isMethodHandle ifTrue:[
ObjectMemory flushCaches.
].
handle moduleID:nil.
handle sysHandle1:nil.
handle sysHandle2:nil.
"Modified: / 21.10.1998 / 21:31:48 / cg"
! !
!ObjectFileLoader class methodsFor:'queries'!
canLoadObjectFiles
"return true, if dynamic loading is possible.
Currently, only ELF based systems, AIX 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
"
ObjectFileLoader canLoadObjectFiles
"
"Modified: 8.1.1997 / 18:13:01 / 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 primCanLoadObjectFiles
"
! !
!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 oldSpaceReserve|
handle notNil ifTrue:[
moduleID := handle moduleID
].
"/
"/ for various reasons, classes, methods, literals, methodDicts etc.
"/ must be allocated in oldSpace when coming from a compiled
"/ classLibrary, and no compressing grabage collect is allowed during
"/ the creation of those.
"/ Therefore, we must ensure, that enough oldSpace reserve is available ...
"/ (how much is enough ?)
"/
oldSpaceReserve := OldSpaceReserve ? (1024*1024).
%{ /* CALLSSTACK: 128000 */
OBJ (*addr)();
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);
addr = (OBJFUNC)(__longIntVal(address));
/*
* allow function to be interrupted
*/
if (interruptable != true) {
wasBlocked = (__BLOCKINTERRUPTS() == true);
}
force = (forceOld == true);
if (force) {
int reserve = __intVal(oldSpaceReserve);
if ((__oldSpaceSize() - __oldSpaceUsed()) < reserve) {
__moreOldSpace(__thisContext, reserve);
}
prevSpace = __allocForceSpace(OLDSPACE);
}
#ifdef alpha
if (@global(Verbose) == true)
printf("calling initfunc %lx ...\n", addr);
#else
if (@global(Verbose) == true)
printf("calling initfunc %x ...\n", addr);
#endif
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 infoPrintCR.
].
aClass deinitialize.
aClass update:#aboutToUnload with:nil from:self
]
]
]
]
"Modified: 10.1.1997 / 17:56:50 / cg"
!
invalidateModule:handle
"invalidate all of the classes code objects ..."
|id|
Verbose ifTrue:[
'invalidate module; name=' infoPrint. handle pathName infoPrint.
' id=' infoPrint. handle moduleID infoPrintCR.
].
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 = (char *)__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:[ statusCode == -4 ifTrue:[
status := #tryAgain
] 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."
^ self
performModuleInitAt:initAddr invokeInitializeMethods:true for:className identifyAs:handle.
!
performModuleInitAt:initAddr invokeInitializeMethods:invokeInitializeMethods for:className identifyAs:handle
"Initialize a loaded smalltalk module."
|status badClassName infoCollection info classNames classes
stillTrying|
"
need 4 passes to init: 0: let module register itself & create its pools/globals
0b check if modules superclasses are all loaded
1: let it get var-refs to other pools/globals
2: let it install install class, methods and literals
3: let it send #initialize to its class object
"
stillTrying := true.
[stillTrying] whileTrue:[
stillTrying := false.
"/
"/ let it register itself
"/ and define its globals
"/
Verbose ifTrue:[
'phase 0 (module registration) ...' infoPrintCR
].
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 infoPrintCR
].
(status ~~ #ok) ifTrue:[
(status == #missingClass) ifTrue:[
('ObjectFileLoader [error]: load failed - missing class: ' , badClassName) infoPrintCR.
^ info
].
(status == #versionMismatch) ifTrue:[
('ObjectFileLoader [error]: load failed - version mismatch: ' , badClassName) infoPrintCR.
^ info
].
(status == #unregisteredSuperclass) ifTrue:[
('ObjectFileLoader [error]: load failed - unregistered: ' , badClassName) infoPrintCR.
^ info
].
(status ~~ #tryAgain) ifTrue:[
'ObjectFileLoader [error]: load failed' infoPrintCR.
^ Array with:#loadFailed with:nil
].
(status == #tryAgain) ifTrue:[
"/ tryAgain:
"/ must retry after initialization, to initialize
"/ sub-subclasses of autoloaded classes
"/ (sigh - class objects are created in phase 3,
"/ so we must first complete the initialization cycle,
"/ then do all again, for remaining modules)
stillTrying := true.
'ObjectFileLoader [info]: retry registration after init' infoPrintCR.
]
].
"/
"/ remaining initialization
"/
"/ module exports: declare module-globals & symbols ...
Verbose ifTrue:[
'phase 1 (resolve globals) ...' infoPrintCR
].
self moduleInit:1 forceOld:true interruptable:false.
"/ module-imports: resolve globals ...
"/ create methods & install ...
Verbose ifTrue:[
'phase 2 (create objects) ...' infoPrintCR
].
self moduleInit:2 forceOld:true interruptable:false.
].
ObjectMemory flushCaches.
"/ 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 -
'ObjectFileLoader [error]: registration failed' infoPrintCR.
^ 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.
invokeInitializeMethods ifTrue:[
Verbose ifTrue:[
'phase 3 (send #initialize) ...' infoPrintCR
].
"/ initialize ...
self moduleInit:3 forceOld:false interruptable:true.
].
^ Array with:#ok with:nil
"Modified: 10.1.1997 / 17:58:41 / cg"
!
revalidateModule:handle
"revalidate all of the classes code objects ..."
|id|
Verbose ifTrue:[
'revalidate module; name=' infoPrint. handle pathName infoPrint.
' id=' infoPrint. handle moduleID infoPrintCR.
].
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' infoPrintCR.
].
'ObjectFileLoader [warning]: check failed - no behavior' errorPrintCR.
^ false
].
Verbose ifTrue:[
'true' infoPrintCR.
('ObjectFileLoader [info]: check for ' , aClass name , ' being loaded') infoPrintCR.
].
aClass autoload.
(aClass isBehavior and:[aClass isLoaded]) ifTrue:[
Verbose ifTrue:[
('ObjectFileLoader [info]: ok, loaded. continue registration of actual class') infoPrintCR.
].
aClass signature. "/ req'd in VM for validation
^ true
].
('ObjectFileLoader [warning]: superclass not loaded; registration of ' , aClass name , ' fails') errorPrintCR.
^ false
"Modified: 10.1.1997 / 17:58:48 / cg"
!
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 infoPrintCR.
].
id := handle moduleID.
%{
__UNREGISTER_BY_ID(__intVal(id));
%}
! !
!ObjectFileLoader class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libcomp/ObjectFileLoader.st,v 1.228 2003-08-29 16:34:15 cg Exp $'
! !
ObjectFileLoader initialize!