hg/stx-libcomp: comparison ObjectFileLoader.st

equal deleted inserted replaced

-:fceb50f108b6
+:524785227024
 # ifndef dl_h
 #  include <dl.h>
 #  define dl_h
 # endif
 # include <errno.h>
-#endif
-#ifdef BEOS_DL
-# include <be/kernel/image.h>
 #endif
 #ifdef WIN_DL
 # undef INT
 # undef UINT
 Verbose := false.
 "/ Verbose := true.
 OperatingSystem isMSDOSlike ifTrue:[
-	"/ default setup for msc
 	ParserFlags useBorlandC ifTrue:[
+	    "/ default setup for bcc
 	    libDir := '..\lib\bc'.
 	    libDir asFilename exists ifFalse:[
 		libDir := '..\lib\lib\bc'.
 		libDir asFilename exists ifFalse:[
 		    libDir := '..\lib'.
 copyLibrariesWhenLoading
 "under windows, a library file (dll) which has been loaded cannot be overwritten.
 This makes it troublesome, to recompile a new lib while a smalltalk is being executed.
 When CopyLibrariesWhenLoading is true, ddl files are copied to a tempdir before loading,
 so that the original can still be recompiled.
-Makes loading a bit slower (due to copying and less sharing/caching of already loaded dlls),
+Makes loading a bit slower (due to the copying),
-so it is of by default and must be turned on explicitly during development."
+so it is off by default and must be turned on explicitly during development."
 ^ CopyLibrariesWhenLoading ? false
 "
 self copyLibrariesWhenLoading
 self copyLibrariesWhenLoading:true
 "
+"Modified (comment): / 22-07-2018 / 18:10:15 / Stefan Vogel"
 !
 copyLibrariesWhenLoading:aBoolean
 "under windows, a library file (dll) which has been loaded cannot be overwritten.
 This makes it troublesome, to recompile a new lib while a smalltalk is being executed.
 RETURN ( @symbol(coff));
 # endif
 # if defined(WIN_DL)
 RETURN ( @symbol(dll));
 # endif
-# if defined(BEOS_DL)
-RETURN ( @symbol(beobj));
-# endif
 # if defined(__VMS__)
 RETURN ( @symbol(exe));
 # endif
 # if defined(__osx__)
 RETURN ( @symbol(macho));
 ^ 'nm ' , file
 "Modified: / 4.5.1998 / 12:18:47 / cg"
 !
-objectFileExtension
+objectFileSuffix
 "return the fileName extension used for objects,
 as generated by myself (output of cc).
 This is very machine specific."
 OperatingSystem isMSDOSlike ifTrue:[
 	"/ includes all of win32s, win95, winNT & os/2
-	^ '.obj'
+	^ 'obj'
 ].
 OperatingSystem isVMSlike ifTrue:[
-	^ '.obj'
+	^ 'obj'
 ].
-^ '.o'
+^ 'o'
 "
 ObjectFileLoader objectFileExtension
-"
-"Modified: / 4.5.1998 / 12:17:34 / cg"
-!
-sharedLibraryExtension
-"return the fileName extension used for dynamic loadable objects,
-as generated by myself (output of linker).
-This is very machine specific."
-|suff|
-suff := self sharedLibrarySuffix.
-suff notNil ifTrue:[^ '.' , suff].
-^ suff
-"
-ObjectFileLoader sharedLibraryExtension
 "
 "Modified: / 4.5.1998 / 12:17:34 / cg"
 !
 OperatingSystem isVMSlike ifTrue:[
 	^ #('exe')
 ].
 os := OperatingSystem getSystemType.
-(os = 'linux') ifTrue:[
+(os == #linux) ifTrue:[
 	"/ are we really still supporting that old stuff?
 	self loadableBinaryObjectFormat == #aout ifTrue:[
 	    ^ #('o' 'obj' 'a')
 	].
 	^ #('so')
 "
 ObjectFileLoader validBinaryExtensions
 "
-"Modified: / 1.10.1998 / 12:46:03 / cg"
+"Modified: / 01-10-1998 / 12:46:03 / cg"
+"Modified: / 22-07-2018 / 16:14:54 / Stefan Vogel"
 ! !
 !ObjectFileLoader class methodsFor:'dynamic object loading'!
 loadCPlusPlusObjectFile:aFileName
 "Modified: 6.7.1997 / 12:34:48 / cg"
 !
 loadLibrary:aLibraryFileName
 "load a library; search in some standard places and using
-standard suffixes (i.e. no suffix should be given in the arg).
+standard suffixes (i.e. suffix may be omitted from LibraryFileName).
-Returns a handle or nil.
+Returns a handle or raise an error.
 Use this to attach C-libraries."
-|s suffixes handle libFilename libPath|
+|suffix suffixes handle libFilename libPath|
 Verbose ifTrue:[
 	('loadLibrary:' , aLibraryFileName) errorPrintCR.
 ].
 libFilename := aLibraryFileName asFilename.
-(s := libFilename suffix) isEmpty ifTrue:[
+(suffix := libFilename suffix) isEmpty ifTrue:[
 	suffixes := self validBinaryExtensions
 ] ifFalse:[
-	suffixes := Array with:s
+	suffixes := Array with:suffix
 ].
 "/ try each suffix ...
 suffixes do:[:aSuffix |
 	|fn f|
 	Verbose ifTrue:[
 	    ('loadLibrary try:' , fn asString) errorPrintCR.
 	].
-	handle := self loadObjectFile:fn asString.
+	handle := self loadObjectFile:fn.
-	handle notNil ifTrue:[^ handle].
+	handle notNil ifTrue:[
+	    ^ handle
+	].
 	(libFilename isAbsolute
 	 or:[(aLibraryFileName startsWith:'./')
 	 or:[(aLibraryFileName startsWith:'../')]]) ifTrue:[
 	    "/ already tried...
 	    libPath := self libPath.
 	    libPath notEmptyOrNil ifTrue:[
 		libPath asCollectionOfSubCollectionsSeparatedBy:$: do:[:eachSinglePath |
 		    f := eachSinglePath asFilename construct:fn.
 		    f exists ifTrue:[
-			handle := self loadObjectFile:f pathName.
+			handle := self loadObjectFile:f.
-			handle notNil ifTrue:[^ handle].
+			handle notNil ifTrue:[
+			    ^ handle
+			].
 		    ]
 		]
 	    ].
 	]
 ].
-^ nil
+ObjectFileLoadError
+	raiseErrorString:('Cannot find or load dll/library: "%1"' bindWith:aLibraryFileName asString).
-"
+"
+ObjectFileLoader loadLibrary:'libc.so.6'
 ObjectFileLoader loadLibrary:'libjpeg'
 ObjectFileLoader loadLibrary:'odbc32'
 "
 "Modified: / 04-05-1999 / 17:01:47 / cg"
 "Modified: / 20-09-2017 / 20:10:15 / stefan"
+"Modified: / 22-07-2018 / 16:40:34 / Stefan Vogel"
 !
 loadMethodObjectFile:aFileName
 "load an object file (.o-file) for a single method into the image;
 This does a slightly different initialization.
 initAddr := self getFunction:'__' , initName , '_Init' from:handle.
 initAddr isNil ifTrue:[
 	initAddr := self getFunction:'_' , initName , '_Init' from:handle.
 	initAddr isNil ifTrue:[
-	    (self getListOfUndefinedSymbolsFrom:handle) size > 0 ifTrue:[
+	    (self getListOfUndefinedSymbolsFrom:handle) size ~~ 0 ifTrue:[
 		self listUndefinedSymbolsIn:handle.
 		'ObjectFileLoader [info]: undefined symbols in primitive code' errorPrintCR.
 	    ] ifFalse:[
 		('ObjectFileLoader [info]: ' , initName , '_Init() lookup failed') errorPrintCR
 	    ].
 handle method:m.
 ^ handle
 "Created: / 05-12-1995 / 20:59:46 / cg"
 "Modified: / 15-11-2010 / 13:20:36 / cg"
+"Modified: / 01-03-2019 / 16:03:41 / Claus Gittinger"
 !
 loadObjectFile:aFileName
 "load an object file (.o-file) into the image;
 the class name is not needed (multiple definitions may be in the file).
 This may be either a smalltalk object or a C-object file.
-The object files init function (if any) is called, and the module
+The object file's init function (if any) is called, and the module
 is unloaded if it returns failure (use lowLevel load, to load a file
 without automatic initialization).
 Return nil on error, an objectFile handle if ok."
 ^ self
 	loadObjectFile:aFileName
 	invokeInitializeMethods:true
+"Modified (comment): / 10-04-2019 / 05:47:49 / Claus Gittinger"
+"Modified: / 17-10-2019 / 13:46:10 / Stefan Vogel"
 !
 loadObjectFile:pathNameOrFilename invokeInitializeMethods:invokeInitializeMethods
 "load an object file (.dll or .so-file) into the image;
 the class name is not needed (multiple definitions may be in the file).
 filename := pathNameOrFilename asFilename.
 pathName := filename pathName.
 handle := self handleForDynamicObject:filename.
 handle notNil ifTrue:[
-	"already loaded"
+"already loaded"
-	^ handle.
+^ handle.
 ].
 handle := self loadDynamicObject:filename.
 handle isNil ifTrue:[
-	^ nil
+^ nil
 ].
 didInit := false.
 isCModule := false.
 "with dld, load may have worked, even if undefined symbols
 are to be resolved. If that's the case, load all libraries ..."
 ParserFlags searchedLibraries notEmptyOrNil ifTrue:[
-	(self hasUndefinedSymbolsIn:handle) ifTrue:[
+(self hasUndefinedSymbolsIn:handle) ifTrue:[
-	    self initializeLoader.
+self initializeLoader.
-	    ParserFlags searchedLibraries do:[:libName |
+ParserFlags searchedLibraries do:[:libName |
-		(self hasUndefinedSymbolsIn:handle) ifTrue:[
+(self hasUndefinedSymbolsIn:handle) ifTrue:[
-		    Logger info:'   ... trying  %1 to resolve undefined symbols ...' with:libName.
+Logger info:'   ... trying  %1 to resolve undefined symbols ...' with:libName.
-		    dummyHandle := Array new:4.
+dummyHandle := Array new:4.
-		    dummyHandle := self primLoadDynamicObject:libName into:dummyHandle.
+dummyHandle := self primLoadDynamicObject:libName into:dummyHandle.
 "/                    dummyHandle isNil ifTrue:[
 "/                        Transcript showCR:'   ... load of library ' , libName , ' failed.'.
 "/                    ]
-		]
+]
-	    ].
+].
-	    (self hasUndefinedSymbolsIn:handle) isNil ifTrue:[
+(self hasUndefinedSymbolsIn:handle) isNil ifTrue:[
-		Logger info:'still undefined symbols in %1.' with:pathName.
+Logger info:'still undefined symbols in %1.' with:pathName.
-	    ].
+].
-	]
+]
 ].
 "
 first, expect the classes-name to be the fileNames-baseName
 (if it's not, it may be a method or function module;
 "look for explicit initDefinition (xxx_InitDefinition) function
 This is used in ST packaged classLib object files"
 (initFunctionName startsWith:'lib') ifTrue:[
-	definitionClassName := initFunctionName copyFrom:4.
+definitionClassName := initFunctionName copyFrom:4.
-	definitionClass := Smalltalk classNamed:definitionClassName.
+definitionClass := Smalltalk classNamed:definitionClassName.
 ].
-(definitionClass isNil or:[definitionClass isLoaded not]) ifTrue:[
+(definitionClass isNil or:[definitionClass isLoaded not or:[definitionClass isObsolete]]) ifTrue:[
-	"the project definition class has not been loaded yet.
+"the project definition class has not been loaded yet.
-	 initialize and load it"
+initialize and load it"
-	initDefinitionAddr := self findInitDefinitionFunction:initFunctionName in:handle.
+initDefinitionAddr := self findInitDefinitionFunction:initFunctionName in:handle.
-	initDefinitionAddr isNil ifTrue:[
+initDefinitionAddr isNil ifTrue:[
 Logger warning: 'no init definitions for: %1' with: pathName.
-	] ifFalse:[
+] ifFalse:[
-	    Verbose ifTrue:[
+Verbose ifTrue:[
 Logger info: 'calling initDefinition at: %1' with: (initDefinitionAddr printStringRadix:16).
-	    ].
+].
-	    info := self
+info := self
-			performModuleInitAt:initDefinitionAddr
+performModuleInitAt:initDefinitionAddr
-			invokeInitializeMethods:false
+invokeInitializeMethods:false
-			for:definitionClassName
+for:definitionClassName
-			identifyAs:handle.
+identifyAs:handle.
-	    status := info at:1.
+status := info at:1.
-	    status == #ok ifTrue:[
+status == #ok ifTrue:[
-		"/ now, we have only loaded and installed the projectDefinition class.
+"/ now, we have only loaded and installed the projectDefinition class.
-		"/ (but no containing classes or extensions, yet).
+"/ (but no containing classes or extensions, yet).
-		"/ let the projectDefinition load any prereqs
+"/ let the projectDefinition load any prereqs
-	       definitionClassName notNil ifTrue:[
+definitionClassName notNil ifTrue:[
-		    definitionClass := Smalltalk classNamed:definitionClassName.
+definitionClass := Smalltalk classNamed:definitionClassName.
-		    definitionClass notNil ifTrue:[
+definitionClass notNil ifTrue:[
-"/                        "if projectDefinition denies loading, unload"
+[
-"/                            self unloadDynamicObject:handle.
+definitionClass checkForLoad.   "/ raise exception if not supported on platform / not licensed
+] on:PackageLoadError do:[:ex|
-			definitionClass
+self unloadObjectFileAndRemoveClasses:pathName.
-			    checkForLoad;                           "/ raise exception if not supported on platform / not licensed
+ex reject.
-			    initialize;
+^ nil.
-			    preLoadAction;
+].
-			    loadMandatoryPreRequisitesAsAutoloaded:false.
+definitionClass isObsolete ifTrue:[
-		    ].
+"we come here when doing a filein and a (illegal) proceed from the PackageLoadError"
-		].
+^ nil.
-	    ]
+].
-	].
+definitionClass
+initialize;
+preLoadAction;
+loadMandatoryPreRequisitesAsAutoloaded:false.
+].
+].
+]
+].
 ].
 "look for explicit init (xxx_Init) function
 This is used in ST object files"
 initAddr := self findInitFunction:initFunctionName in:handle.
 initAddr notNil ifTrue:[
-	Verbose ifTrue:[
+Verbose ifTrue:[
 Logger info: ' calling init at: %1' with: (initAddr printStringRadix:16).
-	].
+].
-	info := self
+info := self
-		    performModuleInitAt:initAddr
+performModuleInitAt:initAddr
-		    invokeInitializeMethods:invokeInitializeMethods
+invokeInitializeMethods:invokeInitializeMethods
-		    for:nil
+for:nil
-		    identifyAs:handle.
+identifyAs:handle.
-	status := info at:1.
+status := info at:1.
-	status == #ok ifTrue:[
+status == #ok ifTrue:[
-	    didInit := true.
+didInit := true.
-	    definitionClassName notNil ifTrue:[
+definitionClassName notNil ifTrue:[
-		definitionClass := Smalltalk classNamed:definitionClassName.
+definitionClass := Smalltalk classNamed:definitionClassName.
-	    ]
+]
-	]
+]
 ] ifFalse:[
-	"look for explicit C-init (xxx__Init) function
+"look for explicit C-init (xxx__Init) function
-	 This is used in C object files"
+This is used in C object files"
-	initAddr := self findFunction:initFunctionName suffix:'__Init' in:handle.
+initAddr := self findFunction:initFunctionName suffix:'__Init' in:handle.
-	initAddr notNil ifTrue:[
+initAddr notNil ifTrue:[
-	    isCModule := true.
+isCModule := true.
-	    OSSignalInterrupt handle:[:ex |
+OSSignalInterrupt handle:[:ex |
-		Logger error:'hard error in initFunction of class-module: %1' with:pathName.
+Logger error:'hard error in initFunction of class-module: %1' with:pathName.
-		status := #initFailed.
+status := #initFailed.
-	    ] do:[
+] do:[
-		cRetVal := self
+cRetVal := self
-		    saveCallInitFunctionAt:initAddr
+saveCallInitFunctionAt:initAddr
-		    in:pathNameOrFilename
+in:pathNameOrFilename
-		    specialInit:false
+specialInit:false
-		    forceOld:true
+forceOld:true
-		    interruptable:false
+interruptable:false
-		    argument:0
+argument:0
-		    identifyAs:handle
+identifyAs:handle
-		    returnsObject:false.
+returnsObject:false.
-		(cRetVal < 0) ifTrue:[
+(cRetVal < 0) ifTrue:[
-		    Verbose ifTrue:[
+Verbose ifTrue:[
 Logger info: 'init function returns failure ... unload'.
-		    ].
+].
-		    status := #initFailed.
+status := #initFailed.
-		] ifFalse:[
+] ifFalse:[
-		    didInit := true.
+didInit := true.
-		]
+]
-	    ]
+]
-	] ifFalse:[
+] ifFalse:[
-	    status := #noInitFunction.
+status := #noInitFunction.
-	    "look for any init-function(s); call them all"
+"look for any init-function(s); call them all"
-	    Verbose ifTrue:[
+Verbose ifTrue:[
 Logger info: 'no good init functions found; looking for candidates ...'.
-	    ].
+].
-	    initNames := self namesMatching:'*_Init' segment:'[tT?]' in:pathName.
+initNames := self namesMatching:'*_Init' segment:'[tT?]' in:pathName.
-	    initNames notNil ifTrue:[
+initNames notNil ifTrue:[
-		initNames do:[:aName |
+initNames do:[:aName |
-		    initAddr := self getFunction:aName from:handle.
+initAddr := self getFunction:aName from:handle.
-		    initAddr isNil ifTrue:[
+initAddr isNil ifTrue:[
-			(aName startsWith:'_') ifTrue:[
+(aName startsWith:'_') ifTrue:[
-			    initAddr := self getFunction:(aName copyFrom:2) from:handle.
+initAddr := self getFunction:(aName copyFrom:2) from:handle.
-			].
+].
-		    ].
+].
-		    initAddr isNil ifTrue:[
+initAddr isNil ifTrue:[
-			Transcript showCR:('no symbol: ',aName,' in ', pathName).
+Transcript showCR:('no symbol: ',aName,' in ', pathName).
-		    ] ifFalse:[
+] ifFalse:[
-			Verbose ifTrue:[
+Verbose ifTrue:[
 Logger info: ' calling init at: %1' with: (initAddr printStringRadix:16)
-			].
+].
-			self
+self
-			    performModuleInitAt:initAddr
+performModuleInitAt:initAddr
-			    invokeInitializeMethods:invokeInitializeMethods
+invokeInitializeMethods:invokeInitializeMethods
-			    for:nil
+for:nil
-			    identifyAs:handle.
+identifyAs:handle.
-			didInit := true.
+didInit := true.
-		    ]
+]
-		].
+].
-	    ].
+].
-	]
+]
 ].
 (invokeInitializeMethods and:[didInit not]) ifTrue:[
-	status == #noInitFunction ifTrue:[
+status == #noInitFunction ifTrue:[
-	    msg := 'no classLib init function found; assume load ok'
+msg := 'no classLib init function found; assume load ok'
-	] ifFalse:[
+] ifFalse:[
-	    (status ~~ #registrationFailed
+(status ~~ #registrationFailed
-		and:[status ~~ #initFailed
+and:[status ~~ #initFailed
-		and:[status ~~ #missingClass
+and:[status ~~ #missingClass
-		and:[status ~~ #versionMismatch]]])
+and:[status ~~ #versionMismatch]]])
-	    ifTrue:[
+ifTrue:[
-		self listUndefinedSymbolsIn:handle.
+self listUndefinedSymbolsIn:handle.
-	    ].
+].
-	    Verbose ifTrue:[
+Verbose ifTrue:[
 Logger info: ': unloading, since init failed ...'.
-	    ].
+].
-	    "/ give caller a chance to prevent unloading (to register later, when a prerequisite class comes)
+"/ give caller a chance to prevent unloading (to register later, when a prerequisite class comes)
-	    status == #missingClass ifTrue:[
+status == #missingClass ifTrue:[
-		doNotUnload := (SuperClassMissingErrorNotification query ? false).
+doNotUnload := (SuperClassMissingErrorNotification query ? false).
-	    ] ifFalse:[
+] ifFalse:[
-		status == #registrationFailed ifTrue:[
+status == #registrationFailed ifTrue:[
-		    doNotUnload := (RegistrationFailedErrorNotification query ? false).
+doNotUnload := (RegistrationFailedErrorNotification query ? false).
-		] ifFalse:[
+] ifFalse:[
-		    doNotUnload := false.
+doNotUnload := false.
-		].
+].
-	    ].
+].
-	    doNotUnload ifFalse:[
+doNotUnload ifFalse:[
-		self unloadDynamicObject:handle.
+self unloadDynamicObject:handle.
-		Verbose ifTrue:[
+Verbose ifTrue:[
 Logger info: 'unloaded'.
-		].
+].
-		handle := nil.
+handle := nil.
-	    ].
+].
-	    status == #initFailed ifTrue:[
+status == #initFailed ifTrue:[
-		msg := 'module not loaded (init function signaled failure).'
+msg := 'module not loaded (init function signaled failure).'
-	    ] ifFalse:[
+] ifFalse:[
-		status == #missingClass ifTrue:[
+status == #missingClass ifTrue:[
-		    msg := 'module not loaded (superclass missing: ' , (info at:2) , ').'
+msg := 'module not loaded (superclass missing: ' , (info at:2) , ').'
-		] ifFalse:[
+] ifFalse:[
-		    status == #registrationFailed ifTrue:[
+status == #registrationFailed ifTrue:[
-			msg :=  'module registration failed (incompatible object or missing superclass)'
+msg :=  'module registration failed (incompatible object or missing superclass)'
-		    ] ifFalse:[
+] ifFalse:[
-			status == #versionMismatch ifTrue:[
+status == #versionMismatch ifTrue:[
-			    msg :=  'module registration failed (class version mismatch ' , (info at:2) printString , ')'
+msg :=  'module registration failed (class version mismatch ' , (info at:2) printString , ')'
-			] ifFalse:[
+] ifFalse:[
-			    (self namesMatching:'*__sepInitCode__*' segment:'[tT?]' in:pathName) notNil ifTrue:[
+(self namesMatching:'*__sepInitCode__*' segment:'[tT?]' in:pathName) notNil ifTrue:[
-				msg := 'module not loaded (unknown error reason).'
+msg := 'module not loaded (unknown error reason).'
-			    ] ifFalse:[
+] ifFalse:[
-				msg := 'module not loaded (no _Init entry in object file ?).'
+msg := 'module not loaded (no _Init entry in object file ?).'
-			    ]
+]
-			]
+]
-		    ].
+].
-		].
+].
-	    ].
+].
-	].
+].
-	Verbose ifTrue:[
+Verbose ifTrue:[
-	    Logger debug:'%1: %2' with:pathNameOrFilename asFilename baseName with:msg.
+Logger debug:'%1: %2' with:pathNameOrFilename asFilename baseName with:msg.
-	].
+].
 ].
 isCModule ifFalse:[
-	Smalltalk flushCachedClasses.
+Smalltalk flushCachedClasses.
-	Class flushSubclassInfo.
+Class flushSubclassInfo.
-	(definitionClass notNil and:[definitionClass isLoaded]) ifTrue:[
+(definitionClass notNil and:[definitionClass isLoaded and:[definitionClass isObsolete not]]) ifTrue:[
-definitionClass checkForLoad.               "/ raise exception if not supported on platform / not licensed
+[
+definitionClass checkForLoad.   "/ raise exception if not supported on platform / not licensed
+] on:PackageLoadError do:[:ex|
+self unloadObjectFileAndRemoveClasses:pathName.
+ex reject.
+^ nil.
+].
 Smalltalk changed: #aboutToLoadPackage with: definitionClass.
-	    definitionClass
+definitionClass
-		loadAllClassesAsAutoloaded:true;
+initialize;
-		loadPreRequisitesAsAutoloaded:true;     "/ load non-mandatory prerequisites
+loadAllClassesAsAutoloaded:true;
-		projectIsLoaded:true.                   "/ this performs the postLoadAction, too.
+loadPreRequisitesAsAutoloaded:true;     "/ load non-mandatory prerequisites
+projectIsLoaded:true.                   "/ this performs the postLoadAction, too.
 Smalltalk changed: #packageLoaded with: definitionClass.
-	].
+].
-	Smalltalk isInitialized ifTrue:[
+Smalltalk isInitialized ifTrue:[
-	    "really don't know, if and what has changed ...
+"really don't know, if and what has changed ...
-	     ... but assume, that new classes have been installed."
+... but assume, that new classes have been installed."
-	    Smalltalk changed:#postLoad.
+Smalltalk changed:#postLoad.
-	].
+].
 ].
 ^ handle
 "Modified: / 15-11-2010 / 13:19:26 / cg"
 "Modified: / 20-09-2016 / 00:02:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 "Modified (comment): / 13-02-2017 / 20:27:55 / cg"
+"Modified: / 17-10-2019 / 14:51:08 / Stefan Vogel"
 !
 unloadAllObsoleteObjectFiles
 "unload all dynamically loaded object files for which the classes/method
 has been already garbage collected."
 "
 "Modified: 5.12.1995 / 18:16:52 / cg"
 !
-unloadObjectFile:aFileName
+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 := self handleForDynamicObject:aFilename.
-	handle := LoadedObjects at:aFileName ifAbsent:nil
-].
 handle isNil ifTrue:[
-	('ObjectFileLoader [info]: oops - file to be unloaded was not loaded dynamically (', aFileName , ')') infoPrintCR.
+	Logger info:'oops - file to be unloaded was not loaded dynamically (%1)' with:aFilename.
 	^ self
 ].
 "/ call the modules deInit-function and unload...
 self unloadDynamicObject:handle
 "Modified: / 06-12-2006 / 18:19:13 / cg"
