ObjectFileLoader.st
branchjv
changeset 3738 dc47a2c6de4c
parent 3727 5ce5e4d7a752
parent 3737 b7c743f08003
child 3761 c9ef7286d1fb
--- a/ObjectFileLoader.st	Sat Mar 26 07:56:56 2016 +0000
+++ b/ObjectFileLoader.st	Mon Mar 28 07:02:21 2016 +0200
@@ -1226,20 +1226,20 @@
      Returns nil on error, or the objectFile's handle if ok."
 
     |filename pathName handle initAddr initDefinitionAddr initFunctionName initNames didInit info status
-     dummyHandle msg isCModule doNotUnload definitionClassName definitionClass|
+     dummyHandle msg isCModule doNotUnload definitionClassName definitionClass cRetVal|
 
     filename := pathNameOrFilename asFilename.
     pathName := filename pathName.
 
     handle := self handleForDynamicObject:filename.
     handle notNil ifTrue:[
-	"already loaded"
-	^ handle.
+        "already loaded"
+        ^ handle.
     ].
 
     handle := self loadDynamicObject:filename.
     handle isNil ifTrue:[
-	^ nil
+        ^ nil
     ].
 
     didInit := false.
@@ -1249,23 +1249,23 @@
      are to be resolved. If that's the case, load all libraries ..."
 
     ParserFlags searchedLibraries notNil ifTrue:[
-	(self hasUndefinedSymbolsIn:handle) ifTrue:[
-	    self initializeLoader.
-
-	    ParserFlags searchedLibraries do:[:libName |
-		(self hasUndefinedSymbolsIn:handle) ifTrue:[
-		    Transcript showCR:'   ... trying ' , libName , ' to resolve undefined symbols ...'.
-		    dummyHandle := Array new:4.
-		    dummyHandle := self primLoadDynamicObject:libName into:dummyHandle.
+        (self hasUndefinedSymbolsIn:handle) ifTrue:[
+            self initializeLoader.
+
+            ParserFlags searchedLibraries do:[:libName |
+                (self hasUndefinedSymbolsIn:handle) ifTrue:[
+                    Transcript showCR:'   ... trying ' , libName , ' to resolve undefined symbols ...'.
+                    dummyHandle := Array new:4.
+                    dummyHandle := self primLoadDynamicObject:libName into:dummyHandle.
 "/                    dummyHandle isNil ifTrue:[
 "/                        Transcript showCR:'   ... load of library ' , libName , ' failed.'.
 "/                    ]
-		]
-	    ].
-	    (self hasUndefinedSymbolsIn:handle) isNil ifTrue:[
-		Transcript showCR:('ObjectFileLoader [info]: still undefined symbols in ', pathName,'.').
-	    ].
-	]
+                ]
+            ].
+            (self hasUndefinedSymbolsIn:handle) isNil ifTrue:[
+                Transcript showCR:('ObjectFileLoader [info]: still undefined symbols in ', pathName,'.').
+            ].
+        ]
     ].
 
     "
