--- a/Smalltalk.st Sun Jan 25 13:34:40 2015 +0100
+++ b/Smalltalk.st Sun Jan 25 13:48:44 2015 +0100
@@ -676,7 +676,6 @@
Stdout reOpen. Stderr reOpen. Stdin reOpen.
! !
-
!Smalltalk class methodsFor:'Compatibility-GNU'!
system:command
@@ -2171,6 +2170,151 @@
!Smalltalk class methodsFor:'private-system management-packages'!
+basicLoadPackage:aPackageString fromDirectory:packageDirOrStringOrNil asAutoloaded:doLoadAsAutoloaded
+ "load a package referenced by aPackageString - a string like 'stx:libbasic'.
+ The package is either located in packageDirOrStringOrNil, or in the current directory (if nil).
+ Answer true, if the load succeeded, false if it failed"
+
+ |packageDirOrNil "shLibName"
+ binaryClassLibraryFilename projectDefinitionFilename projectDefinitionClass projectDefinitionClassName silent somethingHasBeenLoaded
+ loadOK "exePath" errorInInitialize|
+
+ packageDirOrStringOrNil notNil ifTrue:[
+ packageDirOrNil := packageDirOrStringOrNil asFilename.
+ ].
+ VerboseLoading ifTrue:[
+ silent := false
+ ] ifFalse:[
+ silent := (SilentLoading or:[ StandAlone ]) or:[ InfoPrinting not ].
+ ].
+
+ "For now: have to read the project definition first!!
+ The class library may contain subclasses of classes in prerequisite packages -
+ so the prerequisite packages have to be loaded first"
+ "normally there is a project definiton, use that one to pull in the rest"
+
+ "maybe, it is already in the image"
+ projectDefinitionClass := ProjectDefinition definitionClassForPackage:aPackageString.
+ (projectDefinitionClass notNil and:[projectDefinitionClass supportedOnPlatform not]) ifTrue:[
+ ^ PackageNotCompatibleError raiseRequestWith:aPackageString errorString:' - package is not compatible with this platform'.
+ ].
+
+ "Is there a shared library (.dll or .so) ?"
+ binaryClassLibraryFilename := ObjectFileLoader
+ binaryClassFilenameForPackage:aPackageString
+ inDirectory:packageDirOrNil.
+
+ (binaryClassLibraryFilename notNil and:[binaryClassLibraryFilename exists]) ifTrue:[
+ |loadErrorOccurred|
+
+ loadErrorOccurred := false.
+ ObjectFileLoader objectFileLoadErrorNotification handle:[:ex |
+ loadErrorOccurred := true.
+ ex proceedWith:true.
+ ] do:[
+ loadOK := (ObjectFileLoader loadObjectFile:binaryClassLibraryFilename) notNil.
+ "/ loadOK := self loadPackage:aPackageString fromClassLibrary:binaryClassLibraryFilename.
+ ].
+ (loadOK and:[loadErrorOccurred not]) ifTrue:[
+ silent ifFalse:[
+ Transcript showCR:('loaded package: ' , aPackageString , ' from binary classLib file: ' , binaryClassLibraryFilename pathName).
+ ].
+ "now, all compiled classes have been loaded.
+ keep classes in the package which are autoloaded as autoloaded."
+ ^ true
+ ].
+
+ loadErrorOccurred ifTrue:[
+ self breakPoint:#cg.
+ projectDefinitionClass := ProjectDefinition definitionClassForPackage:aPackageString.
+ projectDefinitionClass notNil ifTrue:[
+ projectDefinitionClass supportedOnPlatform ifTrue:[
+ "/ load prerequisites...
+ projectDefinitionClass loadPreRequisitesAsAutoloaded:doLoadAsAutoloaded.
+ self breakPoint:#cg.
+ ].
+ ].
+ ].
+ ].
+ packageDirOrNil isNil ifTrue:[
+ ^ PackageNotFoundError raiseRequestWith:aPackageString.
+ ].
+
+ "fallback - go through the project definition"
+ projectDefinitionClass isNil ifTrue:[
+ projectDefinitionClassName := ProjectDefinition initialClassNameForDefinitionOf:aPackageString.
+ "/ try to load the project definition class
+ projectDefinitionFilename := (packageDirOrNil / projectDefinitionClassName) withSuffix:'st'.
+ projectDefinitionFilename exists ifFalse:[
+ projectDefinitionFilename := (packageDirOrNil / 'source' / projectDefinitionClassName) withSuffix:'st'.
+ ].
+ projectDefinitionFilename exists ifTrue:[
+ Class withoutUpdatingChangesDo:[
+ Smalltalk silentlyLoadingDo:[
+ Error handle:[:ex |
+ "/ catch error during initialization;
+ ex suspendedContext withAllSendersDo:[:sender |
+ sender selector == #initialize ifTrue:[
+ sender receiver isBehavior ifTrue:[
+ sender receiver name = projectDefinitionClassName ifTrue:[
+ errorInInitialize := true
+ ]
+ ]
+ ]
+ ].
+ errorInInitialize ifFalse:[ ex reject ].
+ ] do:[
+ projectDefinitionFilename fileIn.
+ ].
+ ].
+ ].
+ errorInInitialize ifTrue:[
+ Transcript showCR:'Smalltalk [info]: an error happened in #initialize - retry after loading package.'.
+ ].
+ projectDefinitionClass := ProjectDefinition definitionClassForPackage:aPackageString.
+ ].
+ ].
+ projectDefinitionClass notNil ifTrue:[
+ projectDefinitionClass autoload.
+ projectDefinitionClass supportedOnPlatform ifFalse:[
+ ^ PackageNotCompatibleError raiseRequestWith:aPackageString errorString:' - package is not compatible with this platform'.
+ ].
+ projectDefinitionClass loadPreRequisitesAsAutoloaded:doLoadAsAutoloaded.
+ somethingHasBeenLoaded := projectDefinitionClass loadAsAutoloaded:doLoadAsAutoloaded.
+ errorInInitialize ifTrue:[
+ Transcript showCR:('Smalltalk [info]: retrying #initialize').
+ projectDefinitionClass initialize.
+ ].
+ (silent not and:[somethingHasBeenLoaded]) ifTrue:[
+ Transcript showCR:('Smalltalk [info]: loaded package: ' , aPackageString , ' from project definition').
+ ].
+ ^ true.
+ ].
+
+ "/ source files-file loading no longer supported
+ "/ however, allow for autoload-stub loaded
+ doLoadAsAutoloaded ifTrue:[
+ self
+ recursiveInstallAutoloadedClassesFrom:packageDirOrNil
+ rememberIn:(Set new)
+ maxLevels:2
+ noAutoload:false
+ packageTop:packageDirOrNil
+ showSplashInLevels:0.
+ ^ true
+ ].
+
+ ^ PackageNotFoundError raiseRequestWith:aPackageString errorString:' - no projectDef, dll or loadAll found'.
+
+ "
+ Smalltalk loadPackageWithId:'stx:libbasic'
+ Smalltalk loadPackageWithId:'stx:goodies/persistency'
+ Smalltalk loadPackageWithId:'exept:ctypes'
+ "
+
+ "Modified: / 29-07-2011 / 19:55:35 / cg"
+!
+
loadExtensionsForPackage:aPackageId
| extensionsLoaded |
@@ -2451,144 +2595,15 @@
The package is either located in packageDirOrStringOrNil, or in the current directory (if nil).
Answer true, if the load succeeded, false if it failed"
- |packageDirOrNil "shLibName"
- binaryClassLibraryFilename projectDefinitionFilename projectDefinitionClass projectDefinitionClassName silent somethingHasBeenLoaded
- loadOK "exePath" errorInInitialize|
-
- packageDirOrStringOrNil notNil ifTrue:[
- packageDirOrNil := packageDirOrStringOrNil asFilename.
- ].
- VerboseLoading ifTrue:[
- silent := false
- ] ifFalse:[
- silent := (SilentLoading or:[ StandAlone ]) or:[ InfoPrinting not ].
- ].
-
- "For now: have to read the project definition first!!
- The class library may contain subclasses of classes in prerequisite packages -
- so the prerequisite packages have to be loaded first"
- "normally there is a project definiton, use that one to pull in the rest"
-
- "maybe, it is already in the image"
- projectDefinitionClass := ProjectDefinition definitionClassForPackage:aPackageString.
- (projectDefinitionClass notNil and:[projectDefinitionClass supportedOnPlatform not]) ifTrue:[
- ^ PackageNotCompatibleError raiseRequestWith:aPackageString errorString:' - package is not compatible with this platform'.
- ].
-
- "Is there a shared library (.dll or .so) ?"
- binaryClassLibraryFilename := ObjectFileLoader
- binaryClassFilenameForPackage:aPackageString
- inDirectory:packageDirOrNil.
-
- (binaryClassLibraryFilename notNil and:[binaryClassLibraryFilename exists]) ifTrue:[
- |loadErrorOccurred|
-
- loadErrorOccurred := false.
- ObjectFileLoader objectFileLoadErrorNotification handle:[:ex |
- loadErrorOccurred := true.
- ex proceedWith:true.
- ] do:[
- loadOK := (ObjectFileLoader loadObjectFile:binaryClassLibraryFilename) notNil.
- "/ loadOK := self loadPackage:aPackageString fromClassLibrary:binaryClassLibraryFilename.
- ].
- (loadOK and:[loadErrorOccurred not]) ifTrue:[
- silent ifFalse:[
- Transcript showCR:('loaded package: ' , aPackageString , ' from binary classLib file: ' , binaryClassLibraryFilename pathName).
- ].
- "now, all compiled classes have been loaded.
- keep classes in the package which are autoloaded as autoloaded."
- ^ true
- ].
-
- loadErrorOccurred ifTrue:[
- self breakPoint:#cg.
- projectDefinitionClass := ProjectDefinition definitionClassForPackage:aPackageString.
- projectDefinitionClass notNil ifTrue:[
- projectDefinitionClass supportedOnPlatform ifTrue:[
- "/ load prerequisites...
- projectDefinitionClass loadPreRequisitesAsAutoloaded:doLoadAsAutoloaded.
- self breakPoint:#cg.
- ].
- ].
- ].
- ].
- packageDirOrNil isNil ifTrue:[
- ^ PackageNotFoundError raiseRequestWith:aPackageString.
- ].
-
- "fallback - go through the project definition"
- projectDefinitionClass isNil ifTrue:[
- projectDefinitionClassName := ProjectDefinition initialClassNameForDefinitionOf:aPackageString.
- "/ try to load the project definition class
- projectDefinitionFilename := (packageDirOrNil / projectDefinitionClassName) withSuffix:'st'.
- projectDefinitionFilename exists ifFalse:[
- projectDefinitionFilename := (packageDirOrNil / 'source' / projectDefinitionClassName) withSuffix:'st'.
- ].
- projectDefinitionFilename exists ifTrue:[
- Class withoutUpdatingChangesDo:[
- Smalltalk silentlyLoadingDo:[
- Error handle:[:ex |
- "/ catch error during initialization;
- ex suspendedContext withAllSendersDo:[:sender |
- sender selector == #initialize ifTrue:[
- sender receiver isBehavior ifTrue:[
- sender receiver name = projectDefinitionClassName ifTrue:[
- errorInInitialize := true
- ]
- ]
- ]
- ].
- errorInInitialize ifFalse:[ ex reject ].
- ] do:[
- projectDefinitionFilename fileIn.
- ].
- ].
- ].
- errorInInitialize ifTrue:[
- Transcript showCR:'Smalltalk [info]: an error happened in #initialize - retry after loading package.'.
- ].
- projectDefinitionClass := ProjectDefinition definitionClassForPackage:aPackageString.
- ].
- ].
- projectDefinitionClass notNil ifTrue:[
- projectDefinitionClass autoload.
- projectDefinitionClass supportedOnPlatform ifFalse:[
- ^ PackageNotCompatibleError raiseRequestWith:aPackageString errorString:' - package is not compatible with this platform'.
- ].
- projectDefinitionClass loadPreRequisitesAsAutoloaded:doLoadAsAutoloaded.
- somethingHasBeenLoaded := projectDefinitionClass loadAsAutoloaded:doLoadAsAutoloaded.
- errorInInitialize ifTrue:[
- Transcript showCR:('Smalltalk [info]: retrying #initialize').
- projectDefinitionClass initialize.
- ].
- (silent not and:[somethingHasBeenLoaded]) ifTrue:[
- Transcript showCR:('Smalltalk [info]: loaded package: ' , aPackageString , ' from project definition').
- ].
- ^ true.
- ].
-
- "/ source files-file loading no longer supported
- "/ however, allow for autoload-stub loaded
- doLoadAsAutoloaded ifTrue:[
- self
- recursiveInstallAutoloadedClassesFrom:packageDirOrNil
- rememberIn:(Set new)
- maxLevels:2
- noAutoload:false
- packageTop:packageDirOrNil
- showSplashInLevels:0.
- ^ true
- ].
-
- ^ PackageNotFoundError raiseRequestWith:aPackageString errorString:' - no projectDef, dll or loadAll found'.
-
- "
- Smalltalk loadPackageWithId:'stx:libbasic'
- Smalltalk loadPackageWithId:'stx:goodies/persistency'
- Smalltalk loadPackageWithId:'exept:ctypes'
- "
-
- "Modified: / 29-07-2011 / 19:55:35 / cg"
+ |ret|
+
+ Smalltalk changed:#prePackageLoad with:aPackageString asSymbol.
+ [
+ ret := self basicLoadPackage:aPackageString fromDirectory:packageDirOrStringOrNil asAutoloaded:doLoadAsAutoloaded
+ ] ensure:[
+ Smalltalk changed:#postPackageLoad with:aPackageString asSymbol.
+ ].
+ ^ ret
!
loadPackage:packageId fromLoadAllFile:aFilename
@@ -8140,11 +8155,11 @@
!Smalltalk class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.1099 2015-01-25 12:29:34 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.1100 2015-01-25 12:48:44 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.1099 2015-01-25 12:29:34 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.1100 2015-01-25 12:48:44 cg Exp $'
!
version_SVN