-!
+"Modified: / 17-10-2019 / 13:35:52 / Stefan Vogel"
+!
-unloadObjectFileAndRemoveClasses:aFileName
+unloadObjectFileAndRemoveClasses:aFilename
 "unload an object file (.o-file) from the image and remove all
 corresponding classes from the system.
 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 := self handleForDynamicObject:aFilename.
-	handle := LoadedObjects at:aFileName ifAbsent:nil
-].
 handle isNil ifTrue:[
-	('ObjectFileLoader [info]: oops - file to be unloaded was not loaded dynamically (', (aFileName ? 'unknown-file') , ')') infoPrintCR.
+	Logger info:'oops - file to be unloaded was not loaded dynamically (%1)' with:aFilename.
 	^ self
 ].
 handle isClassLibHandle ifFalse:[
 	self error:'Module is not a classLib module. Proceed to unload anyway' mayProceed:true.
 ].
 "/ call the modules deInit-function and unload...
 self unloadDynamicObject:handle
 "Modified: / 06-12-2006 / 18:19:19 / cg"
+"Modified: / 17-10-2019 / 13:38:01 / Stefan Vogel"
 ! !
 !ObjectFileLoader class methodsFor:'dynamic object queries'!
 findFunction:functionName suffix:suffix in:handle
 * don't know how to do it
 */
 #endif
 #ifdef WIN_DL
