hg/stx-libcomp: comparison ObjFLoader.st

equal deleted inserted replaced

-:84a1ddf215a5
+:f8dd8ba75205
 hereby transferred.
 "
 Object subclass:#ObjectFileLoader
 instanceVariableNames:''
-classVariableNames:'MySymbolTable StubNr Verbose'
+classVariableNames:'MySymbolTable 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/Attic/ObjFLoader.st,v 1.6 1994-03-30 10:09:51 claus Exp $
 '!
 %{
 /*
 * by default, use whatever the system provides
 */
 #ifdef sunos
 # define SUN_DL
+# define HAS_DL
 #endif
 #ifdef NeXT
 # define NEXT_DL
+# define HAS_DL
 #endif
 #ifdef SYSV4
 # define SYSV4_DL
+# define HAS_DL
 #endif
 /*
-* but GNU_DL overwrites this
+* but GNU_DL overwrites this - its better
 */
 #ifdef GNU_DL
+# define HAS_DL
 # undef SYSV4_DL
 # undef NEXT_DL
 # undef SUN_DL
 #endif
 #  define _RLD_H_
 #  include <rld.h>
 # endif
 #endif /* NEXT_DL */
+#include <stdio.h>
+/*
+* if no dynamic link facilities, do it the hard way ...
+*/
+#ifndef HAS_DL
+# ifdef A_DOT_OUT
+#  include <a.out.h>
+#  ifndef N_MAGIC
+#   if defined(sinix) && defined(BSD)
+#    define N_MAGIC(hdr) (hdr.a_magic & 0xFFFF)
+#   else
+#    define N_MAGIC(hdr) (hdr.a_magic)
+#   endif
+#  endif
+# endif /* a.out */
+# ifdef COFF
+#  ifdef mips
+#    include <sys/exec.h>
+#  else
+#    include <a.out.h>
+#  endif
+# endif /* coff */
+# ifdef ELF
+#  include <elf.h>
+# endif /* elf */
+#endif /* not HAS_DL */
 static OBJ loadAddrLow, loadAddrHi;
 %}
+!ObjectFileLoader class methodsFor:'documentation'!
+copyright
+"
+COPYRIGHT (c) 1993 by Claus Gittinger
+All Rights Reserved
+This software is furnished under a license and may be used
+only in accordance with the terms of that license and with the
+inclusion of the above copyright notice.   This software may not
+be provided or otherwise made available to, or used by, any
+other person.  No title to or ownership of the software is
+hereby transferred.
+"
+!
+version
+"
+$Header: /cvs/stx/stx/libcomp/Attic/ObjFLoader.st,v 1.7 1994-06-02 20:26:03 claus Exp $
+"
+!
+documentation
+"
+This class knowns how to dynamically load in external object-modules.
+There are basically two totally different mechanisms to do this:
+a) if there exists some dynamic-link facility such as:
+GNU-DL, dlopen (sparc, SYS5.4), rld_open (NeXT),
+this is used
+b) if no such facility exists, the normal linker is used to
+link the module to text/data address as previously malloced,
+and the object file loaded into that space.
+Currently, not all mechanisms work fully satisfying.
+For example, the sun dl*-functions do an exit on link-errors (which
+is certainly not what we want here :-(; the NeXT mechanism does not
+allow for selective unloading (only all or last).
+The only really useful package is the GNU-dl package, which is only
+available for a.out file formats. (i.e. only linux people can use
+it at this time).
+"
+! !
 !ObjectFileLoader class methodsFor:'initialization'!
 initialize
 "name of object file, where initial symbol table is found"
 MySymbolTable := 'smalltalk'.
-StubNr := 1.
 Verbose := false
 !
 verbose:aBoolean
 "turn on/off debug traces"
 ! !
 !ObjectFileLoader class methodsFor:'command defaults'!
 needSeparateIDSpaces
-"return true, if we need separate I and D spaces"
+"return true, if we need separate I and D spaces.
+This is only needed if no dynamic-link facilitiy exists."
 |os cpu|
 os := OperatingSystem getSystemType.
 cpu := OperatingSystem getCPUType.
 (os = 'sunos') ifTrue:[
 (cpu = 'sparc') ifTrue:[ ^ true ]
 ].
 (os = 'linux') ifTrue:[ ^ false ].
-'dont know if we need sepId - assume no' printNewline.
+'dont know if we need sepId - assume no' errorPrintNL.
 ^ false
 !
 absLd:file text:textAddr data:dataAddr
-"this should return a string to link file.o to absolute address"
+"this 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.
 ].
 self error:'do not know how to link absolute'
 !
 absLd:file text:textAddr
-"this should return a string to link file.o to absolute address"
+"this 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.
 ].
 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
