"
 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 StubNr Verbose'
       poolDictionaries:''
       category:'System-Compiler'
!

ObjectFileLoader comment:'

COPYRIGHT (c) 1993 by Claus Gittinger
             All Rights Reserved

this one knowns how to load in external (c)-modules
(see fileIn/cExample.c) it is all experimental and 
WILL DEFINITELY change soon ...

(goal is to allow loading of binary classes)

$Header: /cvs/stx/stx/libcomp/ObjectFileLoader.st,v 1.5 1994-02-25 12:51:52 claus Exp $
'!

%{
/*
 * by default, use whatever the system provides
 */
#ifdef sunos
# define SUN_DL
#endif

#ifdef NeXT
# define NEXT_DL
#endif

#ifdef SYSV4
# define SYSV4_DL
#endif

/*
 * but GNU_DL overwrites this
 */
#ifdef GNU_DL
# undef SYSV4_DL
# undef NEXT_DL
# undef SUN_DL
#endif

#ifdef NEXT_DL
# ifndef _RLD_H_
#  define _RLD_H_
#  include <rld.h>
# endif
#endif /* NEXT_DL */

static OBJ loadAddrLow, loadAddrHi;
%}

!ObjectFileLoader class methodsFor:'initialization'!

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

    MySymbolTable := 'smalltalk'.
    StubNr := 1.
    Verbose := false
!

verbose:aBoolean
    "turn on/off debug traces"

    Verbose := aBoolean

    "ObjectFileLoader verbose:true"
! !

!ObjectFileLoader class methodsFor:'command defaults'!

needSeparateIDSpaces
    "return true, if we need separate I and D spaces"

    |os cpu|

    os := OperatingSystem getSystemType.
    cpu := OperatingSystem getCPUType.

    (os = 'sunos') ifTrue:[
        (cpu = 'sparc') ifTrue:[ ^ true ]
    ].
    (os = 'linux') ifTrue:[ ^ false ].

    'dont know if we need sepId - assume no' printNewline.
    ^ false
!

absLd:file text:textAddr data:dataAddr
   "this should return a string to link file.o to absolute address"

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

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

! !

!ObjectFileLoader class methodsFor:'dynamic loading'!

loadFile:aFileName library:librariesString withBindings:bindings in:aClass
    "first, load the file itself"

    (self loadFile:aFileName with:librariesString) ifFalse:[^ false].

    "then, create stubs"
    self bindExternalFunctions:bindings in:aClass
!

loadFile:aFileName withBindings:bindings in:aClass
    "load an object file containing external functions, and bind the functions as described 
     in bindings, which is an Array of
        (selector functionName argTypes returnType)
     entries, example:
     #(
        (sel1:and: 'f1' (SmallInteger SmallInteger)    nil)   -> bind 'aClass sel1:and:' to: 'void f1(int, int)'
        (sel2:and: 'f2' (String SmallInteger)       String)   -> bind 'aClass sel2:and:' to: 'char *f2(char *, int)'
      )
    "

    "first, load the file itself"

    (self loadFile:aFileName) ifFalse:[^ false].

    "then, create stubs"
    self bindExternalFunctions:bindings in:aClass
!

bindExternalFunctions:bindings in:aClass
    | selector functionName argTypes returnType allOk |

    allOk := true.
    bindings do:[:aBinding |
        selector := aBinding at:1.
        functionName := aBinding at:2.
        argTypes := aBinding at:3.
        returnType := aBinding at:4.
        (self createStubFor:selector calling:functionName args:argTypes returning:returnType in:aClass)
        isNil ifTrue:[
            Transcript showCr:'binding of ' , functionName , ' failed.'.
            allOk := false
        ]
    ].
    ^ allOk
! !

!ObjectFileLoader class methodsFor:'creating stubs'!

storeGlobalAddressesOn:aStream

    Smalltalk allKeysDo:[:key |
        self storeGlobalAddressOf:key on:aStream
    ]

    "ObjectFileLoader storeGlobalAddressesOn:Transcript"
    "|f|
     f := FileStream newFileNamed:'syms.c'.
     ObjectFileLoader storeGlobalAddressesOn:f.
     f close"
!