-/*
-* don't know how to do it
-*/
-#endif
-#ifdef BEOS_DL
 /*
 * don't know how to do it
 */
 #endif
 	}
 }
 }
 #endif
-#ifdef BEOS_DL
-{
-void *h;
-void *addr;
-INT val;
-void *handle;
-if (__bothSmallInteger(sysHandle1, sysHandle2)) {
-# if __POINTER_SIZE__ == 8
-	val = (_intVal(sysHandle2) << 32) + _intVal(sysHandle1);
-# else
-	val = (_intVal(sysHandle2) << 16) + _intVal(sysHandle1);
-# endif
-	handle = (void *)(val);
-	if (__isStringLike(aString)) {
-	    if (@global(Verbose) == true)
-		console_printf("get sym <%s> handle = %"_lx_"\n", __stringVal(aString), (INT)handle);
-	    entry = NULL;
-	    get_image_symbol((image_id) handle, (char *) __stringVal(aString), B_SYMBOL_TYPE_TEXT, &entry);
-	    if (entry != NULL) {
-		addr = (void *)entry;
-		if (@global(Verbose) == true) {
-		    console_printf("get_image_symbol %s ok; addr = %x\n", __stringVal(aString), addr);
-		}
-		address = __MKUINT( (INT)addr );
-	    } else {
-		if (@global(Verbose) == true) {
-		    console_printf("get_image_symbol %s error\n", __stringVal(aString));
-		}
-	    }
-	}
-}
-}
-#endif
 #ifdef DL1_6
 {
 void *h;
 void *addr;
 hasUndefinedSymbolsIn:handle
 "return true, if a module has undefined symbols in it.
 This is only possible if the system supports loading
 modules with undefined things in it - most do not"
-^ (self getListOfUndefinedSymbolsFrom:handle) size > 0
+^ (self getListOfUndefinedSymbolsFrom:handle) size ~~ 0
-"Modified: 25.4.1996 / 09:47:27 / cg"
+"Modified: / 25-04-1996 / 09:47:27 / cg"
+"Modified: / 01-03-2019 / 16:03:33 / Claus Gittinger"
 !
 initFunctionBasenameForFile:pathNameOrFilename
 "return the expected initFunction's name, given a fileName"
 "list undefined objects in a module on the transcript"
 |undefinedNames|
 undefinedNames := self getListOfUndefinedSymbolsFrom:handle.
-undefinedNames size > 0 ifTrue:[
+undefinedNames size ~~ 0 ifTrue:[
 	Transcript showCR:'ObjectFileLoader [info]: undefined:'.
 	undefinedNames do:[:aName |
 	    Transcript showCR:'    ' , aName
 	]
 ].
-"Modified: 18.5.1996 / 15:43:45 / cg"
+"Modified: / 18-05-1996 / 15:43:45 / cg"
+"Modified: / 01-03-2019 / 16:03:37 / Claus Gittinger"
 !
 namesMatching:aPattern segment:segmentPattern in:aPathName
 "search for entries which match a pattern.
 This is obsolete & rubbish - it will vanish soon"
 "Modified: 25.4.1996 / 09:46:27 / cg"
 ! !
 !ObjectFileLoader class methodsFor:'linking objects'!
-createLoadableObjectFor:baseFileName
+createLoadableObjectFor:baseFilenameString
 "given an oFile, arrange for it to be loadable.
 On ELF systems, this means that it has to be linked with the
 -shared option into a .so file;
 DLD based loaders (linux a.out) can directly load a .o file;
 Other systems may require more ..."
-|osType oFileName soFileName expFileName librunExpFileName
+|osType baseFilename oFileName soFileName expFileName librunExpFileName
-needSharedObject ld ldArg expFile ok outfile output libDir libDirBasename
+needSharedObject linker ld ldArg expFile ok outfile output libDir libDirBasename
 errorMessage homeDir fmt|
 osType := OperatingSystem getOSType.
+baseFilename := baseFilenameString asFilename.
+linker := Filename possiblyQuotedPathname:(self linkCommand).
 osType = #win32 ifTrue:[
-self activityNotification:'generating shared object'.
+	self activityNotification:'generating shared object'.
-ParserFlags linkArgs isNil ifTrue:[
+	ParserFlags linkArgs isNil ifTrue:[
-ld := self linkCommand , ' ' , baseFileName , '.obj'.
+	    ld := linker , ' ' , (Filename possiblyQuotedPathname:(baseFilenameString,'.obj')).
-ld := ld
+	    ld := ld
-, ' /NOPACK /NOLOGO /DEBUG /MACHINE:I386 /DLL'
+	       , ' /NOPACK /NOLOGO /DEBUG /MACHINE:I386 /DLL'
-, ' /OUT:' , baseFileName , '.dll '
+	       , ' /OUT:' , (Filename possiblyQuotedPathname:(baseFilenameString,'.dll'))
 "/               , ' /DEF:' , baseFileName , '.def'.
-] ifFalse:[
+	] ifFalse:[
 "/            libDir := ParserFlags libDirectory.
 "/            (libDir notNil and:[libDir asFilename exists]) ifFalse:[
-ParserFlags useBorlandC ifTrue:[
+		ParserFlags useBorlandC ifTrue:[
-libDirBasename := 'lib\bc'
+		    libDirBasename := 'lib\bc'
-] ifFalse:[
+		] ifFalse:[
-ParserFlags useVisualC ifTrue:[
+		    ParserFlags useVisualC ifTrue:[
-libDirBasename := 'lib\vc'
+			libDirBasename := 'lib\vc'
-] ifFalse:[
+		    ] ifFalse:[
-(ParserFlags useMingw32 or:[ParserFlags useMingw64]) ifTrue:[
+			(ParserFlags useMingw32 or:[ParserFlags useMingw64]) ifTrue:[
-libDirBasename := 'lib\mingw'
+			    libDirBasename := 'lib\mingw'
-] ifFalse:[
+			] ifFalse:[
-libDirBasename := 'lib\vc'
+			    libDirBasename := 'lib\vc'
-]
+			]
-]
+		    ]
-].
+		].
-homeDir := Smalltalk packagePath detect:[:p | (p asFilename / 'stx' / libDirBasename) exists] ifNone:nil.
+		homeDir := Smalltalk packagePath detect:[:p | (p asFilename / 'stx' / libDirBasename) exists] ifNone:nil.
-homeDir notNil ifTrue:[
+		homeDir notNil ifTrue:[
-libDir := (homeDir asFilename / 'stx' / libDirBasename) pathName
+		    libDir := (homeDir asFilename / 'stx' / libDirBasename) pathName
-].
+		].
-libDir isNil ifTrue:[
+		libDir isNil ifTrue:[
-"/ some fallback
+		    "/ some fallback
-libDir := #( '..'
+		    libDir := #( '..'
-'..\..'
+				 '..\..'
-'..\..\..'
+				 '..\..\..'
-'..\..\stx'
+				 '..\..\stx'
-'..\..\..\stx'
+				 '..\..\..\stx'
-) detect:[:p | (p asFilename / libDirBasename) exists] ifNone:nil.
+			       ) detect:[:p | (p asFilename / libDirBasename) exists] ifNone:nil.
-libDir isNil ifTrue:[
+		    libDir isNil ifTrue:[
-LastError := errorMessage := 'could not locate directory where .lib files are (',libDirBasename,')'.
+			LastError := errorMessage := 'could not locate directory where .lib files are (',libDirBasename,')'.
-ObjectFileLoadError raiseRequestErrorString:errorMessage.
+			ObjectFileLoadError raiseRequestErrorString:errorMessage.
-^ nil
+			^ nil
-].
+		    ].
-].
+		].
 "/            ].
-ParserFlags useBorlandC ifTrue:[
+	    ParserFlags useBorlandC ifTrue:[
-ld := self linkCommand , ' ' , (ParserFlags linkArgs bindWith:baseFileName).
+		ld := linker , ' ' , (ParserFlags linkArgs bindWith:baseFilenameString).
-ld := ld , ' c0d32.obj ' , baseFileName , '.obj '.
+		ld := ld , ' c0d32.obj ' , (Filename possiblyQuotedPathname:(baseFilenameString , '.obj')).
-ld := ld , ',' , baseFileName , '.dll,,',libDir,'\librun.lib '.
+		ld := ld , ',' , (Filename possiblyQuotedPathname:(baseFilenameString,'.dll')),',,',libDir,'\librun.lib'.
-ld := ld , (ParserFlags searchedLibraries asStringCollection asStringWith: $ ).
+		ld := ld , ' ',(ParserFlags searchedLibraries asStringCollection asStringWith: $ ).
-ld := ld , ' ',libDir,'\cs32i.lib,,'.
+		ld := ld , ' ',libDir,'\cs32i.lib,,'.
-] ifFalse:[
+	    ] ifFalse:[
-ParserFlags useVisualC ifTrue:[
+		ParserFlags useVisualC ifTrue:[
-"/ todo: fix for correct link libs
+		    "/ todo: fix for correct link libs
-ld := self linkCommand , ' ' , (ParserFlags linkArgs bindWith:baseFileName).
+		    ld := linker , ' ' , (ParserFlags linkArgs bindWith:baseFilenameString).
-ld := ld , ' c0d32.obj ' , baseFileName , '.obj '.
+		    ld := ld , ' c0d32.obj ' , (Filename possiblyQuotedPathname:(baseFilenameString,'.obj')).
-ld := ld , ',' , baseFileName , '.dll,,',libDir,'\librun.lib '.
+		    ld := ld , ',' , (Filename possiblyQuotedPathname:(baseFilenameString,'.dll')),',,',libDir,'\librun.lib'.
-ld := ld , (ParserFlags searchedLibraries asStringCollection asStringWith: $ ).
+		    ld := ld , ' ',(ParserFlags searchedLibraries asStringCollection asStringWith: $ ).
-ld := ld , ' ',libDir,'\cs32i.lib,,'.
+		    ld := ld , ' ',libDir,'\cs32i.lib,,'.
-] ifFalse:[
+		] ifFalse:[
-(ParserFlags useMingw64 or:[ParserFlags useMingw32]) ifTrue:[
+		    (ParserFlags useMingw64 or:[ParserFlags useMingw32]) ifTrue:[
-ld := self linkCommand , ' ' , (ParserFlags linkArgs bindWith:baseFileName).
+			ld := linker , ' ' , (ParserFlags linkArgs bindWith:baseFilenameString).
-ld := ld , ' -shared -o ',baseFileName,'.dll '.
+			ld := ld , ' -shared -o ',(Filename possiblyQuotedPathname:(baseFilenameString,'.dll')).
-ld := ld , baseFileName,'.obj '.
+			ld := ld , ' ',(Filename possiblyQuotedPathname:(baseFilenameString,'.obj')).
-ld := ld , libDir,'\librun.lib '.
+			ld := ld , ' ',libDir,'\librun.lib'.
-ld := ld , (ParserFlags searchedLibraries asStringCollection asStringWith: $ ).
+			ld := ld , ' ',(ParserFlags searchedLibraries asStringCollection asStringWith: $ ).
-] ifFalse:[
+		    ] ifFalse:[
-ObjectFileLoadError raiseRequestErrorString:'for dynamic objects, only borlandC is (currently) supported'.
+			ObjectFileLoadError raiseRequestErrorString:'for dynamic objects, only borlandC is (currently) supported'.
-LastError := 'for dynamic objects, only borlandC is (currently) supported'.
+			LastError := 'for dynamic objects, only borlandC is (currently) supported'.
-^ nil
+			^ nil
-]
+		    ]
-]
+		]
-]
+	    ]
-].
+	].
-outfile := (baseFileName , '.out').
+	outfile := (Filename possiblyQuotedPathname:(baseFilenameString , '.out')).
-(Verbose or:[ STCCompilerInterface verbose ]) ifTrue:[
+	(Verbose or:[ STCCompilerInterface verbose ]) ifTrue:[
-Transcript showCR:('executing: ',ld).
+	    Transcript showCR:('executing: ',ld).
-].
+	].
-ok := OperatingSystem executeCommand:(ld , ' >' , outfile, ' 2>&1') showWindow:false.
+	ok := OperatingSystem executeCommand:(ld , ' >' , outfile, ' 2>&1') showWindow:false.
-ok ifFalse:[
+	ok ifFalse:[
-output := (baseFileName , '.out') asFilename contentsOfEntireFile.
+	    output := (baseFilenameString , '.out') asFilename contentsOfEntireFile.
-Transcript showCR:'********************'.
+	    Transcript showCR:'********************'.
-Transcript showCR:'Failed linkCommand:'.
+	    Transcript showCR:'Failed linkCommand:'.
-Transcript showCR:ld.
+	    Transcript showCR:ld.
-Transcript showCR:'ParserFlags are:'.
+	    Transcript showCR:'ParserFlags are:'.
-Transcript showCR:ParserFlags.
+	    Transcript showCR:ParserFlags.
-Transcript showCR:'--------------------'.
+	    Transcript showCR:'--------------------'.
-Transcript showCR:output; endEntry.
+	    Transcript showCR:output; endEntry.
-Transcript showCR:'********************'.
+	    Transcript showCR:'********************'.
-].
+	].
-#('.obj' '.out' '.tds' '.ilc' '.ild'
+	#('obj' 'out' 'tds' 'ilc' 'ild'
-'.ilf' '.ils' '.lib' '.map' '.def' '.o') do:[:eachSuffix|
+	  'ilf' 'ils' 'lib' 'map' 'def' 'o') do:[:eachSuffix|
-(baseFileName , eachSuffix) asFilename remove.
+	    (baseFilename withSuffix:eachSuffix) removeFile.
-].
+	].
-ok ifFalse:[
+	ok ifFalse:[
-LastError := output.
+	    LastError := output.
-"/ ObjectFileLoadError raiseRequestErrorString:'link failed'.
+	    "/ ObjectFileLoadError raiseRequestErrorString:'link failed'.
-^ nil
+	    ^ nil
-].
+	].
-oFileName := (baseFileName , self sharedLibraryExtension) asFilename name.
+	oFileName := (baseFilename withSuffix:self sharedLibrarySuffix) name.
-^ oFileName
+	^ oFileName
 ].
 "/ UNIX systems
