"

 COPYRIGHT (c) 1993 by Claus Gittinger

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

Object subclass:#ObjectFileLoader

	 instanceVariableNames:''

	 classVariableNames:'MySymbolTable Verbose LastError LinkErrorMessage NextHandleID

	 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

#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_

#  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

%}

! !

!ObjectFileLoader class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1993 by Claus Gittinger

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

!

documentation

"

    This class knowns how to dynamically load in external object-modules.

    WARNING:

      As to date, this is completely experimental and WITHOUT ANY WARRANTY.

      It is still being developed and the code below needs cleanup and more

      robustness.

    There are basically two totally different mechanisms to do this:

	a) if there exists some dynamic-link facility such as:

	   GNU-DL, dlopen (sparc, SYS5.4), rld_open (NeXT),

	   this is used

	b) if no such facility exists, the normal linker is used to

	   link the module to text/data address as previously malloced,

	   and the object file loaded into that space.

    Currently, not all mechanisms work fully satisfying.

    For example, the sun dl*-functions do an exit on link-errors (which

    is certainly not what we want here :-(; the NeXT mechanism does not

    allow for selective unloading (only all or last).

    The only really useful packages are the GNU-dl package and the SGI/Unixware

    sys5.4 libdl packages. 

    The GNU-dl package is only available for a.out file formats; 

    i.e. only (a subset of) linux people can use it at this time.

    For the above reasons, dynamic object loading is currently only

    officially released for SYS5.4 and LINUX systems.

    Once stable, the functionality contained herein will be moved into

    the VM. 

    (It is needed there, to allow reloading of objectfiles upon

     image restart; i.e. before any class is reinitialilized).

"

!

version

! !

!ObjectFileLoader class methodsFor:'initialization'!

initialize

    "name of object file, where initial symbol table is found"

    MySymbolTable := 'smalltalk'.

    Verbose := false.

    NextHandleID := 1.

    ObjectMemory addDependent:self.

    OperatingSystem getSystemType = 'linux' ifTrue:[

	'/usr/lib/libc.a' asFilename isReadable ifTrue:[

	    SearchedLibraries := #('/usr/lib/libc.a')

	]

    ].

    "

     ObjectFileLoader initialize

    "

!

lastError

    ^ LastError

!

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) need to set this."

    SearchedLibraries := aCollectionOfArchivePathNames

!

verbose:aBoolean

    "turn on/off debug traces"

    Verbose := aBoolean

    "ObjectFileLoader verbose:true"

! !

!ObjectFileLoader class methodsFor:'change & update'!

update:something

    "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"

! !

!ObjectFileLoader class methodsFor:'defaults'!

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)

	]

    ].

    self error:'do not know how to link absolute'

!

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)

	]

    ].

"

    self error:'do not know how to link absolute'

!

hasValidBinaryExtension:aFilename

    "return true, if aFilename looks ok for binary loading.

     This checks only the extension - not its contents. 

     (So an attempt to load the file may fail due to format errors or unresolved symbols)

     This is very machine specific."

    self validBinaryExtensions do:[:ext |

	(aFilename endsWith:ext) ifTrue:[^ true].

    ].

    ^ false

    "

     ObjectFileLoader hasValidBinaryExtension:'foo.st'

     ObjectFileLoader hasValidBinaryExtension:'foo.o'

     ObjectFileLoader hasValidBinaryExtension:'foo.so'

    "

!

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 ]

    ].

    'OBJFLOADER: dont know if we need sepId - assume no' errorPrintNL.

    ^ false

!

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

!

sharedLibraryExtension

    "return a fileName extension used for dynamic loadable objects.

     This is very machine specific."

    |os|

    os := OperatingSystem getSystemType.

    (os = 'sys5_4') ifTrue:[^ '.so'].

    (os = 'iris') ifTrue:[^ '.so'].

    (os = 'linux') ifTrue:[^ '.o'].

    (os = 'aix') ifTrue:[^ '.so'].

    (os = 'hpux') ifTrue:[^ '.sl'].

    (os = 'msdos') ifTrue:[^ '.dll'].

    (os = 'mswindows') ifTrue:[^ '.dll'].

    (os = 'os2') ifTrue:[^ '.dll'].

    "/ mhmh what is a useful default ?

    ^ '.o'

!

validBinaryExtensions

    "return a collection of valid filename extension for binary files.

     This is very machine specific."

    |os|

    os := OperatingSystem getSystemType.

    (os = 'sys5_4') ifTrue:[^ #('.so') ].

    (os = 'iris') ifTrue:[^ #('.so') ].

    (os = 'linux') ifTrue:[^ #('.o' '.obj' '.so') ].

    (os = 'aix') ifTrue:[^ #('.o' '.so') ].

    (os = 'hpux') ifTrue:[^ #('.o' '.sl') ].

    (os = 'msdos') ifTrue:[^ #('.dll') ].

    (os = 'mswindows') ifTrue:[^ #('.dll') ].

    (os = 'os2') ifTrue:[^ #('.dll') ].

    "/ mhmh what is a useful default ?

    ^ #('.o')

    "

     ObjectFileLoader validBinaryExtensions

    "

! !

!ObjectFileLoader class methodsFor:'dynamic class loading'!

invalidateAndRememberAllObjectFiles

    "invalidate code refs into all dynamically loaded object files.

     Required before writing a snapshot image."

    LoadedObjects notNil ifTrue:[

	ActuallyLoadedObjects := LoadedObjects.

	PreviouslyLoadedObjects := LoadedObjects keys copy.

	ActuallyLoadedObjects keys do:[:aFileName |

	    |handle|

	    handle := ActuallyLoadedObjects at:aFileName.

	    handle isNil ifTrue:[

		self error:'oops, no handle'.

	    ] ifFalse:[

		self invalidateModule:handle

	    ]

	].

	LoadedObjects := nil.

    ].

    "Created: 5.10.1995 / 15:48:56 / claus"

    "Modified: 5.10.1995 / 16:48:51 / claus"

!

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