--- a/ObjectFileLoader.st Mon Jul 15 14:02:07 2002 +0200
+++ b/ObjectFileLoader.st Mon Jul 22 21:04:05 2002 +0200
@@ -327,102 +327,102 @@
|systemType libDir|
OperatingSystem isMSDOSlike ifTrue:[
- "/ default setup for msc
- OperatingSystem getCCDefine ='__BORLANDC__' ifTrue:[
- libDir := '..\libbc'.
- libDir asFilename exists ifFalse:[
- libDir := '..\lib\libbc'.
- libDir asFilename exists ifFalse:[
- libDir := '..\lib'.
- ]
- ].
-
- LinkCommand isNil ifTrue:[
- LinkCommand := 'tlink32'.
- LinkCommand := 'ilink32'.
- ].
- LinkArgs isNil ifTrue:[
- LinkArgs := '-L',libDir,' -L\Programme\Borland\CBuilder3\lib -c -ap -Tpd -s -Gi -v -w-dup ',libDir,'\librun.lib'.
- LinkArgs := '-L',libDir,' -L\Programme\Borland\CBuilder3\lib -r -c -ap -Tpd -Gi -w-dup'.
- ].
- SearchedLibraries := #(
- 'import32.lib'
- ).
- ] ifFalse:[
- LinkCommand isNil ifTrue:[
- LinkCommand := 'link'
- ].
- LinkArgs isNil ifTrue:[
- LinkArgs := '/NOPACK /NOLOGO /DEBUG /MACHINE:I386 /DLL /OUT:%1.dll /DEF:%1.def'
- ].
- ].
+ "/ default setup for msc
+ OperatingSystem getCCDefine ='__BORLANDC__' ifTrue:[
+ libDir := '..\libbc'.
+ libDir asFilename exists ifFalse:[
+ libDir := '..\lib\libbc'.
+ libDir asFilename exists ifFalse:[
+ libDir := '..\lib'.
+ ]
+ ].
+
+ LinkCommand isNil ifTrue:[
+ LinkCommand := 'tlink32'.
+ LinkCommand := 'ilink32'.
+ ].
+ LinkArgs isNil ifTrue:[
+ LinkArgs := '-L',libDir,' -L\Programme\Borland\CBuilder3\lib -c -ap -Tpd -s -Gi -v -w-dup ',libDir,'\librun.lib'.
+ LinkArgs := '-L',libDir,' -L\Programme\Borland\CBuilder3\lib -r -c -ap -Tpd -Gi -w-dup'.
+ ].
+ SearchedLibraries := #(
+ 'import32.lib'
+ ).
+ ] ifFalse:[
+ LinkCommand isNil ifTrue:[
+ LinkCommand := 'link'
+ ].
+ LinkArgs isNil ifTrue:[
+ LinkArgs := '/NOPACK /NOLOGO /DEBUG /MACHINE:I386 /DLL /OUT:%1.dll /DEF:%1.def'
+ ].
+ ].
].
MySymbolTable isNil ifTrue:[
- Verbose := false.
- NextHandleID := 1.
- ObjectMemory addDependent:self.
-
- OperatingSystem isMSDOSlike ifTrue:[
- SearchedLibraries := #(
- 'import32.lib'
- ).
- ].
-
- OperatingSystem isUNIXlike ifTrue:[
- systemType := OperatingSystem getOSType.
-
- "/ name of object file, where initial symbol table is found
- "/ not req'd for all architectures.
-
- MySymbolTable := 'stx'.
-
- "/ default set of libraries to be considered when
- "/ unresolved symbols are encountered during the load.
- "/ Only req'd for linux and sunos non-ELF systems.
- "/ Can (should) be set in the smalltalk.rc file.
-
- SearchedLibraries := #().
-
- (systemType = 'linux'
- or:[systemType = 'sunos']) ifTrue:[
- '/usr/lib/libc.a' asFilename isReadable ifTrue:[
- SearchedLibraries := #('/usr/lib/libc.a')
- ] ifFalse:[
- '/lib/libc.a' asFilename isReadable ifTrue:[
- SearchedLibraries := #('/lib/libc.a')
- ]
- ]
- ].
-
- "/ default libraryPath where shared objects are searched for
- "/ when a dynamic library is loaded without an explicit path.
-
- LoadLibraryPath := OperatingSystem getEnvironment:'LD_LIBRARY_PATH'.
- LoadLibraryPath isNil ifTrue:[
- LoadLibraryPath := #('.'
- 'lib'
- '/usr/local/smalltalk/lib'
- '/usr/local/lib'
- '/usr/lib'
- '/lib'
- ) asOrderedCollection.
- ].
-
- "/ default libraryPath where shared objects are expected
- "/ when a sharedObject load requires other objects to be loaded.
- "/ Only req'd for aix.
- "/ For more compatibility with ELF systems, look for a shell variable
- "/ named LD_LIBRARY_PATH, and - if present - take that instead if a default.
- "/ Can (should) be set in the smalltalk.rc file.
-
- systemType = 'aix' ifTrue:[
- LibPath := OperatingSystem getEnvironment:'LD_LIBRARY_PATH'.
- LibPath isNil ifTrue:[
- LibPath := '.:/usr/local/smalltalk/lib:/usr/local/lib:/usr/lib:/lib'.
- ]
- ].
- ]
+ Verbose := false.
+ NextHandleID := 1.
+ ObjectMemory addDependent:self.
+
+ OperatingSystem isMSDOSlike ifTrue:[
+ SearchedLibraries := #(
+ 'import32.lib'
+ ).
+ ].
+
+ OperatingSystem isUNIXlike ifTrue:[
+ systemType := OperatingSystem getOSType.
+
+ "/ name of object file, where initial symbol table is found
+ "/ not req'd for all architectures.
+
+ MySymbolTable := 'stx'.
+
+ "/ default set of libraries to be considered when
+ "/ unresolved symbols are encountered during the load.
+ "/ Only req'd for linux and sunos non-ELF systems.
+ "/ Can (should) be set in the smalltalk.rc file.
+
+ SearchedLibraries := #().
+
+ (systemType = 'linux'
+ or:[systemType = 'sunos']) ifTrue:[
+ '/usr/lib/libc.a' asFilename isReadable ifTrue:[
+ SearchedLibraries := #('/usr/lib/libc.a')
+ ] ifFalse:[
+ '/lib/libc.a' asFilename isReadable ifTrue:[
+ SearchedLibraries := #('/lib/libc.a')
+ ]
+ ]
+ ].
+
+ "/ default libraryPath where shared objects are searched for
+ "/ when a dynamic library is loaded without an explicit path.
+
+ LoadLibraryPath := OperatingSystem getEnvironment:'LD_LIBRARY_PATH'.
+ LoadLibraryPath isNil ifTrue:[
+ LoadLibraryPath := #('.'
+ 'lib'
+ '/usr/local/smalltalk/lib'
+ '/usr/local/lib'
+ '/usr/lib'
+ '/lib'
+ ) asOrderedCollection.
+ ].
+
+ "/ default libraryPath where shared objects are expected
+ "/ when a sharedObject load requires other objects to be loaded.
+ "/ Only req'd for aix.
+ "/ For more compatibility with ELF systems, look for a shell variable
+ "/ named LD_LIBRARY_PATH, and - if present - take that instead if a default.
+ "/ Can (should) be set in the smalltalk.rc file.
+
+ systemType = 'aix' ifTrue:[
+ LibPath := OperatingSystem getEnvironment:'LD_LIBRARY_PATH'.
+ LibPath isNil ifTrue:[
+ LibPath := '.:/usr/local/smalltalk/lib:/usr/local/lib:/usr/lib:/lib'.
+ ]
+ ].
+ ]
]
"
@@ -710,31 +710,25 @@
|os|
OperatingSystem isMSDOSlike ifTrue:[
- "/ includes all of win32s, win95, winNT & os/2
- ^ 'dll'
+ "/ includes all of win32s, win95, winNT & os/2
+ ^ 'dll'
].
OperatingSystem isVMSlike ifTrue:[
- ^ 'exe'
+ ^ 'exe'
].
os := OperatingSystem getSystemType.
- (os = 'sys5_4') ifTrue:[^ 'so'].
- (os = 'iris') ifTrue:[^ 'so'].
(os = 'linux') ifTrue:[
- self loadableBinaryObjectFormat == #aout ifTrue:[
- "/ not really shared, but loadable
- ^ 'o'
- ].
- ^ 'so'
+ self loadableBinaryObjectFormat == #aout ifTrue:[
+ "/ not really shared, but loadable
+ ^ 'o'
+ ].
].
- (os = 'solaris') ifTrue:[^ 'so' ].
- (os = 'osf') ifTrue:[^ 'so' ].
- (os = 'aix') ifTrue:[^ 'so'].
(os = 'hpux') ifTrue:[^ 'sl'].
"/ mhmh what is a useful default ?
- ^ 'o'
+ ^ 'so'
"
ObjectFileLoader sharedLibrarySuffix
@@ -758,10 +752,6 @@
].
os := OperatingSystem getSystemType.
- (os = 'sys5_4') ifTrue:[^ #('so') ].
- (os = 'iris') ifTrue:[^ #('so') ].
- (os = 'osf') ifTrue:[^ #('so') ].
- (os = 'solaris') ifTrue:[^ #('so') ].
(os = 'sunos') ifTrue:[^ #('o' 'obj' 'a') ].
(os = 'ultrix') ifTrue:[^ #('o' 'obj' 'ld' 'obj.ld') ].
(os = 'linux') ifTrue:[
@@ -770,12 +760,12 @@
].
^ #('so' 'o' 'obj' )
].
- (os = 'aix') ifTrue:[^ #('o' 'so') ].
- (os = 'hpux') ifTrue:[^ #(" 'o' " 'sl') ].
+ (os = 'aix') ifTrue:[^ #('so' 'o') ].
+ (os = 'hpux') ifTrue:[^ #('sl') ].
"/ mhmh what is a useful default ?
- ^ #('o')
+ ^ #('so')
"
ObjectFileLoader validBinaryExtensions
@@ -795,28 +785,28 @@
handle := self loadDynamicObject:aFileName.
handle isNil ifTrue:[
- Transcript showCR:('failed to load: ' , aFileName).
- ('ObjectFileLoader [warning]: '
- , aFileName
- , ' failed. ('
- , LinkErrorMessage
- , ')') errorPrintCR.
- ^ nil
+ Transcript showCR:('failed to load: ' , aFileName).
+ ('ObjectFileLoader [warning]: '
+ , aFileName
+ , ' failed. ('
+ , LinkErrorMessage
+ , ')') errorPrintCR.
+ ^ nil
].
list := self namesMatching:'__GLOBAL_$I*' segment:'[tT?]' in:aFileName.
list size == 1 ifTrue:[
"/ (self isCPlusPlusObject:handle) ifTrue:[
- Verbose ifTrue:[
- 'a c++ object file' infoPrintCR.
- ].
- "
- 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:[
+ 'a c++ object file' infoPrintCR.
+ ].
+ "
+ 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.
@@ -824,51 +814,51 @@
"/ ('calling CTORs at:' , (initAddr printStringRadix:16)) infoPrintCR
"/ ].
- 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:[
- ('no CTOR-func found (' , list first , ')') infoPrintCR.
- ].
- self unloadDynamicObject:aFileName.
- ^ nil
- ].
- Verbose ifTrue:[
- ('calling CTORs at:' , (initAddr printStringRadix:16)) infoPrintCR
- ].
- self callInitFunctionAt:initAddr
- specialInit:false
- forceOld:false
- interruptable:false
- argument:0
- identifyAs:nil
- returnsObject:false.
-
- Verbose ifTrue:[
- 'done with CTORs.' infoPrintCR
- ].
-
- "
- cannot create a CPlusPlus class automatically (there could be more than
- one classes in it too ...)
- "
- ^ handle
+ 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:[
+ ('no CTOR-func found (' , list first , ')') infoPrintCR.
+ ].
+ self unloadDynamicObject:aFileName.
+ ^ nil
+ ].
+ Verbose ifTrue:[
+ ('calling CTORs at:' , (initAddr printStringRadix:16)) infoPrintCR
+ ].
+ self callInitFunctionAt:initAddr
+ specialInit:false
+ forceOld:false
+ interruptable:false
+ argument:0
+ identifyAs:nil
+ returnsObject:false.
+
+ Verbose ifTrue:[
+ 'done with CTORs.' infoPrintCR
+ ].
+
+ "
+ cannot create a CPlusPlus class automatically (there could be more than
+ one classes in it too ...)
+ "
+ ^ handle
].
Verbose ifTrue:[
- 'unknown object file' infoPrintCR
+ 'unknown object file' infoPrintCR
].
self unloadDynamicObject:aFileName.
^ nil
@@ -885,13 +875,13 @@
handle := self loadDynamicObject:aFileName.
handle isNil ifTrue:[
- Transcript showCR:('failed to load: ' , aFileName).
- ('ObjectFileLoader [warning]: '
- , aFileName
- , ' failed. ('
- , LinkErrorMessage
- , ')') errorPrintCR.
- ^ nil
+ Transcript showCR:('failed to load: ' , aFileName).
+ ('ObjectFileLoader [warning]: '
+ , aFileName
+ , ' failed. ('
+ , LinkErrorMessage
+ , ')') errorPrintCR.
+ ^ nil
].
"
@@ -900,9 +890,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.
].
knownToBeOk := true.
@@ -936,92 +926,92 @@
"/ ].
initAddr notNil ifTrue:[
- Verbose ifTrue:[
- ('calling init at: ' , (initAddr printStringRadix:16)) infoPrintCR.
- ].
- info := self performModuleInitAt:initAddr for:aClassName identifyAs:handle.
- status := info at:1.
- "
- if any classes are missing ...
- "
- (status == #missingClass) ifTrue:[
- "
- ... and we are loading a module ...
- "
- Transcript showCR:'try for missing class in same object ...'.
- Verbose ifTrue:[
- 'try for missing class:' infoPrint. (info at:2) infoPrintCR.
- ].
- otherClass := self loadClass:(info at:2) fromObjectFile:aFileName.
- otherClass notNil ifTrue:[
- "
- try again ...
- "
- Transcript showCR:'missing class is here; try again ...'.
- info := self performModuleInitAt:initAddr for:aClassName identifyAs:handle.
- status := info at:1.
- ]
- ].
-
- Verbose ifTrue:[
- 'done init status=' infoPrint. info infoPrintCR.
- ].
- (status == #unregisteredSuperclass) ifTrue:[
- Transcript showCR:'superclass is not registered'.
- ].
-
- (Symbol hasInterned:aClassName) ifTrue:[
- newClass := Smalltalk at:aClassName asSymbol ifAbsent:[nil].
- Verbose ifTrue:[
- 'newClass is: ' infoPrint. newClass infoPrintCR
- ].
- newClass notNil ifTrue:[
- Smalltalk at:aClassName asSymbol put:newClass.
-
- (newClass includesSelector:#initialize) ifTrue:[
- Verbose ifTrue:[
- 'initialize newClass ...' infoPrintCR
- ].
- newClass initialize.
- ].
- "force cache flush"
- Smalltalk isInitialized ifTrue:[
- Smalltalk changed.
- ]
- ].
- ] ifFalse:[
- 'ObjectFileLoader [warning]: class ' errorPrint. aClassName errorPrint.
- ' did not define itself' errorPrintCR
- "
- do not unload - could have installed other classes/methods ...
- "
- ].
- Smalltalk flushCachedClasses.
- ^ newClass
+ Verbose ifTrue:[
+ ('calling init at: ' , (initAddr printStringRadix:16)) infoPrintCR.
+ ].
+ info := self performModuleInitAt:initAddr for:aClassName identifyAs:handle.
+ status := info at:1.
+ "
+ if any classes are missing ...
+ "
+ (status == #missingClass) ifTrue:[
+ "
+ ... and we are loading a module ...
+ "
+ Transcript showCR:'try for missing class in same object ...'.
+ Verbose ifTrue:[
+ 'try for missing class:' infoPrint. (info at:2) infoPrintCR.
+ ].
+ otherClass := self loadClass:(info at:2) fromObjectFile:aFileName.
+ otherClass notNil ifTrue:[
+ "
+ try again ...
+ "
+ Transcript showCR:'missing class is here; try again ...'.
+ info := self performModuleInitAt:initAddr for:aClassName identifyAs:handle.
+ status := info at:1.
+ ]
+ ].
+
+ Verbose ifTrue:[
+ 'done init status=' infoPrint. info infoPrintCR.
+ ].
+ (status == #unregisteredSuperclass) ifTrue:[
+ Transcript showCR:'superclass is not registered'.
+ ].
+
+ (Symbol hasInterned:aClassName) ifTrue:[
+ newClass := Smalltalk at:aClassName asSymbol ifAbsent:[nil].
+ Verbose ifTrue:[
+ 'newClass is: ' infoPrint. newClass infoPrintCR
+ ].
+ newClass notNil ifTrue:[
+ Smalltalk at:aClassName asSymbol put:newClass.
+
+ (newClass includesSelector:#initialize) ifTrue:[
+ Verbose ifTrue:[
+ 'initialize newClass ...' infoPrintCR
+ ].
+ newClass initialize.
+ ].
+ "force cache flush"
+ Smalltalk isInitialized ifTrue:[
+ Smalltalk changed.
+ ]
+ ].
+ ] ifFalse:[
+ 'ObjectFileLoader [warning]: class ' errorPrint. aClassName errorPrint.
+ ' did not define itself' errorPrintCR
+ "
+ do not unload - could have installed other classes/methods ...
+ "
+ ].
+ Smalltalk flushCachedClasses.
+ ^ newClass
].
Verbose ifTrue:[
- ('no symbol: ', symName,' in ',aFileName) infoPrintCR.
+ ('no symbol: ', symName,' in ',aFileName) infoPrintCR.
].
"
unload
"
Verbose ifTrue:[
- 'unloading due to init failure:' infoPrint. handle pathName infoPrintCR.
+ 'unloading due to init failure:' infoPrint. handle pathName infoPrintCR.
].
moreHandles notNil ifTrue:[
- moreHandles do:[:aHandle |
- Verbose ifTrue:[
- ('unloading: ', aHandle printString) infoPrintCR.
- ].
- self unloadDynamicObject:handle.
- ]
+ moreHandles do:[:aHandle |
+ Verbose ifTrue:[
+ ('unloading: ', aHandle printString) infoPrintCR.
+ ].
+ self unloadDynamicObject:handle.
+ ]
].
Verbose ifTrue:[
- ('unloading: ', handle printString) infoPrintCR.
+ ('unloading: ', handle printString) infoPrintCR.
].
self unloadDynamicObject:handle.
^ nil
@@ -1106,7 +1096,7 @@
"/
handle := self loadDynamicObject:aFileName.
handle isNil ifTrue:[
- ^ nil
+ ^ nil
].
"/
@@ -1116,47 +1106,47 @@
initAddr := self getFunction:'__' , initName , '_Init' from:handle.
initAddr isNil ifTrue:[
- initAddr := ObjectFileLoader getFunction:'_' , initName , '_Init' from:handle.
- initAddr isNil ifTrue:[
- (self getListOfUndefinedSymbolsFrom:handle) size > 0 ifTrue:[
- self listUndefinedSymbolsIn:handle.
- 'ObjectFileLoader [info]: undefined symbols in primitive code' infoPrintCR.
- ] ifFalse:[
- ('ObjectFileLoader [info]: ' , initName , '_Init() lookup failed') errorPrintCR
- ].
-
- "/
- "/ not found - unload
- "/
- self unloadDynamicObject:handle.
- ^ nil
- ]
+ initAddr := ObjectFileLoader getFunction:'_' , initName , '_Init' from:handle.
+ initAddr isNil ifTrue:[
+ (self getListOfUndefinedSymbolsFrom:handle) size > 0 ifTrue:[
+ self listUndefinedSymbolsIn:handle.
+ 'ObjectFileLoader [info]: undefined symbols in primitive code' infoPrintCR.
+ ] ifFalse:[
+ ('ObjectFileLoader [info]: ' , initName , '_Init() lookup failed') errorPrintCR
+ ].
+
+ "/
+ "/ not found - unload
+ "/
+ self unloadDynamicObject:handle.
+ ^ nil
+ ]
].
Object osSignalInterruptSignal handle:[:ex |
- ('ObjectFileLoader [warning]: hard error in initFunction: ' , initName , ' of method-module ' , aFileName) errorPrintCR.
- self unloadDynamicObject:handle.
- ^ nil
+ ('ObjectFileLoader [warning]: hard error in initFunction: ' , initName , ' of method-module ' , aFileName) errorPrintCR.
+ self unloadDynamicObject:handle.
+ ^ nil
] do:[
- "/
- "/ call it - it returns the new method object
- "/
- self "/ registration
- callInitFunctionAt:initAddr
- specialInit:true
- forceOld:true
- interruptable:false
- argument:0
- identifyAs:handle
- returnsObject:false.
- m := self
- callInitFunctionAt:initAddr "/ initialization
- specialInit:true
- forceOld:true
- interruptable:false
- argument:2
- identifyAs:handle
- returnsObject:true.
+ "/
+ "/ call it - it returns the new method object
+ "/
+ self "/ registration
+ callInitFunctionAt:initAddr
+ specialInit:true
+ forceOld:true
+ interruptable:false
+ argument:0
+ identifyAs:handle
+ returnsObject:false.
+ m := self
+ callInitFunctionAt:initAddr "/ initialization
+ specialInit:true
+ forceOld:true
+ interruptable:false
+ argument:2
+ identifyAs:handle
+ returnsObject:true.
].
handle method:m.
@@ -2192,228 +2182,228 @@
saveOldMethodsPerClass anyModulesToInitialize|
PreviouslyLoadedObjects notNil ifTrue:[
- anyModulesToInitialize := false.
-
- PreviouslyLoadedObjects do:[:entry |
- |fileName handle cls sel|
-
- fileName := entry key.
- handle := entry value.
- handle moduleID:nil.
-
- handle isClassLibHandle ifTrue:[
- ('ObjectFileLoader [info]: reloading classes in ' , fileName , ' ...') infoPrintCR.
-
- "/
- "/ remember all byteCode methods (as added in the session)
- "/
- savedByteCodeMethods := Dictionary new.
- savedOldClasses := IdentitySet new.
- saveOldMethodsPerClass := Dictionary new.
-
- handle classes do:[:aClass |
- |clsName mthdDict|
-
- (aClass notNil and:[aClass ~~ 0]) ifTrue:[
- clsName := aClass name.
- mthdDict := aClass methodDictionary.
- saveOldMethodsPerClass at:clsName put:mthdDict copy.
- savedMethods := IdentityDictionary new.
- savedOldClasses add:aClass.
- mthdDict keysAndValuesDo:[:sel :m |
- m byteCode notNil ifTrue:[
- "/ an interpreted method - must be preserved
- savedMethods at:sel put:m
- ]
- ].
- savedMethods notEmpty ifTrue:[
- savedByteCodeMethods at:clsName put:savedMethods
- ].
- ]
- ].
- "/
- "/ load the class binary
- "/
- handle := self loadObjectFile:fileName invokeInitializeMethods:false.
- handle notNil ifTrue:[
- anyModulesToInitialize := true
- ].
-
- "/ after reloading of the objectFile,
- "/ some of the changes made in the previous life have to be
- "/ redone here - otherwise, we will be left with the
- "/ state contained in the loaded objectModule - instead of
- "/ what we had when saving the image ...
-
- "/
- "/ reinstall the byteCode methods
- "/
- savedByteCodeMethods keysAndValuesDo:[:nm :savedMethods |
- |cls|
-
- cls := Smalltalk classNamed:nm.
- savedMethods keysAndValuesDo:[:sel :m |
- cls primAddSelector:sel withMethod:m.
+ anyModulesToInitialize := false.
+
+ PreviouslyLoadedObjects do:[:entry |
+ |fileName handle cls sel|
+
+ fileName := entry key.
+ handle := entry value.
+ handle moduleID:nil.
+
+ handle isClassLibHandle ifTrue:[
+ ('ObjectFileLoader [info]: reloading classes in ' , fileName , ' ...') infoPrintCR.
+
+ "/
+ "/ remember all byteCode methods (as added in the session)
+ "/
+ savedByteCodeMethods := Dictionary new.
+ savedOldClasses := IdentitySet new.
+ saveOldMethodsPerClass := Dictionary new.
+
+ handle classes do:[:aClass |
+ |clsName mthdDict|
+
+ (aClass notNil and:[aClass ~~ 0]) ifTrue:[
+ clsName := aClass name.
+ mthdDict := aClass methodDictionary.
+ saveOldMethodsPerClass at:clsName put:mthdDict copy.
+ savedMethods := IdentityDictionary new.
+ savedOldClasses add:aClass.
+ mthdDict keysAndValuesDo:[:sel :m |
+ m byteCode notNil ifTrue:[
+ "/ an interpreted method - must be preserved
+ savedMethods at:sel put:m
+ ]
+ ].
+ savedMethods notEmpty ifTrue:[
+ savedByteCodeMethods at:clsName put:savedMethods
+ ].
+ ]
+ ].
+ "/
+ "/ load the class binary
+ "/
+ handle := self loadObjectFile:fileName invokeInitializeMethods:false.
+ handle notNil ifTrue:[
+ anyModulesToInitialize := true
+ ].
+
+ "/ after reloading of the objectFile,
+ "/ some of the changes made in the previous life have to be
+ "/ redone here - otherwise, we will be left with the
+ "/ state contained in the loaded objectModule - instead of
+ "/ what we had when saving the image ...
+
+ "/
+ "/ reinstall the byteCode methods
+ "/
+ savedByteCodeMethods keysAndValuesDo:[:nm :savedMethods |
+ |cls|
+
+ cls := Smalltalk classNamed:nm.
+ savedMethods keysAndValuesDo:[:sel :m |
+ cls primAddSelector:sel withMethod:m.
"/ ('preserved ' , cls name , '>>' , sel) printCR.
- ]
- ].
-
- "/
- "/ re-remove removed methods
- "/ and re-change method categories
- "/
- savedOldClasses do:[:oldClass |
- |newClass oldMethods newMethodDict oldMthd newMthd
- oldCat oldClassVarString oldClassCategory|
-
- newClass := Smalltalk classNamed:(oldClass name).
- newClass notNil ifTrue:[
- oldClassVarString := oldClass classVariableString.
- newClass classVariableString ~= oldClassVarString ifTrue:[
- "/ there is no need to recreate the variable
- "/ (its in the smalltalk dictionary)
- newClass setClassVariableString:oldClassVarString
- ].
- newClass isMeta ifFalse:[
- oldClassCategory := oldClass category.
- newClass category ~= oldClassCategory ifTrue:[
- newClass category:oldClassCategory
- ]
- ].
- oldMethods := saveOldMethodsPerClass at:oldClass name.
- newMethodDict := newClass methodDictionary.
- newMethodDict keys copy do:[:newSelector |
- (oldMethods includesKey:newSelector) ifFalse:[
+ ]
+ ].
+
+ "/
+ "/ re-remove removed methods
+ "/ and re-change method categories
+ "/
+ savedOldClasses do:[:oldClass |
+ |newClass oldMethods newMethodDict oldMthd newMthd
+ oldCat oldClassVarString oldClassCategory|
+
+ newClass := Smalltalk classNamed:(oldClass name).
+ newClass notNil ifTrue:[
+ oldClassVarString := oldClass classVariableString.
+ newClass classVariableString ~= oldClassVarString ifTrue:[
+ "/ there is no need to recreate the variable
+ "/ (its in the smalltalk dictionary)
+ newClass setClassVariableString:oldClassVarString
+ ].
+ newClass isMeta ifFalse:[
+ oldClassCategory := oldClass category.
+ newClass category ~= oldClassCategory ifTrue:[
+ newClass category:oldClassCategory
+ ]
+ ].
+ oldMethods := saveOldMethodsPerClass at:oldClass name.
+ newMethodDict := newClass methodDictionary.
+ newMethodDict keys copy do:[:newSelector |
+ (oldMethods includesKey:newSelector) ifFalse:[
"/ ('ObjectFileLoader [info]: remove method #' , newSelector , ' from reloaded ' , oldClass name , '.') infoPrintCR.
- newMethodDict removeKey:newSelector
- ] ifTrue:[
- oldMthd := oldMethods at:newSelector.
- newMthd := newMethodDict at:newSelector.
- newMthd category:oldMthd category
- ]
- ]
- ]
- ].
-
- "/
- "/ validate old-classes vs. new classes.
- "/ and if things look ok, get rid of old stuff
- "/ and make instances become instances of the new class
- "/
+ newMethodDict removeKey:newSelector
+ ] ifTrue:[
+ oldMthd := oldMethods at:newSelector.
+ newMthd := newMethodDict at:newSelector.
+ newMthd category:oldMthd category
+ ]
+ ]
+ ]
+ ].
+
+ "/
+ "/ validate old-classes vs. new classes.
+ "/ and if things look ok, get rid of old stuff
+ "/ and make instances become instances of the new class
+ "/
"/ ('ObjectFileLoader [info]: migrating classes ...') infoPrintCR.
- savedOldClasses do:[:oldClass |
- |newClass oldCat oldCVars|
-
- newClass := Smalltalk classNamed:(oldClass name).
- newClass == oldClass ifTrue:[
+ savedOldClasses do:[:oldClass |
+ |newClass oldCat oldCVars|
+
+ newClass := Smalltalk classNamed:(oldClass name).
+ newClass == oldClass ifTrue:[
"/ ('ObjectFileLoader [info]: class ' , oldClass name , ' reloaded.') infoPrintCR.
- ] ifFalse:[
- (newClass isNil or:[newClass == oldClass]) ifTrue:[
- ('ObjectFileLoader [warning]: reload of ' , oldClass name , ' seemed to fail.') errorPrintCR.
- ] ifFalse:[
+ ] ifFalse:[
+ (newClass isNil or:[newClass == oldClass]) ifTrue:[
+ ('ObjectFileLoader [warning]: reload of ' , oldClass name , ' seemed to fail.') errorPrintCR.
+ ] ifFalse:[
"/'oldSize: ' print. oldClass instSize print. ' (' print. oldClass instSize class name print. ') ' print.
"/'newSize: ' print. newClass instSize print. ' (' print. oldClass instSize class name print. ') ' printCR.
- oldClass instSize ~~ newClass instSize ifTrue:[
- ('ObjectFileLoader [warning]: ' , oldClass name , ' has changed its size.') errorPrintCR.
- ] ifFalse:[
- oldClass class instSize ~~ newClass class instSize ifTrue:[
- ('ObjectFileLoader [warning]: ' , oldClass name , ' class has changed its size.') errorPrintCR.
- ] ifFalse:[
+ oldClass instSize ~~ newClass instSize ifTrue:[
+ ('ObjectFileLoader [warning]: ' , oldClass name , ' has changed its size.') errorPrintCR.
+ ] ifFalse:[
+ oldClass class instSize ~~ newClass class instSize ifTrue:[
+ ('ObjectFileLoader [warning]: ' , oldClass name , ' class has changed its size.') errorPrintCR.
+ ] ifFalse:[
"/ ('ObjectFileLoader [info]: migrating ' , oldClass name) infoPrintCR.
- (oldCat := oldClass category) ~= newClass category ifTrue:[
- newClass category:oldCat.
- ].
- (oldCVars := oldClass classVariableString) ~= newClass classVariableString ifTrue:[
- newClass setClassVariableString:oldCVars
- ].
- "/ copy over the oldClasses class-instVars
- (Class instSize + 1) to:(oldClass class instSize) do:[:idx |
- newClass instVarAt:idx put:(oldClass instVarAt:idx)
- ].
- oldClass becomeSameAs:newClass
+ (oldCat := oldClass category) ~= newClass category ifTrue:[
+ newClass category:oldCat.
+ ].
+ (oldCVars := oldClass classVariableString) ~= newClass classVariableString ifTrue:[
+ newClass setClassVariableString:oldCVars
+ ].
+ "/ copy over the oldClasses class-instVars
+ (Class instSize + 1) to:(oldClass class instSize) do:[:idx |
+ newClass instVarAt:idx put:(oldClass instVarAt:idx)
+ ].
+ oldClass becomeSameAs:newClass
"/ oldClass become:newClass
- ]
- ]
- ]
- ]
- ]
-
- ] ifFalse:[
- handle isMethodHandle ifTrue:[
- oldDummyMethod := handle method.
- (oldDummyMethod isKindOf:Method) ifFalse:[
- ('ObjectFileLoader [info]: ignore obsolete (already collected) method in ' , fileName) infoPrintCR
- ] ifTrue:[
- ('ObjectFileLoader [info]: reloading method in ' , fileName , ' ...') infoPrintCR.
- who := oldDummyMethod who.
- newHandle := self loadMethodObjectFile:fileName.
- newHandle isNil ifTrue:[
- ('ObjectFileLoader [warning]: failed to reload method in ' , fileName , ' ...') errorPrintCR.
- handle moduleID:nil.
- ] ifFalse:[
- m := newHandle method.
- oldDummyMethod sourceFilename notNil ifTrue:[
- m sourceFilename:(oldDummyMethod sourceFilename)
- position:(oldDummyMethod sourcePosition).
- ] ifFalse:[
- m source:(oldDummyMethod source).
- ].
- m setPackage:(oldDummyMethod package).
- who notNil ifTrue:[
- cls := who methodClass.
- sel := who methodSelector.
- m == (cls compiledMethodAt:sel) ifFalse:[
- 'ObjectFileLoader [warning]: oops - loaded method installed wrong' errorPrintCR.
- ] ifTrue:[
+ ]
+ ]
+ ]
+ ]
+ ]
+
+ ] ifFalse:[
+ handle isMethodHandle ifTrue:[
+ oldDummyMethod := handle method.
+ (oldDummyMethod isKindOf:Method) ifFalse:[
+ ('ObjectFileLoader [info]: ignore obsolete (already collected) method in ' , fileName) infoPrintCR
+ ] ifTrue:[
+ ('ObjectFileLoader [info]: reloading method in ' , fileName , ' ...') infoPrintCR.
+ who := oldDummyMethod who.
+ newHandle := self loadMethodObjectFile:fileName.
+ newHandle isNil ifTrue:[
+ ('ObjectFileLoader [warning]: failed to reload method in ' , fileName , ' ...') errorPrintCR.
+ handle moduleID:nil.
+ ] ifFalse:[
+ m := newHandle method.
+ oldDummyMethod sourceFilename notNil ifTrue:[
+ m sourceFilename:(oldDummyMethod sourceFilename)
+ position:(oldDummyMethod sourcePosition).
+ ] ifFalse:[
+ m source:(oldDummyMethod source).
+ ].
+ m setPackage:(oldDummyMethod package).
+ who notNil ifTrue:[
+ cls := who methodClass.
+ sel := who methodSelector.
+ m == (cls compiledMethodAt:sel) ifFalse:[
+ 'ObjectFileLoader [warning]: oops - loaded method installed wrong' errorPrintCR.
+ ] ifTrue:[
"/ cls changed:#methodDictionary with:(Array with:sel with:oldDummyMethod).
- ]
- ].
- ]
- ]
- ] ifFalse:[
- handle isFunctionObjectHandle ifTrue:[
- functions := handle functions.
- functions isEmpty ifTrue:[
- ('ObjectFileLoader [info]: ignore obsolete (unreferenced) functions in ' , fileName) infoPrintCR
- ] ifFalse:[
- newHandle := self loadDynamicObject:fileName.
- newHandle isNil ifTrue:[
- ('ObjectFileLoader [warning]: failed to reload ' , fileName , ' ...') errorPrintCR.
- handle moduleID:nil.
- ] ifFalse:[
- ('ObjectFileLoader [info]: reloading ' , fileName , ' ...') infoPrintCR.
- functions do:[:oldFunction |
- newFunction := newHandle getFunction:(oldFunction name).
- newFunction isNil ifTrue:[
- ('ObjectFileLoader [info]: function: ''' , oldFunction name , ''' no longer present.') errorPrintCR.
- oldFunction code:nil.
- oldFunction setName:oldFunction name moduleHandle:nil.
- ] ifFalse:[
- oldFunction code:(newFunction code).
- oldFunction setName:oldFunction name moduleHandle:newHandle.
- ('ObjectFileLoader [info]: rebound function: ''' , oldFunction name , '''.') infoPrintCR.
- ]
- ].
- handle becomeSameAs:newHandle. "/ the old handle is now void
- ]
- ]
- ] ifFalse:[
- ('ObjectFileLoader [info]: ignored invalid (obsolete) objectFile handle: ' , handle printString) infoPrintCR.
- ]
- ]
- ]
- ].
- PreviouslyLoadedObjects := nil.
-
- "/ now, as we hopefully have all loaded,
- "/ send #reinitializeAfterLoad to each of them
- anyModulesToInitialize ifTrue:[
- AbortSignal catch:[
- self moduleInit:4 forceOld:false interruptable:true.
- ]
- ]
+ ]
+ ].
+ ]
+ ]
+ ] ifFalse:[
+ handle isFunctionObjectHandle ifTrue:[
+ functions := handle functions.
+ functions isEmpty ifTrue:[
+ ('ObjectFileLoader [info]: ignore obsolete (unreferenced) functions in ' , fileName) infoPrintCR
+ ] ifFalse:[
+ newHandle := self loadDynamicObject:fileName.
+ newHandle isNil ifTrue:[
+ ('ObjectFileLoader [warning]: failed to reload ' , fileName , ' ...') errorPrintCR.
+ handle moduleID:nil.
+ ] ifFalse:[
+ ('ObjectFileLoader [info]: reloading ' , fileName , ' ...') infoPrintCR.
+ functions do:[:oldFunction |
+ newFunction := newHandle getFunction:(oldFunction name).
+ newFunction isNil ifTrue:[
+ ('ObjectFileLoader [info]: function: ''' , oldFunction name , ''' no longer present.') errorPrintCR.
+ oldFunction code:nil.
+ oldFunction setName:oldFunction name moduleHandle:nil.
+ ] ifFalse:[
+ oldFunction code:(newFunction code).
+ oldFunction setName:oldFunction name moduleHandle:newHandle.
+ ('ObjectFileLoader [info]: rebound function: ''' , oldFunction name , '''.') infoPrintCR.
+ ]
+ ].
+ handle becomeSameAs:newHandle. "/ the old handle is now void
+ ]
+ ]
+ ] ifFalse:[
+ ('ObjectFileLoader [info]: ignored invalid (obsolete) objectFile handle: ' , handle printString) infoPrintCR.
+ ]
+ ]
+ ]
+ ].
+ PreviouslyLoadedObjects := nil.
+
+ "/ now, as we hopefully have all loaded,
+ "/ send #reinitializeAfterLoad to each of them
+ anyModulesToInitialize ifTrue:[
+ AbortSignal catch:[
+ self moduleInit:4 forceOld:false interruptable:true.
+ ]
+ ]
]
"Modified: / 16.5.1998 / 14:23:12 / cg"
@@ -2522,102 +2512,102 @@
osType := OperatingSystem getOSType.
osType = 'win32' ifTrue:[
- self activityNotification:'create def file'.
-
- "/ create a .def file.
- expFileName := '.\' , baseFileName , '.def'.
-
- expFile := expFileName asFilename writeStream.
- expFile notNil ifTrue:[
- OperatingSystem getCCDefine ='__BORLANDC__' ifTrue:[
- expFile nextPutLine:'LIBRARY ' , baseFileName.
- expFile nextPutLine:'SEGMENTS'.
- expFile nextPutLine:' INITCODE PRELOAD SHARED'.
+ self activityNotification:'create def file'.
+
+ "/ create a .def file.
+ expFileName := '.\' , baseFileName , '.def'.
+
+ expFile := expFileName asFilename writeStream.
+ expFile notNil ifTrue:[
+ OperatingSystem getCCDefine ='__BORLANDC__' ifTrue:[
+ expFile nextPutLine:'LIBRARY ' , baseFileName.
+ expFile nextPutLine:'SEGMENTS'.
+ expFile nextPutLine:' INITCODE PRELOAD SHARED'.
"/ expFile nextPutLine:' INITDATA READ WRITE'.
- expFile nextPutLine:'EXPORTS'.
- expFile nextPutLine:' __' , baseFileName , '_Init'.
- ] ifFalse:[
- expFile nextPutLine:'LIBRARY ' , baseFileName.
- expFile nextPutLine:'CODE EXECUTE READ SHARED'.
- expFile nextPutLine:'DATA READ WRITE'.
- expFile nextPutLine:'SECTIONS'.
- expFile nextPutLine:' INITCODE READ EXECUTE SHARED'.
- expFile nextPutLine:' INITDATA READ WRITE'.
- expFile nextPutLine:' RODATA READ SHARED'.
- expFile nextPutLine:'EXPORTS'.
- expFile nextPutLine:' _' , baseFileName , '_Init'.
- expFile nextPutLine:'IMPORTS'.
- ].
- expFile close.
- ].
-
- self activityNotification:'generating shared object'.
-
- LinkArgs isNil ifTrue:[
- ld := LinkCommand , ' ' , baseFileName , '.obj'.
- ld := ld
- , ' /NOPACK /NOLOGO /DEBUG /MACHINE:I386 /DLL'
- , ' /OUT:' , baseFileName , '.dll '
- , ' /DEF:' , baseFileName , '.def'.
- ] ifFalse:[
- libDir := '..\libbc'.
- libDir asFilename exists ifFalse:[
- libDir := '..\lib\libbc'.
- libDir asFilename exists ifFalse:[
- libDir := '..\lib'.
- libDir asFilename exists ifFalse:[
- libDir := '..\..\libbc'.
- libDir asFilename exists ifFalse:[
- self halt:'oops - need dir where .lib files are'
- ]
- ]
- ]
- ].
-
- OperatingSystem getCCDefine ='__BORLANDC__' ifTrue:[
- ld := LinkCommand , ' ' , (LinkArgs bindWith:baseFileName).
- ld := ld , ' c0d32.obj ' , baseFileName , '.obj '.
- ld := ld , ',' , baseFileName , '.dll,,',libDir,'\librun.lib '.
- ld := ld , (SearchedLibraries asStringCollection asStringWith: $ ).
- ld := ld , ' ',libDir,'\cs32i.lib,,'.
- ] ifFalse:[
- LastError := 'currently only support borlandC'.
- self halt:'currently only support borlandC'.
- ^ nil
- ]
- ].
-
- outfile := (baseFileName , '.out').
-
- OperatingSystem isMSWINDOWSNTlike ifTrue:[
- ok := OperatingSystem executeCommand:ld
- ] ifFalse:[
- ok := OperatingSystem executeCommand:(ld , ' >' , outfile).
-
- ok ifFalse:[
- output := (baseFileName , '.out') asFilename contents asString.
- Transcript showCR:output; endEntry.
- ]
- ].
-
- (baseFileName , '.out') asFilename delete.
- (baseFileName , '.tds') asFilename delete.
- (baseFileName , '.ilc') asFilename delete.
- (baseFileName , '.ild') asFilename delete.
- (baseFileName , '.ilf') asFilename delete.
- (baseFileName , '.ils') asFilename delete.
- (baseFileName , '.lib') asFilename delete.
- (baseFileName , '.map') asFilename delete.
- (baseFileName , '.def') asFilename delete.
- (baseFileName , '.obj') asFilename delete.
-
- ok ifFalse:[
- "/ self halt.
- LastError := output.
- ^ nil
- ].
- oFileName := (Filename currentDirectory construct:(baseFileName , self sharedLibraryExtension)) name.
- ^ oFileName
+ expFile nextPutLine:'EXPORTS'.
+ expFile nextPutLine:' __' , baseFileName , '_Init'.
+ ] ifFalse:[
+ expFile nextPutLine:'LIBRARY ' , baseFileName.
+ expFile nextPutLine:'CODE EXECUTE READ SHARED'.
+ expFile nextPutLine:'DATA READ WRITE'.
+ expFile nextPutLine:'SECTIONS'.
+ expFile nextPutLine:' INITCODE READ EXECUTE SHARED'.
+ expFile nextPutLine:' INITDATA READ WRITE'.
+ expFile nextPutLine:' RODATA READ SHARED'.
+ expFile nextPutLine:'EXPORTS'.
+ expFile nextPutLine:' _' , baseFileName , '_Init'.
+ expFile nextPutLine:'IMPORTS'.
+ ].
+ expFile close.
+ ].
+
+ self activityNotification:'generating shared object'.
+
+ LinkArgs isNil ifTrue:[
+ ld := LinkCommand , ' ' , baseFileName , '.obj'.
+ ld := ld
+ , ' /NOPACK /NOLOGO /DEBUG /MACHINE:I386 /DLL'
+ , ' /OUT:' , baseFileName , '.dll '
+ , ' /DEF:' , baseFileName , '.def'.
+ ] ifFalse:[
+ libDir := '..\libbc'.
+ libDir asFilename exists ifFalse:[
+ libDir := '..\lib\libbc'.
+ libDir asFilename exists ifFalse:[
+ libDir := '..\lib'.
+ libDir asFilename exists ifFalse:[
+ libDir := '..\..\libbc'.
+ libDir asFilename exists ifFalse:[
+ self halt:'oops - need dir where .lib files are'
+ ]
+ ]
+ ]
+ ].
+
+ OperatingSystem getCCDefine ='__BORLANDC__' ifTrue:[
+ ld := LinkCommand , ' ' , (LinkArgs bindWith:baseFileName).
+ ld := ld , ' c0d32.obj ' , baseFileName , '.obj '.
+ ld := ld , ',' , baseFileName , '.dll,,',libDir,'\librun.lib '.
+ ld := ld , (SearchedLibraries asStringCollection asStringWith: $ ).
+ ld := ld , ' ',libDir,'\cs32i.lib,,'.
+ ] ifFalse:[
+ LastError := 'currently only support borlandC'.
+ self halt:'currently only support borlandC'.
+ ^ nil
+ ]
+ ].
+
+ outfile := (baseFileName , '.out').
+
+ OperatingSystem isMSWINDOWSNTlike ifTrue:[
+ ok := OperatingSystem executeCommand:ld
+ ] ifFalse:[
+ ok := OperatingSystem executeCommand:(ld , ' >' , outfile).
+
+ ok ifFalse:[
+ output := (baseFileName , '.out') asFilename contents asString.
+ Transcript showCR:output; endEntry.
+ ]
+ ].
+
+ (baseFileName , '.out') asFilename delete.
+ (baseFileName , '.tds') asFilename delete.
+ (baseFileName , '.ilc') asFilename delete.
+ (baseFileName , '.ild') asFilename delete.
+ (baseFileName , '.ilf') asFilename delete.
+ (baseFileName , '.ils') asFilename delete.
+ (baseFileName , '.lib') asFilename delete.
+ (baseFileName , '.map') asFilename delete.
+ (baseFileName , '.def') asFilename delete.
+ (baseFileName , '.obj') asFilename delete.
+
+ ok ifFalse:[
+ "/ self halt.
+ LastError := output.
+ ^ nil
+ ].
+ oFileName := (Filename currentDirectory construct:(baseFileName , self sharedLibraryExtension)) name.
+ ^ oFileName
].
"/ UNIX systems
@@ -2625,117 +2615,115 @@
ld := 'ld'.
needSharedObject := false.
+ ObjectFileLoader loadableBinaryObjectFormat == #elf ifTrue:[
+ "
+ link it to a shared object with 'ld -shared'
+ "
+ needSharedObject := true.
+ ldArg := '-shared'.
+ ].
+
osType = 'irix' ifTrue:[
- "
- link it to a shared object with 'ld -shared'
- "
- needSharedObject := true.
- ldArg := '-shared'.
+ "
+ link it to a shared object with 'ld -shared'
+ "
+ needSharedObject := true.
+ ldArg := '-shared'.
].
osType = 'sys5_4' ifTrue:[
- "
- link it to a shared object with 'ld -G'
- "
- needSharedObject := true.
- ldArg := '-G'.
+ "
+ link it to a shared object with 'ld -G'
+ "
+ needSharedObject := true.
+ ldArg := '-G'.
].
osType = 'osf' ifTrue:[
- "
- link it to a shared object with 'ld -shared'
- "
- needSharedObject := true.
- ldArg := '-shared'.
- ].
-
- osType = 'linux' ifTrue:[
- ObjectFileLoader loadableBinaryObjectFormat == #elf ifTrue:[
- "
- link it to a shared object with 'ld -shared'
- "
- needSharedObject := true.
- ldArg := '-shared'.
- ]
+ "
+ link it to a shared object with 'ld -shared'
+ "
+ needSharedObject := true.
+ ldArg := '-shared'.
].
osType = 'solaris' ifTrue:[
- "
- link it to a shared object with 'ld -G -B dynamic'
- "
- needSharedObject := true.
+ "
+ link it to a shared object with 'ld -G -B dynamic'
+ "
+ needSharedObject := true.
"/ ldArg := '-G -B dynamic'.
- ldArg := '-G -Bdynamic'.
+ ldArg := '-G -Bdynamic'.
].
osType = 'hpux' ifTrue:[
- "
- link it to a shared object with 'ld -b -B immediate'
- "
- needSharedObject := true.
- ldArg := '-b -B immediate'.
+ "
+ link it to a shared object with 'ld -b -B immediate'
+ "
+ needSharedObject := true.
+ ldArg := '-b -B immediate'.
].
osType = 'aix' ifTrue:[
- self activityNotification:'create export file'.
-
- "/ create an exports file.
- expFileName := './' , baseFileName , '.exp'.
-
- expFile := expFileName asFilename writeStream.
- expFile notNil ifTrue:[
- expFile nextPutAll:'#!! ./' , baseFileName , (self sharedLibraryExtension).
- expFile cr.
- expFile nextPutAll:'_' , baseFileName , '_Init'.
- expFile close.
- ].
-
- self activityNotification:'generating shared object'.
-
- "
- link it to a shared object with 'cc -bI:...librun.exp -bE -bMSRE'
- "
- needSharedObject := true.
- ld := 'cc'.
- librunExpFileName := Smalltalk getSystemFileName:'lib/librun_aix.exp'.
- librunExpFileName isNil ifTrue:[
- LastError := 'missing exports file: ''lib/librun_aix.exp'' - cannot link'.
- ^ nil
- ].
-
- ldArg := '-bI:' , librunExpFileName ,
- ' -bE:' , baseFileName , '.exp' ,
- ' -bM:SRE -e _' , baseFileName , '_Init'.
+ self activityNotification:'create export file'.
+
+ "/ create an exports file.
+ expFileName := './' , baseFileName , '.exp'.
+
+ expFile := expFileName asFilename writeStream.
+ expFile notNil ifTrue:[
+ expFile nextPutAll:'#!! ./' , baseFileName , (self sharedLibraryExtension).
+ expFile cr.
+ expFile nextPutAll:'_' , baseFileName , '_Init'.
+ expFile close.
+ ].
+
+ self activityNotification:'generating shared object'.
+
+ "
+ link it to a shared object with 'cc -bI:...librun.exp -bE -bMSRE'
+ "
+ needSharedObject := true.
+ ld := 'cc'.
+ librunExpFileName := Smalltalk getSystemFileName:'lib/librun_aix.exp'.
+ librunExpFileName isNil ifTrue:[
+ LastError := 'missing exports file: ''lib/librun_aix.exp'' - cannot link'.
+ ^ nil
+ ].
+
+ ldArg := '-bI:' , librunExpFileName ,
+ ' -bE:' , baseFileName , '.exp' ,
+ ' -bM:SRE -e _' , baseFileName , '_Init'.
].
oFileName := './' , baseFileName , (self objectFileExtension).
needSharedObject ifTrue:[
- self activityNotification:'generating shared object'.
-
- soFileName := './' , baseFileName , (self sharedLibraryExtension).
- OperatingSystem removeFile:soFileName.
- ld := ld , ' ' , ldArg , ' ',
- (SearchedLibraries asStringCollection asStringWith: $ ),
- ' -o ' , soFileName , ' ' , oFileName.
-
- Verbose ifTrue:[
- 'linking with:' infoPrintCR.
- ' ' infoPrint. ld infoPrintCR.
- ].
- ok := OperatingSystem
- executeCommand:(ld , ' >errorOutput 2>&1').
-
- ok ifFalse:[
- output := 'errorOutput' asFilename contents asString.
- Transcript showCR:'linker error message:'.
- Transcript showCR:output; endEntry.
- ].
-
- OperatingSystem removeFile:oFileName.
- expFileName notNil ifTrue:[
- OperatingSystem removeFile:expFileName
- ].
- ^ soFileName.
+ self activityNotification:'generating shared object'.
+
+ soFileName := './' , baseFileName , (self sharedLibraryExtension).
+ OperatingSystem removeFile:soFileName.
+ ld := ld , ' ' , ldArg , ' ',
+ (SearchedLibraries asStringCollection asStringWith: $ ),
+ ' -o ' , soFileName , ' ' , oFileName.
+
+ Verbose ifTrue:[
+ 'linking with:' infoPrintCR.
+ ' ' infoPrint. ld infoPrintCR.
+ ].
+ ok := OperatingSystem
+ executeCommand:(ld , ' >errorOutput 2>&1').
+
+ ok ifFalse:[
+ output := 'errorOutput' asFilename contents asString.
+ Transcript showCR:'linker error message:'.
+ Transcript showCR:output; endEntry.
+ ].
+
+ OperatingSystem removeFile:oFileName.
+ expFileName notNil ifTrue:[
+ OperatingSystem removeFile:expFileName
+ ].
+ ^ soFileName.
].
"
@@ -3698,12 +3686,12 @@
(it should then NOT install it, but return the method object instead).
DANGER: Internal & highly specialized. Dont use in your programs.
- This interface may change without notice."
+ This interface may change without notice."
|moduleID retVal oldSpaceReserve|
handle notNil ifTrue:[
- moduleID := handle moduleID
+ moduleID := handle moduleID
].
"/
"/ for various reasons, classes, methods, literals, methodDicts etc.
@@ -3724,61 +3712,61 @@
extern int __oldSpaceSize(), __oldSpaceUsed();
if (__isInteger(address)) {
- if (_isSmallInteger(argument)) {
- arg = __intVal(argument);
-
- addr = (OBJFUNC)(__longIntVal(address));
-
- /*
- * allow function to be interrupted
- */
- if (interruptable != true) {
- wasBlocked = (__BLOCKINTERRUPTS() == true);
- }
-
- force = (forceOld == true);
- if (force) {
- int reserve = __intVal(oldSpaceReserve);
- if ((__oldSpaceSize() - __oldSpaceUsed()) < reserve) {
- __moreOldSpace(__thisContext, reserve);
- }
- prevSpace = __allocForceSpace(OLDSPACE);
- }
+ if (_isSmallInteger(argument)) {
+ arg = __intVal(argument);
+
+ addr = (OBJFUNC)(__longIntVal(address));
+
+ /*
+ * allow function to be interrupted
+ */
+ if (interruptable != true) {
+ wasBlocked = (__BLOCKINTERRUPTS() == true);
+ }
+
+ force = (forceOld == true);
+ if (force) {
+ int reserve = __intVal(oldSpaceReserve);
+ if ((__oldSpaceSize() - __oldSpaceUsed()) < reserve) {
+ __moreOldSpace(__thisContext, reserve);
+ }
+ prevSpace = __allocForceSpace(OLDSPACE);
+ }
#ifdef alpha
- if (@global(Verbose) == true)
- printf("calling initfunc %lx ...\n", addr);
+ if (@global(Verbose) == true)
+ printf("calling initfunc %lx ...\n", addr);
#else
- if (@global(Verbose) == true)
- printf("calling initfunc %x ...\n", addr);
+ if (@global(Verbose) == true)
+ printf("calling initfunc %x ...\n", addr);
#endif
- if (special == true) {
- if (__isSmallInteger(moduleID)) {
- __SET_MODULE_ID(__intVal(moduleID));
- }
- retVal = (*addr)(arg, __pRT__);
- __SET_MODULE_ID(0);
- if (returnsObject != true) {
- retVal = nil;
- }
- } else {
- if (returnsObject == true) {
- retVal = (*addr)(arg);
- } else {
- ret = (int) ((*addr)(arg));
- retVal = __MKSMALLINT(ret);
- }
- }
-
- if (force) {
- __allocForceSpace(prevSpace);
- }
-
- if (! wasBlocked) {
- __UNBLOCKINTERRUPTS();
- }
- RETURN (retVal);
- }
+ if (special == true) {
+ if (__isSmallInteger(moduleID)) {
+ __SET_MODULE_ID(__intVal(moduleID));
+ }
+ retVal = (*addr)(arg, __pRT__);
+ __SET_MODULE_ID(0);
+ if (returnsObject != true) {
+ retVal = nil;
+ }
+ } else {
+ if (returnsObject == true) {
+ retVal = (*addr)(arg);
+ } else {
+ ret = (int) ((*addr)(arg));
+ retVal = __MKSMALLINT(ret);
+ }
+ }
+
+ if (force) {
+ __allocForceSpace(prevSpace);
+ }
+
+ if (! wasBlocked) {
+ __UNBLOCKINTERRUPTS();
+ }
+ RETURN (retVal);
+ }
}
%}.
self primitiveFailed
@@ -4105,6 +4093,6 @@
!ObjectFileLoader class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libcomp/ObjectFileLoader.st,v 1.224 2002-02-28 13:54:08 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libcomp/ObjectFileLoader.st,v 1.225 2002-07-22 19:04:05 cg Exp $'
! !
ObjectFileLoader initialize!