-ld := self linkCommand ? 'ld'.
+ld := linker ? 'ld'.
 needSharedObject := false.
 fmt := self loadableBinaryObjectFormat.
-(fmt == #elf
+(fmt == #elf or:[ fmt == #macho ]) ifTrue:[
-or:[ fmt == #macho ]) ifTrue:[
+	"
-"
+	 link it to a shared object with 'ld -shared'
-link it to a shared object with 'ld -shared'
+	"
-"
+	needSharedObject := true.
-needSharedObject := true.
+	ld := linker ? 'cc'.
-ld := self linkCommand ? 'cc'.
+	ldArg := self linkSharedArgs.
-ldArg := self linkSharedArgs.
+	ldArg isNil ifTrue:[
-ldArg isNil ifTrue:[
+	    "/ some default
-"/ some default
+	    ExternalBytes sizeofPointer == 4 ifTrue:[
-ExternalAddress pointerSize == 4 ifTrue:[
+		ldArg := '-m32 -shared'.
-ldArg := '-m32 -shared'.
+	    ] ifFalse:[
-] ifFalse:[
+		ldArg := '--shared'.
-ldArg := '--shared'.
+	    ]
-]
+	]
-]
 ].
 osType = #irix ifTrue:[
-"
+	"
-link it to a shared object with 'ld -shared'
+	 link it to a shared object with 'ld -shared'
-"
+	"
-needSharedObject := true.
+	needSharedObject := true.
-ldArg := self linkSharedArgs ? '-shared'.
+	ldArg := self linkSharedArgs ? '-shared'.
 ].
 osType = #'sys5_4' ifTrue:[
-"
+	"
-link it to a shared object with 'ld -G'
+	 link it to a shared object with 'ld -G'
-"
+	"
-needSharedObject := true.
+	needSharedObject := true.
-ldArg := self linkSharedArgs ? '-G'.
+	ldArg := self linkSharedArgs ? '-G'.
 ].
 osType = #solaris ifTrue:[
