"
 COPYRIGHT (c) 1993 by Claus Gittinger
	      All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"

Object subclass:#ObjectFileLoader
	 instanceVariableNames:''
	 classVariableNames:'MySymbolTable Verbose LastError LinkErrorMessage NextHandleID
		LoadedObjects PreviouslyLoadedObjects ActuallyLoadedObjects
		SearchedLibraries'
	 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).
"
! !

!ObjectFileLoader class methodsFor:'initialization'!

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

    MySymbolTable := 'smalltalk'.
    Verbose := false.
    NextHandleID := 1.
    ObjectMemory addDependent:self.
    SearchedLibraries := #().
    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.
	self rememberAllObjectFiles.
	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
	     identifyAs:nil
	     returnsObject:false.

	Verbose ifTrue:[
	    'done with CTORs.' infoPrintNL
	].

	"
	 cannot create a CPlusPlus class automatically (there could be more than
	 one classes in it too ...)
	"
	^ handle
    ].


    Verbose ifTrue:[
	'unknown object file' infoPrintNL
    ].
    self unloadDynamicObject:aFileName.
    ^ nil
!

loadClass:aClassName fromObjectFile:aFileName
    "load a compiled class (.o-file) into the image"

    |handle initAddr symName newClass list moreHandles info status 
     otherClass knownToBeOk|

    handle := self loadDynamicObject:aFileName.
    handle isNil ifTrue:[
	Transcript showCr:('loadDynamic: ', aFileName,' failed.').
	^ nil
    ].

    "
     get the Init-function; let the class install itself
    "
    symName := '_' , aClassName , '_Init'.
    initAddr := self getFunction:symName from:handle.
    initAddr isNil ifTrue:[
	"try with added underscore"
	symName := '__' , aClassName , '_Init'.
	initAddr := self getFunction:symName from:handle.
	initAddr isNil ifTrue:[
	    "try with added period (AIX)"
	    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.
	].
	info := self performModuleInitAt:initAddr identifyAs:handle.
	status := info at:1.
	"
	 if any classes are missing ...
	"
	(status == #missingClass:) ifTrue:[
	    "
	     ... and we are loading a module ...
	    "
	    Transcript showCr:'try for missing class in same object ...'.
	    otherClass := self loadClass:(status at:2) fromObjectFile:aFileName.
	    otherClass notNil ifTrue:[
		"
		 try again ...
		"
		Transcript showCr:'missing class is here; try again ...'.
		info := 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 isInitialized ifTrue:[
		    Smalltalk changed.
		]
	    ].
	] ifFalse:[
	    'LOADER: class ' errorPrint. aClassName errorPrint.
	    ' did not define itself' errorPrintNL
	    "
	     do not unload - could have installed other classes/methods ...
	    "
	].
	^ newClass
    ].

    Verbose ifTrue:[
	('no symbol: ', symName,' in ',aFileName) infoPrintNL.
    ].

    "
     unload
    "
    Verbose ifTrue:[
	'unloading due to init failure:' infoPrint. handle pathName infoPrintNL.
    ].

    moreHandles notNil ifTrue:[
	moreHandles do:[:aHandle |
	    Verbose ifTrue:[
		('unloading: ', aHandle printString) infoPrintNL.
	    ].
	    self unloadDynamicObject:handle.
	]
    ].

    Verbose ifTrue:[
	('unloading: ', handle printString) infoPrintNL.
    ].
    self unloadDynamicObject:handle.
    ^ nil

    "
     ObjectFileLoader loadClass:'Tetris'      fromObjectFile:'../clients/Tetris/Tetris.o'
     ObjectFileLoader loadClass:'TetrisBlock' fromObjectFile:'../clients/Tetris/TBlock.o'
     ObjectFileLoader loadClass:'Foo'         fromObjectFile:'classList.o'
    "