storeGlobalAddressOf:aSymbol on:aStream
    |globalName|

    globalName := aSymbol asString.
    (globalName includes:$:) ifTrue:[
        globalName replaceAll:$: by:$_
    ].

    aStream nextPutAll:'#define ',globalName,'_addr '.
    aStream nextPutAll:(Smalltalk cellAt:aSymbol) printString.
    aStream cr.

    aStream nextPutAll:'#define ',globalName,' ( *( (OBJ *) ',globalName,'_addr))'.
    aStream cr

    "ObjectFileLoader storeGlobalAddressOf:#String on:Transcript"
    "ObjectFileLoader storeGlobalAddressOf:#Symbol on:Transcript"
!

createStubFor:aSelector calling:functionName args:argTypes returning:returnType in:aClass
    "create a method calling a stub function"

    |address newMethod s|

    address := self createStubCalling:functionName args:argTypes returning:returnType.
    address isNil ifTrue:[^ nil].

    newMethod := Method new.
    newMethod code:address.
    newMethod category:'external functions'.
    s := '"calls external function 

' , (self cTypeFor:returnType) , ' ' , functionName , '( '.
    argTypes notNil ifTrue:[
        argTypes do:[:type |
            s := s , (self cTypeFor:type) , ' '
        ]
    ].
    s := s , ')
"'.
    newMethod source:s.
    newMethod numberOfMethodVars:0.
    newMethod stackSize:0.

    aClass class addSelector:aSelector withMethod:newMethod.

    SilentLoading ifFalse:[
        Transcript showCr:('created stub: ',aClass class name,' ', aSelector)
    ].

    ^ newMethod

    "ObjectFileLoader createStubFor:#printf: 
                            calling:'printf' 
                               args:#(String) 
                          returning:nil 
                                 in:TestClass"
    "ObjectFileLoader createStubFor:#printf:with:
                            calling:'printf' 
                               args:#(String SmallInteger)
                          returning:nil 
                                 in:TestClass"
!

createStubCalling:functionName args:argTypes returning:returnType
    "create a stub function for calling functionName - return the address of the
     function in core or nil on error"

    |baseName p t l handle address stubName|

    stubName := 'stub000' , (StubNr printStringRadix:16).
    stubName := stubName copyFrom:(stubName size - 7).

    baseName := self createStubSource:stubName calling:functionName args:argTypes returning:returnType.
    baseName isNil ifTrue:[^ nil].

    "compile it ..."
    Verbose ifTrue:[
        Transcript showCr:'compiling stub ...', baseName. Transcript endEntry
    ].

    (OperatingSystem executeCommand:('make /tmp/' , baseName , '.o')) ifFalse:[
        Transcript showCr:'compilation error.'.
        ^ nil
    ].
    OperatingSystem executeCommand:('mv ' , baseName , '.o /tmp/' , baseName , '.o').
    Verbose ifFalse:[
        OperatingSystem executeCommand:('rm /tmp/' , baseName , '.c').
    ].

    (OperatingSystem getOSType = 'sys5.4') ifTrue:[
        "make it a sharable object"

        Verbose ifTrue:[
            Transcript showCr:'makeing shared object stub ...', baseName. Transcript endEntry.
        ].
        OperatingSystem executeCommand:('ld -G -o /tmp/',baseName,'.so /tmp/',baseName,'.o').

        "attach to it"
        handle := self openDynamicObject:('/tmp/',baseName,'.so').
        handle isNil ifTrue:[
            Transcript showCr:('dlopen error:', '/tmp/',baseName,'.so').
            ^ nil
        ].
        "find the stubs address"
        address := self getSymbol:stubName from:handle.
        address isNil ifTrue:[
            Transcript showCr:'dlsym failed'.
             ^ nil
        ]
    ].

    ((OperatingSystem getOSType = 'sunos') 
     or:[OperatingSystem getOSType = 'linux']) ifTrue:[
        "load it"
        (self loadFile:('/tmp/' , baseName , '.o')) ifFalse:[
            Transcript showCr:'load error.'.
            ^ nil
        ].

        "find the stubs address (use nm to get the address)"
        t := Text new.
        p := PipeStream readingFrom:('nm SymbolTable|grep ' , stubName , ' |grep T').
        [p atEnd] whileFalse:[
            l := p nextLine.
            l notNil ifTrue:[
                t add:l
            ]
        ].
        p close.
        (t size == 1) ifFalse:[
            Transcript showCr:('oops, ' , stubName , ' not in name-list.').
            ^ nil
        ].
        address := Integer readFrom:(ReadStream on:(t at:1)) radix:16
    ].

    address isNil ifTrue:[
        Transcript showCr:'no way to dynamically load objects'.
        ^ nil
    ].

    Verbose ifTrue:[
        Transcript show:'stub ' , stubName , ' address:'.
        Transcript showCr:(address printStringRadix:16).
    ].

    StubNr := StubNr + 1.
    ^ address

    "ObjectFileLoader createStubCalling:'printf' args:#(String) returning:nil"
!

createStubSource:stubName calling:functionName args:argTypes returning:returnType
    "create a temp file with stub-code - return base-filename or nil"

    |pid baseName index aStream argName|

    pid := OperatingSystem getProcessId printString.
    baseName := 'stc' ,  pid.
    aStream := FileStream newFileNamed:('/tmp/' , baseName , '.c').
    aStream nextPutAll:'
#include <stc.h>
'.

    OperatingSystem getOSType = 'sys5.4' ifTrue:[
        self storeGlobalAddressesOn:aStream.
    ].

    aStream nextPutAll:'
' , stubName , '(self, __sel, SND_COMMA __srch, __pI,
                 __a1, __a2, __a3, __a4, __a5, __a6, __a7, __a8)
    OBJ __a1, __a2, __a3, __a4, __a5, __a6, __a7, __a8;
    OBJ __sel, __srch;
    SENDER_DECL
{
    extern OBJ _ISKINDOF_(), ExternalStream;
'.

    returnType notNil ifTrue:[
        aStream nextPutAll:'    '.
        aStream nextPutAll:(self cTypeFor:returnType).
        aStream nextPutAll:' __ret;'.
        aStream cr
    ].

    "gen type checking code"
    argTypes notNil ifTrue:[
        index := 0.
        argTypes do:[:argType |
            (index + 1) timesRepeat:[ aStream nextPutAll:'    '].
            argName := '__a' , (index + 1) printString.
            aStream nextPutAll:'if ('.
            (self checkType:argType name:argName on:aStream) ifFalse:[^ nil].
            aStream nextPutAll:') {'.
            aStream cr.
            index := index + 1
        ]
    ].
    "call the function"

    (index + 1) timesRepeat:[ aStream nextPutAll:'    '].
    returnType notNil ifTrue:[
        aStream nextPutAll:'__ret = '
    ].
    aStream nextPutAll:functionName , '('.
    argTypes notNil ifTrue:[
        index := 0.
        argTypes do:[:argType |
            argName := '__a' , (index + 1) printString.
            self convertStToC:argType name:argName on:aStream.
            index := index + 1.
            (index == argTypes size) ifFalse:[
                aStream nextPutAll:','
            ]
        ]
    ].
    aStream nextPutAll:');'. aStream cr.

    argTypes notNil ifTrue:[
        argTypes size timesRepeat:[
            index timesRepeat:[ aStream nextPutAll:'    '].
            aStream nextPutAll:'}'. aStream cr.
            index := index - 1
        ]
    ].

    returnType notNil ifTrue:[
        aStream nextPutAll:'    return '.
        self convertCToSt:returnType name:'__ret' on:aStream.
        aStream nextPutAll:';'
    ] ifFalse:[
        aStream nextPutAll:'    return self;'
    ].
    aStream cr.

    aStream nextPutAll:'}'. aStream cr.
    aStream close.
    ^ baseName

    "ObjectFileLoader createStubSource:'stub1' calling:'printMessage'  args:#(String) returning:nil"
    "ObjectFileLoader createStubSource:'stub2' calling:'printMessage2' args:#(String SmallInteger) returning:#String"
    "ObjectFileLoader createStubSource:'stub3' calling:'sqrt'          args:#(Float) returning:#Float"
    "ObjectFileLoader createStubSource:'stub4' calling:'checking'      args:#(SmallInteger SmallInteger) returning:#Boolean"
    "ObjectFileLoader createStubSource:'stub5' calling:'fprintf'       args:#(ExternalStream  String) returning:#SmallInteger"
!

checkType:argType name:argName on:aStream
    (argType == #SmallInteger) ifTrue:[
        aStream nextPutAll:'_isSmallInteger(' , argName , ')'.
        ^ true
    ].
    (argType == #Float) ifTrue:[
        aStream nextPutAll:'__isFloat(' , argName , ')'.
        ^ true
    ].
    (argType == #String) ifTrue:[
        aStream nextPutAll:'__isString(' , argName , ')'.
        ^ true
    ].
    (argType == #Boolean) ifTrue:[
        aStream nextPutAll:'((' , argName , '==true)'.
        aStream nextPutAll:'||(' , argName , '==false))'.
        ^ true
    ].
    (argType == #ByteArray) ifTrue:[
        aStream nextPutAll:'__isByteArray(' , argName , ')'.
        ^ true
    ].
    (argType == #ExternalStream) ifTrue:[
        aStream nextPutAll:'(_ISKINDOF_(' , argName , ', SND_COMMA ExternalStream)==true)'.
        ^ true
    ].
    self error:'argType ' , argType, ' not (yet) supported'.
    ^ false
!

convertStToC:stType name:argName on:aStream
    |idx|

    (stType == #SmallInteger) ifTrue:[
        aStream nextPutAll:'_intVal(' , argName , ')'.
        ^ true
    ].
    (stType == #Float) ifTrue:[
        aStream nextPutAll:'_floatVal(' , argName , ')'.
        ^ true
    ].
    (stType == #String) ifTrue:[
        aStream nextPutAll:'_stringVal(' , argName , ')'.
        ^ true
    ].
    (stType == #Boolean) ifTrue:[
        aStream nextPutAll:'((' , argName , '==true) ? 1 : 0)'.
        ^ true
    ].
    (stType == #ByteArray) ifTrue:[
        aStream nextPutAll:'(_ByteArrayInstPtr(' , argName , ')->ba_element)'.
        ^ true
    ].
    (stType == #ExternalStream) ifTrue:[
        "find the file-pointer inst-var"
        idx := (ExternalStream allInstVarNames indexOf:'filePointer').
        aStream nextPutAll:'_intVal(_InstPtr(' , argName , ')->i_instvars['.
        aStream nextPutAll:(idx - 1) printString, '])'.
        ^ true
    ].
    ^ false
!

convertCToSt:stType name:argName on:aStream
    (stType == #SmallInteger) ifTrue:[
        aStream nextPutAll:'_MKSMALLINT(' , argName , ')'.
        ^ true
    ].
    (stType == #Float) ifTrue:[
        aStream nextPutAll:'_MKFLOAT(' , argName , ' COMMA_SND)'.
        ^ true
    ].
    (stType == #String) ifTrue:[
        aStream nextPutAll:'(' , argName , ' ? _MKSTRING(' , argName , ' COMMA_SND) : nil)'.
        ^ true
    ].
    (stType == #Boolean) ifTrue:[
        aStream nextPutAll:'(' , argName , ' ? true : false)'.
        ^ true
    ].
    ^ false
!

cTypeFor:aType
    (aType == #SmallInteger) ifTrue:[
        ^ 'int'
    ].
    (aType == #Boolean) ifTrue:[
        ^ 'int'
    ].
    (aType == #Float) ifTrue:[
        ^ 'double'
    ].
    (aType == #String) ifTrue:[
        ^ 'char *'
    ].
    (aType == nil) ifTrue:[
        ^ 'void'
    ].
    self error:'type ' , aType, ' not supported'.
    ^ ''
! !

!ObjectFileLoader class methodsFor:'loading objects'!

loadFile:oFile with:librariesString
    "load in an object files code, linking in libraries"

    |tmpOfile errStream errors errText ok pid|

    pid := OperatingSystem getProcessId printString.
    tmpOfile := '/tmp/stc_ld' ,  pid.
    Verbose ifTrue:[
        Transcript showCr:'executing: ' , ('ld -o ',tmpOfile,' -r ' , oFile , ' ' , librariesString , '>/tmp/out 2>/tmp/err')
    ].
    (OperatingSystem executeCommand:'ld -o ',tmpOfile,' -r ' , oFile , ' ' , librariesString , '>/tmp/out 2>/tmp/err')
    ifFalse:[
        errStream := FileStream oldFileNamed:'/tmp/err'.
        errStream isNil ifTrue:[
            self notify:'errors during link.'
        ] ifFalse:[
            errors := errStream contents.
            errText := errors asText.
            (errText size > 20) ifTrue:[
                errText grow:20.
                errText add:'... '.
                errors := errText
            ].
            OperatingSystem executeCommand:'rm /tmp/err /tmp/out'.
            self notify:('link errors:\\' , errors asString) withCRs
        ].
        ^ false
    ].
    ok := self loadFile:tmpOfile.
    OperatingSystem executeCommand:('rm ' , tmpOfile).
    ^ ok
!

loadFile:oFile
    "load in an object file"

    | unixCommand errStream errors errText
      text data textSize dataSize dataAddr textAddr newTextSize newDataSize|

    "find out, how much memory we need"

    textSize := ObjectFile textSizeOf:oFile.
    textSize isNil ifTrue:[
        Transcript showCr:'bad text-size in object file'.
        ^ false
    ].
    Verbose ifTrue:[
        Transcript showCr:'text-size: ' , (textSize printStringRadix:16)
    ].

    dataSize := ObjectFile dataSizeOf:oFile.
    dataSize isNil ifTrue:[
        Transcript showCr:'bad data-size in object file'.
        ^ false
    ].

    Verbose ifTrue:[
        Transcript showCr:'data-size: ' , (dataSize printStringRadix:16)
    ].

    "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:[
            Transcript showCr:'cannot allocate memory for text'.
            ^ false
        ].

        Verbose ifTrue:[
            Transcript showCr:'text: ' , (text address printStringRadix:16)
        ].

        (dataSize ~~ 0) ifTrue:[
            data := ExternalBytes newForData:dataSize.
            (data isNil) ifTrue:[
                Transcript showCr:'cannot allocate memory for data'.
                text notNil ifTrue:[text free].
                ^ false
            ].
            Verbose ifTrue:[
                Transcript showCr:'data: ' , (data address printStringRadix:16)
            ]
        ].
        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:[
            Transcript showCr:'cannot allocate memory for text+data'.
            ^ false
        ].
        Verbose ifTrue:[
            Transcript showCr:'addr: ' , (text address printStringRadix:16)
        ].
        unixCommand := (self absLd:oFile text:text address) 
                       , ' >/tmp/out 2>/tmp/err'.
    ].

    Verbose ifTrue:[
        Transcript showCr:'executing: ' , unixCommand
    ].

    Transcript showCr:'linking ...'.
    (OperatingSystem executeCommand:unixCommand) ifFalse: [
        errStream := FileStream oldFileNamed:'/tmp/err'.
        errStream notNil ifTrue:[
            errors := errStream contents.
            errText := errors asText.
            (errText size > 20) ifTrue:[
                errText grow:20.
                errText add:'... '.
                errors := errText
            ].
            OperatingSystem executeCommand:'rm /tmp/err /tmp/out'.
            self notify:('link errors:\\' , errors asString) withCRs
        ].
        Transcript showCr:'link unsuccessful.'.
        text notNil ifTrue:[text free].
        data notNil ifTrue:[data free].
        ^ false
    ].

    Transcript showCr:'link successful'.

    OperatingSystem executeCommand:'rm /tmp/err /tmp/out'.

    "find out, if space needs have changed after link (they do so on some machines)"

    newTextSize := ObjectFile textSizeOf:'a.out'.
    newTextSize isNil ifTrue:[
        Transcript showCr:'bad new-text-size in a.out object file'.
        text notNil ifTrue:[text free].
        data notNil ifTrue:[data free].
        ^ false
    ].
    Verbose ifTrue:[
        Transcript showCr:'new-text-size: ' , (newTextSize printStringRadix:16)
    ].

    newDataSize := ObjectFile dataSizeOf:'a.out'.
    newDataSize isNil ifTrue:[
        Transcript showCr:'bad new-data-size in a.out object file'.
        text notNil ifTrue:[text free].
        data notNil ifTrue:[data free].
        ^ false
    ].

    Verbose ifTrue:[
        Transcript showCr:'new-data-size: ' , (newDataSize printStringRadix:16)
    ].

    "if size has changed, do it again"

    ((newTextSize ~~ textSize) or:[newDataSize ~~ dataSize]) ifTrue:[

       Transcript showCr:'size changed after link - do it again'.

        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:[
                Transcript showCr:'cannot allocate memory for text'.
                ^ false
            ].

            Verbose ifTrue:[
                Transcript showCr:'text: ' , (text address printStringRadix:16)
            ].

            (dataSize ~~ 0) ifTrue:[
                data := ExternalBytes newForData:dataSize.
                (data isNil) ifTrue:[
                    Transcript showCr:'cannot allocate memory for data'.
                    text notNil ifTrue:[text free].
                    ^ false
                ].
                Verbose ifTrue:[
                    Transcript showCr:'data: ' , (data address printStringRadix:16)
                ]
            ].

            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:[
                Transcript showCr:'cannot allocate memory for text'.
                ^ false
            ].
            Verbose ifTrue:[
                Transcript showCr:'addr: ' , (text address printStringRadix:16)
            ].
            unixCommand := (self absLd:oFile text:text address) 
                           , ' >/tmp/out 2>/tmp/err'.
        ].

        Verbose ifTrue:[
            Transcript showCr:'executing: ' , unixCommand
        ].

        Transcript showCr:'linking ...'.
        (OperatingSystem executeCommand:unixCommand) ifFalse: [
            errStream := FileStream oldFileNamed:'/tmp/err'.
            errStream notNil ifTrue:[
                errors := errStream contents.
                errText := errors asText.
                (errText size > 20) ifTrue:[
                    errText grow:20.
                    errText add:'... '.
                    errors := errText
                ].
                OperatingSystem executeCommand:'rm /tmp/err /tmp/out'.
                self notify:('link errors:\\' , errors asString) withCRs
            ].
            Transcript showCr:'link unsuccessful.'.
            text notNil ifTrue:[text free].
            data notNil ifTrue:[data free].
            ^ false
        ].

        Transcript showCr:'link successful'.

        OperatingSystem executeCommand:'rm /tmp/err /tmp/out'.

        "check again for size change - should not happen"

        newTextSize := ObjectFile textSizeOf:'a.out'.
        newTextSize isNil ifTrue:[
            Transcript showCr:'bad text-size in a.out object file'.
            text notNil ifTrue:[text free].
            data notNil ifTrue:[data free].
            ^ false
        ].
        Verbose ifTrue:[
            Transcript showCr:'new-text-size: ' , (newTextSize printStringRadix:16)
        ].

        newDataSize := ObjectFile dataSizeOf:'a.out'.
        newDataSize isNil ifTrue:[
            Transcript showCr:'bad data-size in object file'.
            text notNil ifTrue:[text free].
            data notNil ifTrue:[data free].
            ^ false
        ].

        Verbose ifTrue:[
            Transcript showCr:'new-data-size: ' , (newDataSize printStringRadix:16)
        ].

        ((newTextSize ~~ textSize) or:[newDataSize ~~ dataSize]) ifTrue:[
            Transcript showCr:'size changed again - I give up'.
            text notNil ifTrue:[text free].
            data notNil ifTrue:[data free].
            ^ false
        ].
    ].

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

    Transcript showCr:'loading ' , textSize printString , ' bytes at ' , (textAddr printStringRadix:16).
    Transcript showCr:'loading ' , dataSize printString , ' bytes at ' , (dataAddr printStringRadix:16).

    (ObjectFile loadObjectFile:'a.out'
                textAddr:textAddr textSize:textSize
                dataAddr:dataAddr dataSize:dataSize) isNil ifTrue: [
        Transcript showCr:'load in error'.
        text notNil ifTrue:[text free].
        data notNil ifTrue:[data free].
        ^ false
    ].

    Transcript showCr:'load in successful'.

    OperatingSystem executeCommand:'mv a.out SymbolTable'.
    MySymbolTable := 'SymbolTable'.
    ^ true