-"
+	"
-link it to a shared object with 'ld -G -B dynamic'
+	 link it to a shared object with 'ld -G -B dynamic'
-"
+	"
-needSharedObject := true.
+	needSharedObject := true.
-ldArg := self linkSharedArgs ? '-G -Bdynamic'.
+	ldArg := self linkSharedArgs ? '-G -Bdynamic'.
 ].
 osType = #hpux ifTrue:[
-"
+	"
-link it to a shared object with 'ld -b -B immediate'
+	 link it to a shared object with 'ld -b -B immediate'
-"
+	"
-needSharedObject := true.
+	needSharedObject := true.
-ldArg := self linkSharedArgs ? '-b -B immediate'.
+	ldArg := self linkSharedArgs ? '-b -B immediate'.
 ].
 osType = #aix ifTrue:[
-self activityNotification:'create export file'.
+	self activityNotification:'create export file'.
-"/ create an exports file.
+	"/ create an exports file.
-expFileName := './' , baseFileName , '.exp'.
+	expFileName := './' , baseFilenameString , '.exp'.
-[
+	[
-expFile := expFileName asFilename writeStream.
+	    expFile := expFileName asFilename writeStream.
-expFile nextPutAll:'#!! ./' , baseFileName , (self sharedLibraryExtension).
+	    expFile nextPutAll:'#!! ./' , baseFilenameString , '.', self sharedLibrarySuffix.
-expFile cr.
+	    expFile cr.
-expFile nextPutAll:'_' , baseFileName , '_Init'.
+	    expFile nextPutAll:'_' , baseFilenameString , '_Init'.
-expFile close.
+	    expFile close.
-] on:FileStream openErrorSignal do:[:ex| "do nothing"].
+	] on:OpenError do:[:ex| "do nothing"].
-self activityNotification:'generating shared object'.
+	self activityNotification:'generating shared object'.
-"
+	"
-link it to a shared object with 'cc -bI:...librun.exp -bE -bMSRE'
+	 link it to a shared object with 'cc -bI:...librun.exp -bE -bMSRE'
-"
+	"
-needSharedObject := true.
+	needSharedObject := true.
-ld := 'cc'.
+	ld := 'cc'.
-librunExpFileName := Smalltalk getSystemFileName:'lib/librun_aix.exp'.
+	librunExpFileName := Smalltalk getSystemFileName:'lib/librun_aix.exp'.
-librunExpFileName isNil ifTrue:[
+	librunExpFileName isNil ifTrue:[
-LastError := 'missing exports file: ''lib/librun_aix.exp'' - cannot link'.
+	    LastError := 'missing exports file: ''lib/librun_aix.exp'' - cannot link'.
-^ nil
+	    ^ nil
-].
+	].
-ldArg := '-bI:' , librunExpFileName ,
+	ldArg := '-bI:' , librunExpFileName ,
-' -bE:' , baseFileName , '.exp' ,
+		' -bE:' , baseFilenameString , '.exp' ,
-' -bM:SRE -e _' , baseFileName , '_Init'.
+		' -bM:SRE -e _' , baseFilenameString , '_Init'.
 ].