@@ -1280,208 +1280,208 @@
      This is used in ST packaged classLib object files"
 
     (initFunctionName startsWith:'lib') ifTrue:[
-	definitionClassName := initFunctionName copyFrom:4.
-	definitionClass := Smalltalk classNamed:definitionClassName.
+        definitionClassName := initFunctionName copyFrom:4.
+        definitionClass := Smalltalk classNamed:definitionClassName.
     ].
     (definitionClass isNil or:[definitionClass isLoaded not]) ifTrue:[
-	"the project definition class has not been loaded yet.
-	 initialize and load it"
-
-	initDefinitionAddr := self findInitDefinitionFunction:initFunctionName in:handle.
-	initDefinitionAddr isNil ifTrue:[
-	    ('WARNING: no init definitions for: ' , pathName) errorPrintCR.
-	] ifFalse:[
-	    Verbose ifTrue:[
-		('calling initDefinition at:' , (initDefinitionAddr printStringRadix:16)) errorPrintCR.
-	    ].
-	    info := self
-			performModuleInitAt:initDefinitionAddr
-			invokeInitializeMethods:false
-			for:definitionClassName
-			identifyAs:handle.
-	    status := info at:1.
-	    status == #ok ifTrue:[
-		"/ now, we have only loaded and installed the projectDefinition class.
-		"/ (but no containing classes or extensions, yet).
-		"/ let the projectDefinition load any prereqs
-	       definitionClassName notNil ifTrue:[
-		    definitionClass := Smalltalk classNamed:definitionClassName.
-		    definitionClass notNil ifTrue:[
-			definitionClass
-			    initialize;
-			    loadMandatoryPreRequisitesAsAutoloaded:false.
-		    ].
-		].
-	    ]
-	].
+        "the project definition class has not been loaded yet.
+         initialize and load it"
+
+        initDefinitionAddr := self findInitDefinitionFunction:initFunctionName in:handle.
+        initDefinitionAddr isNil ifTrue:[
+            ('WARNING: no init definitions for: ' , pathName) errorPrintCR.
+        ] ifFalse:[
+            Verbose ifTrue:[
+                ('calling initDefinition at:' , (initDefinitionAddr printStringRadix:16)) errorPrintCR.
+            ].
+            info := self
+                        performModuleInitAt:initDefinitionAddr
+                        invokeInitializeMethods:false
+                        for:definitionClassName
+                        identifyAs:handle.
+            status := info at:1.
+            status == #ok ifTrue:[
+                "/ now, we have only loaded and installed the projectDefinition class.
+                "/ (but no containing classes or extensions, yet).
+                "/ let the projectDefinition load any prereqs
+               definitionClassName notNil ifTrue:[
+                    definitionClass := Smalltalk classNamed:definitionClassName.
+                    definitionClass notNil ifTrue:[
+                        definitionClass
+                            initialize;
+                            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:[
-	    ('calling init at:' , (initAddr printStringRadix:16)) errorPrintCR.
-	].
-	info := self
-		    performModuleInitAt:initAddr
-		    invokeInitializeMethods:invokeInitializeMethods
-		    for:nil
-		    identifyAs:handle.
-	status := info at:1.
-	status == #ok ifTrue:[
-	    didInit := true.
-	    definitionClassName notNil ifTrue:[
-		definitionClass := Smalltalk classNamed:definitionClassName.
-	    ]
-	]
+        Verbose ifTrue:[
+            ('calling init at:' , (initAddr printStringRadix:16)) errorPrintCR.
+        ].
+        info := self
+                    performModuleInitAt:initAddr
+                    invokeInitializeMethods:invokeInitializeMethods
+                    for:nil
+                    identifyAs:handle.
+        status := info at:1.
+        status == #ok ifTrue:[
+            didInit := true.
+            definitionClassName notNil ifTrue:[
+                definitionClass := Smalltalk classNamed:definitionClassName.
+            ]
+        ]
     ] ifFalse:[
-	"look for explicit C-init (xxx__Init) function
-	 This is used in C object files"
-
-	initAddr := self findFunction:initFunctionName suffix:'__Init' in:handle.
-	initAddr notNil ifTrue:[
-	    isCModule := true.
-
-	    OSSignalInterrupt handle:[:ex |
-		('ObjectFileLoader [warning]: hard error in initFunction of class-module: ' , pathName) errorPrintCR.
-		status := #initFailed.
-	    ] do:[
-		(self
-		    saveCallInitFunctionAt:initAddr
-		    in:pathNameOrFilename
-		    specialInit:false
-		    forceOld:true
-		    interruptable:false
-		    argument:0
-		    identifyAs:handle
-		    returnsObject:false) < 0
-		ifTrue:[
-		    Verbose ifTrue:[
-			'init function return failure ... unload' errorPrintCR.
-		    ].
-		    status := #initFailed.
-		] ifFalse:[
-		    didInit := true.
-		]
-	    ]
-	] ifFalse:[
-	    status := #noInitFunction.
-
-	    "look for any init-function(s); call them all"
-	    Verbose ifTrue:[
-		'no good init functions found; looking for candidates ...' errorPrintCR.
-	    ].
-	    initNames := self namesMatching:'*_Init' segment:'[tT?]' in:pathName.
-	    initNames notNil ifTrue:[
-		initNames do:[:aName |
-		    initAddr := self getFunction:aName from:handle.
-		    initAddr isNil ifTrue:[
-			(aName startsWith:'_') ifTrue:[
-			    initAddr := self getFunction:(aName copyFrom:2) from:handle.
-			].
-		    ].
-		    initAddr isNil ifTrue:[
-			Transcript showCR:('no symbol: ',aName,' in ', pathName).
-		    ] ifFalse:[
-			Verbose ifTrue:[
-			    ('calling init at:' , (initAddr printStringRadix:16)) errorPrintCR
-			].
-			self
-			    performModuleInitAt:initAddr
-			    invokeInitializeMethods:invokeInitializeMethods
-			    for:nil
-			    identifyAs:handle.
-			didInit := true.
-		    ]
-		].
-	    ].
-	]
+        "look for explicit C-init (xxx__Init) function
+         This is used in C object files"
+
+        initAddr := self findFunction:initFunctionName suffix:'__Init' in:handle.
+        initAddr notNil ifTrue:[
+            isCModule := true.
+
+            OSSignalInterrupt handle:[:ex |
+                ('ObjectFileLoader [warning]: hard error in initFunction of class-module: ' , pathName) errorPrintCR.
+                status := #initFailed.
+            ] do:[
+                cRetVal := self
+                    saveCallInitFunctionAt:initAddr
+                    in:pathNameOrFilename
+                    specialInit:false
+                    forceOld:true
+                    interruptable:false
+                    argument:0
+                    identifyAs:handle
+                    returnsObject:false.
+                (cRetVal < 0) ifTrue:[
+                    Verbose ifTrue:[
+                        'init function return failure ... unload' errorPrintCR.
+                    ].
+                    status := #initFailed.
+                ] ifFalse:[
+                    didInit := true.
+                ]
+            ]
+        ] ifFalse:[
+            status := #noInitFunction.
+
+            "look for any init-function(s); call them all"
+            Verbose ifTrue:[
+                'no good init functions found; looking for candidates ...' errorPrintCR.
+            ].
+            initNames := self namesMatching:'*_Init' segment:'[tT?]' in:pathName.
+            initNames notNil ifTrue:[
+                initNames do:[:aName |
+                    initAddr := self getFunction:aName from:handle.
+                    initAddr isNil ifTrue:[
+                        (aName startsWith:'_') ifTrue:[
+                            initAddr := self getFunction:(aName copyFrom:2) from:handle.
+                        ].
+                    ].
+                    initAddr isNil ifTrue:[
+                        Transcript showCR:('no symbol: ',aName,' in ', pathName).
+                    ] ifFalse:[
+                        Verbose ifTrue:[
+                            ('calling init at:' , (initAddr printStringRadix:16)) errorPrintCR
+                        ].
+                        self
+                            performModuleInitAt:initAddr
+                            invokeInitializeMethods:invokeInitializeMethods
+                            for:nil
+                            identifyAs:handle.
+                        didInit := true.
+                    ]
+                ].
+            ].
+        ]
     ].
 
     (invokeInitializeMethods and:[didInit not]) ifTrue:[
-	status == #noInitFunction ifTrue:[
-	    msg := 'no classLib init function found; assume load ok'
-	] ifFalse:[
-	    (status ~~ #registrationFailed
-		and:[status ~~ #initFailed
-		and:[status ~~ #missingClass
-		and:[status ~~ #versionMismatch]]])
-	    ifTrue:[
-		self listUndefinedSymbolsIn:handle.
-	    ].
-
-	    Verbose ifTrue:[
-		'unloading, since init failed ...' errorPrintCR.
-	    ].
-
-	    "/ give caller a chance to prevent unloading (to register later, when a prerequisite class comes)
-	    status == #missingClass ifTrue:[
-		self breakPoint:#sv.
-		doNotUnload := (SuperClassMissingErrorNotification query ? false).
-	    ] ifFalse:[
-		status == #registrationFailed ifTrue:[
-		    self breakPoint:#sv.
-		    doNotUnload := (RegistrationFailedErrorNotification query ? false).
-		] ifFalse:[
-		    doNotUnload := false.
-		].
-	    ].
-	    doNotUnload ifFalse:[
-		self unloadDynamicObject:handle.
-		Verbose ifTrue:[
-		    'unloaded.' errorPrintCR.
-		].
-		handle := nil.
-	    ].
-
-	    status == #initFailed ifTrue:[
-		msg := 'module not loaded (init function signaled failure).'
-	    ] ifFalse:[
-		status == #missingClass ifTrue:[
-		    msg := 'module not loaded (superclass missing: ' , (info at:2) , ').'
-		] ifFalse:[
-		    status == #registrationFailed ifTrue:[
-			msg :=  'module registration failed (incompatible object or missing superclass)'
-		    ] ifFalse:[
-			status == #versionMismatch ifTrue:[
-			    msg :=  'module registration failed (class version mismatch ' , (info at:2) printString , ')'
-			] ifFalse:[
-			    (self namesMatching:'*__sepInitCode__*' segment:'[tT?]' in:pathName) notNil ifTrue:[
-				msg := 'module not loaded (unknown error reason).'
-			    ] ifFalse:[
-				msg := 'module not loaded (no _Init entry in object file ?).'
-			    ]
-			]
-		    ].
-		].
-	    ].
-	].
-	msg := 'ObjectFileLoader [info]: <1p>: <2p>' expandMacrosWith:pathNameOrFilename asFilename baseName with:msg.
-	Smalltalk isStandAloneApp ifTrue:[
-	    msg errorPrintCR
-	] ifFalse:[
-	    Transcript showCR:msg
-	].
+        status == #noInitFunction ifTrue:[
+            msg := 'no classLib init function found; assume load ok'
+        ] ifFalse:[
+            (status ~~ #registrationFailed
+                and:[status ~~ #initFailed
+                and:[status ~~ #missingClass
+                and:[status ~~ #versionMismatch]]])
+            ifTrue:[
+                self listUndefinedSymbolsIn:handle.
+            ].
+
+            Verbose ifTrue:[
+                'unloading, since init failed ...' errorPrintCR.
+            ].
+
+            "/ give caller a chance to prevent unloading (to register later, when a prerequisite class comes)
+            status == #missingClass ifTrue:[
+                self breakPoint:#sv.
+                doNotUnload := (SuperClassMissingErrorNotification query ? false).
+            ] ifFalse:[
+                status == #registrationFailed ifTrue:[
+                    self breakPoint:#sv.
+                    doNotUnload := (RegistrationFailedErrorNotification query ? false).
+                ] ifFalse:[
+                    doNotUnload := false.
+                ].
+            ].
+            doNotUnload ifFalse:[
+                self unloadDynamicObject:handle.
+                Verbose ifTrue:[
+                    'unloaded.' errorPrintCR.
+                ].
+                handle := nil.
+            ].
+
+            status == #initFailed ifTrue:[
+                msg := 'module not loaded (init function signaled failure).'
+            ] ifFalse:[
+                status == #missingClass ifTrue:[
+                    msg := 'module not loaded (superclass missing: ' , (info at:2) , ').'
+                ] ifFalse:[
+                    status == #registrationFailed ifTrue:[
+                        msg :=  'module registration failed (incompatible object or missing superclass)'
+                    ] ifFalse:[
+                        status == #versionMismatch ifTrue:[
+                            msg :=  'module registration failed (class version mismatch ' , (info at:2) printString , ')'
+                        ] ifFalse:[
+                            (self namesMatching:'*__sepInitCode__*' segment:'[tT?]' in:pathName) notNil ifTrue:[
+                                msg := 'module not loaded (unknown error reason).'
+                            ] ifFalse:[
+                                msg := 'module not loaded (no _Init entry in object file ?).'
+                            ]
+                        ]
+                    ].
+                ].
+            ].
+        ].
+        msg := 'ObjectFileLoader [info]: <1p>: <2p>' expandMacrosWith:pathNameOrFilename asFilename baseName with:msg.
+        Smalltalk isStandAloneApp ifTrue:[
+            msg errorPrintCR
+        ] ifFalse:[
+            Transcript showCR:msg
+        ].
     ].
 
     isCModule ifFalse:[
-	Smalltalk flushCachedClasses.
-	Class flushSubclassInfo.
-
-	(definitionClass notNil and:[definitionClass isLoaded]) ifTrue:[
-	    definitionClass supportedOnPlatform ifTrue:[
-		definitionClass loadAllClassesAsAutoloaded:true.
-		"/ load non-mandatory prerequisites
-		definitionClass loadPreRequisitesAsAutoloaded:true.
-		definitionClass projectIsLoaded:true.
-	    ].
-	].
-	Smalltalk isInitialized ifTrue:[
-	    "really don't know, if and what has changed ...
-	     ... but assume, that new classes have been installed."
-	    Smalltalk changed:#postLoad.
-	].
+        Smalltalk flushCachedClasses.
+        Class flushSubclassInfo.
+
+        (definitionClass notNil and:[definitionClass isLoaded]) ifTrue:[
+            definitionClass supportedOnPlatform ifTrue:[
+                definitionClass loadAllClassesAsAutoloaded:true.
+                "/ load non-mandatory prerequisites
+                definitionClass loadPreRequisitesAsAutoloaded:true.
+                definitionClass projectIsLoaded:true.
+            ].
+        ].
+        Smalltalk isInitialized ifTrue:[
+            "really don't know, if and what has changed ...
+             ... but assume, that new classes have been installed."
+            Smalltalk changed:#postLoad.
+        ].
     ].
     ^ handle
 
