Autoload.st
changeset 8588 4bf5e572f5d9
parent 8482 6ca4f0d2594d
child 8590 4a2b666c8ade
--- 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 <myName>.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!