"
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
Object subclass:#ObjectFileLoader
instanceVariableNames:''
classVariableNames:'MySymbolTable Verbose LastError LoadedObjects'
poolDictionaries:''
category:'System-Compiler'
!
ObjectFileLoader comment:'
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
$Header: /cvs/stx/stx/libcomp/Attic/ObjFLoader.st,v 1.10 1994-10-10 00:56:47 claus Exp $
'!
%{
/*
* by default, use whatever the system provides
*/
#ifdef sunos
# define SUN_DL
# define HAS_DL
#endif
#ifdef NeXT
# define NEXT_DL
# define HAS_DL
#endif
#ifdef SYSV4
# define SYSV4_DL
# define HAS_DL
#endif
/*
* but GNU_DL overwrites this - its better
*/
#ifdef GNU_DL
# define HAS_DL
# undef SYSV4_DL
# undef NEXT_DL
# undef SUN_DL
#endif
#ifdef NEXT_DL
# ifndef _RLD_H_
# define _RLD_H_
# include <rld.h>
# endif
#endif /* NEXT_DL */
#include <stdio.h>
/*
* if no dynamic link facilities, do it the hard way ...
*/
#ifndef 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 SYSV4_DL
# include <dlfcn.h>
# define dlcfn_h
#endif
#ifdef GNU_DL
# ifndef dld_h
# include "dld.h"
# define dld_h
# endif
#endif
static OBJ loadAddrLow, loadAddrHi;
%}
!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.
"
!
version
"
$Header: /cvs/stx/stx/libcomp/Attic/ObjFLoader.st,v 1.10 1994-10-10 00:56:47 claus Exp $
"
!
documentation
"
This class knowns how to dynamically load in external object-modules.
As to date, this is completely experimental and WITHOUT ANY WARRANTY.
It is still being developed and the code below needs cleanup and more
robustness.
There are basically two totally different mechanisms to do this:
a) if there exists some dynamic-link facility such as:
GNU-DL, dlopen (sparc, SYS5.4), rld_open (NeXT),
this is used
b) if no such facility exists, the normal linker is used to
link the module to text/data address as previously malloced,
and the object file loaded into that space.
Currently, not all mechanisms work fully satisfying.
For example, the sun dl*-functions do an exit on link-errors (which
is certainly not what we want here :-(; the NeXT mechanism does not
allow for selective unloading (only all or last).
The only really useful package is the GNU-dl package, which is only
available for a.out file formats. (i.e. only linux people can use
it at this time).
"
! !
!ObjectFileLoader class methodsFor:'initialization'!
initialize
"name of object file, where initial symbol table is found"
MySymbolTable := 'smalltalk'.
Verbose := false.
!
verbose:aBoolean
"turn on/off debug traces"
Verbose := aBoolean
"ObjectFileLoader verbose:true"
! !
!ObjectFileLoader class methodsFor:'command defaults'!
needSeparateIDSpaces
"return true, if we need separate I and D spaces.
This is only needed if no dynamic-link facilitiy exists."
|os cpu|
os := OperatingSystem getSystemType.
cpu := OperatingSystem getCPUType.
(os = 'sunos') ifTrue:[
(cpu = 'sparc') ifTrue:[ ^ true ]
].
(os = 'linux') ifTrue:[ ^ false ].
'dont know if we need sepId - assume no' errorPrintNL.
^ false
!
absLd:file text:textAddr data:dataAddr
"this should return a string to link file.o to absolute address.
This is only needed if no dynamic-link facilitiy exists."
|os cpu|
os := OperatingSystem getSystemType.
cpu := OperatingSystem getCPUType.
(os = 'sunos') ifTrue:[
(cpu = 'sparc') ifTrue:[
" "
^ ('ld -A ' , MySymbolTable , ' -x -Bstatic' ,
' -Ttext ' , (textAddr printStringRadix:16) ,
' -Tdata ' , (dataAddr printStringRadix:16) , ' ' , file)
" "
"
^ ('ld -A ' , MySymbolTable , ' -T ',
(textAddr printStringRadix:16),
' -N -x ' , file)
"
]
].
"
(os = 'ultrix') ifTrue:[
(cpu = 'mips') ifTrue:[
^ ('ld -A ' , MySymbolTable , ' -x -N -T ' , (textAddr printStringRadix:16) , ' ' , file)
]
].
"
(os = 'linux') ifTrue:[
^ ('ld -A ' , MySymbolTable ,
' -x -N ',
' -Ttext ' , (textAddr printStringRadix:16) ,
' -Tdata ' , (dataAddr printStringRadix:16) , ' ' , file)
].
self error:'do not know how to link absolute'
!
absLd:file text:textAddr
"this should return a string to link file.o to absolute address.
This is only needed if no dynamic-link facilitiy exists."
|os cpu|
os := OperatingSystem getSystemType.
cpu := OperatingSystem getCPUType.
(os = 'sunos') ifTrue:[
(cpu = 'sparc') ifTrue:[
^ ('ld -A ' , MySymbolTable , ' -T ',
(textAddr printStringRadix:16),
' -N -x ' , file)
]
].
(os = 'linux') ifTrue:[
^ ('ld -A ' , MySymbolTable ,
' -x -N -Ttext ' , (textAddr printStringRadix:16) , ' ' , file)
].
self error:'do not know how to link absolute'
!
nm:file
"this should return a string to list the namelist of file"
|os cpu|
os := OperatingSystem getSystemType.
(os = 'iris') ifTrue:[
^ 'nm -B ' , file
].
^ 'nm ' , file
! !
!ObjectFileLoader class methodsFor:'loading objects'!
loadFile:oFile with:librariesString
"load in an object files code, linking in libraries.
This is only needed if no dynamic link facility exists."
|tmpOfile errStream errors errText handle pid cmd|
pid := OperatingSystem getProcessId printString.
tmpOfile := '/tmp/stc_ld' , pid.
cmd := 'ld -o ', tmpOfile, ' -r ' , oFile , ' ' , librariesString , '>/tmp/out 2>/tmp/err'.
Verbose ifTrue:[
('executing: ld -o ', cmd) errorPrintNL
].
(OperatingSystem executeCommand:cmd) ifFalse:[
errStream := FileStream oldFileNamed:'/tmp/err'.
errStream isNil ifTrue:[
self notify:'errors during link.'
] ifFalse:[
errors := errStream contents.
errText := errors asText.
(errText size > 20) ifTrue:[
errText grow:20.
errText add:'... '.
errors := errText
].
OperatingSystem executeCommand:'rm /tmp/err /tmp/out'.
self notify:('link errors:\\' , errors asString) withCRs
].
^ false
].
handle := self loadFile:tmpOfile.
OperatingSystem executeCommand:('rm ' , tmpOfile).
^ handle
!
loadFile:oFile
"load in an object file - return a handle or nil.
This is only needed if no dynamic link facility exists.
It allocates some memory for text and data, calls for the linker
to relocate the oFile to that address and loads the sections."
|unixCommand errStream errors errText
text data textSize dataSize dataAddr textAddr newTextSize newDataSize|
"find out, how much memory we need"
textSize := self textSizeOf:oFile.
textSize isNil ifTrue:[
'bad text-size in object file' errorPrintNL.
^ nil
].
Verbose ifTrue:[
('text-size: ' , (textSize printStringRadix:16)) errorPrintNL
].
dataSize := self dataSizeOf:oFile.
dataSize isNil ifTrue:[
'bad data-size in object file' errorPrintNL.
^ nil
].
Verbose ifTrue:[
('data-size: ' , (dataSize printStringRadix:16)) errorPrintNL
].
"allocate some memory for text and some for data;
then call linker to link the file to those addresses"
self needSeparateIDSpaces ifTrue:[
text := ExternalBytes newForText:textSize.
text isNil ifTrue:[
'cannot allocate memory for text' errorPrintNL.
^ nil
].
Verbose ifTrue:[
('text: ' , (text address printStringRadix:16)) errorPrintNL
].
(dataSize ~~ 0) ifTrue:[
data := ExternalBytes newForData:dataSize.
(data isNil) ifTrue:[
'cannot allocate memory for data' errorPrintNL.
text notNil ifTrue:[text free].
^ nil
].
Verbose ifTrue:[
('data: ' , (data address printStringRadix:16)) errorPrintNL
]
].
dataSize == 0 ifTrue:[
unixCommand := (self absLd:oFile text:text address) , ' >/tmp/out 2>/tmp/err'.
] ifFalse:[
unixCommand := (self absLd:oFile text:text address data:data address)
, ' >/tmp/out 2>/tmp/err'.
]
] ifFalse:[
text := ExternalBytes newForText:(textSize + dataSize).
text isNil ifTrue:[
'cannot allocate memory for text+data' errorPrintNL.
^ nil
].
Verbose ifTrue:[
('addr: ' , (text address printStringRadix:16)) errorPrintNL
].
unixCommand := (self absLd:oFile text:text address) , ' >/tmp/out 2>/tmp/err'.
].
Verbose ifTrue:[
('executing: ' , unixCommand) errorPrintNL
].
'linking ...' printNewline.
(OperatingSystem executeCommand:unixCommand) ifFalse: [
errStream := FileStream oldFileNamed:'/tmp/err'.
errStream notNil ifTrue:[
errors := errStream contents.
errText := errors asText.
(errText size > 20) ifTrue:[
errText grow:20.
errText add:'... '.
errors := errText
].
OperatingSystem executeCommand:'rm /tmp/err /tmp/out'.
self notify:('link errors:\\' , errors asString) withCRs
].
'link unsuccessful.' errorPrintNL.
text notNil ifTrue:[text free].
data notNil ifTrue:[data free].
^ nil
].
'link successful' errorPrintNL.
OperatingSystem executeCommand:'rm /tmp/err /tmp/out'.
"find out, if space needs have changed after link (they do so on some machines)"
newTextSize := self textSizeOf:'a.out'.
newTextSize isNil ifTrue:[
'bad new-text-size in a.out object file' errorPrintNL.
text notNil ifTrue:[text free].
data notNil ifTrue:[data free].
^ nil
].
Verbose ifTrue:[
('new-text-size: ' , (newTextSize printStringRadix:16)) errorPrintNL
].
newDataSize := self dataSizeOf:'a.out'.
newDataSize isNil ifTrue:[
'bad new-data-size in a.out object file' errorPrintNL.
text notNil ifTrue:[text free].
data notNil ifTrue:[data free].
^ nil
].
Verbose ifTrue:[
('new-data-size: ' , (newDataSize printStringRadix:16)) errorPrintNL
].
"if size has changed, do it again"
((newTextSize ~~ textSize) or:[newDataSize ~~ dataSize]) ifTrue:[
'size changed after link - do it again' printNewline.
text notNil ifTrue:[text free. text := nil].
data notNil ifTrue:[data free. data := nil].
textSize := newTextSize.
dataSize := newDataSize.
self needSeparateIDSpaces ifTrue:[
text := ExternalBytes newForText:textSize.
text isNil ifTrue:[
'cannot allocate memory for new text' errorPrintNL.
^ nil
].
Verbose ifTrue:[
('new text: ' , (text address printStringRadix:16)) errorPrintNL
].
(dataSize ~~ 0) ifTrue:[
data := ExternalBytes newForData:dataSize.
(data isNil) ifTrue:[
'cannot allocate memory for new data' errorPrintNL.
text notNil ifTrue:[text free].
^ nil
].
Verbose ifTrue:[
('new data: ' , (data address printStringRadix:16)) errorPrintNL
]
].
dataSize == 0 ifTrue:[
unixCommand := (self absLd:oFile text:text address) , ' >/tmp/out 2>/tmp/err'.
] ifFalse:[
unixCommand := (self absLd:oFile text:text address data:data address)
, ' >/tmp/out 2>/tmp/err'.
]
] ifFalse:[
text := ExternalBytes newForText:(textSize + dataSize).
text isNil ifTrue:[
'cannot allocate memory for new text' errorPrintNL.
^ nil
].
Verbose ifTrue:[
('new text+data: ' , (text address printStringRadix:16)) errorPrintNL
].
unixCommand := (self absLd:oFile text:text address) , ' >/tmp/out 2>/tmp/err'.
].
Verbose ifTrue:[
('executing: ' , unixCommand) errorPrintNL
].
'linking ...' errorPrintNL.
(OperatingSystem executeCommand:unixCommand) ifFalse: [
errStream := FileStream oldFileNamed:'/tmp/err'.
errStream notNil ifTrue:[
errors := errStream contents.
errText := errors asText.
(errText size > 20) ifTrue:[
errText grow:20.
errText add:'... '.
errors := errText
].
OperatingSystem executeCommand:'rm /tmp/err /tmp/out'.
self notify:('link errors:\\' , errors asString) withCRs
].
'link unsuccessful.' errorPrintNL.
text notNil ifTrue:[text free].
data notNil ifTrue:[data free].
^ nil
].
'link successful' errorPrintNL.
OperatingSystem executeCommand:'rm /tmp/err /tmp/out'.
"check again for size change - should not happen"
newTextSize := self textSizeOf:'a.out'.
newTextSize isNil ifTrue:[
'bad text-size in a.out object file' errorPrintNL.
text notNil ifTrue:[text free].
data notNil ifTrue:[data free].
^ nil
].
Verbose ifTrue:[
('new-text-size: ' , (newTextSize printStringRadix:16)) errorPrintNL
].
newDataSize := self dataSizeOf:'a.out'.
newDataSize isNil ifTrue:[
'bad data-size in object file' errorPrintNL.
text notNil ifTrue:[text free].
data notNil ifTrue:[data free].
^ nil
].
Verbose ifTrue:[
('new-data-size: ' , (newDataSize printStringRadix:16)) errorPrintNL
].
((newTextSize ~~ textSize) or:[newDataSize ~~ dataSize]) ifTrue:[
'size changed again - I give up' errorPrintNL.
text notNil ifTrue:[text free].
data notNil ifTrue:[data free].
^ nil
].
].
"only thing left to do is to load in text at textAddr and
data at dataAddr ... "
text notNil ifTrue:[
textAddr := text address
] ifFalse:[
textAddr := nil
].
data notNil ifTrue:[
dataAddr := data address
] ifFalse:[
dataAddr := nil
].
Verbose ifTrue:[
textAddr notNil ifTrue:[
('loading ' , textSize printString , ' bytes at ' , (textAddr printStringRadix:16)) errorPrintNL.
].
dataAddr notNil ifTrue:[
('loading ' , dataSize printString , ' bytes at ' , (dataAddr printStringRadix:16)) errorPrintNL.
].
].
(self loadObjectFile:'a.out'
textAddr:textAddr textSize:textSize
dataAddr:dataAddr dataSize:dataSize) isNil ifTrue: [
'load error' errorPrintNL.
text notNil ifTrue:[text free].
data notNil ifTrue:[data free].
^ nil
].
'dynamic load successful' errorPrintNL.
OperatingSystem executeCommand:'mv a.out SymbolTable'.
MySymbolTable := 'SymbolTable'.
^ (Array with:text with:data)
! !
!ObjectFileLoader class methodsFor:'dynamic class loading'!
loadClass:aClassName fromObjectFile:aFileName
"load a compiled class (.o-file) into the image"
|handle initAddr symName newClass list moreHandles|
handle := self openDynamicObject:aFileName.
handle isNil ifTrue:[
Transcript showCr:('openDynamic: ',aFileName,' failed.').
^ nil
].
"
get the Init-function; let the class install itself
"
symName := '_' , aClassName , '_Init'.
initAddr := self getFunction:symName from:handle.
initAddr isNil ifTrue:[
"try with added underscore"
symName := '__' , aClassName , '_Init'.
initAddr := self getFunction:symName from:handle.
].
"
if there are any undefined symbols, we may have to load more
"
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:[
Transcript showCr:'calling init at: ' , (initAddr printStringRadix:16)
].
self callInitFunctionAt:initAddr.
(Symbol hasInterned:aClassName) ifTrue:[
newClass := Smalltalk at:aClassName asSymbol ifAbsent:[nil].
newClass notNil ifTrue:[
newClass initialize.
"force cache flush"
Smalltalk at:aClassName asSymbol put:newClass.
Smalltalk changed.
].
] ifFalse:[
'LOADER: class ' errorPrintNL. aClassName errorPrintNL.
' did not define itself' errorPrintNL
"
do not unload - could have installed its methods ...
"
].
^ newClass
].
Verbose ifTrue:[
Transcript showCr:('no symbol: ', symName,' in ',aFileName).
].
"
unload
"
moreHandles notNil ifTrue:[
self closeAllDynamicObjects:moreHandles.
].
self closeDynamicObject:handle.
^ nil
"ObjectFileLoader loadClass:'Tetris' fromObjectFile:'../clients/Tetris/Tetris.o'"
"ObjectFileLoader loadClass:'TetrisBlock' fromObjectFile:'../clients/Tetris/TBlock.o'"
"ObjectFileLoader loadClass:'Foo' fromObjectFile:'classList.o'"
!
loadObjectFile:aFileName
"load an object file (.o-file) into the image;
the class name is not needed (multiple definitions may be in the file).
Return false on error, true if ok."
|handle initAddr symName className newClass list initNames|
handle := self openDynamicObject:aFileName.
handle isNil ifTrue:[
Transcript showCr:('openDynamic: ',aFileName,' failed.').
^ false
].
className := OperatingSystem baseNameOf:aFileName.
(className endsWith:'.o') ifTrue:[
className := className copyTo:(className size - 2)
] ifFalse:[
(className endsWith:'.obj') ifTrue:[
className := className copyTo:(className size - 4)
] ifFalse:[
(className endsWith:'.so') ifTrue:[
className := className copyTo:(className size - 3)
]
]
].
"
look for explicit init function
"
initAddr := self getFunction:(className , '_Init') from:handle.
initAddr isNil ifTrue:[
initAddr := self getFunction:('_' , className , '_Init') from:handle.
].
initAddr notNil ifTrue:[
self callInitFunctionAt:initAddr.
] ifFalse:[
"
look for init-function(s)
"
initNames := self namesMatching:'*_Init' segment:'[tT]' in:aFileName.
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).
^ nil
].
Verbose ifTrue:[
Transcript showCr:'calling init at:' , (initAddr printStringRadix:16)
].
self callInitFunctionAt:initAddr.
].
].
"/ (Symbol hasInterned:className) ifTrue:[
"/ newClass := Smalltalk at:className asSymbol ifAbsent:[nil].
"/ newClass notNil ifTrue:[
"/ newClass initialize.
"/ "force cache flush"
"/ Smalltalk at:className asSymbol put:newClass.
"/ ].
"/ ].
"
really dont know, if it has changed ...
"
Smalltalk changed.
^ true
!
loadCPlusPlusObjectFile:aFileName
"load a c++ object file (.o-file) into the image"
|handle initAddr symName className newClass list|
handle := self openDynamicObject:aFileName.
handle isNil ifTrue:[
Transcript showCr:('openDynamic: ',aFileName,' failed.').
^ nil
].
list := self namesMatching:'__GLOBAL_$I*' segment:'[tT]' in:aFileName.
list size == 1 ifTrue:[
"/ (self isCPlusPlusObject:handle) ifTrue:[
Verbose ifTrue:[
Transcript showCr:'a c++ object file'
].
"
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:[
"/ Transcript showCr:'calling CTORs at:' , (initAddr printStringRadix:16)
"/ ].
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:[
Transcript showCr:'no CTOR-func found (' , list first , ')'
].
self closeDynamicObject:aFileName.
^ nil
].
Verbose ifTrue:[
Transcript showCr:'calling CTORs at:' , (initAddr printStringRadix:16)
].
self callFunctionAt:initAddr forceOld:false arg:0.
Verbose ifTrue:[
Transcript showCr:'done with CTORs.'
].
"
cannot create a CPlusPlus class automatically (there could be more than
one classes in it too ...)
"
^ handle
].
Verbose ifTrue:[
Transcript showCr:'unknown object file'
].
self closeDynamicObject:aFileName.
^ nil
!
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 moreHandles|
inits := list select:[:symbol | symbol notNil and:[symbol endsWith:'_Init']].
inits notNil ifTrue:[
classNames := inits collect:[:symbol |
(symbol startsWith:'___') ifTrue:[
symbol copyFrom:4 to:(symbol size - 5)
] ifFalse:[
(symbol startsWith:'__') ifTrue:[
symbol copyFrom:3 to:(symbol size - 5)
] ifFalse:[
(symbol startsWith:'_') ifTrue:[
symbol copyFrom:2 to:(symbol size - 5)
] ifFalse:[
symbol
]
]
]
].
"
autoload those classes
"
classNames do:[:aClassName |
|cls|
(cls := Smalltalk classNamed:aClassName) notNil ifTrue:[
'autoloading ' print. aClassName printNL.
cls autoload
]
]
].
^ nil
!
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
].
handle isNil ifTrue:[
self error:'this file was not loaded dynamically'.
^ self
].
"/call the deInit-function ...
self closeDynamicObject:aFileName
!
unloadAllObjectFiles
"unload all dynamically loaded object files from the image.
see DANGER ALERT in ObjectFileLoader>>unloadObjectFile:"
|handle|
LoadedObjects notNil ifTrue:[
LoadedObjects keysDo:[:aFileName |
self unloadObjectFile:aFileName
]
].
"
ObjectFileLoader unloadAllObjectFiles
"
! !
!ObjectFileLoader class methodsFor:'dynamic object access'!
openDynamicObject:pathName
"open an object-file (load/map into my address space).
Return a non-nil handle if ok, nil otherwise.
No bindings are done - only a pure load is performed.
This function is not supported on all architectures.
"
|handle|
Verbose ifTrue:[
Transcript showCr:'openDynamic: ' , pathName
].
handle := self primOpenDynamicObject:pathName into:(Array new:2).
handle isNil ifTrue:[
LastError == #notImplemented ifTrue:[
Verbose ifTrue:[
Transcript showCr:'no dynamic load facility or load failed.'.
].
"try it the hard way"
handle := self loadFile:pathName.
]
].
"
remember loaded object for later unloading
"
LoadedObjects isNil ifTrue:[
LoadedObjects := Dictionary new.
].
LoadedObjects at:pathName put:handle.
^ handle
"sys5.4:
|handle|
handle := ObjectFileLoader openDynamicObject:'../stc/mod1.so'.
ObjectFileLoader getFunction:'module1' from:handle
"
"next:
|handle|
handle := ObjectFileLoader openDynamicObject:'../goodies/Path/AbstrPath.o'.
ObjectFileLoader getFunction:'__AbstractPath_Init' from:handle
"
"GLD:
|handle|
handle := ObjectFileLoader openDynamicObject:'../clients/Tetris/Tetris.o'.
ObjectFileLoader getFunction:'__TetrisBlock_Init' from:handle
"
!
primOpenDynamicObject:pathName into:aBuffer
"open an object-file (map into my address space).
Return an OS-handle (whatever that is) - where some space
(a 2-element array) has to be passed in for this.
This function is not supported on all architectures.
Dont depend on the values or types returned in aBuffer,
it depends on the underlying dynamic load package."
%{ /* UNLIMITEDSTACK */
#ifdef GNU_DL
# ifndef dld_h
# include "dld.h"
# define dld_h
# endif
static firstCall = 1;
extern char *__myName__;
if (firstCall) {
firstCall = 0;
(void) dld_init (__myName__);
}
if (__isString(pathName)) {
if (dld_link(_stringVal(pathName))) {
dld_perror("cant link");
ObjectFileLoader_LastError = @symbol(linkError);
RETURN ( nil );
}
RETURN ( pathName );
}
RETURN ( nil );
#endif
#ifdef SYSV4_DL
# ifndef dlfcn_h
# include <dlfcn.h>
# define dlfcn_h
# endif
void *handle;
if ((pathName == nil) || __isString(pathName)) {
if (__isArray(aBuffer)
&& (_arraySize(aBuffer) == 2)) {;
if (pathName == nil)
handle = dlopen((char *)0, RTLD_NOW);
else
handle = dlopen(_stringVal(pathName), RTLD_NOW);
if (! handle) {
fprintf(stderr, "dlopen %s error: <%s>\n",
_stringVal(pathName), dlerror());
ObjectFileLoader_LastError = @symbol(linkError);
RETURN (nil);
}
if (ObjectFileLoader_Verbose == true)
printf("open %s handle = %x\n", _stringVal(pathName), handle);
_ArrayInstPtr(aBuffer)->a_element[0] =
_MKSMALLINT( (int)handle & 0xFFFF );
_ArrayInstPtr(aBuffer)->a_element[1] =
_MKSMALLINT( ((int)handle >> 16) & 0xFFFF );
RETURN (aBuffer);
}
}
#endif
#ifdef SUN_DL
# ifndef dlfcn_h
# include <dlfcn.h>
# define dlfcn_h
# endif
void *handle;
if ((pathName == nil) || __isString(pathName)) {
if (__isArray(aBuffer)
&& (_arraySize(aBuffer) == 2)) {;
if (pathName == nil)
handle = dlopen((char *)0, 1);
else
handle = dlopen(_stringVal(pathName), 1);
if (! handle) {
fprintf(stderr, "dlopen %s error: <%s>\n",
_stringVal(pathName), dlerror());
ObjectFileLoader_LastError = @symbol(linkError);
RETURN (nil);
}
if (ObjectFileLoader_Verbose == true)
printf("open %s handle = %x\n", _stringVal(pathName), handle);
_ArrayInstPtr(aBuffer)->a_element[0] =
_MKSMALLINT( (int)handle & 0xFFFF );
_ArrayInstPtr(aBuffer)->a_element[1] =
_MKSMALLINT( ((int)handle >> 16) & 0xFFFF );
RETURN (aBuffer);
}
}
#endif
#ifdef NEXT_DL
long result;
char *files[2];
NXStream *errOut;
if (__isString(pathName)) {
files[0] = (char *) _stringVal(pathName);
files[1] = (char *) 0;
errOut = NXOpenFile(2, 2);
result = rld_load(errOut,
(struct mach_header **)0,
files,
(char *)0);
NXClose(errOut);
if (! result) {
ObjectFileLoader_LastError = @symbol(linkError);
fprintf(stderr, "rld_load %s failed\n", _stringVal(pathName));
RETURN (nil);
}
if (ObjectFileLoader_Verbose == true)
printf("rld_load %s ok\n", _stringVal(pathName));
RETURN (pathName);
}
#endif
%}.
LastError := #notImplemented.
^ nil
!
closeDynamicObject:handle
"close an object-file (unmap from my address space)
and remove the entry from the remembered object file set."
|key|
(self primCloseDynamicObject:handle) ifTrue:[
"
remove from loaded objects
"
LoadedObjects notNil ifTrue:[
key := LoadedObjects keyAtValue:handle.
key notNil ifTrue:[
LoadedObjects removeKey:key
]
]
] ifFalse:[
self error:'closeDynamic failed'
]
!
primCloseDynamicObject:handle
"close an object-file (unmap from my address space)."
|low hi|
%{
#ifdef GNU_DL
# ifndef dld_h
# include "dld.h"
# define dld_h
# endif
if (__isString(handle)) {
if (dld_unlink_by_file(_stringVal(handle), 1)) {
dld_perror("cant unlink");
RETURN (false);
}
RETURN (true);
}
RETURN (false);
#endif
%}.
low := handle at:1.
hi := handle at:2.
%{
#ifdef SYSV4_DL
# ifndef dlfcn_h
# include <dlfcn.h>
# define dlfcn_h
# endif
void *h;
int val;
if (_isSmallInteger(low) && _isSmallInteger(hi)) {
val = (_intVal(hi) << 16) + _intVal(low);
h = (void *)(val);
if (ObjectFileLoader_Verbose == true)
printf("close handle = %x\n", h);
if (dlclose(h) != 0) {
fprintf(stderr, "dlclose failed with:<%s>\n", dlerror());
RETURN (false);
}
RETURN (true);
}
#endif
#ifdef SUN_DL
# ifndef dlfcn_h
# include <dlfcn.h>
# define dlfcn_h
# endif
void *h;
int val;
if (_isSmallInteger(low) && _isSmallInteger(hi)) {
val = (_intVal(hi) << 16) + _intVal(low);
h = (void *)(val);
if (ObjectFileLoader_Verbose == true)
printf("close handle = %x\n", h);
dlclose(h);
RETURN (true);
}
#endif
%}.
^ false
!
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
!
isCPlusPlusObject:handle
"return true, if the loaded object is a c++ object module"
(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
!
namesMatching:aPattern segment:segmentPattern in:aFileName
|p l s addr segment name entry|
l := OrderedCollection new.
p := PipeStream readingFrom:(self nm:aFileName).
p isNil ifTrue:[
('cannot read names from ' , aFileName) errorPrintNL.
^ nil
].
[p atEnd] whileFalse:[
entry := p nextLine.
Verbose ifTrue:[
entry printNL.
].
entry notNil ifTrue:[
s := ReadStream on:entry.
addr := s nextWord.
segment := s nextWord.
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: ' print. name printNL.
]
] ifFalse:[
Verbose ifTrue:[
name print. ' segment mismatch ' print.
segmentPattern print. ' ' print. segment printNL.
]
]
]
]
]
].
p close.
^ l
!
isObjectiveCObject:handle
"not yet implemented"
^ false
!
getFunction:aString from:handle
"return the address of a function from a dynamically loaded object file.
Handle must be the one returned previously from openDynamicObject.
Return the address of the function, or nil on any error."
^ self getSymbol:aString function:true from:handle
!
getSymbol:aString function:isFunction from:handle
"return the address of a symbol/function from a dynamically loaded object file.
Handle must be the one returned previously from openDynamicObject.
Return the address of the symbol, or nil on any error."
|low hi lowAddr hiAddr|
%{ /* STACK: 20000 */
#ifdef GNU_DL
# ifndef dld_h
# include "dld.h"
# define dld_h
# endif
void (*func)();
unsigned long addr;
char *name;
if (__isString(aString)) {
name = (char *) _stringVal(aString);
if (isFunction == false) {
addr = dld_get_symbol(name);
} else {
func = (void (*) ()) dld_get_func(name);
if (func) {
if (ObjectFileLoader_Verbose == true)
printf("addr of %s = %x\n", name, (INT)func);
if (dld_function_executable_p(name)) {
lowAddr = _MKSMALLINT( (INT)func & 0xFFFF );
hiAddr = _MKSMALLINT( ((INT)func >> 16) & 0xFFFF );
} else {
char **undefNames;
char **nm;
int i;
if (ObjectFileLoader_Verbose == true) {
printf ("function %s not executable\n", name);
dld_perror("not executable");
printf("undefined:\n");
nm = undefNames = dld_list_undefined_sym();
for (i=dld_undefined_sym_count; i; i--) {
printf(" %s\n", *nm++);
}
}
free(undefNames);
}
} else {
dld_perror("get_func");
}
}
}
#endif
%}.
low := handle at:1.
hi := handle at:2.
%{
#ifdef SYSV4_DL
# ifndef dlfcn_h
# include <dlfcn.h>
# define dlfcn_h
# endif
void *h;
void *addr;
int val;
if (_isSmallInteger(low) && _isSmallInteger(hi)) {
val = (_intVal(hi) << 16) + _intVal(low);
h = (void *)(val);
if (__isString(aString)) {
if (ObjectFileLoader_Verbose == true)
printf("get sym <%s> handle = %x\n", _stringVal(aString), h);
addr = dlsym(h, (char *) _stringVal(aString));
if (addr) {
if (ObjectFileLoader_Verbose == true)
printf("addr = %x\n", addr);
lowAddr = _MKSMALLINT( (int)addr & 0xFFFF );
hiAddr = _MKSMALLINT( ((int)addr >> 16) & 0xFFFF );
} else {
if (ObjectFileLoader_Verbose == true)
printf("dlsym %s error: <%s>\n", _stringVal(aString), dlerror());
}
}
}
#endif
#ifdef SUN_DL
# include <dlfcn.h>
void *h;
void *addr;
int val;
if (_isSmallInteger(low) && _isSmallInteger(hi)) {
val = (_intVal(hi) << 16) + _intVal(low);
h = (void *)(val);
if (__isString(aString)) {
if (ObjectFileLoader_Verbose == true)
printf("get sym <%s> handle = %x\n", _stringVal(aString), h);
addr = dlsym(h, _stringVal(aString));
if (addr) {
if (ObjectFileLoader_Verbose == true)
printf("addr = %x\n", addr);
lowAddr = _MKSMALLINT( (int)addr & 0xFFFF );
hiAddr = _MKSMALLINT( ((int)addr >> 16) & 0xFFFF );
} else {
if (ObjectFileLoader_Verbose == true)
printf("dlsym %s error: <%s>\n", _stringVal(aString), dlerror());
}
}
}
#endif
#ifdef NEXT_DL
unsigned long addr;
long result;
NXStream *errOut;
if (__isString(aString)) {
if (ObjectFileLoader_Verbose == true)
printf("get sym <%s>\n", _stringVal(aString));
errOut = NXOpenFile(2, 2);
result = rld_lookup(errOut,
(char *) _stringVal(aString),
&addr);
NXClose(errOut);
if (result) {
if (ObjectFileLoader_Verbose == true)
printf("addr = %x\n", addr);
lowAddr = _MKSMALLINT( (int)addr & 0xFFFF );
hiAddr = _MKSMALLINT( ((int)addr >> 16) & 0xFFFF );
}
}
#endif
%}
.
lowAddr notNil ifTrue:[
^ (hiAddr * 16r10000) + lowAddr
].
^ nil
!
getListOfUndefinedSymbolsFrom:handle
"return a collection of undefined symbols in a dynamically loaded object file.
Handle must be the one returned previously from openDynamicObject."
|list|
list := Array new:100. "no more than 100 symbols"
%{
#ifdef GNU_DL
# ifndef dld_h
# include "dld.h"
# define dld_h
# endif
void (*func)();
unsigned long addr;
char *name;
int nMax;
if (__isArray(list)) {
char **undefNames;
char **nm;
int index;
nMax = _arraySize(list);
nm = undefNames = dld_list_undefined_sym();
for (index = 0; index < dld_undefined_sym_count; index++) {
_ArrayInstPtr(list)->a_element[index] = _MKSTRING(*nm++);
if (index == nMax)
break;
}
free(undefNames);
}
#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
%}.
^ list
!
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
%}
!
callInitFunctionAt:initAddr
"
need 4 passes to init: 0: create my pools
1: get var-refs to other pools
2: install class, methods and literals
3: send #initialize to class
"
self callFunctionAt:initAddr forceOld:true arg:0.
self callFunctionAt:initAddr forceOld:true arg:1.
self callFunctionAt:initAddr forceOld:true arg:2.
self callFunctionAt:initAddr forceOld:false arg:3.
!
callFunctionAt:address forceOld:forceOld arg:argument
"call a function at address - this is very dangerous.
This is needed to call the classes init-function after loading in a
class-object file. ForceOld (if true) will have the memory manager
allocate things in oldSpace instead of newSpace.
DANGER: Internal. Dont use in your programs."
|low hi lowAddr hiAddr|
hi := address // 16r10000.
low := address \\ 16r10000.
%{
void (*addr)();
unsigned val;
typedef void (*VOIDFUNC)();
int savInt;
extern int _immediateInterrupt;
int prevSpace;
int arg = 0;
if (_isSmallInteger(low) && _isSmallInteger(hi)) {
val = (_intVal(hi) << 16) + _intVal(low);
addr = (VOIDFUNC) val;
if (_isSmallInteger(argument)) {
arg = _intVal(argument);
}
/*
* allow function to be interrupted
*/
savInt = _immediateInterrupt;
_immediateInterrupt = 1;
if (forceOld == true) {
prevSpace = __allocForceSpace(OLDSPACE);
(*addr)(arg COMMA_CON);
__allocForceSpace(prevSpace);
} else {
(*addr)(arg COMMA_CON);
}
_immediateInterrupt = savInt;
}
%}
! !
!ObjectFileLoader class methodsFor:'primitive loading'!
textSizeOf:aFileName
"
get the size of the text-segment (nBytes)
"
%{ /* NOCONTEXT */
#ifdef HAS_DL
/*
* not needed, if dynamic link facilities exist
*/
#else /* no DL-support */
char *fname;
int fd;
if (! __isString(aFileName)) {
RETURN (nil);
}
fname = (char *) _stringVal(aFileName);
# if defined(A_DOT_OUT) && !defined(ELF)
# if !defined(sco) && !defined(isc)
{
struct exec header;
if ((fd = open(fname, 0)) < 0) {
fprintf(stderr, "cannot open <%s>\n", fname);
RETURN ( nil );
}
if (read(fd, &header, sizeof(header)) != sizeof(header)) {
fprintf(stderr, "cannot read header of <%s>\n", fname);
close(fd);
RETURN ( nil );
}
close(fd);
if (N_MAGIC(header) != OMAGIC) {
fprintf(stderr, "header is (0%o) %x - should be (0%o)%x\n",
N_MAGIC(header), N_MAGIC(header),
OMAGIC, OMAGIC);
RETURN ( nil );
}
RETURN ( _MKSMALLINT(header.a_text) );
}
# endif
# endif
/*
* need support for other headers ... (i.e. coff, elf)
*/
#endif
%}.
^ self error:'objectFile format not supported'
!
dataSizeOf:aFileName
"
get the size of the data-segment (nBytes)
"
%{ /* NOCONTEXT */
#ifdef HAS_DL
/*
* not needed, if dynamic link facilities exist
*/
#else /* no DL-support */
char *fname;
int fd;
if (! __isString(aFileName)) {
RETURN ( nil );
}
fname = (char *) _stringVal(aFileName);
# if defined(A_DOT_OUT) && !defined(ELF)
# if !defined(sco) && !defined(isc)
{
struct exec header;
unsigned size;
if ((fd = open(fname, 0)) < 0) {
fprintf(stderr, "cannot open <%s>\n", fname);
RETURN ( nil );
}
if (read(fd, &header, sizeof(header)) != sizeof(header)) {
fprintf(stderr, "cannot read header of <%s>\n", fname);
close(fd);
RETURN ( nil );
}
close(fd);
if (N_MAGIC(header) != OMAGIC) {
fprintf(stderr, "header is (0%o) %x - should be (0%o)%x\n",
N_MAGIC(header), N_MAGIC(header),
OMAGIC, OMAGIC);
RETURN ( nil );
}
size = header.a_data;
# if defined(sinix) && defined(BSD)
size += header.a_bss;
# endif
RETURN ( _MKSMALLINT(size) );
}
# endif
# endif
/*
* need support for other headers ... (i.e. coff, elf)
*/
#endif
%}
.
^ self error:'objectFile format not supported'
!
loadObjectFile:aFileName textAddr:textAddr textSize:textSize
dataAddr:dataAddr dataSize:dataSize
"the object in aFileName must have been linked for
absolute address textAddr/dataAddr (using ld -A).
Load the contents from the file. Memory must have previously
been allocated using ExternalBytes."
%{ /* NOCONTEXT */
#ifdef HAS_DL
/*
* not needed, if dynamic link facilities exist
*/
#else /* no DL-support */
if (! __isString(aFileName)) {
RETURN ( nil );
}
# if defined(A_DOT_OUT) && !defined(ELF)
# if !defined(sco) && !defined(isc)
{
char *fname = (char *) _stringVal(aFileName);
unsigned taddr, daddr;
unsigned tsize, dsize;
unsigned toffset = 0;
unsigned doffset = 0;
int fd;
struct exec header;
char *cp;
int bssCount;
unsigned magic = OMAGIC;
int nread;
taddr = _isSmallInteger(textAddr) ? (unsigned) _intVal(textAddr) : 0;
daddr = _isSmallInteger(dataAddr) ? (unsigned) _intVal(dataAddr) : 0;
tsize = _isSmallInteger(textSize) ? _intVal(textSize) : 0;
dsize = _isSmallInteger(dataSize) ? _intVal(dataSize) : 0;
if ((fd = open(fname, 0)) < 0) {
fprintf(stderr, "cannot open <%s>\n", fname);
RETURN ( nil );
}
if (read(fd, &header, sizeof(header)) != sizeof(header)) {
fprintf(stderr, "cannot read header of <%s>\n", fname);
close(fd);
RETURN ( nil );
}
if (N_MAGIC(header) != magic) {
fprintf(stderr, "header is (0%o) %x should be (0%o) %x\n",
N_MAGIC(header), N_MAGIC(header),
magic, magic);
close(fd);
RETURN ( nil );
}
/*
* some linkers produce a huge output file, with zeros up to the
* real code ... - thats what toffset, doffset are for.
*/
# if defined(sinix) && defined(BSD)
toffset = N_TXTADDR(header);
doffset = toffset + taddr + tsize /* - 0x800 */;
daddr = taddr + tsize;
# else
# if defined(mips) && defined(ultrix)
toffset = N_TXTOFF(header.ex_f, header.ex_o);
doffset = toffset + tsize;
daddr = taddr + tsize;
# else
# if defined(N_TXTOFF)
toffset = N_TXTOFF(header);
doffset = N_DATOFF(header);
daddr = taddr + tsize;
# else
fprintf(stderr, "dont know text/data offsets in objectfile\n");
RETURN ( nil );
# endif
# endif
# endif
# ifdef SUPERDEBUG
printf("toffs:%x taddr:%x tsize:%d doffs:%x daddr:%x dsize:%d\n",
toffset, taddr, tsize, doffset,daddr, dsize);
# endif
if (lseek(fd, (long)toffset, 0) < 0) {
fprintf(stderr, "cannot seek to text\n");
close(fd);
RETURN ( nil );
}
if ((nread = read(fd, taddr, tsize)) != tsize) {
perror("read");
fprintf(stderr, "cannot read text wanted:%d got:%d\n", tsize, nread);
close(fd);
RETURN ( nil );
}
# ifdef SUPERDEBUG
printf("1st bytes of text: %02x %02x %02x %02x\n",
*((char *)taddr) & 0xFF, *((char *)taddr+1) & 0xFF,
*((char *)taddr+2) & 0xFF, *((char *)taddr+3) & 0xFF);
# endif
if (dsize) {
if (lseek(fd, (long)doffset, 0) < 0) {
fprintf(stderr, "cannot seek to data\n");
close(fd);
RETURN ( nil );
}
if (read(fd, daddr, dsize) != dsize) {
fprintf(stderr, "cannot read data\n");
close(fd);
RETURN ( nil );
}
# ifdef SUPERDEBUG
{
char *ptr;
int i;
ptr = (char *)daddr;
fprintf(stderr, "bytes of data (at %x):\n", ptr);
for (i=dsize; i>0; i--, ptr++)
printf("%02x ", *ptr & 0xFF);
}
# endif
}
close(fd);
# ifdef NOTDEF
if (header.a_bss != 0) {
fprintf(stderr, "warning: bss not empty\n");
cp = ((char *)daddr) + header.a_data;
for (bssCount=header.a_bss; bssCount; bssCount--)
*cp++ = 0;
}
# endif
}
RETURN ( self );
# endif
# endif
/*
* need support for other headers ... (i.e. coff, elf)
*/
#endif
%}.
^ self error:'objectFile format not supported'
! !
ObjectFileLoader initialize!