--- a/ObjFLoader.st Sun Oct 02 23:01:25 1994 +0100
+++ b/ObjFLoader.st Mon Oct 10 01:58:23 1994 +0100
@@ -1,6 +1,6 @@
"
COPYRIGHT (c) 1993 by Claus Gittinger
- All Rights Reserved
+ 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
@@ -12,16 +12,16 @@
Object subclass:#ObjectFileLoader
instanceVariableNames:''
- classVariableNames:'MySymbolTable Verbose LastError'
+ classVariableNames:'MySymbolTable Verbose LastError LoadedObjects'
poolDictionaries:''
category:'System-Compiler'
!
ObjectFileLoader comment:'
COPYRIGHT (c) 1993 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
-$Header: /cvs/stx/stx/libcomp/Attic/ObjFLoader.st,v 1.9 1994-08-22 12:48:28 claus Exp $
+$Header: /cvs/stx/stx/libcomp/Attic/ObjFLoader.st,v 1.10 1994-10-10 00:56:47 claus Exp $
'!
%{
@@ -97,6 +97,13 @@
# define dlcfn_h
#endif
+#ifdef GNU_DL
+# ifndef dld_h
+# include "dld.h"
+# define dld_h
+# endif
+#endif
+
static OBJ loadAddrLow, loadAddrHi;
%}
@@ -105,7 +112,7 @@
copyright
"
COPYRIGHT (c) 1993 by Claus Gittinger
- All Rights Reserved
+ 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
@@ -118,20 +125,24 @@
version
"
-$Header: /cvs/stx/stx/libcomp/Attic/ObjFLoader.st,v 1.9 1994-08-22 12:48:28 claus Exp $
+$Header: /cvs/stx/stx/libcomp/Attic/ObjFLoader.st,v 1.10 1994-10-10 00:56:47 claus Exp $
"
!
documentation
"
This class knowns how to dynamically load in external object-modules.
+ As to date, this is completely experimental and WITHOUT ANY WARRANTY.
+ It is still being developed and the code below needs cleanup and more
+ robustness.
+
There are basically two totally different mechanisms to do this:
- a) if there exists some dynamic-link facility such as:
- GNU-DL, dlopen (sparc, SYS5.4), rld_open (NeXT),
- this is used
- b) if no such facility exists, the normal linker is used to
- link the module to text/data address as previously malloced,
- and the object file loaded into that space.
+ 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
@@ -149,7 +160,7 @@
"name of object file, where initial symbol table is found"
MySymbolTable := 'smalltalk'.
- Verbose := false
+ Verbose := false.
!
verbose:aBoolean
@@ -172,7 +183,7 @@
cpu := OperatingSystem getCPUType.
(os = 'sunos') ifTrue:[
- (cpu = 'sparc') ifTrue:[ ^ true ]
+ (cpu = 'sparc') ifTrue:[ ^ true ]
].
(os = 'linux') ifTrue:[ ^ false ].
@@ -189,31 +200,31 @@
os := OperatingSystem getSystemType.
cpu := OperatingSystem getCPUType.
(os = 'sunos') ifTrue:[
- (cpu = 'sparc') ifTrue:[
+ (cpu = 'sparc') ifTrue:[
" "
- ^ ('ld -A ' , MySymbolTable , ' -x -Bstatic' ,
- ' -Ttext ' , (textAddr printStringRadix:16) ,
- ' -Tdata ' , (dataAddr printStringRadix:16) , ' ' , file)
+ ^ ('ld -A ' , MySymbolTable , ' -x -Bstatic' ,
+ ' -Ttext ' , (textAddr printStringRadix:16) ,
+ ' -Tdata ' , (dataAddr printStringRadix:16) , ' ' , file)
" "
"
- ^ ('ld -A ' , MySymbolTable , ' -T ',
- (textAddr printStringRadix:16),
- ' -N -x ' , file)
+ ^ ('ld -A ' , MySymbolTable , ' -T ',
+ (textAddr printStringRadix:16),
+ ' -N -x ' , file)
"
- ]
+ ]
].
"
(os = 'ultrix') ifTrue:[
- (cpu = 'mips') ifTrue:[
- ^ ('ld -A ' , MySymbolTable , ' -x -N -T ' , (textAddr printStringRadix:16) , ' ' , file)
- ]
+ (cpu = 'mips') ifTrue:[
+ ^ ('ld -A ' , MySymbolTable , ' -x -N -T ' , (textAddr printStringRadix:16) , ' ' , file)
+ ]
].
"
(os = 'linux') ifTrue:[
- ^ ('ld -A ' , MySymbolTable ,
- ' -x -N ',
- ' -Ttext ' , (textAddr printStringRadix:16) ,
- ' -Tdata ' , (dataAddr printStringRadix:16) , ' ' , file)
+ ^ ('ld -A ' , MySymbolTable ,
+ ' -x -N ',
+ ' -Ttext ' , (textAddr printStringRadix:16) ,
+ ' -Tdata ' , (dataAddr printStringRadix:16) , ' ' , file)
].
self error:'do not know how to link absolute'
!
@@ -227,16 +238,16 @@
os := OperatingSystem getSystemType.
cpu := OperatingSystem getCPUType.
(os = 'sunos') ifTrue:[
- (cpu = 'sparc') ifTrue:[
- ^ ('ld -A ' , MySymbolTable , ' -T ',
- (textAddr printStringRadix:16),
- ' -N -x ' , file)
+ (cpu = 'sparc') ifTrue:[
+ ^ ('ld -A ' , MySymbolTable , ' -T ',
+ (textAddr printStringRadix:16),
+ ' -N -x ' , file)
- ]
+ ]
].
(os = 'linux') ifTrue:[
- ^ ('ld -A ' , MySymbolTable ,
- ' -x -N -Ttext ' , (textAddr printStringRadix:16) , ' ' , file)
+ ^ ('ld -A ' , MySymbolTable ,
+ ' -x -N -Ttext ' , (textAddr printStringRadix:16) , ' ' , file)
].
self error:'do not know how to link absolute'
!
@@ -248,7 +259,7 @@
os := OperatingSystem getSystemType.
(os = 'iris') ifTrue:[
- ^ 'nm -B ' , file
+ ^ 'nm -B ' , file
].
^ 'nm ' , file
! !
@@ -265,24 +276,24 @@
tmpOfile := '/tmp/stc_ld' , pid.
cmd := 'ld -o ', tmpOfile, ' -r ' , oFile , ' ' , librariesString , '>/tmp/out 2>/tmp/err'.
Verbose ifTrue:[
- ('executing: ld -o ', cmd) errorPrintNL
+ ('executing: ld -o ', cmd) errorPrintNL
].
(OperatingSystem executeCommand:cmd) ifFalse:[
- errStream := FileStream oldFileNamed:'/tmp/err'.
- errStream isNil ifTrue:[
- self notify:'errors during link.'
- ] ifFalse:[
- errors := errStream contents.
- errText := errors asText.
- (errText size > 20) ifTrue:[
- errText grow:20.
- errText add:'... '.
- errors := errText
- ].
- OperatingSystem executeCommand:'rm /tmp/err /tmp/out'.
- self notify:('link errors:\\' , errors asString) withCRs
- ].
- ^ false
+ errStream := FileStream oldFileNamed:'/tmp/err'.
+ errStream isNil ifTrue:[
+ self notify:'errors during link.'
+ ] ifFalse:[
+ errors := errStream contents.
+ errText := errors asText.
+ (errText size > 20) ifTrue:[
+ errText grow:20.
+ errText add:'... '.
+ errors := errText
+ ].
+ OperatingSystem executeCommand:'rm /tmp/err /tmp/out'.
+ self notify:('link errors:\\' , errors asString) withCRs
+ ].
+ ^ false
].
handle := self loadFile:tmpOfile.
OperatingSystem executeCommand:('rm ' , tmpOfile).
@@ -291,7 +302,9 @@
loadFile:oFile
"load in an object file - return a handle or nil.
- This is only needed if no dynamic link facility exists."
+ This is only needed if no dynamic link facility exists.
+ It allocates some memory for text and data, calls for the linker
+ to relocate the oFile to that address and loads the sections."
|unixCommand errStream errors errText
text data textSize dataSize dataAddr textAddr newTextSize newDataSize|
@@ -300,88 +313,88 @@
textSize := self textSizeOf:oFile.
textSize isNil ifTrue:[
- 'bad text-size in object file' errorPrintNL.
- ^ nil
+ 'bad text-size in object file' errorPrintNL.
+ ^ nil
].
Verbose ifTrue:[
- ('text-size: ' , (textSize printStringRadix:16)) errorPrintNL
+ ('text-size: ' , (textSize printStringRadix:16)) errorPrintNL
].
dataSize := self dataSizeOf:oFile.
dataSize isNil ifTrue:[
- 'bad data-size in object file' errorPrintNL.
- ^ nil
+ 'bad data-size in object file' errorPrintNL.
+ ^ nil
].
Verbose ifTrue:[
- ('data-size: ' , (dataSize printStringRadix:16)) errorPrintNL
+ ('data-size: ' , (dataSize printStringRadix:16)) errorPrintNL
].
"allocate some memory for text and some for data;
then call linker to link the file to those addresses"
self needSeparateIDSpaces ifTrue:[
- text := ExternalBytes newForText:textSize.
- text isNil ifTrue:[
- 'cannot allocate memory for text' errorPrintNL.
- ^ nil
- ].
+ text := ExternalBytes newForText:textSize.
+ text isNil ifTrue:[
+ 'cannot allocate memory for text' errorPrintNL.
+ ^ nil
+ ].
- Verbose ifTrue:[
- ('text: ' , (text address printStringRadix:16)) errorPrintNL
- ].
+ Verbose ifTrue:[
+ ('text: ' , (text address printStringRadix:16)) errorPrintNL
+ ].
- (dataSize ~~ 0) ifTrue:[
- data := ExternalBytes newForData:dataSize.
- (data isNil) ifTrue:[
- 'cannot allocate memory for data' errorPrintNL.
- text notNil ifTrue:[text free].
- ^ nil
- ].
- Verbose ifTrue:[
- ('data: ' , (data address printStringRadix:16)) errorPrintNL
- ]
- ].
- dataSize == 0 ifTrue:[
- unixCommand := (self absLd:oFile text:text address) , ' >/tmp/out 2>/tmp/err'.
- ] ifFalse:[
- unixCommand := (self absLd:oFile text:text address data:data address)
- , ' >/tmp/out 2>/tmp/err'.
- ]
+ (dataSize ~~ 0) ifTrue:[
+ data := ExternalBytes newForData:dataSize.
+ (data isNil) ifTrue:[
+ 'cannot allocate memory for data' errorPrintNL.
+ text notNil ifTrue:[text free].
+ ^ nil
+ ].
+ Verbose ifTrue:[
+ ('data: ' , (data address printStringRadix:16)) errorPrintNL
+ ]
+ ].
+ dataSize == 0 ifTrue:[
+ unixCommand := (self absLd:oFile text:text address) , ' >/tmp/out 2>/tmp/err'.
+ ] ifFalse:[
+ unixCommand := (self absLd:oFile text:text address data:data address)
+ , ' >/tmp/out 2>/tmp/err'.
+ ]
] ifFalse:[
- text := ExternalBytes newForText:(textSize + dataSize).
- text isNil ifTrue:[
- 'cannot allocate memory for text+data' errorPrintNL.
- ^ nil
- ].
- Verbose ifTrue:[
- ('addr: ' , (text address printStringRadix:16)) errorPrintNL
- ].
- unixCommand := (self absLd:oFile text:text address) , ' >/tmp/out 2>/tmp/err'.
+ text := ExternalBytes newForText:(textSize + dataSize).
+ text isNil ifTrue:[
+ 'cannot allocate memory for text+data' errorPrintNL.
+ ^ nil
+ ].
+ Verbose ifTrue:[
+ ('addr: ' , (text address printStringRadix:16)) errorPrintNL
+ ].
+ unixCommand := (self absLd:oFile text:text address) , ' >/tmp/out 2>/tmp/err'.
].
Verbose ifTrue:[
- ('executing: ' , unixCommand) errorPrintNL
+ ('executing: ' , unixCommand) errorPrintNL
].
'linking ...' printNewline.
(OperatingSystem executeCommand:unixCommand) ifFalse: [
- errStream := FileStream oldFileNamed:'/tmp/err'.
- errStream notNil ifTrue:[
- errors := errStream contents.
- errText := errors asText.
- (errText size > 20) ifTrue:[
- errText grow:20.
- errText add:'... '.
- errors := errText
- ].
- OperatingSystem executeCommand:'rm /tmp/err /tmp/out'.
- self notify:('link errors:\\' , errors asString) withCRs
- ].
- 'link unsuccessful.' errorPrintNL.
- text notNil ifTrue:[text free].
- data notNil ifTrue:[data free].
- ^ nil
+ errStream := FileStream oldFileNamed:'/tmp/err'.
+ errStream notNil ifTrue:[
+ errors := errStream contents.
+ errText := errors asText.
+ (errText size > 20) ifTrue:[
+ errText grow:20.
+ errText add:'... '.
+ errors := errText
+ ].
+ OperatingSystem executeCommand:'rm /tmp/err /tmp/out'.
+ self notify:('link errors:\\' , errors asString) withCRs
+ ].
+ 'link unsuccessful.' errorPrintNL.
+ text notNil ifTrue:[text free].
+ data notNil ifTrue:[data free].
+ ^ nil
].
'link successful' errorPrintNL.
@@ -392,177 +405,177 @@
newTextSize := self textSizeOf:'a.out'.
newTextSize isNil ifTrue:[
- 'bad new-text-size in a.out object file' errorPrintNL.
- text notNil ifTrue:[text free].
- data notNil ifTrue:[data free].
- ^ nil
+ 'bad new-text-size in a.out object file' errorPrintNL.
+ text notNil ifTrue:[text free].
+ data notNil ifTrue:[data free].
+ ^ nil
].
Verbose ifTrue:[
- ('new-text-size: ' , (newTextSize printStringRadix:16)) errorPrintNL
+ ('new-text-size: ' , (newTextSize printStringRadix:16)) errorPrintNL
].
newDataSize := self dataSizeOf:'a.out'.
newDataSize isNil ifTrue:[
- 'bad new-data-size in a.out object file' errorPrintNL.
- text notNil ifTrue:[text free].
- data notNil ifTrue:[data free].
- ^ nil
+ 'bad new-data-size in a.out object file' errorPrintNL.
+ text notNil ifTrue:[text free].
+ data notNil ifTrue:[data free].
+ ^ nil
].
Verbose ifTrue:[
- ('new-data-size: ' , (newDataSize printStringRadix:16)) errorPrintNL
+ ('new-data-size: ' , (newDataSize printStringRadix:16)) errorPrintNL
].
"if size has changed, do it again"
((newTextSize ~~ textSize) or:[newDataSize ~~ dataSize]) ifTrue:[
- 'size changed after link - do it again' printNewline.
+ 'size changed after link - do it again' printNewline.
- text notNil ifTrue:[text free. text := nil].
- data notNil ifTrue:[data free. data := nil].
- textSize := newTextSize.
- dataSize := newDataSize.
+ text notNil ifTrue:[text free. text := nil].
+ data notNil ifTrue:[data free. data := nil].
+ textSize := newTextSize.
+ dataSize := newDataSize.
- self needSeparateIDSpaces ifTrue:[
- text := ExternalBytes newForText:textSize.
- text isNil ifTrue:[
- 'cannot allocate memory for new text' errorPrintNL.
- ^ nil
- ].
+ self needSeparateIDSpaces ifTrue:[
+ text := ExternalBytes newForText:textSize.
+ text isNil ifTrue:[
+ 'cannot allocate memory for new text' errorPrintNL.
+ ^ nil
+ ].
- Verbose ifTrue:[
- ('new text: ' , (text address printStringRadix:16)) errorPrintNL
- ].
+ Verbose ifTrue:[
+ ('new text: ' , (text address printStringRadix:16)) errorPrintNL
+ ].
- (dataSize ~~ 0) ifTrue:[
- data := ExternalBytes newForData:dataSize.
- (data isNil) ifTrue:[
- 'cannot allocate memory for new data' errorPrintNL.
- text notNil ifTrue:[text free].
- ^ nil
- ].
- Verbose ifTrue:[
- ('new data: ' , (data address printStringRadix:16)) errorPrintNL
- ]
- ].
+ (dataSize ~~ 0) ifTrue:[
+ data := ExternalBytes newForData:dataSize.
+ (data isNil) ifTrue:[
+ 'cannot allocate memory for new data' errorPrintNL.
+ text notNil ifTrue:[text free].
+ ^ nil
+ ].
+ Verbose ifTrue:[
+ ('new data: ' , (data address printStringRadix:16)) errorPrintNL
+ ]
+ ].
- dataSize == 0 ifTrue:[
- unixCommand := (self absLd:oFile text:text address) , ' >/tmp/out 2>/tmp/err'.
- ] ifFalse:[
- unixCommand := (self absLd:oFile text:text address data:data address)
- , ' >/tmp/out 2>/tmp/err'.
- ]
- ] ifFalse:[
- text := ExternalBytes newForText:(textSize + dataSize).
- text isNil ifTrue:[
- 'cannot allocate memory for new text' errorPrintNL.
- ^ nil
- ].
- Verbose ifTrue:[
- ('new text+data: ' , (text address printStringRadix:16)) errorPrintNL
- ].
- unixCommand := (self absLd:oFile text:text address) , ' >/tmp/out 2>/tmp/err'.
- ].
+ dataSize == 0 ifTrue:[
+ unixCommand := (self absLd:oFile text:text address) , ' >/tmp/out 2>/tmp/err'.
+ ] ifFalse:[
+ unixCommand := (self absLd:oFile text:text address data:data address)
+ , ' >/tmp/out 2>/tmp/err'.
+ ]
+ ] ifFalse:[
+ text := ExternalBytes newForText:(textSize + dataSize).
+ text isNil ifTrue:[
+ 'cannot allocate memory for new text' errorPrintNL.
+ ^ nil
+ ].
+ Verbose ifTrue:[
+ ('new text+data: ' , (text address printStringRadix:16)) errorPrintNL
+ ].
+ unixCommand := (self absLd:oFile text:text address) , ' >/tmp/out 2>/tmp/err'.
+ ].
- Verbose ifTrue:[
- ('executing: ' , unixCommand) errorPrintNL
- ].
+ Verbose ifTrue:[
+ ('executing: ' , unixCommand) errorPrintNL
+ ].
- 'linking ...' errorPrintNL.
- (OperatingSystem executeCommand:unixCommand) ifFalse: [
- errStream := FileStream oldFileNamed:'/tmp/err'.
- errStream notNil ifTrue:[
- errors := errStream contents.
- errText := errors asText.
- (errText size > 20) ifTrue:[
- errText grow:20.
- errText add:'... '.
- errors := errText
- ].
- OperatingSystem executeCommand:'rm /tmp/err /tmp/out'.
- self notify:('link errors:\\' , errors asString) withCRs
- ].
- 'link unsuccessful.' errorPrintNL.
- text notNil ifTrue:[text free].
- data notNil ifTrue:[data free].
- ^ nil
- ].
+ 'linking ...' errorPrintNL.
+ (OperatingSystem executeCommand:unixCommand) ifFalse: [
+ errStream := FileStream oldFileNamed:'/tmp/err'.
+ errStream notNil ifTrue:[
+ errors := errStream contents.
+ errText := errors asText.
+ (errText size > 20) ifTrue:[
+ errText grow:20.
+ errText add:'... '.
+ errors := errText
+ ].
+ OperatingSystem executeCommand:'rm /tmp/err /tmp/out'.
+ self notify:('link errors:\\' , errors asString) withCRs
+ ].
+ 'link unsuccessful.' errorPrintNL.
+ text notNil ifTrue:[text free].
+ data notNil ifTrue:[data free].
+ ^ nil
+ ].
- 'link successful' errorPrintNL.
+ 'link successful' errorPrintNL.
- OperatingSystem executeCommand:'rm /tmp/err /tmp/out'.
+ OperatingSystem executeCommand:'rm /tmp/err /tmp/out'.
- "check again for size change - should not happen"
+ "check again for size change - should not happen"
- newTextSize := self textSizeOf:'a.out'.
- newTextSize isNil ifTrue:[
- 'bad text-size in a.out object file' errorPrintNL.
- text notNil ifTrue:[text free].
- data notNil ifTrue:[data free].
- ^ nil
- ].
- Verbose ifTrue:[
- ('new-text-size: ' , (newTextSize printStringRadix:16)) errorPrintNL
- ].
+ newTextSize := self textSizeOf:'a.out'.
+ newTextSize isNil ifTrue:[
+ 'bad text-size in a.out object file' errorPrintNL.
+ text notNil ifTrue:[text free].
+ data notNil ifTrue:[data free].
+ ^ nil
+ ].
+ Verbose ifTrue:[
+ ('new-text-size: ' , (newTextSize printStringRadix:16)) errorPrintNL
+ ].
- newDataSize := self dataSizeOf:'a.out'.
- newDataSize isNil ifTrue:[
- 'bad data-size in object file' errorPrintNL.
- text notNil ifTrue:[text free].
- data notNil ifTrue:[data free].
- ^ nil
- ].
+ newDataSize := self dataSizeOf:'a.out'.
+ newDataSize isNil ifTrue:[
+ 'bad data-size in object file' errorPrintNL.
+ text notNil ifTrue:[text free].
+ data notNil ifTrue:[data free].
+ ^ nil
+ ].
- Verbose ifTrue:[
- ('new-data-size: ' , (newDataSize printStringRadix:16)) errorPrintNL
- ].
+ Verbose ifTrue:[
+ ('new-data-size: ' , (newDataSize printStringRadix:16)) errorPrintNL
+ ].
- ((newTextSize ~~ textSize) or:[newDataSize ~~ dataSize]) ifTrue:[
- 'size changed again - I give up' errorPrintNL.
- text notNil ifTrue:[text free].
- data notNil ifTrue:[data free].
- ^ nil
- ].
+ ((newTextSize ~~ textSize) or:[newDataSize ~~ dataSize]) ifTrue:[
+ 'size changed again - I give up' errorPrintNL.
+ text notNil ifTrue:[text free].
+ data notNil ifTrue:[data free].
+ ^ nil
+ ].
].
"only thing left to do is to load in text at textAddr and
data at dataAddr ... "
text notNil ifTrue:[
- textAddr := text address
+ textAddr := text address
] ifFalse:[
- textAddr := nil
+ textAddr := nil
].
data notNil ifTrue:[
- dataAddr := data address
+ dataAddr := data address
] ifFalse:[
- dataAddr := nil
+ dataAddr := nil
].
Verbose ifTrue:[
- textAddr notNil ifTrue:[
- ('loading ' , textSize printString , ' bytes at ' , (textAddr printStringRadix:16)) errorPrintNL.
- ].
- dataAddr notNil ifTrue:[
- ('loading ' , dataSize printString , ' bytes at ' , (dataAddr printStringRadix:16)) errorPrintNL.
- ].
+ textAddr notNil ifTrue:[
+ ('loading ' , textSize printString , ' bytes at ' , (textAddr printStringRadix:16)) errorPrintNL.
+ ].
+ dataAddr notNil ifTrue:[
+ ('loading ' , dataSize printString , ' bytes at ' , (dataAddr printStringRadix:16)) errorPrintNL.
+ ].
].
(self loadObjectFile:'a.out'
- textAddr:textAddr textSize:textSize
- dataAddr:dataAddr dataSize:dataSize) isNil ifTrue: [
- 'load error' errorPrintNL.
- text notNil ifTrue:[text free].
- data notNil ifTrue:[data free].
- ^ nil
+ textAddr:textAddr textSize:textSize
+ dataAddr:dataAddr dataSize:dataSize) isNil ifTrue: [
+ 'load error' errorPrintNL.
+ text notNil ifTrue:[text free].
+ data notNil ifTrue:[data free].
+ ^ nil
].
'dynamic load successful' errorPrintNL.
OperatingSystem executeCommand:'mv a.out SymbolTable'.
MySymbolTable := 'SymbolTable'.
- ^ (Array with:textAddr with:dataAddr)
+ ^ (Array with:text with:data)
! !
!ObjectFileLoader class methodsFor:'dynamic class loading'!
@@ -574,8 +587,8 @@
handle := self openDynamicObject:aFileName.
handle isNil ifTrue:[
- Transcript showCr:('openDynamic: ',aFileName,' failed.').
- ^ nil
+ Transcript showCr:('openDynamic: ',aFileName,' failed.').
+ ^ nil
].
"
@@ -584,9 +597,9 @@
symName := '_' , aClassName , '_Init'.
initAddr := self getFunction:symName from:handle.
initAddr isNil ifTrue:[
- "try with added underscore"
- symName := '__' , aClassName , '_Init'.
- initAddr := self getFunction:symName from:handle.
+ "try with added underscore"
+ symName := '__' , aClassName , '_Init'.
+ initAddr := self getFunction:symName from:handle.
].
"
@@ -594,52 +607,52 @@
"
list := self getListOfUndefinedSymbolsFrom:handle.
list notNil ifTrue:[
- moreHandles := self loadModulesFromListOfUndefined:list.
+ moreHandles := self loadModulesFromListOfUndefined:list.
- "
- now, try again
- "
- symName := '_' , aClassName , '_Init'.
- initAddr := self getFunction:symName from:handle.
- initAddr isNil ifTrue:[
- "try with added underscore"
- symName := '__' , aClassName , '_Init'.
- initAddr := self getFunction:symName from:handle.
- ].
+ "
+ now, try again
+ "
+ symName := '_' , aClassName , '_Init'.
+ initAddr := self getFunction:symName from:handle.
+ initAddr isNil ifTrue:[
+ "try with added underscore"
+ symName := '__' , aClassName , '_Init'.
+ initAddr := self getFunction:symName from:handle.
+ ].
].
initAddr notNil ifTrue:[
- Verbose ifTrue:[
- 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:'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).
+ Transcript showCr:('no symbol: ', symName,' in ',aFileName).
].
"
unload
"
moreHandles notNil ifTrue:[
- self closeAllDynamicObjects:moreHandles.
+ self closeAllDynamicObjects:moreHandles.
].
self closeDynamicObject:handle.
^ nil
@@ -658,21 +671,21 @@
handle := self openDynamicObject:aFileName.
handle isNil ifTrue:[
- Transcript showCr:('openDynamic: ',aFileName,' failed.').
- ^ false
+ Transcript showCr:('openDynamic: ',aFileName,' failed.').
+ ^ false
].
className := OperatingSystem baseNameOf:aFileName.
(className endsWith:'.o') ifTrue:[
- className := className copyTo:(className size - 2)
+ className := className copyTo:(className size - 2)
] ifFalse:[
- (className endsWith:'.obj') ifTrue:[
- className := className copyTo:(className size - 4)
- ] ifFalse:[
- (className endsWith:'.so') ifTrue:[
- className := className copyTo:(className size - 3)
- ]
- ]
+ (className endsWith:'.obj') ifTrue:[
+ className := className copyTo:(className size - 4)
+ ] ifFalse:[
+ (className endsWith:'.so') ifTrue:[
+ className := className copyTo:(className size - 3)
+ ]
+ ]
].
"
@@ -680,31 +693,31 @@
"
initAddr := self getFunction:(className , '_Init') from:handle.
initAddr isNil ifTrue:[
- initAddr := self getFunction:('_' , className , '_Init') from:handle.
+ initAddr := self getFunction:('_' , className , '_Init') from:handle.
].
initAddr notNil ifTrue:[
- self callInitFunctionAt:initAddr.
+ self callInitFunctionAt:initAddr.
] ifFalse:[
- "
- look for init-function(s)
- "
- initNames := self namesMatching:'*_Init' segment:'[tT]' in:aFileName.
- initNames do:[:aName |
- initAddr := self getFunction:aName from:handle.
- initAddr isNil ifTrue:[
- (aName startsWith:'_') ifTrue:[
- initAddr := self getFunction:(aName copyFrom:2) from:handle.
- ].
- ].
- initAddr isNil ifTrue:[
- Transcript showCr:('no symbol: ',aName,' in ',aFileName).
- ^ nil
- ].
- Verbose ifTrue:[
- Transcript showCr:'calling init at:' , (initAddr printStringRadix:16)
- ].
- self callInitFunctionAt:initAddr.
- ].
+ "
+ look for init-function(s)
+ "
+ initNames := self namesMatching:'*_Init' segment:'[tT]' in:aFileName.
+ initNames do:[:aName |
+ initAddr := self getFunction:aName from:handle.
+ initAddr isNil ifTrue:[
+ (aName startsWith:'_') ifTrue:[
+ initAddr := self getFunction:(aName copyFrom:2) from:handle.
+ ].
+ ].
+ initAddr isNil ifTrue:[
+ Transcript showCr:('no symbol: ',aName,' in ',aFileName).
+ ^ nil
+ ].
+ Verbose ifTrue:[
+ Transcript showCr:'calling init at:' , (initAddr printStringRadix:16)
+ ].
+ self callInitFunctionAt:initAddr.
+ ].
].
"/ (Symbol hasInterned:className) ifTrue:[
@@ -730,23 +743,23 @@
handle := self openDynamicObject:aFileName.
handle isNil ifTrue:[
- Transcript showCr:('openDynamic: ',aFileName,' failed.').
- ^ nil
+ Transcript showCr:('openDynamic: ',aFileName,' failed.').
+ ^ nil
].
list := self namesMatching:'__GLOBAL_$I*' segment:'[tT]' 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
- "
+ 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*' segment:'[tT]' in:aFileName.
"/ initAddr := self getFunction:'__CTOR_LIST__' from:handle.
@@ -754,44 +767,44 @@
"/ 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.'
- ].
+ 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
+ "
+ cannot create a CPlusPlus class automatically (there could be more than
+ one classes in it too ...)
+ "
+ ^ handle
].
Verbose ifTrue:[
- Transcript showCr:'unknown object file'
+ Transcript showCr:'unknown object file'
].
self closeDynamicObject:aFileName.
^ nil
@@ -805,34 +818,73 @@
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
- ]
- ]
- ]
+ classNames := inits collect:[:symbol |
+ (symbol startsWith:'___') ifTrue:[
+ symbol copyFrom:4 to:(symbol size - 5)
+ ] ifFalse:[
+ (symbol startsWith:'__') ifTrue:[
+ symbol copyFrom:3 to:(symbol size - 5)
+ ] ifFalse:[
+ (symbol startsWith:'_') ifTrue:[
+ symbol copyFrom:2 to:(symbol size - 5)
+ ] ifFalse:[
+ symbol
+ ]
+ ]
+ ]
+ ].
+ "
+ autoload those classes
+ "
+ classNames do:[:aClassName |
+ |cls|
+
+ (cls := Smalltalk classNamed:aClassName) notNil ifTrue:[
+ 'autoloading ' print. aClassName printNL.
+ cls autoload
+ ]
+ ]
].
^ nil
+!
+
+unloadObjectFile:aFileName
+ "unload an object file (.o-file) from the image.
+ DANGER ALERT: currently, you have to make sure that no references to
+ objects of this module exist - in future versions, the system will keep
+ track of these. For now, use at your own risk.
+ (especially critical are blocks-functions)."
+
+ |handle|
+
+ LoadedObjects notNil ifTrue:[
+ handle := LoadedObjects at:aFileName
+ ].
+ handle isNil ifTrue:[
+ self error:'this file was not loaded dynamically'.
+ ^ self
+ ].
+
+ "/call the deInit-function ...
+
+ self closeDynamicObject:aFileName
+!
+
+unloadAllObjectFiles
+ "unload all dynamically loaded object files from the image.
+ see DANGER ALERT in ObjectFileLoader>>unloadObjectFile:"
+
+ |handle|
+
+ LoadedObjects notNil ifTrue:[
+ LoadedObjects keysDo:[:aFileName |
+ self unloadObjectFile:aFileName
+ ]
+ ].
+
+ "
+ ObjectFileLoader unloadAllObjectFiles
+ "
! !
!ObjectFileLoader class methodsFor:'dynamic object access'!
@@ -847,19 +899,28 @@
|handle|
Verbose ifTrue:[
- Transcript showCr:'openDynamic: ' , pathName
+ Transcript showCr:'openDynamic: ' , pathName
].
handle := self primOpenDynamicObject:pathName into:(Array new:2).
handle isNil ifTrue:[
- LastError == #notImplemented ifTrue:[
- Verbose ifTrue:[
- Transcript showCr:'no dynamic load facility or load failed.'.
- ].
- "try it the hard way"
- handle := self loadFile:pathName.
- ]
+ LastError == #notImplemented ifTrue:[
+ Verbose ifTrue:[
+ Transcript showCr:'no dynamic load facility or load failed.'.
+ ].
+ "try it the hard way"
+ handle := self loadFile:pathName.
+ ]
].
+
+ "
+ remember loaded object for later unloading
+ "
+ LoadedObjects isNil ifTrue:[
+ LoadedObjects := Dictionary new.
+ ].
+ LoadedObjects at:pathName put:handle.
+
^ handle
"sys5.4:
@@ -890,22 +951,25 @@
%{ /* UNLIMITEDSTACK */
#ifdef GNU_DL
+# ifndef dld_h
# include "dld.h"
+# define dld_h
+# endif
static firstCall = 1;
extern char *__myName__;
if (firstCall) {
- firstCall = 0;
- (void) dld_init (__myName__);
+ firstCall = 0;
+ (void) dld_init (__myName__);
}
if (__isString(pathName)) {
- if (dld_link(_stringVal(pathName))) {
- dld_perror("cant link");
- ObjectFileLoader_LastError = @symbol(linkError);
- RETURN ( nil );
- }
- RETURN ( pathName );
+ if (dld_link(_stringVal(pathName))) {
+ dld_perror("cant link");
+ ObjectFileLoader_LastError = @symbol(linkError);
+ RETURN ( nil );
+ }
+ RETURN ( pathName );
}
RETURN ( nil );
#endif
@@ -918,60 +982,63 @@
void *handle;
if ((pathName == nil) || __isString(pathName)) {
- if (__isArray(aBuffer)
- && (_arraySize(aBuffer) == 2)) {;
- if (pathName == nil)
- handle = dlopen((char *)0, RTLD_NOW);
- else
- handle = dlopen(_stringVal(pathName), RTLD_NOW);
+ if (__isArray(aBuffer)
+ && (_arraySize(aBuffer) == 2)) {;
+ if (pathName == nil)
+ handle = dlopen((char *)0, RTLD_NOW);
+ else
+ handle = dlopen(_stringVal(pathName), RTLD_NOW);
- if (! handle) {
- fprintf(stderr, "dlopen %s error: <%s>\n",
- _stringVal(pathName), dlerror());
- ObjectFileLoader_LastError = @symbol(linkError);
- RETURN (nil);
- }
+ if (! handle) {
+ fprintf(stderr, "dlopen %s error: <%s>\n",
+ _stringVal(pathName), dlerror());
+ ObjectFileLoader_LastError = @symbol(linkError);
+ RETURN (nil);
+ }
- if (ObjectFileLoader_Verbose == true)
- printf("open %s handle = %x\n", _stringVal(pathName), handle);
+ if (ObjectFileLoader_Verbose == true)
+ printf("open %s handle = %x\n", _stringVal(pathName), handle);
- _ArrayInstPtr(aBuffer)->a_element[0] =
- _MKSMALLINT( (int)handle & 0xFFFF );
- _ArrayInstPtr(aBuffer)->a_element[1] =
- _MKSMALLINT( ((int)handle >> 16) & 0xFFFF );
- RETURN (aBuffer);
- }
+ _ArrayInstPtr(aBuffer)->a_element[0] =
+ _MKSMALLINT( (int)handle & 0xFFFF );
+ _ArrayInstPtr(aBuffer)->a_element[1] =
+ _MKSMALLINT( ((int)handle >> 16) & 0xFFFF );
+ RETURN (aBuffer);
+ }
}
#endif
#ifdef SUN_DL
-# include <dlfcn.h>
+# ifndef dlfcn_h
+# include <dlfcn.h>
+# define dlfcn_h
+# endif
void *handle;
if ((pathName == nil) || __isString(pathName)) {
- if (__isArray(aBuffer)
- && (_arraySize(aBuffer) == 2)) {;
- if (pathName == nil)
- handle = dlopen((char *)0, 1);
- else
- handle = dlopen(_stringVal(pathName), 1);
+ if (__isArray(aBuffer)
+ && (_arraySize(aBuffer) == 2)) {;
+ if (pathName == nil)
+ handle = dlopen((char *)0, 1);
+ else
+ handle = dlopen(_stringVal(pathName), 1);
- if (! handle) {
- fprintf(stderr, "dlopen %s error: <%s>\n",
- _stringVal(pathName), dlerror());
- ObjectFileLoader_LastError = @symbol(linkError);
- RETURN (nil);
- }
+ if (! handle) {
+ fprintf(stderr, "dlopen %s error: <%s>\n",
+ _stringVal(pathName), dlerror());
+ ObjectFileLoader_LastError = @symbol(linkError);
+ RETURN (nil);
+ }
- if (ObjectFileLoader_Verbose == true)
- printf("open %s handle = %x\n", _stringVal(pathName), handle);
+ if (ObjectFileLoader_Verbose == true)
+ printf("open %s handle = %x\n", _stringVal(pathName), handle);
- _ArrayInstPtr(aBuffer)->a_element[0] =
- _MKSMALLINT( (int)handle & 0xFFFF );
- _ArrayInstPtr(aBuffer)->a_element[1] =
- _MKSMALLINT( ((int)handle >> 16) & 0xFFFF );
- RETURN (aBuffer);
- }
+ _ArrayInstPtr(aBuffer)->a_element[0] =
+ _MKSMALLINT( (int)handle & 0xFFFF );
+ _ArrayInstPtr(aBuffer)->a_element[1] =
+ _MKSMALLINT( ((int)handle >> 16) & 0xFFFF );
+ RETURN (aBuffer);
+ }
}
#endif
@@ -981,24 +1048,24 @@
NXStream *errOut;
if (__isString(pathName)) {
- files[0] = (char *) _stringVal(pathName);
- files[1] = (char *) 0;
- errOut = NXOpenFile(2, 2);
- result = rld_load(errOut,
- (struct mach_header **)0,
- files,
- (char *)0);
- NXClose(errOut);
- if (! result) {
- ObjectFileLoader_LastError = @symbol(linkError);
- fprintf(stderr, "rld_load %s failed\n", _stringVal(pathName));
- RETURN (nil);
- }
+ files[0] = (char *) _stringVal(pathName);
+ files[1] = (char *) 0;
+ errOut = NXOpenFile(2, 2);
+ result = rld_load(errOut,
+ (struct mach_header **)0,
+ files,
+ (char *)0);
+ NXClose(errOut);
+ if (! result) {
+ ObjectFileLoader_LastError = @symbol(linkError);
+ fprintf(stderr, "rld_load %s failed\n", _stringVal(pathName));
+ RETURN (nil);
+ }
- if (ObjectFileLoader_Verbose == true)
- printf("rld_load %s ok\n", _stringVal(pathName));
+ if (ObjectFileLoader_Verbose == true)
+ printf("rld_load %s ok\n", _stringVal(pathName));
- RETURN (pathName);
+ RETURN (pathName);
}
#endif
%}.
@@ -1007,22 +1074,47 @@
!
closeDynamicObject:handle
+ "close an object-file (unmap from my address space)
+ and remove the entry from the remembered object file set."
+
+ |key|
+
+ (self primCloseDynamicObject:handle) ifTrue:[
+ "
+ remove from loaded objects
+ "
+ LoadedObjects notNil ifTrue:[
+ key := LoadedObjects keyAtValue:handle.
+ key notNil ifTrue:[
+ LoadedObjects removeKey:key
+ ]
+ ]
+ ] ifFalse:[
+ self error:'closeDynamic failed'
+ ]
+!
+
+primCloseDynamicObject:handle
"close an object-file (unmap from my address space)."
|low hi|
+
%{
#ifdef GNU_DL
+# ifndef dld_h
# include "dld.h"
+# define dld_h
+# endif
if (__isString(handle)) {
- if (dld_unlink_by_file(_stringVal(handle), 1)) {
- dld_perror("cant unlink");
- }
- RETURN ( self );
+ if (dld_unlink_by_file(_stringVal(handle), 1)) {
+ dld_perror("cant unlink");
+ RETURN (false);
+ }
+ RETURN (true);
}
- RETURN (self);
+ RETURN (false);
#endif
%}.
-
low := handle at:1.
hi := handle at:2.
%{
@@ -1035,28 +1127,37 @@
int val;
if (_isSmallInteger(low) && _isSmallInteger(hi)) {
- val = (_intVal(hi) << 16) + _intVal(low);
- h = (void *)(val);
- if (ObjectFileLoader_Verbose == true)
- printf("close handle = %x\n", h);
- dlclose(h);
+ val = (_intVal(hi) << 16) + _intVal(low);
+ h = (void *)(val);
+ if (ObjectFileLoader_Verbose == true)
+ printf("close handle = %x\n", h);
+ if (dlclose(h) != 0) {
+ fprintf(stderr, "dlclose failed with:<%s>\n", dlerror());
+ RETURN (false);
+ }
+ RETURN (true);
}
#endif
#ifdef SUN_DL
-# include <dlfcn.h>
+# ifndef dlfcn_h
+# include <dlfcn.h>
+# define dlfcn_h
+# endif
void *h;
int val;
if (_isSmallInteger(low) && _isSmallInteger(hi)) {
- val = (_intVal(hi) << 16) + _intVal(low);
- h = (void *)(val);
- if (ObjectFileLoader_Verbose == true)
- printf("close handle = %x\n", h);
- dlclose(h);
+ val = (_intVal(hi) << 16) + _intVal(low);
+ h = (void *)(val);
+ if (ObjectFileLoader_Verbose == true)
+ printf("close handle = %x\n", h);
+ dlclose(h);
+ RETURN (true);
}
#endif
-%}
+%}.
+ ^ false
!
isSmalltalkObject:handle
@@ -1088,35 +1189,35 @@
l := OrderedCollection new.
p := PipeStream readingFrom:(self nm:aFileName).
p isNil ifTrue:[
- ('cannot read names from ' , aFileName) errorPrintNL.
- ^ nil
+ ('cannot read names from ' , aFileName) errorPrintNL.
+ ^ nil
].
[p atEnd] whileFalse:[
- entry := p nextLine.
- Verbose ifTrue:[
- entry printNL.
- ].
- entry notNil ifTrue:[
- 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:[
- (segmentPattern isNil or:[segmentPattern match:segment]) ifTrue:[
- l add:name.
- Verbose ifTrue:[
- 'found name: ' print. name printNL.
- ]
- ] ifFalse:[
- Verbose ifTrue:[
- name print. ' segment mismatch ' print.
- segmentPattern print. ' ' print. segment printNL.
- ]
- ]
- ]
- ]
- ]
+ entry := p nextLine.
+ Verbose ifTrue:[
+ entry printNL.
+ ].
+ entry notNil ifTrue:[
+ 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:[
+ (segmentPattern isNil or:[segmentPattern match:segment]) ifTrue:[
+ l add:name.
+ Verbose ifTrue:[
+ 'found name: ' print. name printNL.
+ ]
+ ] ifFalse:[
+ Verbose ifTrue:[
+ name print. ' segment mismatch ' print.
+ segmentPattern print. ' ' print. segment printNL.
+ ]
+ ]
+ ]
+ ]
+ ]
].
p close.
^ l
@@ -1146,44 +1247,48 @@
%{ /* STACK: 20000 */
#ifdef GNU_DL
+# ifndef dld_h
# include "dld.h"
+# define dld_h
+# endif
+
void (*func)();
unsigned long addr;
char *name;
if (__isString(aString)) {
- name = (char *) _stringVal(aString);
- if (isFunction == false) {
- addr = dld_get_symbol(name);
- } else {
- func = (void (*) ()) dld_get_func(name);
- if (func) {
- if (ObjectFileLoader_Verbose == true)
- printf("addr of %s = %x\n", name, (INT)func);
- if (dld_function_executable_p(name)) {
- lowAddr = _MKSMALLINT( (INT)func & 0xFFFF );
- hiAddr = _MKSMALLINT( ((INT)func >> 16) & 0xFFFF );
- } else {
- char **undefNames;
- char **nm;
- int i;
+ name = (char *) _stringVal(aString);
+ if (isFunction == false) {
+ addr = dld_get_symbol(name);
+ } else {
+ func = (void (*) ()) dld_get_func(name);
+ if (func) {
+ if (ObjectFileLoader_Verbose == true)
+ printf("addr of %s = %x\n", name, (INT)func);
+ if (dld_function_executable_p(name)) {
+ lowAddr = _MKSMALLINT( (INT)func & 0xFFFF );
+ hiAddr = _MKSMALLINT( ((INT)func >> 16) & 0xFFFF );
+ } else {
+ char **undefNames;
+ char **nm;
+ int i;
- if (ObjectFileLoader_Verbose == true) {
- printf ("function %s not executable\n", name);
- dld_perror("not executable");
+ 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");
- }
- }
+ 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
%}.
@@ -1201,22 +1306,22 @@
int val;
if (_isSmallInteger(low) && _isSmallInteger(hi)) {
- val = (_intVal(hi) << 16) + _intVal(low);
- h = (void *)(val);
- if (__isString(aString)) {
- if (ObjectFileLoader_Verbose == true)
- printf("get sym <%s> handle = %x\n", _stringVal(aString), h);
- addr = dlsym(h, (char *) _stringVal(aString));
- if (addr) {
- if (ObjectFileLoader_Verbose == true)
- printf("addr = %x\n", addr);
- lowAddr = _MKSMALLINT( (int)addr & 0xFFFF );
- hiAddr = _MKSMALLINT( ((int)addr >> 16) & 0xFFFF );
- } else {
- if (ObjectFileLoader_Verbose == true)
- printf("dlsym %s error: <%s>\n", _stringVal(aString), dlerror());
- }
- }
+ val = (_intVal(hi) << 16) + _intVal(low);
+ h = (void *)(val);
+ if (__isString(aString)) {
+ if (ObjectFileLoader_Verbose == true)
+ printf("get sym <%s> handle = %x\n", _stringVal(aString), h);
+ addr = dlsym(h, (char *) _stringVal(aString));
+ if (addr) {
+ if (ObjectFileLoader_Verbose == true)
+ printf("addr = %x\n", addr);
+ lowAddr = _MKSMALLINT( (int)addr & 0xFFFF );
+ hiAddr = _MKSMALLINT( ((int)addr >> 16) & 0xFFFF );
+ } else {
+ if (ObjectFileLoader_Verbose == true)
+ printf("dlsym %s error: <%s>\n", _stringVal(aString), dlerror());
+ }
+ }
}
#endif
@@ -1227,22 +1332,22 @@
int val;
if (_isSmallInteger(low) && _isSmallInteger(hi)) {
- val = (_intVal(hi) << 16) + _intVal(low);
- h = (void *)(val);
- if (__isString(aString)) {
- if (ObjectFileLoader_Verbose == true)
- printf("get sym <%s> handle = %x\n", _stringVal(aString), h);
- addr = dlsym(h, _stringVal(aString));
- if (addr) {
- if (ObjectFileLoader_Verbose == true)
- printf("addr = %x\n", addr);
- lowAddr = _MKSMALLINT( (int)addr & 0xFFFF );
- hiAddr = _MKSMALLINT( ((int)addr >> 16) & 0xFFFF );
- } else {
- if (ObjectFileLoader_Verbose == true)
- printf("dlsym %s error: <%s>\n", _stringVal(aString), dlerror());
- }
- }
+ val = (_intVal(hi) << 16) + _intVal(low);
+ h = (void *)(val);
+ if (__isString(aString)) {
+ if (ObjectFileLoader_Verbose == true)
+ printf("get sym <%s> handle = %x\n", _stringVal(aString), h);
+ addr = dlsym(h, _stringVal(aString));
+ if (addr) {
+ if (ObjectFileLoader_Verbose == true)
+ printf("addr = %x\n", addr);
+ lowAddr = _MKSMALLINT( (int)addr & 0xFFFF );
+ hiAddr = _MKSMALLINT( ((int)addr >> 16) & 0xFFFF );
+ } else {
+ if (ObjectFileLoader_Verbose == true)
+ printf("dlsym %s error: <%s>\n", _stringVal(aString), dlerror());
+ }
+ }
}
#endif
@@ -1252,25 +1357,25 @@
NXStream *errOut;
if (__isString(aString)) {
- if (ObjectFileLoader_Verbose == true)
- printf("get sym <%s>\n", _stringVal(aString));
- errOut = NXOpenFile(2, 2);
- result = rld_lookup(errOut,
- (char *) _stringVal(aString),
- &addr);
- NXClose(errOut);
- if (result) {
- if (ObjectFileLoader_Verbose == true)
- printf("addr = %x\n", addr);
- lowAddr = _MKSMALLINT( (int)addr & 0xFFFF );
- hiAddr = _MKSMALLINT( ((int)addr >> 16) & 0xFFFF );
- }
+ if (ObjectFileLoader_Verbose == true)
+ printf("get sym <%s>\n", _stringVal(aString));
+ errOut = NXOpenFile(2, 2);
+ result = rld_lookup(errOut,
+ (char *) _stringVal(aString),
+ &addr);
+ NXClose(errOut);
+ if (result) {
+ if (ObjectFileLoader_Verbose == true)
+ printf("addr = %x\n", addr);
+ lowAddr = _MKSMALLINT( (int)addr & 0xFFFF );
+ hiAddr = _MKSMALLINT( ((int)addr >> 16) & 0xFFFF );
+ }
}
#endif
%}
.
lowAddr notNil ifTrue:[
- ^ (hiAddr * 16r10000) + lowAddr
+ ^ (hiAddr * 16r10000) + lowAddr
].
^ nil
!
@@ -1285,26 +1390,29 @@
%{
#ifdef GNU_DL
+# ifndef dld_h
# include "dld.h"
+# define dld_h
+# endif
void (*func)();
unsigned long addr;
char *name;
int nMax;
if (__isArray(list)) {
- char **undefNames;
- char **nm;
- int index;
+ char **undefNames;
+ char **nm;
+ int index;
- nMax = _arraySize(list);
+ 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);
+ 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
@@ -1349,9 +1457,9 @@
callInitFunctionAt:initAddr
"
need 4 passes to init: 0: create my pools
- 1: get var-refs to other pools
- 2: install class, methods and literals
- 3: send #initialize to class
+ 1: get var-refs to other pools
+ 2: install class, methods and literals
+ 3: send #initialize to class
"
self callFunctionAt:initAddr forceOld:true arg:0.
self callFunctionAt:initAddr forceOld:true arg:1.
@@ -1380,27 +1488,27 @@
int arg = 0;
if (_isSmallInteger(low) && _isSmallInteger(hi)) {
- val = (_intVal(hi) << 16) + _intVal(low);
- addr = (VOIDFUNC) val;
+ val = (_intVal(hi) << 16) + _intVal(low);
+ addr = (VOIDFUNC) val;
- if (_isSmallInteger(argument)) {
- arg = _intVal(argument);
- }
- /*
- * allow function to be interrupted
- */
- savInt = _immediateInterrupt;
- _immediateInterrupt = 1;
+ if (_isSmallInteger(argument)) {
+ arg = _intVal(argument);
+ }
+ /*
+ * allow function to be interrupted
+ */
+ savInt = _immediateInterrupt;
+ _immediateInterrupt = 1;
- if (forceOld == true) {
- prevSpace = __allocForceSpace(OLDSPACE);
- (*addr)(arg COMMA_CON);
- __allocForceSpace(prevSpace);
- } else {
- (*addr)(arg COMMA_CON);
- }
+ if (forceOld == true) {
+ prevSpace = __allocForceSpace(OLDSPACE);
+ (*addr)(arg COMMA_CON);
+ __allocForceSpace(prevSpace);
+ } else {
+ (*addr)(arg COMMA_CON);
+ }
- _immediateInterrupt = savInt;
+ _immediateInterrupt = savInt;
}
%}
! !
@@ -1422,7 +1530,7 @@
int fd;
if (! __isString(aFileName)) {
- RETURN (nil);
+ RETURN (nil);
}
fname = (char *) _stringVal(aFileName);
@@ -1430,26 +1538,26 @@
# if defined(A_DOT_OUT) && !defined(ELF)
# if !defined(sco) && !defined(isc)
{
- struct exec header;
+ 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 ((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) );
+ 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
@@ -1476,7 +1584,7 @@
int fd;
if (! __isString(aFileName)) {
- RETURN ( nil );
+ RETURN ( nil );
}
fname = (char *) _stringVal(aFileName);
@@ -1484,31 +1592,31 @@
# if defined(A_DOT_OUT) && !defined(ELF)
# if !defined(sco) && !defined(isc)
{
- struct exec header;
- unsigned size;
+ 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 ((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 (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;
+ size += header.a_bss;
# endif
- RETURN ( _MKSMALLINT(size) );
+ RETURN ( _MKSMALLINT(size) );
}
# endif
# endif
@@ -1522,7 +1630,7 @@
!
loadObjectFile:aFileName textAddr:textAddr textSize:textSize
- dataAddr:dataAddr dataSize:dataSize
+ dataAddr:dataAddr dataSize:dataSize
"the object in aFileName must have been linked for
absolute address textAddr/dataAddr (using ld -A).
@@ -1536,127 +1644,127 @@
*/
#else /* no DL-support */
if (! __isString(aFileName)) {
- RETURN ( nil );
+ 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;
+ 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;
+ 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 );
- }
+ 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.
- */
+ /*
+ * 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;
+ 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;
+ 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;
+ toffset = N_TXTOFF(header);
+ doffset = N_DATOFF(header);
+ daddr = taddr + tsize;
# else
- fprintf(stderr, "dont know text/data offsets in objectfile\n");
- RETURN ( nil );
+ 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);
+ 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 );
- }
+ 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);
+ 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 (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 );
- }
+ if (read(fd, daddr, dsize) != dsize) {
+ fprintf(stderr, "cannot read data\n");
+ close(fd);
+ RETURN ( nil );
+ }
# ifdef SUPERDEBUG
- {
- char *ptr;
- int i;
+ {
+ 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);
- }
+ 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);
+ }
+ 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;
- }
+ 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 );