! !

!ObjectFileLoader class methodsFor:'dynamic class loading'!

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

    |handle initAddr symName|

    handle := self openDynamicObject:aFileName.
    handle isNil ifTrue:[
        Transcript showCr:('openDynamic: ',aFileName,' failed.').
        ^ nil
    ].
    OperatingSystem getOSType = 'sys5.4' ifTrue:[
        symName := '_' , aClassName , '_Init'
    ] ifFalse:[
        symName := '__' , aClassName , '_Init'
    ].
    initAddr := self getSymbol:symName from:handle.
    initAddr isNil ifTrue:[
        Transcript showCr:('no symbol: ',symName,' in ',aFileName).
        ^ nil
    ].
    self callFunctionAt:initAddr.
    ^ Smalltalk at:aClassName asSymbol

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

loadObjectFile:aFileName
    "load a compiled class (.o-file) into the image; the class name
     is not needed (multiple definitions may be in the file)"

    |handle initAddr symName className|

    handle := self openDynamicObject:aFileName.
    handle isNil ifTrue:[
        Transcript showCr:('openDynamic: ',aFileName,' failed.').
        ^ nil
    ].
    className := OperatingSystem baseNameOf:aFileName.
    (className endsWith:'.o') ifTrue:[
        className := className copyTo:(className size - 2)
    ].
    OperatingSystem getOSType = 'sys5.4' ifTrue:[
        symName := '_' , className , '_Init'
    ] ifFalse:[
        symName := '__' , className , '_Init'
    ].
    initAddr := self getSymbol:symName from:handle.
    initAddr isNil ifTrue:[
        className := Smalltalk classNameForFile:className.
        OperatingSystem getOSType = 'sys5.4' ifTrue:[
            symName := '_' , className , '_Init'
        ] ifFalse:[
            symName := '__' , className , '_Init'
        ].
        initAddr := self getSymbol:symName from:handle.
        initAddr isNil ifTrue:[
            Transcript showCr:('no symbol: ',symName,' in ',aFileName).
            ^ nil
        ].
    ].
    self callFunctionAt:initAddr.
