--- 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 <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
!
@@ -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 <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')
- 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 <dlfcn.h>
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!