-"generate type checking code"
-(argType == #SmallInteger) ifTrue:[
-aStream nextPutAll:'_isSmallInteger(' , argName , ')'.
-^ true
-].
-(argType == #Float) ifTrue:[
-aStream nextPutAll:'__isFloat(' , argName , ')'.
-^ true
-].
-(argType == #Character) ifTrue:[
-aStream nextPutAll:'__isCharacter(' , argName , ')'.
-^ true
-].
-(argType == #String) ifTrue:[
-aStream nextPutAll:'__isString(' , argName , ')'.
-^ true
-].
-(argType == #Symbol) ifTrue:[
-aStream nextPutAll:'__isSymbol(' , 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
-"generate type conversion code"
-|idx|
-(stType == #SmallInteger) ifTrue:[
-aStream nextPutAll:'_intVal(' , argName , ')'.
-^ true
-].
-(stType == #Float) ifTrue:[
-aStream nextPutAll:'_floatVal(' , argName , ')'.
-^ true
-].
-(stType == #Character) ifTrue:[
-aStream nextPutAll:'_characterVal(' , argName , ')'.
-^ true
-].
-(stType == #String) ifTrue:[
-aStream nextPutAll:'_stringVal(' , argName , ')'.
-^ true
-].
-(stType == #Symbol) 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
-"generate type conversion code"
-(stType == #SmallInteger) ifTrue:[
-aStream nextPutAll:'_MKSMALLINT(' , argName , ')'.
-^ true
-].
-(stType == #Float) ifTrue:[
-aStream nextPutAll:'_MKFLOAT(' , argName , ' COMMA_SND)'.
-^ true
-].
-(stType == #Character) ifTrue:[
-aStream nextPutAll:'_MKCHARACTER(' , argName , ')'.
-^ true
-].
-(stType == #String) ifTrue:[
-aStream nextPutAll:'(' , argName , ' ? _MKSTRING(' , argName , ' COMMA_SND) : nil)'.
-^ true
-].
-(stType == #Symbol) ifTrue:[
-aStream nextPutAll:'(' , argName , ' ? _MKSYMBOL(' , argName , ' COMMA_SND) : nil)'.
-^ true
-].
-(stType == #Boolean) ifTrue:[
-aStream nextPutAll:'(' , argName , ' ? true : false)'.
-^ true
-].
-^ false
-!
-cTypeFor:aType
-"return c-type for an ST-type"
-(aType == #SmallInteger) ifTrue:[
-^ 'int'
-].
-(aType == #Boolean) ifTrue:[
-^ 'int'
-].
-(aType == #Float) ifTrue:[
-^ 'double'
-].
-(aType == #Character) ifTrue:[
-^ 'char'
-].
-(aType == #String) ifTrue:[
-^ 'char *'
-].
-(aType == #Symbol) ifTrue:[
-^ 'char *'
-].
-(aType == #ByteArray) ifTrue:[
-^ 'unsigned char *'
-].
-(aType == nil) ifTrue:[
-^ 'void'
-].
-(aType == #ExternalStream) ifTrue:[
-^ 'void *'        "actually its FILE *, but better avoid including stdio.h"
-].
-self error:'type ' , aType, ' not supported'.
-^ ''
-! !
 !ObjectFileLoader class methodsFor:'loading objects'!
 loadFile:oFile with:librariesString
-"load in an object files code, linking in libraries"
+"load in an object files code, linking in libraries.
+This is only needed if no dynamic link facility exists."
-|tmpOfile errStream errors errText ok pid|
+|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:[
-Transcript showCr:'executing: ' , ('ld -o ',tmpOfile,' -r ' , oFile , ' ' , librariesString , '>/tmp/out 2>/tmp/err')
+('executing: ld -o ', cmd) errorPrintNL
 ].
-(OperatingSystem executeCommand:'ld -o ',tmpOfile,' -r ' , oFile , ' ' , librariesString , '>/tmp/out 2>/tmp/err')
+(OperatingSystem executeCommand:cmd) ifFalse:[
-ifFalse:[
 errStream := FileStream oldFileNamed:'/tmp/err'.
 errStream isNil ifTrue:[
 self notify:'errors during link.'
 ] ifFalse:[
 errors := errStream contents.
 OperatingSystem executeCommand:'rm /tmp/err /tmp/out'.
 self notify:('link errors:\\' , errors asString) withCRs
 ].
 ^ false
 ].
-ok := self loadFile:tmpOfile.
+handle := self loadFile:tmpOfile.
 OperatingSystem executeCommand:('rm ' , tmpOfile).
-^ ok
+^ handle
 !
 loadFile:oFile
-"load in an object file"
+"load in an object file - return a handle or nil.
+This is only needed if no dynamic link facility exists."
-| unixCommand errStream errors errText
-text data textSize dataSize dataAddr textAddr newTextSize newDataSize|
+|unixCommand errStream errors errText
+text data textSize dataSize dataAddr textAddr newTextSize newDataSize|
 "find out, how much memory we need"
-textSize := ObjectFile textSizeOf:oFile.
+textSize := self textSizeOf:oFile.
 textSize isNil ifTrue:[
-Transcript showCr:'bad text-size in object file'.
+'bad text-size in object file' errorPrintNL.
-^ false
+^ nil
 ].
 Verbose ifTrue:[
-Transcript showCr:'text-size: ' , (textSize printStringRadix:16)
+('text-size: ' , (textSize printStringRadix:16)) errorPrintNL
 ].
-dataSize := ObjectFile dataSizeOf:oFile.
+dataSize := self dataSizeOf:oFile.
 dataSize isNil ifTrue:[
-Transcript showCr:'bad data-size in object file'.
+'bad data-size in object file' errorPrintNL.
-^ false
+^ nil
 ].
 Verbose ifTrue:[
-Transcript showCr:'data-size: ' , (dataSize printStringRadix:16)
+('data-size: ' , (dataSize printStringRadix:16)) errorPrintNL
 ].
 "allocate some memory for text and some for data;
 then call linker to link the file to those addresses"
 self needSeparateIDSpaces ifTrue:[
 text := ExternalBytes newForText:textSize.
 text isNil ifTrue:[
-Transcript showCr:'cannot allocate memory for text'.
+'cannot allocate memory for text' errorPrintNL.
-^ false
+^ nil
 ].
 Verbose ifTrue:[
-Transcript showCr:'text: ' , (text address printStringRadix:16)
+('text: ' , (text address printStringRadix:16)) errorPrintNL
 ].
 (dataSize ~~ 0) ifTrue:[
 data := ExternalBytes newForData:dataSize.
 (data isNil) ifTrue:[
-Transcript showCr:'cannot allocate memory for data'.
+'cannot allocate memory for data' errorPrintNL.
 text notNil ifTrue:[text free].
-^ false
+^ nil
 ].
 Verbose ifTrue:[
-Transcript showCr:'data: ' , (data address printStringRadix:16)
+('data: ' , (data address printStringRadix:16)) errorPrintNL
 ]
 ].
 dataSize == 0 ifTrue:[
-unixCommand := (self absLd:oFile text:text address)
+unixCommand := (self absLd:oFile text:text address) , ' >/tmp/out 2>/tmp/err'.
-, ' >/tmp/out 2>/tmp/err'.
 ] ifFalse:[
-unixCommand := (self absLd:oFile text:text address
+unixCommand := (self absLd:oFile text:text address data:data 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'.
+'cannot allocate memory for text+data' errorPrintNL.
-^ false
+^ nil
 ].
 Verbose ifTrue:[
-Transcript showCr:'addr: ' , (text address printStringRadix:16)
+('addr: ' , (text address printStringRadix:16)) errorPrintNL
 ].
-unixCommand := (self absLd:oFile text:text address)
+unixCommand := (self absLd:oFile text:text address) , ' >/tmp/out 2>/tmp/err'.
-, ' >/tmp/out 2>/tmp/err'.
 ].
 Verbose ifTrue:[
-Transcript showCr:'executing: ' , unixCommand
+('executing: ' , unixCommand) errorPrintNL
 ].
 'linking ...' printNewline.
 (OperatingSystem executeCommand:unixCommand) ifFalse: [
 errStream := FileStream oldFileNamed:'/tmp/err'.
 errors := errText
 ].
 OperatingSystem executeCommand:'rm /tmp/err /tmp/out'.
 self notify:('link errors:\\' , errors asString) withCRs
 ].
-Transcript showCr:'link unsuccessful.'.
+'link unsuccessful.' errorPrintNL.
 text notNil ifTrue:[text free].
 data notNil ifTrue:[data free].
-^ false
+^ nil
 ].
-'link successful' printNewline.
+'link successful' errorPrintNL.
 OperatingSystem executeCommand:'rm /tmp/err /tmp/out'.
 "find out, if space needs have changed after link (they do so on some machines)"
-newTextSize := ObjectFile textSizeOf:'a.out'.
+newTextSize := self textSizeOf:'a.out'.
 newTextSize isNil ifTrue:[
-Transcript showCr:'bad new-text-size in a.out object file'.
+'bad new-text-size in a.out object file' errorPrintNL.
 text notNil ifTrue:[text free].
 data notNil ifTrue:[data free].
-^ false
+^ nil
 ].
 Verbose ifTrue:[
-Transcript showCr:'new-text-size: ' , (newTextSize printStringRadix:16)
+('new-text-size: ' , (newTextSize printStringRadix:16)) errorPrintNL
 ].
-newDataSize := ObjectFile dataSizeOf:'a.out'.
+newDataSize := self dataSizeOf:'a.out'.
 newDataSize isNil ifTrue:[
-Transcript showCr:'bad new-data-size in a.out object file'.
+'bad new-data-size in a.out object file' errorPrintNL.
 text notNil ifTrue:[text free].
 data notNil ifTrue:[data free].
-^ false
+^ nil
 ].
 Verbose ifTrue:[
-Transcript showCr:'new-data-size: ' , (newDataSize printStringRadix:16)
+('new-data-size: ' , (newDataSize printStringRadix:16)) errorPrintNL
 ].
 "if size has changed, do it again"
 ((newTextSize ~~ textSize) or:[newDataSize ~~ dataSize]) ifTrue:[
 dataSize := newDataSize.
 self needSeparateIDSpaces ifTrue:[
 text := ExternalBytes newForText:textSize.
 text isNil ifTrue:[
-Transcript showCr:'cannot allocate memory for text'.
+'cannot allocate memory for new text' errorPrintNL.
-^ false
+^ nil
 ].
 Verbose ifTrue:[
-Transcript showCr:'text: ' , (text address printStringRadix:16)
+('new text: ' , (text address printStringRadix:16)) errorPrintNL
 ].
 (dataSize ~~ 0) ifTrue:[
 data := ExternalBytes newForData:dataSize.
 (data isNil) ifTrue:[
-Transcript showCr:'cannot allocate memory for data'.
+'cannot allocate memory for new data' errorPrintNL.
 text notNil ifTrue:[text free].
-^ false
+^ nil
 ].
 Verbose ifTrue:[
-Transcript showCr:'data: ' , (data address printStringRadix:16)
+('new data: ' , (data address printStringRadix:16)) errorPrintNL
 ]
 ].
 dataSize == 0 ifTrue:[
-unixCommand := (self absLd:oFile text:text address)
+unixCommand := (self absLd:oFile text:text address) , ' >/tmp/out 2>/tmp/err'.
-, ' >/tmp/out 2>/tmp/err'.
 ] ifFalse:[
-unixCommand := (self absLd:oFile text:text address
+unixCommand := (self absLd:oFile text:text address data:data 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'.
+'cannot allocate memory for new text' errorPrintNL.
-^ false
+^ nil
 ].
 Verbose ifTrue:[
-Transcript showCr:'addr: ' , (text address printStringRadix:16)
+('new text+data: ' , (text address printStringRadix:16)) errorPrintNL
 ].
-unixCommand := (self absLd:oFile text:text address)
+unixCommand := (self absLd:oFile text:text address) , ' >/tmp/out 2>/tmp/err'.
-, ' >/tmp/out 2>/tmp/err'.
 ].
 Verbose ifTrue:[
-Transcript showCr:'executing: ' , unixCommand
+('executing: ' , unixCommand) errorPrintNL
 ].
-'linking ...' printNewline.
+'linking ...' errorPrintNL.
 (OperatingSystem executeCommand:unixCommand) ifFalse: [
 errStream := FileStream oldFileNamed:'/tmp/err'.
 errStream notNil ifTrue:[
 errors := errStream contents.
 errText := errors asText.
 errors := errText
 ].
 OperatingSystem executeCommand:'rm /tmp/err /tmp/out'.
 self notify:('link errors:\\' , errors asString) withCRs
 ].
-Transcript showCr:'link unsuccessful.'.
+'link unsuccessful.' errorPrintNL.
 text notNil ifTrue:[text free].
 data notNil ifTrue:[data free].
-^ false
+^ nil
 ].
-'link successful' printNewline.
+'link successful' errorPrintNL.
 OperatingSystem executeCommand:'rm /tmp/err /tmp/out'.
 "check again for size change - should not happen"
-newTextSize := ObjectFile textSizeOf:'a.out'.
+newTextSize := self textSizeOf:'a.out'.
 newTextSize isNil ifTrue:[
-Transcript showCr:'bad text-size in a.out object file'.
+'bad text-size in a.out object file' errorPrintNL.
 text notNil ifTrue:[text free].
 data notNil ifTrue:[data free].
-^ false
+^ nil
 ].
 Verbose ifTrue:[
-Transcript showCr:'new-text-size: ' , (newTextSize printStringRadix:16)
+('new-text-size: ' , (newTextSize printStringRadix:16)) errorPrintNL
 ].
-newDataSize := ObjectFile dataSizeOf:'a.out'.
+newDataSize := self dataSizeOf:'a.out'.
 newDataSize isNil ifTrue:[
-Transcript showCr:'bad data-size in object file'.
+'bad data-size in object file' errorPrintNL.
 text notNil ifTrue:[text free].
 data notNil ifTrue:[data free].
-^ false
+^ nil
 ].
 Verbose ifTrue:[
-Transcript showCr:'new-data-size: ' , (newDataSize printStringRadix:16)
+('new-data-size: ' , (newDataSize printStringRadix:16)) errorPrintNL
 ].
 ((newTextSize ~~ textSize) or:[newDataSize ~~ dataSize]) ifTrue:[
-Transcript showCr:'size changed again - I give up'.
+'size changed again - I give up' errorPrintNL.
 text notNil ifTrue:[text free].
 data notNil ifTrue:[data free].
-^ false
+^ nil
 ].
 ].
 "only thing left to do is to load in text at textAddr and
 data at dataAddr ... "
 dataAddr := nil
 ].
 Verbose ifTrue:[
 textAddr notNil ifTrue:[
-Transcript showCr:'loading ' , textSize printString , ' bytes at ' , (textAddr printStringRadix:16).
+('loading ' , textSize printString , ' bytes at ' , (textAddr printStringRadix:16)) errorPrintNL.
 ].
 dataAddr notNil ifTrue:[
-Transcript showCr:'loading ' , dataSize printString , ' bytes at ' , (dataAddr printStringRadix:16).
+('loading ' , dataSize printString , ' bytes at ' , (dataAddr printStringRadix:16)) errorPrintNL.
 ].
 ].
-(ObjectFile loadObjectFile:'a.out'
+(self loadObjectFile:'a.out'
 textAddr:textAddr textSize:textSize
 dataAddr:dataAddr dataSize:dataSize) isNil ifTrue: [
-Transcript showCr:'load in error'.
+'load error' errorPrintNL.
 text notNil ifTrue:[text free].
 data notNil ifTrue:[data free].
-^ false
+^ nil
 ].
-'dynamic load successful' printNewline.
+'dynamic load successful' errorPrintNL.
 OperatingSystem executeCommand:'mv a.out SymbolTable'.
 MySymbolTable := 'SymbolTable'.
-^ true
+^ (Array with:textAddr with:dataAddr)
 ! !
 !ObjectFileLoader class methodsFor:'dynamic class loading'!
 loadClass:aClassName fromObjectFile:aFileName
 "load a compiled class (.o-file) into the image"
-|handle initAddr symName|
+|handle initAddr symName newClass list moreHandles|
 handle := self openDynamicObject:aFileName.
 handle isNil ifTrue:[
 Transcript showCr:('openDynamic: ',aFileName,' failed.').
 ^ nil
 ].
+"
+get the Init-function; let the class install itself
+"
 symName := '_' , aClassName , '_Init'.
-initAddr := self getSymbol:symName from:handle.
+initAddr := self getFunction:symName from:handle.
 initAddr isNil ifTrue:[
 "try with added underscore"
 symName := '__' , aClassName , '_Init'.
-initAddr := self getSymbol:symName from:handle.
+initAddr := self getFunction:symName from:handle.
+].
+"
+if there are any undefined symbols, we may have to load more
+"
+list := self getListOfUndefinedSymbolsFrom:handle.
+list notNil ifTrue:[
+moreHandles := self loadModulesFromListOfUndefined:list.
+"
+now, try again
+"
+symName := '_' , aClassName , '_Init'.
+initAddr := self getFunction:symName from:handle.
 initAddr isNil ifTrue:[
-Transcript showCr:('no symbol: ',symName,' in ',aFileName).
+"try with added underscore"
-^ nil
+symName := '__' , aClassName , '_Init'.
-].
+initAddr := self getFunction:symName from:handle.
 ].
-self callFunctionAt:initAddr.
+].
-^ Smalltalk at:aClassName asSymbol
+initAddr notNil ifTrue:[
+Verbose ifTrue:[
+Transcript showCr:'calling init at: ' , (initAddr printStringRadix:16)
+].
+self callInitFunctionAt:initAddr.
+(Symbol hasInterned:aClassName) ifTrue:[
+newClass := Smalltalk at:aClassName asSymbol ifAbsent:[nil].
+newClass notNil ifTrue:[
+newClass initialize.
+"force cache flush"
+Smalltalk at:aClassName asSymbol put:newClass.
+Smalltalk changed.
+].
+] ifFalse:[
+'LOADER: class ' errorPrintNL. aClassName errorPrintNL.
+' did not define itself' errorPrintNL
+"
+do not unload - could have installed its methods ...
+"
+].
+^ newClass
+].
+Verbose ifTrue:[
+Transcript showCr:('no symbol: ', symName,' in ',aFileName).
+].
+"
+unload
+"
+moreHandles notNil ifTrue:[
+self closeAllDynamicObjects:moreHandles.
+].
+self closeDynamicObject:handle.
+^ nil
 "ObjectFileLoader loadClass:'Tetris'      fromObjectFile:'../clients/Tetris/Tetris.o'"
 "ObjectFileLoader loadClass:'TetrisBlock' fromObjectFile:'../clients/Tetris/TBlock.o'"
+"ObjectFileLoader loadClass:'Foo'         fromObjectFile:'classList.o'"
 !
 loadObjectFile:aFileName
-"load a compiled class (.o-file) into the image; the class name
+"load an object file (.o-file) into the image;
-is not needed (multiple definitions may be in the file)"
+the class name is not needed (multiple definitions may be in the file)."
-|handle initAddr symName className|
+|handle initAddr symName className newClass list|
 handle := self openDynamicObject:aFileName.
 handle isNil ifTrue:[
 Transcript showCr:('openDynamic: ',aFileName,' failed.').
 ^ nil
 ].
-"load worked - now get init functions address"
+"
+look for init-function
+"
 className := OperatingSystem baseNameOf:aFileName.
 (className endsWith:'.o') ifTrue:[
 className := className copyTo:(className size - 2)
 ].
 symName := '_' , className , '_Init'.
-initAddr := self getSymbol:symName from:handle.
+initAddr := self getFunction:symName from:handle.
 initAddr isNil ifTrue:[
 "try with added underscore"
 symName := '__' , className , '_Init'.
-initAddr := self getSymbol:symName from:handle.
+initAddr := self getFunction:symName from:handle.
 initAddr isNil ifTrue:[
 "try className from fileName"
 className := Smalltalk classNameForFile:className.
 symName := '_' , className , '_Init'.
-initAddr := self getSymbol:symName from:handle.
+initAddr := self getFunction:symName from:handle.
 initAddr isNil ifTrue:[
 "and with added underscore"
 symName := '__' , className , '_Init'.
-initAddr := self getSymbol:symName from:handle.
+initAddr := self getFunction:symName from:handle.
 initAddr isNil ifTrue:[
 Transcript showCr:('no symbol: ',symName,' in ',aFileName).
+"
+unload
+"
+self closeDynamicObject:handle.
 ^ nil
 ].
 ].
 ].
 ].
-self callFunctionAt:initAddr.
+Verbose ifTrue:[
+Transcript showCr:'calling init at:' , (initAddr printStringRadix:16)
+].
+self callInitFunctionAt:initAddr.
+(Symbol hasInterned:className) ifTrue:[
+newClass := Smalltalk at:className asSymbol ifAbsent:[nil].
+newClass notNil ifTrue:[
+newClass initialize.
+"force cache flush"
+Smalltalk at:className asSymbol put:newClass.
+Smalltalk changed.
+].
+].
+^ newClass
+!
+loadCPlusPlusObjectFile:aFileName
+"load a c++ object file (.o-file) into the image"
+|handle initAddr symName className newClass list|
+handle := self openDynamicObject:aFileName.
+handle isNil ifTrue:[
+Transcript showCr:('openDynamic: ',aFileName,' failed.').
+^ nil
+].
+list := self namesMatching:'__GLOBAL_$I*' in:aFileName.
+list size == 1 ifTrue:[
+"/    (self isCPlusPlusObject:handle) ifTrue:[
+Verbose ifTrue:[
+Transcript showCr:'a c++ object file'
+].
+"
+what I would like to get is the CTOR_LIST,
+and call each function.
+But dld cannot (currently) handle SET-type symbols, therefore
+we search (using nm) for all __GLOBAL_$I* syms, get their values
+and call them each
+"
+"/        list := self namesMatching:'__GLOBAL_$I*' in:aFileName.
+"/        initAddr := self getFunction:'__CTOR_LIST__' from:handle.
+"/        Verbose ifTrue:[
+"/            Transcript showCr:'calling CTORs at:' , (initAddr printStringRadix:16)
+"/        ].
+initAddr := self getFunction:list first from:handle.
+initAddr isNil ifTrue:[
+"
+try with added underscore
+"
+initAddr := self getFunction:('_' , list first) from:handle.
+].
+(initAddr isNil and:[list first startsWith:'_']) ifTrue:[
+"
+try with removed underscore
+"
+initAddr := self getFunction:(list first copyFrom:2) from:handle.
+].
+initAddr isNil ifTrue:[
+Verbose ifTrue:[
+Transcript showCr:'no CTOR-func found (' , list first , ')'
+].
+self closeDynamicObject:aFileName.
+^ nil
+].
+Verbose ifTrue:[
+Transcript showCr:'calling CTORs at:' , (initAddr printStringRadix:16)
+].
+self callFunctionAt:initAddr forceOld:false arg:0.
+Verbose ifTrue:[
+Transcript showCr:'done with CTORs.'
+].
+"
+cannot create a CPlusPlus class automatically (there could be more than
+one classes in it too ...)
+"
+^ handle
+].
+Verbose ifTrue:[
+Transcript showCr:'unknown object file'
+].
+self closeDynamicObject:aFileName.
+^ nil
+!
+loadModulesFromListOfUndefined:list
+"try to figure out what has to be loaded to resolve symbols from list.
+return a list of handles of loaded objects
+"
+|inits classNames moreHandles|
+inits := list select:[:symbol | symbol notNil and:[symbol endsWith:'_Init']].
+inits notNil ifTrue:[
+classNames := inits collect:[:symbol |
+(symbol startsWith:'___') ifTrue:[
+symbol copyFrom:4 to:(symbol size - 5)
+] ifFalse:[
+(symbol startsWith:'__') ifTrue:[
+symbol copyFrom:3 to:(symbol size - 5)
+] ifFalse:[
+(symbol startsWith:'_') ifTrue:[
+symbol copyFrom:2 to:(symbol size - 5)
+] ifFalse:[
+symbol
+]
+]
+]
+].
+"
+autoload those classes
+"
+classNames do:[:aClassName |
+aClassName knownAsSymbol ifTrue:[
+(Smalltalk includesKey:aClassName asSymbol) ifTrue:[
+'autoloading ' print. aClassName printNL.
+(Smalltalk at:aClassName asSymbol) autoload
+]
+]
+]
+].
+^ nil
 ! !
 !ObjectFileLoader class methodsFor:'dynamic object access'!
 openDynamicObject:pathName
-"open an object-file (map into my address space).
+"open an object-file (load/map into my address space).
 Return a non-nil handle if ok, nil otherwise.
-This function is not supported on all architectures."
+No bindings are done - only a pure load is performed.
+This function is not supported on all architectures.
+"
 |handle|
+Verbose ifTrue:[
+Transcript showCr:'openDynamic: ' , pathName
+].
 handle := self primOpenDynamicObject:pathName into:(Array new:2).
+handle isNil ifTrue:[
+Verbose ifTrue:[
+Transcript showCr:'no dynamic load facility or load failed.'.
+].
+"try it the hard way"
+handle := self loadFile:pathName.
+].
 ^ handle
 "sys5.4:
 |handle|
 handle := ObjectFileLoader openDynamicObject:'../stc/mod1.so'.
-ObjectFileLoader getSymbol:'module1' from:handle
+ObjectFileLoader getFunction:'module1' from:handle
 "
 "next:
 |handle|
 handle := ObjectFileLoader openDynamicObject:'../goodies/Path/AbstrPath.o'.
-ObjectFileLoader getSymbol:'__AbstractPath_Init' from:handle
+ObjectFileLoader getFunction:'__AbstractPath_Init' from:handle
 "
 "GLD:
 |handle|
 handle := ObjectFileLoader openDynamicObject:'../clients/Tetris/Tetris.o'.
-ObjectFileLoader getSymbol:'__TetrisBlock_Init' from:handle
+ObjectFileLoader getFunction:'__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
+Dont depend on the values or types returned in aBuffer,
-on the underlying dynamic load package."
+it depends on the underlying dynamic load package."
 %{  /* UNLIMITEDSTACK */
 #ifdef GNU_DL
 #   include "dld.h"
+static firstCall = 1;
+extern char *__myName__;
+if (firstCall) {
+firstCall = 0;
+(void) dld_init (__myName__);
+}
 if (__isString(pathName)) {
 if (dld_link(_stringVal(pathName))) {
 dld_perror("cant link");
 RETURN ( 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());
+fprintf(stderr, "dlopen %s error: <%s>\n", _stringVal(pathName), dlerror());
 RETURN (nil);
 }
-printf("open %s handle = %x\n", _stringVal(pathName), handle);
+if (ObjectFileLoader_Verbose == true)
+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 ));
 }
 #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());
+fprintf(stderr, "dlopen %s error: <%s>\n", _stringVal(pathName), dlerror());
 RETURN (nil);
 }
-printf("open %s handle = %x\n", _stringVal(pathName), handle);
+if (ObjectFileLoader_Verbose == true)
+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 ));
 }
 #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));