-oFileName := baseFileName , self objectFileExtension.
+oFileName := baseFilename withSuffix:self objectFileSuffix.
 needSharedObject ifTrue:[
-self activityNotification:'generating shared object'.
+	self activityNotification:'generating shared object'.
-soFileName := baseFileName , self sharedLibraryExtension.
+	soFileName := baseFilename withSuffix:self sharedLibrarySuffix.
-OperatingSystem removeFile:soFileName.
+	soFileName removeFile.
-ld := ld , ' ' , ldArg , ' ', (ParserFlags linkArgs ? '') ,
-' -o ' , soFileName , ' ' , oFileName , ' ',
+	ld := ld , ' ' , ldArg , ' ', (ParserFlags linkArgs ? '') ,
-((ParserFlags searchedLibraries  ? #()) asStringCollection asStringWith: $ ).
+		 ' -o ' , soFileName name, ' ' , oFileName name , ' ',
+		 ((ParserFlags searchedLibraries  ? #()) asStringCollection asStringWith: $ ).
-(Verbose or:[ STCCompilerInterface verbose ]) ifTrue:[
-Transcript showCR:('linking with: ',ld).
+	(Verbose or:[ STCCompilerInterface verbose ]) ifTrue:[
-].
+	    Transcript showCR:('linking with: ',ld).
-ok := OperatingSystem executeCommand:(ld , ' >errorOutput 2>&1').
+	].
+	ok := OperatingSystem executeCommand:(ld , ' >errorOutput 2>&1').
-ok ifFalse:[
-output := 'errorOutput' asFilename contentsOfEntireFile.
+	ok ifFalse:[
-Transcript showCR:'********************'.
+	    output := 'errorOutput' asFilename contentsOfEntireFile.
-Transcript showCR:'linker command:'.
+	    Transcript showCR:'********************'.
-Transcript showCR:ld; endEntry.
+	    Transcript showCR:'linker command:'.
-Transcript showCR:'--------------------'.
+	    Transcript showCR:ld; endEntry.
-Transcript showCR:'linker error message:'.
+	    Transcript showCR:'--------------------'.
-Transcript showCR:output.
+	    Transcript showCR:'linker error message:'.
-Transcript showCR:'********************'.
+	    Transcript showCR:output.
-].
+	    Transcript showCR:'********************'.
+	].
-OperatingSystem removeFile:oFileName.
-expFileName notNil ifTrue:[
+	oFileName removeFile.
-OperatingSystem removeFile:expFileName
+	expFileName notNil ifTrue:[
-].
+	    expFileName asFilename removeFile.
-^ soFileName.
+	].
+	^ soFileName name.
 ].
 "
 assume we can load an ordinary binary
 "
 ^ oFileName
 "Modified: / 29-07-2004 / 17:29:44 / stefan"
 "Modified: / 25-02-2017 / 09:18:42 / cg"
+"Modified: / 28-03-2019 / 16:29:48 / Claus Gittinger"
+"Modified (format): / 10-04-2019 / 06:18:38 / Claus Gittinger"
 ! !
 !ObjectFileLoader class methodsFor:'lowlevel object loading'!
 initializeLoader
 pathName := pathNameOrFilename asString.
 ].
 ].
 Verbose ifTrue:[
-	('loadDynamic: ',pathNameOrFilename asString,' (',pathName asString,')...') errorPrintCR
+('loadDynamic: ',pathNameOrFilename asString,' (',pathName asString,')...') errorPrintCR
 ].
 encodedPathName := OperatingSystem encodePath:pathName.
 "/ already loaded ?
 handle := self handleForDynamicObject:encodedPathName.
 handle notNil ifTrue:[
-	Verbose ifTrue:[
+Verbose ifTrue:[
 ('... ' , pathName asString , ' already loaded.') errorPrintCR.
-	].
+].
-	^ handle
+^ handle
 ].
 Verbose ifTrue:[
-	('initializeLoader...') errorPrintCR
+('initializeLoader...') errorPrintCR
 ].
 self initializeLoader.
 "/
 "/ the 1st two entries are system dependent;
 buffer := Array new:4.
 buffer at:3 put:pathName.
 buffer at:4 put:NextHandleID. NextHandleID := NextHandleID + 1.
 Verbose ifTrue:[
-	('primLoadDynamicObject...') errorPrintCR
+('primLoadDynamicObject...') errorPrintCR
 ].
 buffer := self primLoadDynamicObject:encodedPathName into:buffer.
 Verbose ifTrue:[
-	('done') errorPrintCR
+('done') errorPrintCR
 ].
 buffer isNil ifTrue:[
-	LastError == #notImplemented ifTrue:[
+LastError == #notImplemented ifTrue:[
-	    'ObjectFileLoader [warning]: no dynamic load facility present.' infoPrintCR.
+'ObjectFileLoader [warning]: no dynamic load facility present.' infoPrintCR.
-	] ifFalse:[
+] ifFalse:[
-	    LastError == #linkError ifTrue:[
+LastError == #linkError ifTrue:[
-		LinkErrorMessage notNil ifTrue:[
+LinkErrorMessage notNil ifTrue:[
-		    ('ObjectFileLoader [warning]: load error:' , LinkErrorMessage) infoPrintCR.
+('ObjectFileLoader [warning]: load error:' , LinkErrorMessage) infoPrintCR.
-		] ifFalse:[
+] ifFalse:[
-		    ('ObjectFileLoader [warning]: load error') infoPrintCR.
+('ObjectFileLoader [warning]: load error') infoPrintCR.
-		].
+].
-	    ].
+].
-	].
+].
 Logger warning: 'failed to load ''%1''' with: pathName.