!

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
!

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 info status suffixLen
     undefinedNames dummyHandle|

    handle := self loadDynamicObject:aFileName.
    handle isNil ifTrue:[
	Transcript showCr:('loadDynamic: ',aFileName,' failed.').
	^ false
    ].

    didInit := false.

    "/ with dld, load may have worked, even if undefined symbols
    "/ are to be resolved. If thats the case, load all libraries ...

    SearchedLibraries notNil ifTrue:[
	(self hasUndefinedSymbolsIn:handle) ifTrue:[
	    SearchedLibraries do:[:libName |
		(self hasUndefinedSymbolsIn:handle) ifTrue:[
		    Transcript showCr:'   ... trying ' , libName , ' to resolve undefined symbols ...'.
		    dummyHandle := Array new:4.
		    dummyHandle := self primLoadDynamicObject:libName into:dummyHandle.
		    dummyHandle isNil ifTrue:[
			Transcript showCr:'   ... load of library ' , libName , ' failed.'.
		    ]
		]
	    ].
	    (self hasUndefinedSymbolsIn:handle) isNil ifTrue:[
		Transcript showCr:('loadDynamic: still undefined symbols in ',aFileName,'.').
	    ].
	]
    ].

    "
     first, expect the classes-name to be the 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:[
	"/
	"/ special for broken ultrix nlist (will not find symbol with single
	"/ underscore; workaround: add another underscore
	"/
	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.
	].
	info := self performModuleInitAt:initAddr identifyAs:handle.
	status := info at:1.
	status == #ok ifTrue:[
	    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).
		] ifFalse:[
		    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:[
	status == #registrationFailed ifTrue:[
	    Transcript showCr:'incompatible object (recompile without commonSymbols ?)'
	].
	self listUndefinedSymbolsIn:handle.
	self unloadDynamicObject:handle.
	Transcript showCr:'module not loaded.'
    ].

    Smalltalk isInitialized ifTrue:[
	"
	 really dont know, if it has changed ...
	"
	Smalltalk changed.
    ].
    ^ true
!

loadMethodObjectFile:aFileName
    "load an object file (.o-file) for a single method into the image; 
     This does a slightly different initialization.
     Return an object handle; nil on error"

    |handle initAddr initName idx m|

    "
     load the objectfile
    "
    handle := self loadDynamicObject:aFileName.
    handle isNil ifTrue:[
	^ nil
    ].

    initName := aFileName asString.
    (initName startsWith:'./') ifTrue:[
	initName := initName copyFrom:3
    ].
    idx := initName indexOf:$..
    idx ~~ 0 ifTrue:[
	initName := initName copyTo:(idx -1).
    ].

    initAddr := self getFunction:'__' , initName , '_Init' from:handle.
    initAddr isNil ifTrue:[
	initAddr := ObjectFileLoader getFunction:'_' , initName , '_Init' from:handle.
	initAddr isNil ifTrue:[
	    (self getListOfUndefinedSymbolsFrom:handle) size > 0 ifTrue:[
		self listUndefinedSymbolsIn:handle.
		'undefined symbols in primitive code' errorPrintNL.
	    ] ifFalse:[
		(initName , '_Init() lookup failed') errorPrintNL
	    ].

	    self unloadDynamicObject:handle.
	    ^ nil
	]
    ].

    m := self
	callInitFunctionAt:initAddr 
	specialInit:true
	forceOld:true 
	interruptable:false
	argument:2
	identifyAs:handle
	returnsObject:true.

    handle method:m.
    ^ handle

    "Created: 5.12.1995 / 20:59:46 / cg"
    "Modified: 6.12.1995 / 13:13:44 / cg"
!

reloadAllRememberedObjectFiles
    "reload all object modules as were loaded when the image was saved.
     Some care has to be taken, if files are missing or otherwise corrupted."

    |oldDummyMethod where m newHandle|

    PreviouslyLoadedObjects notNil ifTrue:[
	PreviouslyLoadedObjects do:[:entry |
	    |fileName handle|

	    fileName := entry key.
	    handle := entry value.
	    handle moduleID:nil.

	    handle isClassLibHandle ifTrue:[
		('OBJFLOADER: reloading classes in ' , fileName , ' ...') infoPrintNL.
		self loadObjectFile:fileName
	    ] ifFalse:[
		handle isMethodHandle ifTrue:[
		    oldDummyMethod := handle method.
		    oldDummyMethod isNil ifTrue:[
			('OBJFLOADER: ignore obsolete (already collected) method in ' , fileName) infoPrintNL
		    ] ifFalse:[
			('OBJFLOADER: reloading method in ' , fileName , ' ...') infoPrintNL.
			where := oldDummyMethod who.
			newHandle := self loadMethodObjectFile:fileName.
			newHandle isNil ifTrue:[
			    ('OBJFLOADER: failed to reload method in ' , fileName , ' ...') infoPrintNL.
			] ifFalse:[
			    m := newHandle method.
			    m source:(oldDummyMethod source).
			    m package:(oldDummyMethod package).
			    where notNil ifTrue:[
				m == ((where at:1) compiledMethodAt:(where at:2)) ifFalse:[
				    'OBJFLOADER: oops - loaded method installed wrong' errorPrintNL.
				].
			    ].
			]
		    ]
		] ifFalse:[
		    ('OBJFLOADER: oops - invalid (obsolete) objectFile handle: ' , handle printString) infoPrintNL.
		]
	    ]
	].
	PreviouslyLoadedObjects := nil
    ]

    "Modified: 6.12.1995 / 18:37:32 / cg"