+fprintf(stderr, "rld_load %s failed\n", _stringVal(pathName));
 RETURN (nil);
 }
-printf("rld_load %s ok\n", _stringVal(pathName));
+if (ObjectFileLoader_Verbose == true)
+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
 %}.
 if (dld_unlink_by_file(_stringVal(handle), 1)) {
 dld_perror("cant unlink");
 }
 RETURN ( self );
 }
+RETURN (self);
 #endif
 %}.
 hi := handle at:1.
 low := handle at:2.
 int val;
 if (_isSmallInteger(low) && _isSmallInteger(hi)) {
 val = (_intVal(hi) << 16) + _intVal(low);
 h = (void *)(val);
-printf("close handle = %x\n", h);
+if (ObjectFileLoader_Verbose == true)
+printf("close handle = %x\n", h);
 dlclose(h);
 }
 #endif
 #ifdef SUN_DL
 int val;
 if (_isSmallInteger(low) && _isSmallInteger(hi)) {
 val = (_intVal(hi) << 16) + _intVal(low);
 h = (void *)(val);
-printf("close handle = %x\n", h);
+if (ObjectFileLoader_Verbose == true)
+printf("close handle = %x\n", h);
 dlclose(h);
 }
 #endif
 %}
 !
-getSymbol:aString from:handle
+isSmalltalkObject:handle
-"return the address of a symbol from a dynamically loaded object file.
+"return true, if the loaded object is a smalltalk object module"
+"not yet implemented - stc_compiled_smalltalk is a static symbol,
+not found in list - need nm-interface, or nlist-walker
+"
+^ true.
+(self getSymbol:'__stc_compiled_smalltalk' function:true from:handle) notNil ifTrue:[^ true].
+(self getSymbol:'__stc_compiled_smalltalk' function:false from:handle) notNil ifTrue:[^ true].
+^ false
+!
+isCPlusPlusObject:handle
+"return true, if the loaded object is a c++ object module"
+(self getSymbol:'__gnu_compiled_cplusplus' function:true from:handle) notNil ifTrue:[^ true].
+(self getSymbol:'__CTOR_LIST__' function:true from:handle) notNil ifTrue:[^ true].
+(self getSymbol:'__CTOR_LIST__' function:false from:handle) notNil ifTrue:[^ true].
+(self getSymbol:'__gnu_compiled_cplusplus' function:false from:handle) notNil ifTrue:[^ true].
+^ false
+!
+namesMatching:aPattern in:aFileName
+|p l s addr segment name entry|
+l := OrderedCollection new.
+p := PipeStream readingFrom:('nm ' , aFileName).
+p isNil ifTrue:[
+('cannot read names from ' , aFileName) errorPrintNL.
+^ nil
+].
+[p atEnd] whileFalse:[
+entry := p nextLine.
+s := ReadStream on:entry.
+addr := s nextWord.
+segment := s nextWord.
+name := s upToEnd withoutSeparators.
+(addr notNil and:[segment notNil and:[name notNil]]) ifTrue:[
+(aPattern match:name) ifTrue:[
+l add:name
+]
+]
+].
+p close.
+^ l
+!
+isObjectiveCObject:handle
+"not yet implemented"
+^ false
+!
+getFunction:aString from:handle
+"return the address of a function from a dynamically loaded object file.
+Handle must be the one returned previously from openDynamicObject.
+Return the address of the function, or nil on any error."
+^ self getSymbol:aString function:true from:handle
+!
+getSymbol:aString function:isFunction from:handle
+"return the address of a symbol/function from a dynamically loaded object file.
 Handle must be the one returned previously from openDynamicObject.
 Return the address of the symbol, or nil on any error."
 |low hi lowAddr hiAddr|