! !

!ObjectFileLoader class methodsFor:'dynamic object access'!

openDynamicObject:pathName
    "open an object-file (map into my address space).
     Return a non-nil handle if ok, nil otherwise.
     This function is not supported on all architectures."

    |handle|

    handle := self primOpenDynamicObject:pathName into:(Array new:2).
    ^ handle

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

primOpenDynamicObject:pathName into:aBuffer
    "open an object-file (map into my address space).
     This function is not supported on all architectures.
     Dont depend on the returned value or class of it, it depends
     on the underlying dynamic load package."

%{  /* UNLIMITEDSTACK */

#ifdef GNU_DL
#   include "dld.h"
    if (__isString(pathName)) {
        if (dld_link(_stringVal(pathName))) {
            dld_perror("cant link");
            RETURN ( nil );
        }
        RETURN ( pathName );
    }
    RETURN ( nil );
#endif

#ifdef SYSV4_DL
#   include <dlfcn.h>
    void *handle;

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

        if (! handle) {
            printf("dlopen %s error: <%s>\n", _stringVal(pathName), dlerror());
            RETURN (nil);
        }

        printf("open %s handle = %x\n", _stringVal(pathName), handle);
        _AT_PUT_(aBuffer COMMA_SND, _MKSMALLINT(1), 
                                   _MKSMALLINT( (int)handle & 0xFFFF ));
        _AT_PUT_(aBuffer COMMA_SND, _MKSMALLINT(2), 
                                   _MKSMALLINT( ((int)handle >> 16) & 0xFFFF ));
    }
