.
"
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
NextHandleID PreviouslyLoadedObjects'
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.38 1995-08-27 23:24:55 claus Exp $
'!
!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.38 1995-08-27 23:24:55 claus Exp $
"
!
documentation
"
This class knowns how to dynamically load in external object-modules.
WARNING:
As to date, this is completely experimental and WITHOUT ANY WARRANTY.
It is still being developed and the code below needs cleanup and more
robustness.
There are basically two totally different mechanisms to do this:
a) if there exists some dynamic-link facility such as:
GNU-DL, dlopen (sparc, SYS5.4), rld_open (NeXT),
this is used
b) if no such facility exists, the normal linker is used to
link the module to text/data address as previously malloced,
and the object file loaded into that space.
Currently, not all mechanisms work fully satisfying.
For example, the sun dl*-functions do an exit on link-errors (which
is certainly not what we want here :-(; the NeXT mechanism does not
allow for selective unloading (only all or last).
The only really useful packages are the GNU-dl package and the SGI/Unixware
sys5.4 libdl packages.
The GNU-dl package is only available for a.out file formats;
i.e. only (a subset of) linux people can use it at this time.
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).
"
! !
!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
#ifdef SYSV4 /* sys5.4 dlopen interface */
# define SYSV4_DL
# define HAS_DL
#endif
#ifdef DL1_6 /* dl1.6 COFF loader */
# define HAS_DL
#endif
#ifdef _AIX
# define AIX_DL
# define HAS_DL
#endif
/*
* but GNU_DL overwrites this - its better
*/
#ifdef GNU_DL /* dld2.3.x interface */
# define HAS_DL
# undef SYSV4_DL
# undef NEXT_DL
# undef SUN_DL
# undef DL1_6
#endif
#include <stdio.h>
/*
* if no dynamic link facilities, try 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 NEXT_DL
# ifndef _RLD_H_
# define _RLD_H_
# include <rld.h>
# 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
%}
! !
!ObjectFileLoader class methodsFor:'initialization'!
initialize
"name of object file, where initial symbol table is found"
MySymbolTable := 'smalltalk'.
Verbose := false.
NextHandleID := 1.
ObjectMemory addDependent:self.
"
ObjectFileLoader initialize
"
!
verbose:aBoolean
"turn on/off debug traces"
Verbose := aBoolean
"ObjectFileLoader verbose:true"
! !
!ObjectFileLoader class methodsFor:'change & update'!
update:something
"sent, when image is saved or restarted"
(something == #aboutToSnapshot) ifTrue:[
self unloadAndRememberAllObjectFiles
].
(something == #restarted) ifTrue:[
self reloadAllRememberedObjectFiles
].
! !
!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 ].
'OBJFLOADER: 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|
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) infoPrintNL
].
(OperatingSystem executeCommand:cmd) ifFalse:[
errStream := FileStream oldFileNamed:'/tmp/err'.
errStream isNil ifTrue:[
self notify:'errors during link.'
] ifFalse:[
errors := errStream contents.
errText := errors asStringCollection.
(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)) infoPrintNL
].
dataSize := self dataSizeOf:oFile.
dataSize isNil ifTrue:[
'bad data-size in object file' errorPrintNL.
^ nil
].
Verbose ifTrue:[
('data-size: ' , (dataSize printStringRadix:16)) infoPrintNL
].
"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)) infoPrintNL
].
(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)) infoPrintNL
]
].
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)) infoPrintNL
].
unixCommand := (self absLd:oFile text:text address) , ' >/tmp/out 2>/tmp/err'.
].
Verbose ifTrue:[
('executing: ' , unixCommand) infoPrintNL
].
'linking ...' printNewline.
(OperatingSystem executeCommand:unixCommand) ifFalse: [
errStream := FileStream oldFileNamed:'/tmp/err'.
errStream notNil ifTrue:[
errors := errStream contents.
errText := errors asStringCollection.
(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' infoPrintNL.
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)) infoPrintNL
].
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)) infoPrintNL
].
"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)) infoPrintNL
].
(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)) infoPrintNL
]
].
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)) infoPrintNL
].
unixCommand := (self absLd:oFile text:text address) , ' >/tmp/out 2>/tmp/err'.
].
Verbose ifTrue:[
('executing: ' , unixCommand) infoPrintNL
].
'linking ...' infoPrintNL.
(OperatingSystem executeCommand:unixCommand) ifFalse: [
errStream := FileStream oldFileNamed:'/tmp/err'.
errStream notNil ifTrue:[
errors := errStream contents.
errText := errors asStringCollection.
(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' infoPrintNL.
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)) infoPrintNL
].
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)) infoPrintNL
].
((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)) infoPrintNL.
].
dataAddr notNil ifTrue:[
('loading ' , dataSize printString , ' bytes at ' , (dataAddr printStringRadix:16)) infoPrintNL.
].
].
(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' infoPrintNL.
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 status otherClass knownToBeOk|
handle := self loadDynamicObject:aFileName.
handle isNil ifTrue:[
Transcript showCr:('loadDynamic: ', aFileName,' failed.').
^ nil
].
"
get the Init-function; let the class install itself
"
symName := '_' , aClassName , '_Init'.
initAddr := self getFunction:symName from:handle.
initAddr isNil ifTrue:[
"try with added underscore"
symName := '__' , aClassName , '_Init'.
initAddr := self getFunction:symName from:handle.
].
knownToBeOk := true.
knownToBeOk ifFalse:[
Verbose ifTrue:[
'looking for undefs ...' infoPrintNL.
].
"
if there are any undefined symbols, we may have to load more
files (libs, other modules)
"
list := self getListOfUndefinedSymbolsFrom:handle.
list notNil ifTrue:[
moreHandles := self loadModulesFromListOfUndefined:list.
"
now, try again
"
symName := '_' , aClassName , '_Init'.
initAddr := self getFunction:symName from:handle.
initAddr isNil ifTrue:[
"try with added underscore"
symName := '__' , aClassName , '_Init'.
initAddr := self getFunction:symName from:handle.
].
]
].
initAddr notNil ifTrue:[
Verbose ifTrue:[
('calling init at: ' , (initAddr printStringRadix:16)) infoPrintNL.
].
status := self performModuleInitAt:initAddr identifyAs:handle.
"
if any classes are missing ...
"
((status at:1) == #missingClass:) ifTrue:[
"
... and we are loading a module ...
"
Transcript showCr:'try for missing class in same object ...'.
otherClass := self loadClass:(status at:2) fromObjectFile:aFileName.
otherClass notNil ifTrue:[
"
try again ...
"
Transcript showCr:'missing class is here; try again ...'.
status := self performModuleInitAt:initAddr identifyAs:handle.
]
].
(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 ' errorPrint. aClassName errorPrint.
' did not define itself' errorPrintNL
"
do not unload - could have installed its methods ...
"
].
^ newClass
].
Verbose ifTrue:[
('no symbol: ', symName,' in ',aFileName) infoPrintNL.
].
"
unload
"
Verbose ifTrue:[
'unloading due to init failure:' infoPrint. (handle at:3) infoPrintNL.
].
moreHandles notNil ifTrue:[
moreHandles do:[:aHandle |
Verbose ifTrue:[
('unloading: ', aHandle printString) infoPrintNL.
].
self unloadDynamicObject:handle.
]
].
Verbose ifTrue:[
('unloading: ', handle printString) infoPrintNL.
].
self unloadDynamicObject:handle.
^ nil
"
ObjectFileLoader loadClass:'Tetris' fromObjectFile:'../clients/Tetris/Tetris.o'
ObjectFileLoader loadClass:'TetrisBlock' fromObjectFile:'../clients/Tetris/TBlock.o'
ObjectFileLoader loadClass:'Foo' fromObjectFile:'classList.o'
"
!
loadObjectFile:aFileName
"load an object file (.o-file) into the image;
the class name is not needed (multiple definitions may be in the file).
Return false on error, true if ok."
|handle initAddr className newClass initNames didInit status suffixLen|
handle := self loadDynamicObject:aFileName.
handle isNil ifTrue:[
Transcript showCr:('loadDynamic: ',aFileName,' failed.').
^ false
].
didInit := false.
"
first, expect the classes-name to be the fileName-base
"
className := OperatingSystem baseNameOf:aFileName.
(className endsWith:'.o') ifTrue:[
suffixLen := 2.
] ifFalse:[
(className endsWith:'.obj') ifTrue:[
suffixLen := 4.
] ifFalse:[
(className endsWith:'.so') ifTrue:[
suffixLen := 3.
] ifFalse:[
suffixLen := 0.
]
]
].
suffixLen ~~ 0 ifTrue:[
className := className copyWithoutLast:suffixLen
].
"
look for explicit init function
"
initAddr := self getFunction:(className , '_Init') from:handle.
initAddr isNil ifTrue:[
initAddr := self getFunction:('_' , className , '_Init') from:handle.
].
initAddr isNil ifTrue:[
"
look for reverse abbreviation
"
className := Smalltalk classNameForFile:className.
className notNil ifTrue:[
initAddr := self getFunction:(className , '_Init') from:handle.
initAddr isNil ifTrue:[
initAddr := self getFunction:('_' , className , '_Init') from:handle.
].
]
].
initAddr notNil ifTrue:[
Verbose ifTrue:[
('calling init at:' , (initAddr printStringRadix:16)) infoPrintNL.
].
status := self performModuleInitAt:initAddr identifyAs:handle.
didInit := true.
] ifFalse:[
"
look for init-function(s); call them all
"
Verbose ifTrue:[
'no init found; looking for candidates ...' infoPrintNL.
].
initNames := self namesMatching:'*_Init' segment:'[tT]' in:aFileName.
initNames notNil ifTrue:[
initNames do:[:aName |
initAddr := self getFunction:aName from:handle.
initAddr isNil ifTrue:[
(aName startsWith:'_') ifTrue:[
initAddr := self getFunction:(aName copyFrom:2) from:handle.
].
].
initAddr isNil ifTrue:[
Transcript showCr:('no symbol: ',aName,' in ',aFileName).
^ false
].
Verbose ifTrue:[
('calling init at:' , (initAddr printStringRadix:16)) infoPrintNL
].
self performModuleInitAt:initAddr identifyAs:handle.
didInit := true.
].
].
].
"/ (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.
"/ ].
"/ ].
didInit ifFalse:[
Transcript showCr:'no init function found'
].
"
really dont know, if it has changed ...
"
Smalltalk changed.
^ true
!
loadCPlusPlusObjectFile:aFileName
"load a c++ object file (.o-file) into the image"
|handle initAddr list|
handle := self loadDynamicObject:aFileName.
handle isNil ifTrue:[
Transcript showCr:('loadDynamic: ',aFileName,' failed.').
^ nil
].
list := self namesMatching:'__GLOBAL_$I*' segment:'[tT]' in:aFileName.
list size == 1 ifTrue:[
"/ (self isCPlusPlusObject:handle) ifTrue:[
Verbose ifTrue:[
'a c++ object file' infoPrintNL.
].
"
what I would like to get is the CTOR_LIST,
and call each function.
But dld cannot (currently) handle SET-type symbols, therefore
we search (using nm) for all __GLOBAL_$I* syms, get their values
and call them each
"
"/ list := self namesMatching:'__GLOBAL_$I*' segment:'[tT]' in:aFileName.
"/ initAddr := self getFunction:'__CTOR_LIST__' from:handle.
"/ Verbose ifTrue:[
"/ ('calling CTORs at:' , (initAddr printStringRadix:16)) infoPrintNL
"/ ].
initAddr := self getFunction:list first from:handle.
initAddr isNil ifTrue:[
"
try with added underscore
"
initAddr := self getFunction:('_' , list first) from:handle.
].
(initAddr isNil and:[list first startsWith:'_']) ifTrue:[
"
try with removed underscore
"
initAddr := self getFunction:(list first copyFrom:2) from:handle.
].
initAddr isNil ifTrue:[
Verbose ifTrue:[
('no CTOR-func found (' , list first , ')') infoPrintNL.
].
self unloadDynamicObject:aFileName.
^ nil
].
Verbose ifTrue:[
('calling CTORs at:' , (initAddr printStringRadix:16)) infoPrintNL
].
self callInitFunctionAt:initAddr
specialInit:false
forceOld:false
interruptable:false
argument:0
identifyAs:nil.
Verbose ifTrue:[
'done with CTORs.' infoPrintNL
].
"
cannot create a CPlusPlus class automatically (there could be more than
one classes in it too ...)
"
^ handle
].
Verbose ifTrue:[
'unknown object file' infoPrintNL
].
self unloadDynamicObject:aFileName.
^ nil
!
loadModulesFromListOfUndefined:list
"try to figure out what has to be loaded to resolve symbols from list.
return a list of handles of loaded objects
"
|inits classNames|
inits := list select:[:symbol | symbol notNil and:[symbol endsWith:'_Init']].
inits notNil ifTrue:[
classNames := inits collect:[:symbol |
(symbol startsWith:'___') ifTrue:[
symbol copyFrom:4 to:(symbol size - 5)
] ifFalse:[
(symbol startsWith:'__') ifTrue:[
symbol copyFrom:3 to:(symbol size - 5)
] ifFalse:[
(symbol startsWith:'_') ifTrue:[
symbol copyFrom:2 to:(symbol size - 5)
] ifFalse:[
symbol
]
]
]
].
"
autoload those classes
"
classNames do:[:aClassName |
|cls|
(cls := Smalltalk classNamed:aClassName) notNil ifTrue:[
'autoloading ' 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 modules deInit-function ...
"/ unload ...
self unloadDynamicObject:handle
!
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
LoadedObjects notNil ifTrue:[
PreviouslyLoadedObjects := LoadedObjects keys copy.
self unloadAllObjectFiles
]
!
reloadAllRememberedObjectFiles
PreviouslyLoadedObjects notNil ifTrue:[
PreviouslyLoadedObjects do:[:fileName |
('OBJFLOADER: reloading ' , fileName , ' ...') infoPrintNL.
self loadObjectFile:fileName
].
PreviouslyLoadedObjects := nil
]
! !
!ObjectFileLoader class methodsFor:'queries'!
loadedObjectFiles
"return a collection containing the names of all
dynamically loaded objects."
LoadedObjects isNil ifTrue:[^ #()].
^ LoadedObjects keys copy
"
ObjectFileLoader loadedObjectFiles
"
! !
!ObjectFileLoader class methodsFor:'dynamic object access'!
loadDynamicObject:pathName
"load an object-file (load/map into my address space).
Return a non-nil handle if ok, nil otherwise.
No bindings are done - only a pure load is performed.
This function is not supported on all architectures.
"
|handle buffer|
Verbose ifTrue:[
('loadDynamic: ' , pathName , ' ...') infoPrintNL
].
"/ already loaded ?
LoadedObjects notNil ifTrue:[
handle := LoadedObjects at:pathName ifAbsent:nil.
handle notNil ifTrue:[
Verbose ifTrue:[
('... ' , pathName , ' already loaded.') infoPrintNL.
].
^ handle
].
].
"/
"/ the 1st two entries are system dependent;
"/ entry 3 is the pathName
"/ entry 4 is a unique ID
"/
buffer := Array new:4.
buffer at:3 put:pathName.
buffer at:4 put:NextHandleID. NextHandleID := NextHandleID + 1.
handle := self primLoadDynamicObject:pathName into:buffer.
handle isNil ifTrue:[
LastError == #notImplemented ifTrue:[
Verbose ifTrue:[
'no dynamic load facility or load failed.' infoPrintNL.
Transcript showCr:'Try to load it myself ...'.
].
"try it the hard way"
handle := self loadFile:pathName.
].
handle isNil ifTrue:[
^ nil
]
].
"
remember loaded object for later unloading
"
LoadedObjects isNil ifTrue:[
LoadedObjects := Dictionary new.
].
LoadedObjects at:pathName put:handle.
Smalltalk flushCachedClasses.
Verbose ifTrue:[
('loadDynamic ok; handle is: ' , handle printString) infoPrintNL.
].
^ handle
"sys5.4:
|handle|
handle := ObjectFileLoader loadDynamicObject:'../stc/mod1.so'.
ObjectFileLoader getFunction:'module1' from:handle
"
"next:
|handle|
handle := ObjectFileLoader loadDynamicObject:'../goodies/Path/AbstrPath.o'.
ObjectFileLoader getFunction:'__AbstractPath_Init' from:handle
"
"GLD:
|handle|
handle := ObjectFileLoader loadDynamicObject:'../clients/Tetris/Tetris.o'.
ObjectFileLoader getFunction:'__TetrisBlock_Init' from:handle
"
!
primLoadDynamicObject:pathName into:aHandle
"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."
%{ /* UNLIMITEDSTACK */
if (! __isArray(aHandle)
|| (_arraySize(aHandle) < 3)) {
return nil;
}
#ifdef GNU_DL
{
static firstCall = 1;
extern char *__myName__;
if (firstCall) {
firstCall = 0;
(void) dld_init (__myName__);
}
if (__isString(pathName)) {
if (dld_link(__stringVal(pathName))) {
if (ObjectFileLoader_Verbose == true) {
printf ("link file %s failed\n", __stringVal(pathName));
dld_perror("cant link");
}
ObjectFileLoader_LastError = @symbol(linkError);
RETURN ( nil );
}
_ArrayInstPtr(aHandle)->a_element[0] = pathName;
__STORE(aHandle, pathName);
RETURN ( aHandle );
}
RETURN ( nil );
}
#endif
#ifdef DL1_6
{
extern char *__myName__;
char *ldname;
OBJ tmpName;
if (__isString(pathName)) {
if ( dl_loadmod_only(__myName__, __stringVal(pathName), &ldname) == 0 ) {
if (ObjectFileLoader_Verbose == true) {
printf ("link file %s failed\n", __stringVal(pathName));
}
RETURN ( nil );
}
/*
* returns the name of the temporary ld-file
* use that as handle ...
*/
tmpName = _MKSTRING(ldname);
_ArrayInstPtr(aHandle)->a_element[0] = tmpName;
__STORE(aHandle, tmpName);
RETURN ( aHandle );
}
RETURN ( nil );
}
#endif
#ifdef AIX_DL
{
extern char *__myName__;
char *ldname;
int *handle;
extern errno;
if (__isString(pathName)) {
if ( (handle = (int *) load(__stringVal(pathName), 0, 0)) == 0 ) {
if (ObjectFileLoader_Verbose == true) {
char *messages[64];
int i;
printf ("load file %s failed errno=%d\n",
__stringVal(pathName), errno);
switch (errno) {
case ENOEXEC:
printf(" load messages:\n");
loadquery(L_GETMESSAGES, messages, sizeof(messages));
for (i=0; messages[i]; i++) {
printf(" %s\n", messages[i]);
}
break;
}
}
RETURN ( nil );
}
if (ObjectFileLoader_Verbose == true) {
printf("load %s handle = %x\n", __stringVal(pathName), handle);
}
_ArrayInstPtr(aHandle)->a_element[0] = _MKSMALLINT( (int)handle & 0xFFFF );
_ArrayInstPtr(aHandle)->a_element[1] = _MKSMALLINT( ((int)handle >> 16) & 0xFFFF );
__STORE(aHandle, pathName);
RETURN (aHandle);
}
RETURN ( nil );
}
#endif
#ifdef SYSV4_DL
{
void *handle;
char *nm;
if ((pathName == nil) || __isString(pathName)) {
handle = dlopen(pathName == nil ? (char *)0 : __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(aHandle)->a_element[0] = _MKSMALLINT( (int)handle & 0xFFFF );
_ArrayInstPtr(aHandle)->a_element[1] = _MKSMALLINT( ((int)handle >> 16) & 0xFFFF );
RETURN (aHandle);
}
}
#endif
#ifdef SUN_DL
{
void *handle;
if ((pathName == nil) || __isString(pathName)) {
if (pathName == nil)
handle = dlopen((char *)0, 1);
else
handle = dlopen(__stringVal(pathName), 1);
if (! handle) {
fprintf(stderr, "dlopen %s error: <%s>\n",
__stringVal(pathName), dlerror());
ObjectFileLoader_LastError = @symbol(linkError);
RETURN (nil);
}
if (ObjectFileLoader_Verbose == true) {
printf("open %s handle = %x\n", __stringVal(pathName), handle);
}
_ArrayInstPtr(aHandle)->a_element[0] = _MKSMALLINT( (int)handle & 0xFFFF );
_ArrayInstPtr(aHandle)->a_element[1] = _MKSMALLINT( ((int)handle >> 16) & 0xFFFF );
RETURN (aHandle);
}
}
#endif
#ifdef NEXT_DL
{
long result;
char *files[2];
NXStream *errOut;
if (__isString(pathName)) {
files[0] = (char *) __stringVal(pathName);
files[1] = (char *) 0;
errOut = NXOpenFile(2, 2);
result = rld_load(errOut,
(struct mach_header **)0,
files,
(char *)0);
NXClose(errOut);
if (! result) {
ObjectFileLoader_LastError = @symbol(linkError);
fprintf(stderr, "rld_load %s failed\n", __stringVal(pathName));
RETURN (nil);
}
if (ObjectFileLoader_Verbose == true)
printf("rld_load %s ok\n", __stringVal(pathName));
_ArrayInstPtr(aHandle)->a_element[0] = pathName;
__STORE(aHandle, pathName);
RETURN ( aHandle );
}
}
#endif
%}.
LastError := #notImplemented.
^ nil
!
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|
'unload module name=' infoPrint. (handle at:3) infoPrintNL.
self performModuleDeInit:handle.
(self primUnloadDynamicObject:handle) ifTrue:[
"
remove from loaded objects
"
LoadedObjects notNil ifTrue:[
key := LoadedObjects keyAtEqualValue:handle.
key notNil ifTrue:[
LoadedObjects removeKey:key
]
].
Smalltalk flushCachedClasses
] ifFalse:[
self error:'unloadDynamic failed'
]
!
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."
%{
OBJ sysHandle1, sysHandle2;
if (! __isArray(aHandle)
|| (_arraySize(aHandle) < 3)) {
return false;
}
sysHandle1 = __ArrayInstPtr(aHandle)->a_element[0];
sysHandle2 = __ArrayInstPtr(aHandle)->a_element[1];
#ifdef GNU_DL
if (__isString(sysHandle1)) {
if (dld_unlink_by_file(__stringVal(sysHandle1), 1)) {
if (ObjectFileLoader_Verbose == true) {
printf ("unlink file %s failed\n", __stringVal(sysHandle1));
dld_perror("cant unlink");
}
RETURN (false);
}
RETURN (true);
}
RETURN (false);
#endif
#ifdef SYSV4_DL
{
void *h;
int val;
OBJ low = sysHandle1, hi = sysHandle2;
if (__bothSmallInteger(low, hi)) {
val = (_intVal(hi) << 16) + _intVal(low);
h = (void *)(val);
if (ObjectFileLoader_Verbose == true)
printf("close handle = %x\n", h);
if (dlclose(h) != 0) {
fprintf(stderr, "dlclose failed with:<%s>\n", dlerror());
RETURN (false);
}
RETURN (true);
}
}
#endif
#ifdef SUN_DL
{
void *h;
int val;
OBJ low = sysHandle1, hi = sysHandle2;
if (__bothSmallInteger(low, hi)) {
val = (_intVal(hi) << 16) + _intVal(low);
h = (void *)(val);
if (ObjectFileLoader_Verbose == true)
printf("close handle = %x\n", h);
dlclose(h);
RETURN (true);
}
}
#endif
#ifdef AIX_DL
{
int *h;
int val;
OBJ low = sysHandle1, hi = sysHandle2;
if (__bothSmallInteger(low, hi)) {
val = (_intVal(hi) << 16) + _intVal(low);
h = (int *)(val);
if (ObjectFileLoader_Verbose == true)
printf("unload handle = %x\n", h);
if ( unload(h) != 0) {
fprintf(stderr, "unload failed\n");
RETURN (false);
}
RETURN (true);
}
}
#endif
%}.
^ false
!
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
!
isObjectiveCObject:handle
"not yet implemented"
^ false
!
namesMatching:aPattern segment:segmentPattern in:aFileName
"this is rubbish - it will vanish soon"
|p l s addr segment name entry|
OperatingSystem getSystemType = 'aix' ifTrue:[
^ nil
].
l := OrderedCollection new.
p := PipeStream readingFrom:(self nm:aFileName).
p isNil ifTrue:[
('cannot read names from ' , aFileName) errorPrintNL.
^ nil
].
[p atEnd] whileFalse:[
entry := p nextLine.
Verbose ifTrue:[
entry infoPrintNL.
].
entry notNil ifTrue:[
s := ReadStream on:entry.
addr := s nextAlphaNumericWord.
segment := s nextAlphaNumericWord.
name := s upToEnd withoutSeparators.
(addr notNil and:[segment notNil and:[name notNil]]) ifTrue:[
(aPattern match:name) ifTrue:[
(segmentPattern isNil or:[segmentPattern match:segment]) ifTrue:[
l add:name.
Verbose ifTrue:[
('found name: ' , name) infoPrintNL.
]
] ifFalse:[
Verbose ifTrue:[
name infoPrint. ' segment mismatch ' infoPrint.
segmentPattern infoPrint. ' ' infoPrint. segment infoPrintNL.
]
]
]
]
]
].
p close.
^ l
!
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."
|fName|
OperatingSystem getSystemType = 'aix' ifTrue:[
fName := '.' , aString
] ifFalse:[
fName := aString
].
^ self getSymbol:fName function:true from:handle
!
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."
|lowAddr hiAddr|
%{ /* STACK: 20000 */
OBJ sysHandle1, sysHandle2;
if (! __isArray(aHandle)
|| (_arraySize(aHandle) < 3)) {
return false;
}
sysHandle1 = __ArrayInstPtr(aHandle)->a_element[0];
sysHandle2 = __ArrayInstPtr(aHandle)->a_element[1];
#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);
} 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 {
if (ObjectFileLoader_Verbose == true) {
printf ("function %s not found\n", name);
dld_perror("get_func");
}
}
}
}
}
#endif /* GNU_DL */
#ifdef DL1_6
{
void *h;
void *addr;
int val;
if (__isString(aString)) {
if (__isString(sysHandle1)) {
if (ObjectFileLoader_Verbose == true)
printf("get sym <%s> handle = %x\n",
__stringVal(aString), __stringVal(sysHandle1));
addr = dl_getsymbol(__stringVal(sysHandle1), __stringVal(aString));
if (addr) {
if (ObjectFileLoader_Verbose == true)
printf("addr = %x\n", addr);
lowAddr = _MKSMALLINT( (int)addr & 0xFFFF );
hiAddr = _MKSMALLINT( ((int)addr >> 16) & 0xFFFF );
} else {
if (ObjectFileLoader_Verbose == true)
printf("dl_getsymbol %s failed\n", __stringVal(aString));
}
}
}
}
#endif
#ifdef SYSV4_DL
{
void *h;
void *addr;
int val;
OBJ low = sysHandle1, hi = sysHandle2;
if (__bothSmallInteger(low, hi)) {
val = (_intVal(hi) << 16) + _intVal(low);
h = (void *)(val);
if (__isString(aString)) {
if (ObjectFileLoader_Verbose == true)
printf("get sym <%s> handle = %x\n", __stringVal(aString), h);
addr = dlsym(h, (char *) __stringVal(aString));
if (addr) {
if (ObjectFileLoader_Verbose == true) {
printf("dlsym %s ok; addr = %x\n", addr);
}
lowAddr = _MKSMALLINT( (int)addr & 0xFFFF );
hiAddr = _MKSMALLINT( ((int)addr >> 16) & 0xFFFF );
} else {
if (ObjectFileLoader_Verbose == true) {
printf("dlsym %s error: %s", __stringVal(aString), dlerror());
}
}
}
}
}
#endif
#ifdef AIX_DL
{
OBJ fileName;
void *h;
void *addr;
int val;
struct nlist nl[2];
OBJ low = sysHandle1, hi = sysHandle2;
if (__bothSmallInteger(low, hi)
&& __isString(fileName)) {
val = (_intVal(hi) << 16) + _intVal(low);
h = (void *)(val);
if (__isString(aString)) {
if (ObjectFileLoader_Verbose == true)
printf("get sym <%s> handle = %x file = %s\n",
__stringVal(aString), h, __stringVal(fileName));
nl[0].n_name = __stringVal(aString);
nl[1].n_name = "";
if (nlist(__stringVal(fileName), &nl) == -1) {
if (ObjectFileLoader_Verbose == true)
printf("nlist error\n");
} else {
addr = (void *)((unsigned)nl[0].n_value + (unsigned)h);
if (ObjectFileLoader_Verbose == true) {
printf("value=%x section=%d type=%x sclass=%d\n",
nl[0].n_value, nl[0].n_scnum, nl[0].n_type, nl[0].n_sclass);
printf("addr = %x\n", addr);
}
lowAddr = _MKSMALLINT( (int)addr & 0xFFFF );
hiAddr = _MKSMALLINT( ((int)addr >> 16) & 0xFFFF );
}
}
}
}
#endif
#ifdef SUN_DL
{
void *h;
void *addr;
int val;
OBJ low = sysHandle1, hi = sysHandle2;
if (__bothSmallInteger(low, hi)) {
val = (_intVal(hi) << 16) + _intVal(low);
h = (void *)(val);
if (__isString(aString)) {
if (ObjectFileLoader_Verbose == true)
printf("get sym <%s> handle = %x\n", __stringVal(aString), h);
addr = dlsym(h, __stringVal(aString));
if (addr) {
if (ObjectFileLoader_Verbose == true)
printf("addr = %x\n", addr);
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:aHandle
"return a collection of undefined symbols in a dynamically loaded object file.
Handle must be the one returned previously from loadDynamicObject."
|list|
list := Array new:100. "no more than 100 symbols"
%{
#ifdef GNU_DL
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 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
%}.
^ 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
%}
!
allModulesDo:aBlock
%{
__REGISTRATION_DO_BLOCK(&aBlock COMMA_SND);
%}
!
performModuleDeInit:handle
|id|
'deInit module name=' infoPrint. (handle at:3) infoPrint.
' id=' infoPrint. (handle at:4) infoPrintNL.
id := handle at:4.
%{
__UNREGISTER_BY_ID(__intVal(id));
%}
!
performModuleInitAt:initAddr identifyAs:handle
"
Initialize a smalltalk module.
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
"
|status badClassName|
"/
"/ let it register itself
"/ and define its globals
"/
Verbose ifTrue:[
'phase 0 ...' infoPrintNL
].
self callInitFunctionAt:initAddr
specialInit:true
forceOld:true
interruptable:false
argument:0
identifyAs:handle.
"/
"/ check if superclasses are present
"/
(status := self loadStatus) == 0 ifFalse:[
badClassName := self classNameThatFailed.
status == -1 ifTrue:[
Transcript showCr:'load failed - missing class: ' , badClassName.
^ Array with:#missingClass:
with:badClassName
].
status == -2 ifTrue:[
Transcript showCr:'load failed - version mismatch: ' , badClassName.
^ Array with:#versionMismatch:
with:badClassName
].
Transcript showCr:'load failed'.
^ Array with:#loadFailed
].
"/
"/ remaining initialization
"/
Verbose ifTrue:[
'phase 1 ...' infoPrintNL
].
self moduleInit:1 forceOld:true interruptable:false.
Verbose ifTrue:[
'phase 2 ...' infoPrintNL
].
self moduleInit:2 forceOld:true interruptable:false.
Verbose ifTrue:[
'phase 3 ...' infoPrintNL
].
self moduleInit:3 forceOld:false interruptable:true.
^ Array with:#ok
!
loadStatus
"ask VM if class-hierarchy has been completely loaded"
|checker checkSymbol|
checker := self.
checkSymbol := #'superClassCheck:'.
%{ /* NOREGISTER */
RETURN (_MKSMALLINT(__check_registration__(&checker, &checkSymbol)));
%}
!
superClassCheck:aClass
"callBack from class registration code in VM: make certain, that aClass is
loaded too ..."
Verbose ifTrue:[
'checkCall for:' infoPrint. aClass name infoPrint. ' -> ' infoPrint.
].
aClass isBehavior ifFalse:[
Verbose ifTrue:[
'false' infoPrintNL.
].
'LOADER: check failed - no behavior' infoPrintNL.
^ false
].
('LOADER: check for ' , aClass name , ' being loaded') infoPrintNL.
aClass autoload.
(aClass isBehavior and:[aClass isLoaded]) ifTrue:[
('LOADER: ok, loaded. continue registration of actual class') infoPrintNL.
^ true
].
('LOADER: nope not loaded. fail registration of actual class') infoPrintNL.
^ false
!
classNameThatFailed
"ask VM for the name of the class that caused trouble"
%{
extern char *__name_registration_failure__();
RETURN (_MKSTRING(__name_registration_failure__()));
%}
!
callInitFunctionAt:address specialInit:special forceOld:forceOld interruptable:interruptable argument:argument identifyAs:handle
"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.
DANGER: Internal. Dont use in your programs."
|low hi lowAddr hiAddr moduleID|
hi := address // 16r10000.
low := address \\ 16r10000.
handle notNil ifTrue:[
moduleID := handle at:4
].
%{
void (*addr)();
unsigned val;
typedef void (*VOIDFUNC)();
int savInt;
int prevSpace, force;
int arg = 0;
int wasBlocked = 1;
extern OBJ __BLOCKINTERRUPTS();
extern int __oldSpaceSize(), __oldSpaceUsed();
if (__bothSmallInteger(low, hi)) {
if (_isSmallInteger(argument)) {
arg = __intVal(argument);
val = (_intVal(hi) << 16) + _intVal(low);
addr = (VOIDFUNC) val;
/*
* allow function to be interrupted
*/
if (interruptable != true) {
wasBlocked = (__BLOCKINTERRUPTS() == true);
}
force = (forceOld == true);
if (force) {
if ((__oldSpaceSize() - __oldSpaceUsed()) < (64*1024)) {
__moreOldSpace(__thisContext, 64*1024);
}
prevSpace = __allocForceSpace(OLDSPACE);
}
if (special == true) {
if (__isSmallInteger(moduleID)) {
__SET_MODULE_ID(__intVal(moduleID));
}
(*addr)(arg, __pRT__ COMMA_CON);
__SET_MODULE_ID(0);
} else {
(*addr)(arg COMMA_CON);
}
if (force) {
__allocForceSpace(prevSpace);
}
if (! wasBlocked) {
__UNBLOCKINTERRUPTS();
}
RETURN (self);
}
}
%}.
self primitiveFailed
!
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;
extern OBJ __BLOCKINTERRUPTS();
if (_isSmallInteger(phase)) {
if (interruptable != true) {
wasBlocked = (__BLOCKINTERRUPTS() == true);
}
force = (forceOld == true);
if (force) {
prevSpace = __allocForceSpace(OLDSPACE);
}
init_registered_modules(__intVal(phase) COMMA_CON);
if (force) {
__allocForceSpace(prevSpace);
}
if (! wasBlocked) {
__UNBLOCKINTERRUPTS();
}
RETURN (self);
}
%}.
self primitiveFailed
! !
!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!