-%{
+%{  /* STACK: 20000 */
 #ifdef GNU_DL
 #   include "dld.h"
 void (*func)();
+unsigned long addr;
+char *name;
 if (__isString(aString)) {
-func = (void (*) ()) dld_get_func(_stringVal(aString));
+name = (char *) _stringVal(aString);
-if (func) {
+if (isFunction == false) {
-printf("addr = %x\n", (INT)func);
+addr = dld_get_symbol(name);
-lowAddr = _MKSMALLINT( (INT)func & 0xFFFF );
-hiAddr = _MKSMALLINT( ((INT)func >> 16) & 0xFFFF );
 } else {
-dld_perror("get_func");
+func = (void (*) ()) dld_get_func(name);
+if (func) {
+if (ObjectFileLoader_Verbose == true)
+printf("addr of %s = %x\n", name, (INT)func);
+if (dld_function_executable_p(name)) {
+lowAddr = _MKSMALLINT( (INT)func & 0xFFFF );
+hiAddr = _MKSMALLINT( ((INT)func >> 16) & 0xFFFF );
+} else {
+char **undefNames;
+char **nm;
+int i;
+if (ObjectFileLoader_Verbose == true) {
+printf ("function %s not executable\n", name);
+dld_perror("not executable");
+printf("undefined:\n");
+nm = undefNames = dld_list_undefined_sym();
+for (i=dld_undefined_sym_count; i; i--) {
+printf("    %s\n", *nm++);
+}
+}
+free(undefNames);
+}
+} else {
+dld_perror("get_func");
+}
 }
 }
 #endif
 %}.
 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);
+if (ObjectFileLoader_Verbose == true)
+printf("get sym <%s> handle = %x\n", _stringVal(aString), h);
 addr = dlsym(h, _stringVal(aString));
 if (addr) {
-printf("addr = %x\n", addr);
+if (ObjectFileLoader_Verbose == true)
+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());
+if (ObjectFileLoader_Verbose == true)
+printf("dlsym %s error: <%s>\n", _stringVal(aString), dlerror());
 }
 }
 }
 #endif
 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);