@@ -4181,32 +4181,32 @@
     checkSymbol := #classPresentCheck:.
 
 %{  /* NOREGISTER */
-    char *badName;
+    char *badName = NULL;
     char interestingClassName[512], *classNameP = 0;
 
     if (__isStringLike(className)) {
-	strncpy(interestingClassName, __stringVal(className), sizeof(interestingClassName));
-	classNameP = interestingClassName;
+        strncpy(interestingClassName, __stringVal(className), sizeof(interestingClassName));
+        classNameP = interestingClassName;
     }
     statusCode = __MKSMALLINT(__check_registration__(classNameP,
-						     &checker, &checkSymbol,
-						     &badName));
+                                                     &checker, &checkSymbol,
+                                                     &badName));
     if (badName) {
-	badClassName = __MKSTRING(badName);
+        badClassName = __MKSTRING(badName);
     }
 %}.
     statusCode == 0 ifTrue:[
-	status := #ok
+        status := #ok
     ] ifFalse:[ statusCode == -1 ifTrue:[
-	status := #missingClass
+        status := #missingClass
     ] ifFalse:[ statusCode == -2 ifTrue:[
-	status := #versionMismatch
+        status := #versionMismatch
     ] ifFalse:[ statusCode == -3 ifTrue:[
-	status := #unregisteredSuperclass
+        status := #unregisteredSuperclass
     ] ifFalse:[ statusCode == -4 ifTrue:[
-	status := #tryAgain
+        status := #tryAgain
     ] ifFalse:[
-	status := #loadFailed
+        status := #loadFailed
     ] ] ] ] ].
 
     ^ Array with:status with:badClassName.