!

revalidateAllObjectFiles
    "revalidate code refs into all dynamically loaded object files.
     Required after writing a snapshot image."

    ActuallyLoadedObjects notNil ifTrue:[
	ActuallyLoadedObjects keys do:[:aFileName |
	    |handle|

	    handle := ActuallyLoadedObjects at:aFileName.
	    handle isNil ifTrue:[
		self error:'oops, no handle'.
	    ] ifFalse:[
		self revalidateModule:handle
	    ]
	].
	LoadedObjects := ActuallyLoadedObjects.
	ActuallyLoadedObjects := PreviouslyLoadedObjects := nil.
    ].

    "Created: 5.10.1995 / 15:49:08 / claus"
    "Modified: 5.10.1995 / 16:49:18 / claus"
!

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

unloadAllObsoleteObjectFiles
    "unload all dynamically loaded object files for which the classes/method
     has been already garbage collected."

    LoadedObjects notNil ifTrue:[
	LoadedObjects keys copy do:[:name |
	    |handle|

	    handle := LoadedObjects at:name ifAbsent:nil.
	    (handle notNil and:[handle isObsolete]) ifTrue:[
		self unloadObjectFile:name 
	    ]
	]
    ].

    "
     ObjectFileLoader unloadAllObsoleteObjectFiles
    "

    "Modified: 5.12.1995 / 18:16:52 / cg"
!

rememberAllObjectFiles
    LoadedObjects notNil ifTrue:[
	PreviouslyLoadedObjects := OrderedCollection new.
	LoadedObjects keysAndValuesDo:[:name :handle |
	    handle isForCollectedObject ifTrue:[
		('OBJFLOADER: ignore object for already collected objects in ' , name) infoPrintNL
	    ] ifFalse:[
		PreviouslyLoadedObjects add:(name -> handle)
	    ]
	].
	PreviouslyLoadedObjects sort:[:a :b | a value moduleID < b value moduleID].
    ]

    "Created: 5.12.1995 / 20:51:07 / cg"
    "Modified: 6.12.1995 / 17:53:08 / cg"
!

unloadAndRememberAllObjectFiles
    LoadedObjects notNil ifTrue:[
	self rememberAllObjectFiles.
	self unloadAllObjectFiles
    ]
!

unloadObjectFile:aFileName
    "unload an object file (.o-file) from the image.
     DANGER ALERT: currently, you have to make sure that no references to
     objects of this module exist - in future versions, the system will keep
     track of these. For now, use at your own risk.
     (especially critical are blocks-functions)."

    |handle|

    LoadedObjects notNil ifTrue:[
	handle := LoadedObjects at:aFileName ifAbsent:nil
    ].
    handle isNil ifTrue:[
	'OBJFLOADER: oops file to be unloaded was not loaded dynamically (', aFileName , ')'.
	^ self
    ].

    "/ call the modules deInit-function ...

    "/ unload ...

    self unloadDynamicObject:handle
! !

!ObjectFileLoader class methodsFor:'dynamic object access'!

callInitFunctionAt:address specialInit:special forceOld:forceOld interruptable:interruptable argument:argument identifyAs:handle returnsObject:returnsObject
    "call a function at address - a very dangerous operation.
     This is needed to call the classes init-function after loading in a
     class-object file or to call the CTORS when c++ modules are loaded.
     ForceOld (if true) will have the memory manager
     allocate things in oldSpace instead of newSpace.
     DANGER: Internal & highly specialized. Dont use in your programs."

    |low hi lowAddr hiAddr moduleID retVal|

    hi := address // 16r10000.
    low := address \\ 16r10000.
    handle notNil ifTrue:[
	moduleID := handle moduleID
    ].
%{
    OBJ (*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 = (OBJFUNC) 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));
		}
		retVal = (*addr)(arg, __pRT__ COMMA_CON);
		__SET_MODULE_ID(0);
	    } else {
		retVal = (*addr)(arg COMMA_CON);
	    }
	    if (returnsObject != true) {
		retVal = nil;
	    }

	    if (force) {
		__allocForceSpace(prevSpace);
	    }

	    if (! wasBlocked) {
		__UNBLOCKINTERRUPTS();
	    }
	    RETURN (retVal);
	}
    }