+if (ObjectFileLoader_Verbose == true)
+printf("get sym <%s> handle = %x\n", _stringVal(aString), h);
 addr = dlsym(h, _stringVal(aString));
 if (addr) {
-printf("addr = %x\n", addr);
+if (ObjectFileLoader_Verbose == true)
+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());
+if (ObjectFileLoader_Verbose == true)
+printf("dlsym %s error: <%s>\n", _stringVal(aString), dlerror());
 }
 }
 }
 #endif
 unsigned long addr;
 long result;
 NXStream *errOut;
 if (__isString(aString)) {
-printf("get sym <%s>\n", _stringVal(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) {
-printf("addr = %x\n", addr);
+if (ObjectFileLoader_Verbose == true)
+printf("addr = %x\n", addr);
 lowAddr = _MKSMALLINT( (int)addr & 0xFFFF );
 hiAddr = _MKSMALLINT( ((int)addr >> 16) & 0xFFFF );
 }
 }
 #endif
 ^ (hiAddr * 16r10000) + lowAddr
 ].
 ^ nil
 !
+getListOfUndefinedSymbolsFrom:handle
+"return a collection of undefined symbols in a dynamically loaded object file.
+Handle must be the one returned previously from openDynamicObject."
+|list|
+list := Array new:100. "no more than 100 symbols"
+%{
+#ifdef GNU_DL
+#   include "dld.h"
+void (*func)();
+unsigned long addr;
+char *name;
+int nMax;
+if (__isArray(list)) {
+char **undefNames;
+char **nm;
+int index;
+nMax = _arraySize(list);
+nm = undefNames = dld_list_undefined_sym();
+for (index = 0; index < dld_undefined_sym_count; index++) {
+_ArrayInstPtr(list)->a_element[index] = _MKSTRING(*nm++);
+if (index == nMax)
+break;
+}
+free(undefNames);
+}
+#endif
+#ifdef SYSV4_DL
+/*
+* dont know how to do it
+*/
+#endif
+#ifdef SUN_DL
+/*
+* dont know how to do it
+*/
+#endif
+#ifdef NEXT_DL
+/*
+* dont know how to do it
+*/
+#endif
+%}.
+^ list
+!
 releaseSymbolTable
 "this is needed on NeXT to forget loaded names. If this wasnt done,
 the same class could not be loaded in again due to multiple defines.
 On other architectures, this is not needed and therefore a noop."
 NXClose(errOut);
 #endif
 %}
 !
