diff -r 6d079a8fb5aa -r 4bf5e572f5d9 Autoload.st --- a/Autoload.st Wed Sep 22 20:25:36 2004 +0200 +++ b/Autoload.st Thu Sep 23 14:57:49 2004 +0200 @@ -14,7 +14,7 @@ nil subclass:#Autoload instanceVariableNames:'' - classVariableNames:'LazyLoading AutoloadFailedSignal LoadedClasses' + classVariableNames:'LazyLoading AutoloadFailedSignal LoadedClasses InProgressClasses' poolDictionaries:'' category:'Kernel-Classes' ! @@ -102,6 +102,7 @@ ]. LoadedClasses isNil ifTrue:[ LoadedClasses := IdentitySet new. + InProgressClasses := IdentitySet new. ]. self ~~ Autoload ifTrue:[ @@ -278,10 +279,8 @@ "use this to force loading - it is defined a noop in all non-autoloading classes" - |mySelf myName myNameSpace newClass oldMeta project prevMode - package| + |myName myNameSpace newClass project prevMode package| - mySelf := self. myName := self name asSymbol. myNameSpace := self nameSpace. @@ -289,7 +288,9 @@ "/ (by loading a binary...) (newClass := Smalltalk at:myName) ~~ self ifTrue:[ (newClass isBehavior and:[newClass isLoaded]) ifTrue:[ - ('Autoload [info]: already loaded: ', myName , '.') infoPrintCR. + (Object infoPrinting and:[Smalltalk silentLoading ~~ true]) ifTrue:[ + Transcript showCR:('Autoload [info]: already loaded: ', myName , '.'); endEntry. + ]. self class becomeSameAs:newClass class. self becomeSameAs:newClass. @@ -304,13 +305,11 @@ ]. [ - "remove myself - to avoid recompilation" - "/ Smalltalk at:myName put:nil. + InProgressClasses add:self. prevMode := ClassCategoryReader sourceMode. -"/ -"/ no- do not do this; it may lead to trouble ... -"/ ClassCategoryReader sourceMode:#reference. + "/ no- do not do this; it may lead to trouble ... + "/ ClassCategoryReader sourceMode:#reference. "/ "/ in order to not get a package of private (or whatever), @@ -353,30 +352,41 @@ ] ] ]. - ClassCategoryReader sourceMode:prevMode. - project notNil ifTrue:[ - Project setProject:project. - ]. - ] ifCurtailed:[ - "something went wrong, restore previous state" + ] ensure:[ + "restore previous state" ClassCategoryReader sourceMode:prevMode. project notNil ifTrue:[ Project setProject:project. ]. - Smalltalk at:myName put:mySelf. + "rehash is needed, because a #become: could have changed the classes identity" + InProgressClasses + rehash; + remove:self ifAbsent:[]. ]. + " + NOTE: ClassLoader did already perform a #becomeSameAs: + of the loaded class to the new class. + + So some of the code below is no longer needed. + " + "did it work ?" newClass := Smalltalk at:myName. - Smalltalk at:myName put:mySelf. "will be undone by become:" + newClass ~~ self ifTrue:[ + "reinstall the autoload class, this will be undone by #become:" + Smalltalk at:myName put:self. + ]. "no - report the error" (newClass isNil or:[newClass isLoaded not]) ifTrue:[ " - this signal is raised, if an autoloaded class - cannot be loaded. Usually, this happends when - some sourcefile is missing, not readable or if + USER INFORMATION: + this exception has been raised because an autoloaded class + could not be loaded. Usually, this happens when + the classes sourcefile is missing, unreadable or if an entry is missing in the abbreviation file. + Check for a readable file named .st in the 'source' directory and (if its a long fileName) for a corresponding entry in the abbreviation file @@ -385,7 +395,7 @@ both 'source' and 'include' directories must be found in one of the directories named in systemPath. - In the debugger, press 'abort' to continue execution. + In the debugger, press 'Abort' to continue execution. " AutoloadFailedSignal raiseRequestWith:self @@ -411,29 +421,31 @@ "/ ]. "/ ]. - LoadedClasses add:newClass. "wow - it worked. now the big trick ..." -"/ newClass class setSoleInstance:self. "/ will be undone by become ... - oldMeta := self class. +"/ newClass class setSoleInstance:self. "/ will be undone by become ... +"/ self setName:(self name , ' (auto)'). -"/ self setName:(self name , ' (auto)'). - self dependents do:[:aDependent | - newClass addDependent:aDependent + Smalltalk changed:#aboutToAutoloadClass with:(self -> newClass). + newClass ~~ self ifTrue:[ + self dependents do:[:aDependent | + newClass addDependent:aDependent + ]. + self class becomeSameAs:newClass class. + self becomeSameAs:newClass. + + ObjectMemory flushCaches. ]. - Smalltalk changed:#aboutToAutoloadClass with:(self -> newClass). - self becomeSameAs:newClass. - oldMeta becomeSameAs:newClass class. - ObjectMemory flushCaches. - LoadedClasses rehash. + "the rehash here is pure superstition" + LoadedClasses rehash; add:newClass. newClass initializeWithAllPrivateClasses. newClass postAutoload. Smalltalk changed:#classDefinition with:newClass. - self changed:#loaded. + self changed:#loaded with:newClass. ^ newClass "Modified: / 5.3.1999 / 12:59:13 / cg" @@ -768,7 +780,10 @@ !Autoload class methodsFor:'queries'! accepts:aSignal - "redefined to avoid recursive autoload" + "redefined to avoid recursive autoload. + (#autoload eventually raises QueryExceptions. + These exception may send #accepts: to exception classes + that are currently being loaded)" |newClass| @@ -789,7 +804,9 @@ ! isBeingLoaded - ^ (self ~~ Autoload) and:[(Smalltalk at:self name) isNil ] + "answer true if the class loading is currently in process" + + ^ (self ~~ Autoload) and:[InProgressClasses includes:self] "Modified: / 16.2.1998 / 11:57:35 / stefan" ! @@ -832,10 +849,74 @@ ^ LoadedClasses includes:aClass ! ! +!Autoload methodsFor:'error handling'! + + +" +*** WARNING +*** +*** this method has been automatically created, +*** since all nil-subclasses should respond to some minimum required +*** protocol. +*** +*** Inspection and/or debugging of instances may not be possible, +*** if you remove/change this method. +" +! ! + +!Autoload methodsFor:'queries'! + +^ self basicSize * (ExternalBytes sizeofDouble) + ]. + self halt:'oops'. + ] + ]. + ^ 0 + + " + Point new byteSize + 'hello' byteSize + (ByteArray with:1 with:2) byteSize + (FloatArray with:1.5) byteSize + (DoubleArray with:1.5) byteSize + (WordArray with:1 with:2) byteSize + " + +" +*** WARNING +*** +*** this method has been automatically created, +*** since all nil-subclasses should respond to some minimum required +*** protocol. +*** +*** Inspection and/or debugging of instances may not be possible, +*** if you remove/change this method. +" +! ! + +!Autoload methodsFor:'testing'! + +"if the reciever is non-nil, return the value of aBlock, passing myself as argument. + Otherwise do nothing and return nil." + + ^ aBlock value:self + +" +*** WARNING +*** +*** this method has been automatically created, +*** since all nil-subclasses should respond to some minimum required +*** protocol. +*** +*** Inspection and/or debugging of instances may not be possible, +*** if you remove/change this method. +" +! ! + !Autoload class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/stx/libbasic/Autoload.st,v 1.126 2004-08-22 16:41:24 stefan Exp $' + ^ '$Header: /cvs/stx/stx/libbasic/Autoload.st,v 1.127 2004-09-23 12:57:49 stefan Exp $' ! ! Autoload initialize!