#endif

#ifdef SUN_DL
#   include <dlfcn.h>
    void *handle;

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

        if (! handle) {
            printf("dlopen %s error: <%s>\n", _stringVal(pathName), dlerror());
            RETURN (nil);
        }

        printf("open %s handle = %x\n", _stringVal(pathName), handle);
        _AT_PUT_(aBuffer COMMA_SND, _MKSMALLINT(1), 
                                   _MKSMALLINT( (int)handle & 0xFFFF ));
        _AT_PUT_(aBuffer COMMA_SND, _MKSMALLINT(2), 
                                   _MKSMALLINT( ((int)handle >> 16) & 0xFFFF ));
    }
#endif

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

    loadAddrLow = nil;
    loadAddrHi = nil;
    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) {
            printf("rld_load %s failed\n", _stringVal(pathName));
            RETURN (nil);
        }

        printf("rld_load %s ok\n", _stringVal(pathName));
        _AT_PUT_(aBuffer COMMA_SND, _MKSMALLINT(1), _MKSMALLINT(1));
        _AT_PUT_(aBuffer COMMA_SND, _MKSMALLINT(2), _MKSMALLINT(0));
    }
#endif
%}.
    ^ aBuffer
!

closeDynamicObject:handle
    "close an object-file (unmap from my address space)."

    |low hi|