-callFunctionAt:address
+callInitFunctionAt:initAddr
+"
+need 3 passes to init: 1: create my pools
+2: get var-refs to other pools
+3: install class, methods and literals
+"
+self callFunctionAt:initAddr forceOld:true arg:0.
+self callFunctionAt:initAddr forceOld:true arg:1.
+self callFunctionAt:initAddr forceOld:true arg:2.
+!
+callFunctionAt:address forceOld:forceOld arg:argument
 "call a function at address - this is very dangerous.
 This is needed to call the classes init-function after loading in a
 class-object file. Dont use in your programs."
 |low hi lowAddr hiAddr|
 void (*addr)();
 unsigned val;
 typedef void (*VOIDFUNC)();
 int savInt;
 extern int _immediateInterrupt;
+int prevSpace;
+int arg = 0;
 if (_isSmallInteger(low) && _isSmallInteger(hi)) {
 val = (_intVal(hi) << 16) + _intVal(low);
 addr = (VOIDFUNC) val;
+if (_isSmallInteger(argument)) {
+arg = _intVal(argument);
+}
 /*
 * allow function to be interrupted
 */
 savInt = _immediateInterrupt;
 _immediateInterrupt = 1;
-(*addr)();
+if (forceOld == true) {
+prevSpace = allocForceSpace(OLDSPACE);
+(*addr)(arg);
+allocForceSpace(prevSpace);
+} else {
+(*addr)(arg);
+}
 _immediateInterrupt = savInt;
 }
 %}
 ! !