%}.
    self primitiveFailed
!

classNameThatFailed
    "ask VM for the name of the class that caused trouble"

%{
    extern char *__name_registration_failure__();

    RETURN (_MKSTRING(__name_registration_failure__()));
%}
!

deinitializeClassesFromModule:handle
    "send #deinitialize to all classes of a module"

    |id classes|

    classes := handle classes.
    classes notNil ifTrue:[
	classes do:[:aClass |
	    aClass isMeta ifFalse:[
		Verbose ifTrue:[
		    'send #deinitialize to:' infoPrint. aClass name infoPrintNL.
		].
		aClass deinitialize
	    ]
	]
    ]
!

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
!

getListOfUndefinedSymbolsFrom:aHandle
    "return a collection of undefined symbols in a dynamically loaded object file.
     Handle must be the one returned previously from loadDynamicObject.
     Not all systems allow an object with undefined symbols to be
     loaded (actually, only dld does)."

    |list|

%{  /* STACK: 20000 */
#ifdef GNU_DL
    void (*func)();
    unsigned long addr;
    char *name;
    int nMax;
    char **undefNames;

    undefNames = dld_list_undefined_sym();
    if (dld_undefined_sym_count > 0) {
	char **nm;
	int index;
	int count = dld_undefined_sym_count;

	if (count > 100) count = 100;
	list = __ARRAY_NEW_INT(count);
	if (list) {
	    nm = undefNames;
	    for (index = 0; index < count; index++) {
		OBJ s;

		s = _MKSTRING(*nm);
		_ArrayInstPtr(list)->a_element[index] = s;
		__STORE(list, s);
		nm++;
	    }
	    free(undefNames);
	}
    }
#endif

#ifdef DL1_6
    /*
     * dont know how to do it
     */
#endif

#ifdef SYSV4_DL
    /*
     * dont know how to do it
     */
#endif

#ifdef SUN_DL
    /*
     * dont know how to do it
     */
#endif

#ifdef NEXT_DL
    /*
     * dont know how to do it
     */
#endif
%}.
    ^ list
!

getSymbol:aString function:isFunction from:aHandle
    "return the address of a symbol/function from a dynamically loaded object file.
     Handle must be the one returned previously from loadDynamicObject.
     Return the address of the symbol, or nil on any error."

    |sysHandle1 sysHandle2 lowAddr hiAddr|

    sysHandle1 := aHandle sysHandle1.
    sysHandle2 := aHandle sysHandle2.