%{
#ifdef GNU_DL
#   include "dld.h"
    if (__isString(handle)) {
        if (dld_unlink_by_file(_stringVal(handle), 1)) {
            dld_perror("cant unlink");
        }
        RETURN ( self );
    }
#endif
%}.

    hi := handle at:1.
    low := handle at:2.
%{
#ifdef SYSV4_DL
#   include <dlfcn.h>
    void *h;
    int val;

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

#ifdef SUN_DL
#   include <dlfcn.h>
    void *h;
    int val;

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

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

    |low hi lowAddr hiAddr|

%{
#ifdef GNU_DL
#   include "dld.h"
    void (*func)();

    if (__isString(aString)) {
        func = (void (*) ()) dld_get_func(_stringVal(aString));
        if (func) {
            printf("addr = %x\n", (INT)func);
            lowAddr = _MKSMALLINT( (INT)func & 0xFFFF );
            hiAddr = _MKSMALLINT( ((INT)func >> 16) & 0xFFFF );
        } else {
            dld_perror("get_func");
        }
    }
#endif
%}.

    hi := handle at:1.
    low := handle at:2.
%{
#ifdef SYSV4_DL
#   include <dlfcn.h>
    void *h;
    void *addr;
    int val;

    if (_isSmallInteger(low) && _isSmallInteger(hi)) {
        val = (_intVal(hi) << 16) + _intVal(low);
        h = (void *)(val);
        if (__isString(aString)) {
            printf("get sym <%s> handle = %x\n", _stringVal(aString), h);
            addr = dlsym(h, _stringVal(aString));
            if (addr) {
                printf("addr = %x\n", addr);
                lowAddr = _MKSMALLINT( (int)addr & 0xFFFF );
                hiAddr = _MKSMALLINT( ((int)addr >> 16) & 0xFFFF );
            } else {
                printf("dlsym %s error: <%s>\n", _stringVal(aString), dlerror());
            }
        }
    }
#endif

#ifdef SUN_DL
#   include <dlfcn.h>
    void *h;
    void *addr;
    int val;

    if (_isSmallInteger(low) && _isSmallInteger(hi)) {
        val = (_intVal(hi) << 16) + _intVal(low);
        h = (void *)(val);
        if (__isString(aString)) {
            printf("get sym <%s> handle = %x\n", _stringVal(aString), h);
            addr = dlsym(h, _stringVal(aString));
            if (addr) {
                printf("addr = %x\n", addr);
                lowAddr = _MKSMALLINT( (int)addr & 0xFFFF );
                hiAddr = _MKSMALLINT( ((int)addr >> 16) & 0xFFFF );
            } else {
                printf("dlsym %s error: <%s>\n", _stringVal(aString), dlerror());
            }
        }
    }
#endif

#ifdef NEXT_DL
    unsigned long addr;
    long result;
    NXStream *errOut;

    if (__isString(aString)) {
        printf("get sym <%s>\n", _stringVal(aString));
        errOut = NXOpenFile(2, 2);
        result = rld_lookup(errOut,
                            (char *) _stringVal(aString),
                            &addr);
        NXClose(errOut);
        if (result) {
            printf("addr = %x\n", addr);
            lowAddr = _MKSMALLINT( (int)addr & 0xFFFF );
            hiAddr = _MKSMALLINT( ((int)addr >> 16) & 0xFFFF );
        }
    }
#endif
%}
.
    lowAddr notNil ifTrue:[
        ^ (hiAddr * 16r10000) + lowAddr
    ].
    ^ nil
!

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

callFunctionAt:address
    "call a function at address - this is very dangerous.
     This is needed to call the classes init-function after loading in a
     class-object file. Dont use in your programs."

    |low hi lowAddr hiAddr|

    hi := address // 16r10000.
    low := address \\ 16r10000.
%{
    void (*addr)();
    unsigned val;
    typedef void (*VOIDFUNC)();

    if (_isSmallInteger(low) && _isSmallInteger(hi)) {
        val = (_intVal(hi) << 16) + _intVal(low);
        addr = (VOIDFUNC) val;
        (*addr)();
    }
%}
! !

ObjectFileLoader initialize!