-	^ nil
+^ nil
 ].
 "
 remember loaded object for later unloading
 "
 handle sysHandle2:(buffer at:2).
 handle pathName:(buffer at:3).
 handle moduleID:(buffer at:4).
 LoadedObjects isNil ifTrue:[
-	LoadedObjects := Dictionary new.
+LoadedObjects := Dictionary new.
 ].
 LoadedObjects at:pathName put:handle.
 "/ Smalltalk flushCachedClasses.
 Verbose ifTrue:[
-	('loadDynamic ok; handle is: ' , handle printString) errorPrintCR.
+('loadDynamic ok; handle is: ' , handle printString) errorPrintCR.
 ].
 "/ ObjectMemory garbageCollect.
 ^ handle
 HINSTANCE handle;
 int err;
 if (__isStringLike(pathName)) {
 	if (@global(Verbose) == true) {
-	    console_fprintf(stderr, "ObjectFileLoader [info]: loading dll: %s...\n", __stringVal(pathName));
+	    console_fprintf(__win32_stderr(), "ObjectFileLoader [info]: loading dll: %s...\n", __stringVal(pathName));
-	    console_fflush(stderr);
+	    console_fflush(__win32_stderr());
 	}
 	//
 	// LOAD_WITH_ALTERED_SEARCH_PATH causes follow-up dlls to be looked up also
 	// in the directory of the loaded library, if an absolute path to
 	// the library has been provided.
 	// Note: this does not work for redirected library symbols, since they are
 	//       resolved ad symbol lookup time and not at library load time
 	//
 	handle = LoadLibraryEx(__stringVal(pathName), NULL, LOAD_WITH_ALTERED_SEARCH_PATH);
 	if (@global(Verbose) == true) {
-	    console_fprintf(stderr, "ObjectFileLoader [info]: handle: %"_lx_"\n", (INT)handle);
+	    console_fprintf(__win32_stderr(), "ObjectFileLoader [info]: handle: %"_lx_"\n", (INT)handle);
-	    console_fflush(stderr);
+	    console_fflush(__win32_stderr());
 	}
 	if (handle == NULL) {
 	    char *msg;
 	    err = GetLastError();
 	    if ((@global(ErrorPrinting) == true)
 	     || (@global(Verbose) == true)) {
-		console_fprintf (stderr,
+		console_fprintf (__win32_stderr(),
 				 "ObjectFileLoader [warning]: LoadLibrary %s failed; error: %x\n",
 				 __stringVal(pathName), err);
 	    }
 	    @global(LastError) = @symbol(loadError);;
 	    @global(LastErrorNumber) = __MKINT(__WIN32_ERR(err));
 	    }
 	    @global(LinkErrorMessage) = __MKSTRING(msg);
 	    RETURN ( nil );
 	}
 # if __POINTER_SIZE__ == 8
-	__ArrayInstPtr(anInfoBuffer)->a_element[0] = __MKSMALLINT( (INT)handle & 0xFFFFFFFFL );
+	__ArrayInstPtr(anInfoBuffer)->a_element[0] = __MKSMALLINT( (UINT)handle & 0xFFFFFFFFL );
-	__ArrayInstPtr(anInfoBuffer)->a_element[1] = __MKSMALLINT( ((INT)handle >> 32) & 0xFFFFFFFFL );
+	__ArrayInstPtr(anInfoBuffer)->a_element[1] = __MKSMALLINT( ((UINT)handle >> 32) & 0xFFFFFFFFL );
 # else
-	__ArrayInstPtr(anInfoBuffer)->a_element[0] = __MKSMALLINT( (INT)handle & 0xFFFF );
+	__ArrayInstPtr(anInfoBuffer)->a_element[0] = __MKSMALLINT( (UINT)handle & 0xFFFF );
-	__ArrayInstPtr(anInfoBuffer)->a_element[1] = __MKSMALLINT( ((INT)handle >> 16) & 0xFFFF );
+	__ArrayInstPtr(anInfoBuffer)->a_element[1] = __MKSMALLINT( ((UINT)handle >> 16) & 0xFFFF );
 # endif
 	RETURN ( anInfoBuffer );
 }
 /*
 * Unlike POSIX.1-2001 dlopen(), Windows has no such handle that
 */
 if (pathName == nil) {
 	__ArrayInstPtr(anInfoBuffer)->a_element[0] = __MKSMALLINT( 0 );
 	__ArrayInstPtr(anInfoBuffer)->a_element[1] = __MKSMALLINT( 0 );
 	RETURN ( anInfoBuffer );
-}
-RETURN ( nil );
-}
-#endif
-#ifdef BEOS_DL
-{
-void *handle;
-int err;
-if (__isStringLike(pathName)) {
-	if (@global(Verbose) == true) {
-	    console_fprintf(stderr, "ObjectFileLoader [info]: loading : %s...\n", __stringVal(pathName));
-	    console_fflush(stderr);
-	}
-	handle = load_add_on(__stringVal(pathName));
-	if (@global(Verbose) == true) {
-	    console_fprintf(stderr, "ObjectFileLoader [info]: handle: %x\n", handle);
-	    console_fflush(stderr);
-	}
-	if (handle == NULL) {
-	    char *msg;
-	    @global(LastError) = @symbol(linkError);
-	    @global(LinkErrorMessage) = __MKSTRING("unknown error");
-	    RETURN ( nil );
-	}
-# if __POINTER_SIZE__ == 8
-	__ArrayInstPtr(anInfoBuffer)->a_element[0] = __MKSMALLINT( (INT)handle & 0xFFFFFFFF );
-	__ArrayInstPtr(anInfoBuffer)->a_element[1] = __MKSMALLINT( ((INT)handle >> 32) & 0xFFFFFFFF );
-# else
-	__ArrayInstPtr(anInfoBuffer)->a_element[0] = __MKSMALLINT( (INT)handle & 0xFFFF );
-	__ArrayInstPtr(anInfoBuffer)->a_element[1] = __MKSMALLINT( ((INT)handle >> 16) & 0xFFFF );
-	RETURN ( anInfoBuffer );
-# endif
 }
 RETURN ( nil );
 }
 #endif
 }
 RETURN (false);
 #endif
 #ifdef WIN_DL