+!ObjectFileLoader class methodsFor:'primitive loading'!
+textSizeOf:aFileName
+"
+get the size of the text-segment (nBytes)
+"
+%{  /* NOCONTEXT */
+#ifdef HAS_DL
+/*
+* not needed, if dynamic link facilities exist
+*/
+#else /* no DL-support */
+char *fname;
+int fd;
+if (! __isString(aFileName)) {
+RETURN (nil);
+}
+fname = (char *) _stringVal(aFileName);
+# if defined(A_DOT_OUT) && !defined(ELF)
+#  if !defined(sco) && !defined(isc)
+{
+struct exec header;
+if ((fd = open(fname, 0)) < 0) {
+fprintf(stderr, "cannot open <%s>\n", fname);
+RETURN ( nil );
+}
+if (read(fd, &header, sizeof(header)) != sizeof(header)) {
+fprintf(stderr, "cannot read header of <%s>\n", fname);
+close(fd);
+RETURN ( nil );
+}
+close(fd);
+if (N_MAGIC(header) != OMAGIC) {
+fprintf(stderr, "header is (0%o) %x - should be (0%o)%x\n",
+N_MAGIC(header), N_MAGIC(header),
+OMAGIC, OMAGIC);
+RETURN ( nil );
+}
+RETURN ( _MKSMALLINT(header.a_text) );
+}
+#  endif
+# endif
+/*
+* need support for other headers ... (i.e. coff, elf)
+*/
+#endif
+%}.
+^ self error:'objectFile format not supported'
+!
+dataSizeOf:aFileName
+"
+get the size of the data-segment (nBytes)
+"
+%{  /* NOCONTEXT */
+#ifdef HAS_DL
+/*
+* not needed, if dynamic link facilities exist
+*/
+#else /* no DL-support */
+char *fname;
+int fd;
+if (! __isString(aFileName)) {
+RETURN ( nil );
+}
+fname = (char *) _stringVal(aFileName);
+# if defined(A_DOT_OUT) && !defined(ELF)
+#  if !defined(sco) && !defined(isc)
+{
+struct exec header;
+unsigned size;
+if ((fd = open(fname, 0)) < 0) {
+fprintf(stderr, "cannot open <%s>\n", fname);
+RETURN ( nil );
+}
+if (read(fd, &header, sizeof(header)) != sizeof(header)) {
+fprintf(stderr, "cannot read header of <%s>\n", fname);
+close(fd);
+RETURN ( nil );
+}
+close(fd);
+if (N_MAGIC(header) != OMAGIC) {
+fprintf(stderr, "header is (0%o) %x - should be (0%o)%x\n",
+N_MAGIC(header), N_MAGIC(header),
+OMAGIC, OMAGIC);
+RETURN ( nil );
+}
+size = header.a_data;
+#   if defined(sinix) && defined(BSD)
+size += header.a_bss;
+#   endif
+RETURN ( _MKSMALLINT(size) );
+}
+#  endif
+# endif
+/*
+* need support for other headers ... (i.e. coff, elf)
+*/
+#endif
+%}
+.
+^ self error:'objectFile format not supported'
+!
+loadObjectFile:aFileName textAddr:textAddr textSize:textSize
+dataAddr:dataAddr dataSize:dataSize
+"the object in aFileName must have been linked for
+absolute address textAddr/dataAddr (using ld -A).
+Load the contents from the file. Memory must have previously
+been allocated using ExternalBytes."
+%{  /* NOCONTEXT */
+#ifdef HAS_DL
+/*
+* not needed, if dynamic link facilities exist
+*/
+#else /* no DL-support */
+if (! __isString(aFileName)) {
+RETURN ( nil );
+}
+# if defined(A_DOT_OUT) && !defined(ELF)
+#  if !defined(sco) && !defined(isc)
+{
+char *fname = (char *) _stringVal(aFileName);
+unsigned taddr, daddr;
+unsigned tsize, dsize;
+unsigned toffset = 0;
+unsigned doffset = 0;
+int fd;
+struct exec header;
+char *cp;
+int bssCount;
+unsigned magic = OMAGIC;
+int nread;
+taddr = _isSmallInteger(textAddr) ? (unsigned) _intVal(textAddr) : 0;
+daddr = _isSmallInteger(dataAddr) ? (unsigned) _intVal(dataAddr) : 0;
+tsize = _isSmallInteger(textSize) ? _intVal(textSize) : 0;
+dsize = _isSmallInteger(dataSize) ? _intVal(dataSize) : 0;
+if ((fd = open(fname, 0)) < 0)  {
+fprintf(stderr, "cannot open <%s>\n", fname);
+RETURN ( nil );
+}
+if (read(fd, &header, sizeof(header)) != sizeof(header)) {
+fprintf(stderr, "cannot read header of <%s>\n", fname);
+close(fd);
+RETURN ( nil );
+}
+if (N_MAGIC(header) != magic) {
+fprintf(stderr, "header is (0%o) %x should be (0%o) %x\n",
+N_MAGIC(header), N_MAGIC(header),
+magic, magic);
+close(fd);
+RETURN ( nil );
+}
+/*
+* some linkers produce a huge output file, with zeros up to the
+* real code ... - thats what toffset, doffset are for.
+*/
+#   if defined(sinix) && defined(BSD)
+toffset = N_TXTADDR(header);
+doffset = toffset + taddr + tsize /* - 0x800 */;
+daddr = taddr + tsize;
+#   else
+#    if defined(mips) && defined(ultrix)
+toffset = N_TXTOFF(header.ex_f, header.ex_o);
+doffset = toffset + tsize;
+daddr = taddr + tsize;
+#    else
+#     if defined(N_TXTOFF)
+toffset = N_TXTOFF(header);
+doffset = N_DATOFF(header);
+daddr = taddr + tsize;
+#     else
+fprintf(stderr, "dont know text/data offsets in objectfile\n");
+RETURN ( nil );
+#     endif
+#    endif
+#   endif
+#   ifdef SUPERDEBUG
+printf("toffs:%x taddr:%x tsize:%d doffs:%x daddr:%x dsize:%d\n",
+toffset, taddr, tsize, doffset,daddr, dsize);
+#   endif
+if (lseek(fd, (long)toffset, 0) < 0) {
+fprintf(stderr, "cannot seek to text\n");
+close(fd);
+RETURN ( nil );
+}
+if ((nread = read(fd, taddr, tsize)) != tsize) {
+perror("read");
+fprintf(stderr, "cannot read text wanted:%d got:%d\n", tsize, nread);
+close(fd);
+RETURN ( nil );
+}
+#   ifdef SUPERDEBUG
+printf("1st bytes of text: %02x %02x %02x %02x\n",
+*((char *)taddr) & 0xFF, *((char *)taddr+1) & 0xFF,
+*((char *)taddr+2) & 0xFF, *((char *)taddr+3) & 0xFF);
+#   endif
+if (dsize) {
+if (lseek(fd, (long)doffset, 0) < 0) {
+fprintf(stderr, "cannot seek to data\n");
+close(fd);
+RETURN ( nil );
+}
+if (read(fd, daddr, dsize) != dsize) {
+fprintf(stderr, "cannot read data\n");
+close(fd);
+RETURN ( nil );
+}
+#   ifdef SUPERDEBUG
+{
+char *ptr;
+int i;
+ptr = (char *)daddr;
+fprintf(stderr, "bytes of data (at %x):\n", ptr);
+for (i=dsize; i>0; i--, ptr++)
+printf("%02x ", *ptr & 0xFF);
+}
+#   endif
+}
+close(fd);
+#   ifdef NOTDEF
+if (header.a_bss != 0) {
+fprintf(stderr, "warning: bss not empty\n");
+cp = ((char *)daddr) + header.a_data;
+for (bssCount=header.a_bss; bssCount; bssCount--)
+*cp++ = 0;
+}
+#   endif
+}
+RETURN ( self );
+#  endif
+# endif
+/*
+* need support for other headers ... (i.e. coff, elf)
+*/
+#endif
+%}.
+^ self error:'objectFile format not supported'
+! !
 ObjectFileLoader initialize!

changeset 20	f8dd8ba75205
parent 19	84a1ddf215a5
child 28	a9d33ea0692d