%{  /* STACK: 20000 */

#ifdef GNU_DL
  {
    void (*func)();
    unsigned long addr;
    char *name;

    if (__isString(aString)) {
	name = (char *) __stringVal(aString);
	if (isFunction == false) {
	    addr = dld_get_symbol(name);
	} 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", __stringVal(aString), 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 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
!

hasUndefinedSymbolsIn:handle
    ^ (self getListOfUndefinedSymbolsFrom:handle) size > 0
!

invalidateModule:handle
    "invalidate all of the classes code objects ..."

    |id|

    Verbose ifTrue:[
	'invalidate module; name=' infoPrint. handle pathName infoPrint.
	' id=' infoPrint. handle moduleID infoPrintNL.
    ].

    id := handle moduleID.
%{
    __INVALIDATE_BY_ID(__intVal(id));
%}
!

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
!

isSmalltalkObject:handle
    "return true, if the loaded object is a smalltalk object module"

    "not yet implemented - stc_compiled_smalltalk is a static symbol,
     not found in list - need nm-interface, or nlist-walker
    "
    ^ true.

    (self getSymbol:'__stc_compiled_smalltalk' function:true from:handle) notNil ifTrue:[^ true].
    (self getSymbol:'__stc_compiled_smalltalk' function:false from:handle) notNil ifTrue:[^ true].
    ^ false
!

listUndefinedSymbolsIn:handle
    |undefinedNames|

    undefinedNames := self getListOfUndefinedSymbolsFrom:handle.
    undefinedNames size > 0 ifTrue:[
	Transcript showCr:'undefined:'.
	undefinedNames do:[:aName |
	    Transcript showCr:'    ' , aName
	]
    ].
!

loadDynamicObject:pathName
    "load an object-file (load/map into my address space).
     Return a non-nil handle if ok, nil otherwise.
     No bindings are done - only a pure load is performed.
     This function is not supported on all architectures.
    "

    |handle buffer|

    Verbose ifTrue:[
	('loadDynamic: ' , pathName , ' ...') infoPrintNL
    ].

    "/ already loaded ?

    LoadedObjects notNil ifTrue:[
	handle := LoadedObjects at:pathName ifAbsent:nil.
	handle notNil ifTrue:[
	    Verbose ifTrue:[
		('... ' , pathName , ' already loaded.') infoPrintNL.
	    ].
	    ^ handle
	].
    ].

    "/
    "/ the 1st two entries are system dependent;
    "/ entry 3 is the pathName
    "/ entry 4 is a unique ID
    "/
    buffer := Array new:4.
    buffer at:3 put:pathName.
    buffer at:4 put:NextHandleID. NextHandleID := NextHandleID + 1.

    buffer := self primLoadDynamicObject:pathName into:buffer.
    buffer isNil ifTrue:[
	LastError == #notImplemented ifTrue:[
	    Verbose ifTrue:[
		'no dynamic load facility or load failed.' infoPrintNL.
		Transcript showCr:'Try to load it myself ...'.
	    ].
	    "try it the hard way"
	    buffer := self loadFile:pathName.
	].
	buffer isNil ifTrue:[
	    LastError == #linkError ifTrue:[
		LinkErrorMessage notNil ifTrue:[
		    Transcript showCr:'Load error:' , LinkErrorMessage
		].    
	    ].    
	    ^ nil
	]
    ].

    "
     remember loaded object for later unloading
    "
    handle := ObjectFileHandle new.
    handle sysHandle1:(buffer at:1).
    handle sysHandle2:(buffer at:2).
    handle pathName:(buffer at:3).
    handle moduleID:(buffer at:4).

    LoadedObjects isNil ifTrue:[
	LoadedObjects := Dictionary new.
    ].
    LoadedObjects at:pathName put:handle.
    Smalltalk flushCachedClasses.

    Verbose ifTrue:[
	('loadDynamic ok; handle is: ' , handle printString) infoPrintNL.
    ].

    ^ handle

    "sys5.4:
     |handle|
     handle := ObjectFileLoader loadDynamicObject:'../stc/mod1.so'.
     ObjectFileLoader getFunction:'module1' from:handle
    "
    "next:
     |handle|
     handle := ObjectFileLoader loadDynamicObject:'../goodies/Path/AbstrPath.o'.
     ObjectFileLoader getFunction:'__AbstractPath_Init' from:handle
    "
    "GLD:
     |handle|
     handle := ObjectFileLoader loadDynamicObject:'../clients/Tetris/Tetris.o'.
     ObjectFileLoader getFunction:'__TetrisBlock_Init' from:handle
    "
!

loadStatus
    "ask VM if class-hierarchy has been completely loaded, and return a symbol describing
     the status."

    |checker checkSymbol status|

    checker := self.
    checkSymbol := #'superClassCheck:'.

%{  /* NOREGISTER */
    status = __MKSMALLINT(__check_registration__(&checker, &checkSymbol));
%}.
    status == 0 ifTrue:[^ #ok].
    status == -1 ifTrue:[^ #missingClass].
    status == -2 ifTrue:[^ #versionMismatch].
    ^ #loadFailed
!

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
!

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
!

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 infoCollection info classNames classes|

    "/
    "/ let it register itself
    "/ and define its globals
    "/
    Verbose ifTrue:[
	'phase 0 ...' infoPrintNL
    ].
    self callInitFunctionAt:initAddr 
	 specialInit:true 
	 forceOld:true 
	 interruptable:false
	 argument:0
	 identifyAs:handle
	 returnsObject:false.

    "/
    "/ check if superclasses are present
    "/
    (status := self loadStatus) ~~ #ok ifTrue:[
	badClassName := self classNameThatFailed.
	(status == #missingClass) ifTrue:[
	    Transcript showCr:'load failed - missing class: ' , badClassName.
	    ^ Array with:#missingClass:
		    with:badClassName
	].
	(status == #versionMismatch) 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
    ].
    ObjectMemory flushCaches.
    self moduleInit:3 forceOld:false interruptable:true.

    "/ ask objectMemory for the classes we have just loaded
    "/ and register them in the handle

    infoCollection := ObjectMemory binaryModuleInfo.
    info := infoCollection at:handle moduleID ifAbsent:nil.
    info isNil ifTrue:[
	"/ mhmh registration failed -
	^ Array with:#registrationFailed
    ].

    classNames := info at:#classNames.
    classNames size > 0 ifTrue:[
	classes := classNames collect:[:nm | Smalltalk classNamed:nm].
    ].
    classes size > 0 ifTrue:[
	classes := classes asArray.
	classes := classes , (classes collect:[:aClass | aClass class]).
    ].
    handle classes:classes.

    ^ Array with:#ok
!

primLoadDynamicObject:pathName into:anInfoBuffer
    "load an object-file (map into my address space).
     Return an OS-handle (whatever that is) - where some space
     (a 3-element array) has to be passed in for this.
     The first two entries are used in a machine dependent way,
     and callers may not depend on what is found there 
     (instead, only pass around handles transparently).
     This function is not supported on all architectures."

%{  /* UNLIMITEDSTACK */

    if (! __isArray(anInfoBuffer)
     || (_arraySize(anInfoBuffer) < 3)) {
	return nil;
    }

#ifdef GNU_DL
  {
    static firstCall = 1;
    extern char *__myName__;
    extern dld_ignore_redefinitions;

    if (firstCall) {
	firstCall = 0;
	(void) dld_init (__myName__);
	dld_ignore_redefinitions = 1;
    }

    if (__isString(pathName)) {
	if (dld_link(__stringVal(pathName))) {
	    if (ObjectFileLoader_Verbose == true) {
		printf ("link file %s failed\n", __stringVal(pathName));
		dld_perror("cant link");
	    }
	    ObjectFileLoader_LastError = @symbol(linkError);
	    RETURN ( nil );
	}
	_ArrayInstPtr(anInfoBuffer)->a_element[0] = pathName;
	__STORE(anInfoBuffer, pathName);
	RETURN ( anInfoBuffer );
    }
    RETURN ( nil );
  }
#endif

#ifdef DL1_6
  {
    extern char *__myName__;
    char *ldname;
    OBJ tmpName;

    if (__isString(pathName)) {
	if ( dl_loadmod_only(__myName__, __stringVal(pathName), &ldname) == 0 ) {
	    if (ObjectFileLoader_Verbose == true) {
		printf ("link file %s failed\n", __stringVal(pathName));
	    }
	    RETURN ( nil );
	}
	/*
	 * returns the name of the temporary ld-file
	 * use that as handle ...
	 */
	tmpName = _MKSTRING(ldname);
	_ArrayInstPtr(anInfoBuffer)->a_element[0] = tmpName;
	__STORE(anInfoBuffer, tmpName);
	RETURN ( anInfoBuffer );
    }
    RETURN ( nil );
  }
#endif

#ifdef AIX_DL
  {
    extern char *__myName__;
    char *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(anInfoBuffer)->a_element[0] = _MKSMALLINT( (int)handle & 0xFFFF );
	_ArrayInstPtr(anInfoBuffer)->a_element[1] = _MKSMALLINT( ((int)handle >> 16) & 0xFFFF );
	RETURN (anInfoBuffer);
    }
    RETURN ( nil );
  }
#endif

#ifdef SYSV4_DL
  {
    void *handle;
    char *nm;
    char *errMsg;

    if ((pathName == nil) || __isString(pathName)) {
	handle = dlopen(pathName == nil ? (char *)0 : __stringVal(pathName), RTLD_NOW);

	if (! handle) {
	    errMsg = dlerror();
	    fprintf(stderr, "dlopen %s error:\n", __stringVal(pathName));
	    fprintf(stderr, "    <%s>\n", errMsg);
	    ObjectFileLoader_LastError = @symbol(linkError);
	    ObjectFileLoader_LinkErrorMessage = _MKSTRING(errMsg);
	    RETURN (nil);
	}

	if (ObjectFileLoader_Verbose == true) {
	    printf("open %s handle = %x\n", __stringVal(pathName), handle);
	}

	_ArrayInstPtr(anInfoBuffer)->a_element[0] = _MKSMALLINT( (int)handle & 0xFFFF );
	_ArrayInstPtr(anInfoBuffer)->a_element[1] = _MKSMALLINT( ((int)handle >> 16) & 0xFFFF );
	RETURN (anInfoBuffer);
    }
  }
#endif

#ifdef SUN_DL
  {
    void *handle;

    if ((pathName == nil) || __isString(pathName)) {
	if (pathName == nil)
	    handle = dlopen((char *)0, 1);
	else
	    handle = dlopen(__stringVal(pathName), 1);

	if (! handle) {
	    fprintf(stderr, "dlopen %s error: <%s>\n", 
				__stringVal(pathName), dlerror());
	    ObjectFileLoader_LastError = @symbol(linkError);
	    RETURN (nil);
	}

	if (ObjectFileLoader_Verbose == true) {
	    printf("open %s handle = %x\n", __stringVal(pathName), handle);
	}

	_ArrayInstPtr(anInfoBuffer)->a_element[0] = _MKSMALLINT( (int)handle & 0xFFFF );
	_ArrayInstPtr(anInfoBuffer)->a_element[1] = _MKSMALLINT( ((int)handle >> 16) & 0xFFFF );
	RETURN (anInfoBuffer);
    }
  }
#endif

#ifdef NEXT_DL
  {
    long result;
    char *files[2];
    NXStream *errOut;

    if (__isString(pathName)) {
	files[0] = (char *) __stringVal(pathName);
	files[1] = (char *) 0;
	errOut = NXOpenFile(2, 2);
	result = rld_load(errOut,
			  (struct mach_header **)0,
			  files,
			  (char *)0);
	NXClose(errOut);
	if (! result) {
	    ObjectFileLoader_LastError = @symbol(linkError);
	    fprintf(stderr, "rld_load %s failed\n", __stringVal(pathName));
	    RETURN (nil);
	}

	if (ObjectFileLoader_Verbose == true)
	    printf("rld_load %s ok\n", __stringVal(pathName));

	_ArrayInstPtr(anInfoBuffer)->a_element[0] = pathName;
	__STORE(anInfoBuffer, pathName);
	RETURN ( anInfoBuffer );
    }
  }
#endif
%}.
    LastError := #notImplemented.
    ^ nil
!

primUnloadDynamicObject:aHandle
    "unload an object-file (unmap from my address space).
     This is a low-level entry, which does not care if there are
     still any code references (from blocks or methods) to this
     module. Calling it for still living classes will definitely
     lead to some fatal conditions to occur later."

    |sysHandle1 sysHandle2|

    sysHandle1 := aHandle sysHandle1.
    sysHandle2 := aHandle sysHandle2.

%{
#ifdef GNU_DL
    if (__isString(sysHandle1)) {
	if (dld_unlink_by_file(__stringVal(sysHandle1), 1)) {
	    if (ObjectFileLoader_Verbose == true) {
		printf ("unlink file %s failed\n", __stringVal(sysHandle1));
		dld_perror("cant unlink");
	    }
	    RETURN (false);
	}
	RETURN (true);
    }
    RETURN (false);
#endif

#ifdef SYSV4_DL
  {
    void *h;
    int val;
    OBJ low = sysHandle1, hi = sysHandle2;

    if (__bothSmallInteger(low, hi)) {
	val = (_intVal(hi) << 16) + _intVal(low);
	h = (void *)(val);
	if (ObjectFileLoader_Verbose == true)
	    printf("close handle = %x\n", h);
	if (dlclose(h) != 0) {
	    fprintf(stderr, "dlclose failed with:<%s>\n", dlerror());
	    RETURN (false);
	}
	RETURN (true);
    }
  }
#endif

#ifdef SUN_DL
  {
    void *h;
    int val;
    OBJ low = sysHandle1, hi = sysHandle2;

    if (__bothSmallInteger(low, hi)) {
	val = (_intVal(hi) << 16) + _intVal(low);
	h = (void *)(val);
	if (ObjectFileLoader_Verbose == true)
	    printf("close handle = %x\n", h);
	dlclose(h);
	RETURN (true);
    }
  }
#endif

#ifdef AIX_DL
  {
    int *h;
    int val;
    OBJ low = sysHandle1, hi = sysHandle2;

    if (__bothSmallInteger(low, hi)) {
	val = (_intVal(hi) << 16) + _intVal(low);
	h = (int *)(val);
	if (ObjectFileLoader_Verbose == true)
	    printf("unload handle = %x\n", h);
	if ( unload(h) != 0) {
	    fprintf(stderr, "unload failed\n");
	    RETURN (false);
	}
	RETURN (true);
    }
  }
#endif
%}.
    ^ false
!

releaseSymbolTable
    "this is needed on NeXT to forget loaded names. If this wasnt done,
     the same class could not be loaded in again due to multiple defines.
     On other architectures, this is not needed and therefore a noop."

%{
#ifdef NEXT_DL
    NXStream *errOut;

    errOut = NXOpenFile(2, 2);
    rld_unload_all(errOut, (long)0);
    rld_load_basefile(errOut, "smalltalk");
    NXClose(errOut);
#endif
%}
!

revalidateModule:handle
    "revalidate all of the classes code objects ..."

    |id|

    Verbose ifTrue:[
	'revalidate module; name=' infoPrint. handle pathName infoPrint.
	' id=' infoPrint. handle moduleID infoPrintNL.
    ].

    id := handle moduleID.
%{
    __REVALIDATE_BY_ID(__intVal(id));
%}
!

superClassCheck:aClass
    "callBack from class registration code in VM: make certain, that aClass is
     loaded too ..."

    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
!

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|

    Verbose ifTrue:[
	'unload module name=' infoPrint. handle pathName infoPrintNL.
    ].

    self deinitializeClassesFromModule:handle.
    self unregisterModule:handle.

    (self primUnloadDynamicObject:handle) ifFalse:[
	^ self error:'unloadDynamic failed'
    ].
    "
     remove from loaded objects
    "
    LoadedObjects notNil ifTrue:[
	key := LoadedObjects keyAtEqualValue:handle.
	key notNil ifTrue:[
	    LoadedObjects removeKey:key
	]
    ].
    Smalltalk flushCachedClasses.

    "
     for individual methods, we keep the methodObject,
     but make it unexecutable. Its still visible in the browser.
    "
    handle isMethodHandle ifTrue:[
	handle method notNil ifTrue:[
	    handle method makeInvalid.
	    ObjectMemory flushCaches.
	]
    ]
!

unregisterModule:handle
    "unregister classes in the VM.
     This invalidates all of the classes code objects ..."

    |id|

    Verbose ifTrue:[
	'unregister module; name=' infoPrint. handle pathName infoPrint.
	' id=' infoPrint. handle moduleID infoPrintNL.
    ].

    id := handle moduleID.
%{
    __UNREGISTER_BY_ID(__intVal(id));
%}
! !

!ObjectFileLoader class methodsFor:'loading objects'!

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)
!

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

!ObjectFileLoader class methodsFor:'primitive loading'!

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'
!

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'
! !

!ObjectFileLoader class methodsFor:'queries'!

canLoadObjectFiles
    "return true, if loading is possible"

    self primCanLoadObjectFiles ifTrue:[^true].

    "/ can add a return true here, if I ever get manual loading to work
    "/ for some specific machine
    ^ false
!

loadedObjectFiles
    "return a collection containing the names of all
     dynamically loaded objects."

    LoadedObjects isNil ifTrue:[^ #()].
    ^ LoadedObjects keys copy

    "
     ObjectFileLoader loadedObjectFiles
    "
!

loadedObjectHandles
    "return a collection of all handles"

    LoadedObjects isNil ifTrue:[^ #()].
    ^ LoadedObjects 

    "
     ObjectFileLoader loadedObjectHandles
    "

    "Created: 17.9.1995 / 14:28:55 / claus"
    "Modified: 17.9.1995 / 16:13:48 / claus"
!

loadedObjectHandlesDo:aBlock
    "enumerate all handles"

    LoadedObjects notNil ifTrue:[
	LoadedObjects copy do:aBlock.
    ].

    "
     ObjectFileLoader loadedObjectHandlesDo:[:h | h pathName printNL]
    "

    "Created: 14.9.1995 / 22:03:13 / claus"
    "Modified: 14.9.1995 / 22:32:48 / claus"
!

pathNameFromID:id
    "given an id, return the pathName, or nil for static modules"

    LoadedObjects notNil ifTrue:[
	LoadedObjects keysAndValuesDo:[:name :handle |
	    handle moduleID == id ifTrue:[
		^ handle pathName
	    ]
	].
    ].
    ^ nil

    "
     ObjectFileLoader pathNameFromID:1        
    "

    "Modified: 28.8.1995 / 18:08:28 / claus"
!

primCanLoadObjectFiles
    "return true, if loading is possible using a standard mechanism"
%{  /* NOCONTEXT */
#ifdef HAS_DL
# if !defined(OS_DEFINE) || defined(unknownOS)
    fprintf(stderr, "*** OS_DEFINE not correct\n");
# else
#  if !defined(CPU_DEFINE) || defined(unknownCPU)
    fprintf(stderr, "*** CPU_DEFINE not correct\n");
#  else
    RETURN (true);
#  endif
# endif
#endif
%}.
    ^ false
! !

!ObjectFileLoader class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libcomp/Attic/ObjFLoader.st,v 1.66 1995-12-07 09:38:36 cg Exp $'
! !
ObjectFileLoader initialize!