diff -r 84a1ddf215a5 -r f8dd8ba75205 ObjFLoader.st --- a/ObjFLoader.st Wed Mar 30 12:10:24 1994 +0200 +++ b/ObjFLoader.st Thu Jun 02 22:26:28 1994 +0200 @@ -12,23 +12,14 @@ 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 $ '! %{ @@ -37,20 +28,24 @@ */ #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 @@ -63,16 +58,90 @@ # endif #endif /* NEXT_DL */ +#include + +/* + * if no dynamic link facilities, do it the hard way ... + */ +#ifndef HAS_DL + +# ifdef A_DOT_OUT +# include +# 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 +# else +# include +# endif +# endif /* coff */ + +# ifdef ELF +# include +# 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 ! @@ -87,7 +156,8 @@ !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| @@ -99,12 +169,13 @@ ]. (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| @@ -141,7 +212,8 @@ ! 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| @@ -163,477 +235,21 @@ ! ! -!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 -'. - - 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') - ifFalse:[ + (OperatingSystem executeCommand:cmd) ifFalse:[ errStream := FileStream oldFileNamed:'/tmp/err'. errStream isNil ifTrue:[ self notify:'errors during link.' @@ -650,36 +266,37 @@ ]. ^ 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'. - ^ false + 'bad text-size in object file' errorPrintNL. + ^ 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'. - ^ false + 'bad data-size in object file' errorPrintNL. + ^ 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; @@ -688,48 +305,45 @@ self needSeparateIDSpaces ifTrue:[ text := ExternalBytes newForText:textSize. text isNil ifTrue:[ - Transcript showCr:'cannot allocate memory for text'. - ^ false + 'cannot allocate memory for text' errorPrintNL. + ^ 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) - , ' >/tmp/out 2>/tmp/err'. + unixCommand := (self absLd:oFile text:text address) , ' >/tmp/out 2>/tmp/err'. ] ifFalse:[ - unixCommand := (self absLd:oFile text:text address - data:data address) + 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 + 'cannot allocate memory for text+data' errorPrintNL. + ^ nil ]. Verbose ifTrue:[ - Transcript showCr:'addr: ' , (text address printStringRadix:16) + ('addr: ' , (text address printStringRadix:16)) errorPrintNL ]. - unixCommand := (self absLd:oFile text:text address) - , ' >/tmp/out 2>/tmp/err'. + unixCommand := (self absLd:oFile text:text address) , ' >/tmp/out 2>/tmp/err'. ]. Verbose ifTrue:[ - Transcript showCr:'executing: ' , unixCommand + ('executing: ' , unixCommand) errorPrintNL ]. 'linking ...' printNewline. @@ -746,39 +360,39 @@ 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" @@ -795,52 +409,49 @@ self needSeparateIDSpaces ifTrue:[ text := ExternalBytes newForText:textSize. text isNil ifTrue:[ - Transcript showCr:'cannot allocate memory for text'. - ^ false + 'cannot allocate memory for new text' errorPrintNL. + ^ 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) - , ' >/tmp/out 2>/tmp/err'. + unixCommand := (self absLd:oFile text:text address) , ' >/tmp/out 2>/tmp/err'. ] ifFalse:[ - unixCommand := (self absLd:oFile text:text address - data:data address) + 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 + 'cannot allocate memory for new text' errorPrintNL. + ^ 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) - , ' >/tmp/out 2>/tmp/err'. + unixCommand := (self absLd:oFile text:text address) , ' >/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:[ @@ -854,46 +465,46 @@ 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 ]. ]. @@ -913,27 +524,27 @@ 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'! @@ -941,36 +552,90 @@ 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). - ^ nil + "try with added underscore" + 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 - is not needed (multiple definitions may be in the file)" + "load an object file (.o-file) into the image; + 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:[ @@ -978,77 +643,229 @@ ^ 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 - on the underlying dynamic load package." + Dont depend on the values or types returned in aBuffer, + 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"); @@ -1070,11 +887,12 @@ 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), @@ -1086,8 +904,6 @@ # include void *handle; - loadAddrLow = nil; - loadAddrHi = nil; if ((pathName == nil) || __isString(pathName)) { if (pathName == nil) handle = dlopen((char *)0, 1); @@ -1095,11 +911,12 @@ 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), @@ -1112,8 +929,6 @@ char *files[2]; NXStream *errOut; - loadAddrLow = nil; - loadAddrHi = nil; if (__isString(pathName)) { files[0] = (char *) _stringVal(pathName); files[1] = (char *) 0; @@ -1124,11 +939,12 @@ (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)); } @@ -1150,6 +966,7 @@ } RETURN ( self ); } + RETURN (self); #endif %}. @@ -1164,7 +981,8 @@ 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 @@ -1177,33 +995,123 @@ 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 - "return the address of a symbol from a dynamically loaded object file. +isSmalltalkObject:handle + "return true, if the loaded object is a smalltalk object module" + + "not yet implemented - stc_compiled_smalltalk is a static symbol, + not found in list - need nm-interface, or nlist-walker + " + ^ true. + + (self getSymbol:'__stc_compiled_smalltalk' function:true from:handle) notNil ifTrue:[^ true]. + (self getSymbol:'__stc_compiled_smalltalk' function:false from:handle) notNil ifTrue:[^ true]. + ^ false +! + +isCPlusPlusObject:handle + "return true, if the loaded object is a c++ object module" + + (self getSymbol:'__gnu_compiled_cplusplus' function:true from:handle) notNil ifTrue:[^ true]. + (self getSymbol:'__CTOR_LIST__' function:true from:handle) notNil ifTrue:[^ true]. + (self getSymbol:'__CTOR_LIST__' function:false from:handle) notNil ifTrue:[^ true]. + (self getSymbol:'__gnu_compiled_cplusplus' function:false from:handle) notNil ifTrue:[^ true]. + ^ false +! + +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)); - if (func) { - printf("addr = %x\n", (INT)func); - lowAddr = _MKSMALLINT( (INT)func & 0xFFFF ); - hiAddr = _MKSMALLINT( ((INT)func >> 16) & 0xFFFF ); + name = (char *) _stringVal(aString); + if (isFunction == false) { + addr = dld_get_symbol(name); } 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 @@ -1222,14 +1130,17 @@ 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()); } } } @@ -1245,14 +1156,17 @@ 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()); } } } @@ -1264,14 +1178,16 @@ 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 ); } @@ -1285,6 +1201,60 @@ ^ 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. @@ -1302,7 +1272,18 @@ %} ! -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." @@ -1317,22 +1298,298 @@ 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!