-INT val;
+# if defined(__BORLANDC__)
-HINSTANCE handle;
+// FreeLibrary in Borland C calls exit, catches it with setjmp()
-int err;
+// but hangs after this.
-jmp_buf exitJmpBuf;
+if (@global(Verbose) == true) {
+	console_fprintf (__win32_stderr(),
+			 "ObjectFileLoader [info]: FreeLibrary is not supported in Borland C\n");
+}
+RETURN (true);
+# else // ! __BORLAND_C__
 if (__bothSmallInteger(sysHandle1, sysHandle2)) {
+	UINT val;
+	HINSTANCE handle;
+	int err;
+	jmp_buf exitJmpBuf;
 # if __POINTER_SIZE__ == 8
-	val = (_intVal(sysHandle2) << 32) + _intVal(sysHandle1);
+	val = ((UINT)_intVal(sysHandle2) << 32) + (UINT)_intVal(sysHandle1);
 # else
-	val = (_intVal(sysHandle2) << 16) + _intVal(sysHandle1);
+	val = ((UINT)_intVal(sysHandle2) << 16) + (UINT)_intVal(sysHandle1);
 # endif
-	handle = (HINSTANCE)(val);
+	handle = (HINSTANCE)val;
-	if (setjmp(exitJmpBuf)) {
+	if (!setjmp(exitJmpBuf)) {
 	    __setAtExitLongJmp(exitJmpBuf);
 	    if (@global(Verbose) == true) {
-		console_fprintf (stderr,
+		console_fprintf (__win32_stderr(),
-				 "ObjectFileLoader [info]: FreeLibrary %s handle: %"_lx_"\n",
+				 "ObjectFileLoader [info]: FreeLibrary handle: %"_lx_"\n",
-				 __stringVal(sysHandle1), (INT)handle);
+				 (INT)handle);
 	    }
 	    if (FreeLibrary(handle) != TRUE) {
-	       __setAtExitLongJmp(0);
+		__setAtExitLongJmp(0);
 		err = GetLastError();
 		if (@global(Verbose) == true) {
-		    console_fprintf (stderr,
+		    console_fprintf (__win32_stderr(),
-				     "ObjectFileLoader [warning]: FreeLibrary %s failed; error: %x\n",
+				     "ObjectFileLoader [warning]: FreeLibrary failed; error: %x\n",
-				     __stringVal(sysHandle1), err);
+				     err);
 		}
 		@global(LastErrorNumber) = __MKINT(__WIN32_ERR(err));
 		RETURN (false);
-	    }
+	    } else {
-} else {
+		__setAtExitLongJmp(0);
-	   __setAtExitLongJmp(0);
-	   console_fprintf(stderr, "ObjectFileLoader [warning]: FreeLibrary called exit() - ignored\n");
-}
-	RETURN (true);
-}
-RETURN (false);
-#endif
-#ifdef BEOS_DL
-int val;
-void *handle;
-int ok, err;
-jmp_buf exitJmpBuf;
-if (__bothSmallInteger(sysHandle1, sysHandle2)) {
-	val = (_intVal(sysHandle2) << 16) + _intVal(sysHandle1);
-	handle = (HINSTANCE)(val);
-	if (setjmp(exitJmpBuf)) {
-	    __setAtExitLongJmp(exitJmpBuf);
-	    ok = unload_add_on((image_id) handle);
-	    __setAtExitLongJmp(0);
-	    if (ok != 0) {
-		@global(LastErrorNumber) = __MKSMALLINT(ok);
-		RETURN (false);
 	    }
 	} else {
+	    // arrive here if FreeLibrary does exit
 	    __setAtExitLongJmp(0);
-	    console_fprintf(stderr, "ObjectFileLoader [warning]: FreeLibrary called exit() - ignored\n");
+	    console_fprintf(__win32_stderr(), "ObjectFileLoader [warning]: FreeLibrary called exit() - ignored\n");
 	}
 	RETURN (true);
 }
 RETURN (false);
-#endif
+# endif // !defined(__BORLAND_C__)
+#endif // WIN_DL
 #ifdef SYSV4_DL
 {
-void *h;
+if (__bothSmallInteger(sysHandle1, sysHandle2)) {
-INT val;
+	void *handle;
-OBJ low = sysHandle1, hi = sysHandle2;
+	unsigned INT val;
-if (__bothSmallInteger(low, hi)) {
 #if __POINTER_SIZE__ == 8
-	val = (__intVal(hi) << 32) + __intVal(low);
+	val = ((unsigned INT)__intVal(sysHandle2) << 32) + (unsigned INT)__intVal(sysHandle1);
 #else
-	val = (_intVal(hi) << 16) + _intVal(low);
+	val = ((unsigned INT)_intVal(sysHandle2) << 16) + (unsigned INT)_intVal(sysHandle1);
 #endif
-	h = (void *)(val);
+	handle = (void *)(val);
 	if (@global(Verbose) == true)
-	    console_printf("close handle = %"_lx_"\n", (INT)h);
+	    console_printf("close handle = %p\n", handle);
-	if (dlclose(h) != 0) {
+	if (dlclose(handle) != 0) {
 	    console_fprintf(stderr, "dlclose failed with:<%s>\n", dlerror());
 	    RETURN (false);
 	}
 	RETURN (true);
 }
 console_fprintf(stderr, "ObjectFileLoader [warning]: Sorry, NeXTStep does not support selective unloading\n");
 }
 #endif
 %}.
 ^ false
+"Modified: / 13-02-2020 / 15:46:13 / Stefan Vogel"
 !
 unloadDynamicObject:handle
 "close an object-file (unmap from my address space)
 and remove the entry from the remembered object file set.
 This is a low-level entry, which does not care if there are
 still any code references (from blocks or methods) to this
 module. Calling it for still living classes will definitely
 lead to some fatal conditions to occur later."
-|key fileName functionName deInitAddr m|
+|key fileName functionName deInitAddr method|
 Verbose ifTrue:[
 	'unload module name=' errorPrint. handle pathName errorPrintCR.
 ].
 "
 for individual methods, we keep the methodObject,
 but make it unexecutable. Its still visible in the browser.
 "
 handle isMethodHandle ifTrue:[
-	((m := handle method) notNil
+	method := handle method.
-	and:[m ~~ 0]) ifTrue:[
+	(method  notNil and:[method ~~ 0]) ifTrue:[
-	    m makeUnloaded.
+	    method makeUnloaded.
-	]
+	].
+	ObjectMemory flushCaches.
 ].
 handle isClassLibHandle ifTrue:[
 	Smalltalk flushCachedClasses.
 	Class flushSubclassInfo.
-].
-handle isMethodHandle ifTrue:[
-	ObjectMemory flushCaches.
 ].
 handle moduleID:nil.
 handle sysHandle1:nil.
 handle sysHandle2:nil.
 ].
 "/ Old way: now obsolete and will wanish soon.
 binaryClassLibraryFilename exists ifFalse:[
 "/ mhmh - is this a good idea ? (temporary kludge)
-ExternalAddress pointerSize == 4 ifTrue:[
+ExternalBytes sizeofPointer == 4 ifTrue:[
 binaryClassLibraryFilename := dir / 'objbc' / shLibName.
 binaryClassLibraryFilename exists ifFalse:[
 binaryClassLibraryFilename := dir / 'objvc' / shLibName.
 binaryClassLibraryFilename exists ifFalse:[
 binaryClassLibraryFilename := dir / 'objmingw' / shLibName.

branch	jv
changeset 4723	524785227024
parent 4651	0057186e74d6
parent 4635	d8c0804e23e3