"

 COPYRIGHT (c) 1991 by Claus Gittinger

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

nil subclass:#Autoload

	instanceVariableNames:''

	classVariableNames:'LazyLoading AutoloadFailedSignal LoadedClasses'

	poolDictionaries:''

	category:'Kernel-Classes'

!

!Autoload class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1991 by Claus Gittinger

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

!

documentation

"

    In memory limited systems (as my 8Mb 386 is) all seldom-used classes are made

    subclasses of this class. Autoload catches all messages and

    files-In the corresponding code when first used. Then the cought message

    is resent to the (now existing) class.

    Late addition: above comment is no longer true - I have made now almost

    all Demos & Goodies be autoloaded ... even for big systems.

"

! !

!Autoload class methodsFor:'initialization'!

initialize

    AutoloadFailedSignal isNil ifTrue:[

	AutoloadFailedSignal := Object errorSignal newSignalMayProceed:true.

	AutoloadFailedSignal nameClass:self message:#autoloadFailedSignal.

	AutoloadFailedSignal notifierString:'autoload failed '.

	self setSuperclass:nil.

	ObjectMemory flushCaches.

    ]

! !

!Autoload class methodsFor:'Signal constants'!

autoloadFailedSignal

    "return the signal raised when an autoload fails"

    ^ AutoloadFailedSignal

! !

!Autoload class methodsFor:'adding/removing autoloaded classes'!

addClass:aClassName

    "given a name, install a corresponding autoload class stub for it"

    self addClass:aClassName inCategory:'autoloaded-Classes'

    "

     Autoload addClass:'Clock'

    "

    "Modified: 24.4.1996 / 19:54:16 / cg"

!

addClass:aClassName inCategory:aCategory

    "given a name, install a corresponding autoload class stub for it"

    |nameSymbol|

    nameSymbol := aClassName asSymbol.

    (Smalltalk at:nameSymbol) isNil ifTrue:[

        Autoload subclass:nameSymbol

             instanceVariableNames:''

             classVariableNames:''

             poolDictionaries:''

             category:aCategory.

    ]

    "

     Autoload addClass:'Clock' inCategory:'autoloaded-Demos'

    "

    "Modified: 24.4.1996 / 19:54:20 / cg"

!

removeClass:aClass

    "remove a class from the list of loaded classes"

    LoadedClasses remove:aClass ifAbsent:[]

    "Modified: 24.4.1996 / 19:54:35 / cg"

! !

!Autoload class methodsFor:'fileout'!

fileOutDefinitionOn:aStream

    "print an expression to define myself on aStream.

     Since autoloaded classes dont know their real definition, simply

     output some comment string making things clear in the browser."

    |myName fileName nm mgr classFileName packageDir|

    (self == Autoload) ifTrue:[^ super fileOutDefinitionOn:aStream].

    myName := self name.

    aStream nextPutAll:'"' ; nextPutAll:'Notice from Autoload:'; cr; cr;

	    spaces:4; nextPutAll:myName , ' is not yet loaded.'; cr; cr.

    aStream nextPutAll:'to load, execute: '.

    aStream cr; cr; spaces:4; nextPutAll:myName  , ' autoload'; cr.

    "

     the following is simply informative ...

     actually, its a hack & kludge - there ought to be a method for this

     in Smalltalk 

     (knowing the details of loading here is no good coding style)

    "

    fileName := Smalltalk fileNameForClass:myName.

    (ObjectFileLoader notNil and:[Smalltalk loadBinaries]) ifTrue:[

	(nm := Smalltalk libraryFileNameOfClass:myName) notNil ifTrue:[

	    nm := nm , ' (a classLibrary, possibly including more classes)'

	] ifFalse:[

	    nm := Smalltalk getBinaryFileName:(fileName , '.so').

	    nm isNil ifTrue:[

		nm := Smalltalk getBinaryFileName:(fileName , '.o')

	    ].

	    nm notNil ifTrue:[

		nm := nm , ' (a classBinary)'

	    ]

	].

    ].

    nm isNil ifTrue:[

	nm := Smalltalk getFileInFileName:(fileName , '.st').

	nm isNil ifTrue:[

	    nm := Smalltalk getSourceFileName:(fileName , '.st').

	].

    ].

    nm notNil ifTrue:[

	aStream cr; nextPutAll:'When accessed, ' , myName , ' will automatically be loaded'; cr.

	aStream nextPutAll:'from: '; cr; spaces:4; nextPutAll:nm.

	nm asFilename isSymbolicLink ifTrue:[

	    aStream cr; cr.

	    aStream nextPutAll:'which is a link to: '; cr; spaces:4; 

		    nextPutAll:(nm asFilename linkInfo at:#path).

	]

    ] ifFalse:[

	aStream cr; nextPutAll:'There is currently no file to load ' , myName , ' from.'; cr; cr.

	(mgr := Smalltalk at:#SourceCodeManager) notNil ifTrue:[

	    classFileName := Smalltalk fileNameForClass:myName.

	    packageDir := Smalltalk sourceDirectoryNameOfClass:myName.

	].

	(classFileName notNil and:[packageDir notNil]) ifTrue:[

	    aStream nextPutAll:'When accessed, I''ll ask the sourceCodeManager to load the code 

from "' , classFileName , '.st" in the "' , packageDir , '" package.'.

	] ifFalse:[

	    aStream nextPutAll:'When accessed, an error will be reported.'.

	]

    ].

    aStream cr; nextPutAll:'"'.

    "Created: 8.12.1995 / 00:31:53 / cg"

    "Modified: 9.12.1995 / 22:31:02 / cg"

! !

!Autoload class methodsFor:'lazy compilation'!

compileLazy

    "return the lazy loading flag - if on, fileIn is much faster,

     but pauses are to be expected later, since methods are compiled

     when first executed."

    ^ LazyLoading

!

compileLazy:aBoolean

    "turn on/off lazy loading - if on, fileIn is much faster,

     but pauses are to be expected later, since methods are compiled

     when first executed.

     If you like it, add a line to your startup file."

    LazyLoading := aBoolean

! !

!Autoload class methodsFor:'loading'!

autoload

    "use this to force loading

     - it is defined a noop in all non-autoloading clases"

    |mySelf myName newClass oldMeta project|

    mySelf := self.

    myName := self name asSymbol.

    "remove myself - to avoid recompilation"

    Smalltalk at:myName put:nil.

    "load it"

    Transcript showCr:('autoloading ', myName , ' ...'); endEntry.

    [

        "/

        "/ in order to not get a package of private (or whatever),

        "/ temporarily set the currentProject to nil.

        "/ we will later set the classes package to something useful

        "/

        Project notNil ifTrue:[

            project := Project current.

            Project setProject:nil.

        ].

        Smalltalk fileInClass:myName initialize:false lazy:LazyLoading.

        project notNil ifTrue:[

            Project setProject:project.

        ].

    ] valueOnUnwindDo:[

        project notNil ifTrue:[

            Project setProject:project.

        ].

        Smalltalk at:myName put:mySelf.

    ].

    "did it work ?"

    newClass := Smalltalk at:myName.

    Smalltalk at:myName put:mySelf.   "will be undone by become:"

    "no - report the error"

    newClass isNil ifTrue:[

        "

         this signal is raised, if an autoloaded class

         cannot be loaded. Usually, this happends when

         some sourcefile is missing, not readable 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

         'include/abbrev.stc'.

         Finally, your searchpath could be set wrong -

         both 'source' and 'include' directories must be found in

         one of the directories named in systemPath.

         In the debugger, press 'abort' to continue execution.

        " 

        AutoloadFailedSignal

            raiseRequestWith:self

            errorString:('autoload of ' , myName , ' failed').

        ^ nil

    ].

    "/

    "/ autoloaded classes get their package from the revision (if present)

    "/ this only happens with autoloaded sourceFiles which have no package

    "/ info encoded. (binary classes have it)

    "/

    newClass package isNil ifTrue:[

        newClass setPackageFromRevision.

    ].

    LoadedClasses isNil ifTrue:[

        LoadedClasses := IdentitySet new.

    ].

    LoadedClasses add:newClass.

    "wow - it worked. now the big trick ..."

"/    newClass class setSoleInstance:self.   "/ will be undone by become ...

    oldMeta := self class.

self setName:(self name , ' (auto)').

self class setName:(self class name , ' (auto)').

    self becomeSameAs:newClass.

    oldMeta becomeSameAs:newClass class.

    ObjectMemory flushCaches.

    LoadedClasses rehash.

    (newClass class implements:#initialize) ifTrue:[

        newClass initialize.

    ].

    newClass postAutoload.

    ^ newClass

    "Modified: 10.4.1996 / 08:52:47 / cg"

! !

!Autoload class methodsFor:'message catching'!

basicNew

    "catch basicNew - load the class and send it to the real one"

    ^ self doesNotUnderstand:(Message selector:#basicNew)

    "Modified: 24.4.1996 / 19:53:10 / cg"

!

basicNew:arg

    "catch basicNew: - load the class and send it to the real one"

    ^ self doesNotUnderstand:(Message selector:#basicNew: with:arg)

    "Modified: 24.4.1996 / 19:53:16 / cg"

!

comment

    "return the classes comment.

     Autoloaded classes have no comment; but I myself have one"

    (self == Autoload) ifTrue:[^ super comment].

    ^ 'not yet loaded'

!

doesNotUnderstand:aMessage

    "cought a message; load the class and retry the message"

    |newClass|

    self ~~ Autoload ifTrue:[

        newClass := self autoload.

        newClass notNil ifTrue:[

            ^ newClass perform:(aMessage selector)

                 withArguments:(aMessage arguments)

        ]

    ].

    ^ super doesNotUnderstand:aMessage

    "Modified: 24.4.1996 / 19:53:27 / cg"

!

new

    "catch new - load the class and send it to the real one"

    ^ self doesNotUnderstand:(Message selector:#new)

    "Modified: 24.4.1996 / 19:53:30 / cg"

!

new:arg

    "catch new: - load the class and send it to the real one"

    ^ self doesNotUnderstand:(Message selector:#new: with:arg)

    "Modified: 24.4.1996 / 19:53:32 / cg"

!

subclass:a1 instanceVariableNames:a2 classVariableNames:a3 poolDictionaries:a4 category:a5

    "catch subclass creation - this forces missing superclasses to be 

     loaded first"

    |newClass sel args|

    "take care: subclassing Autoload must still be possible"

    (self == Autoload) ifTrue:[

	^ super 

	    subclass:a1 

	    instanceVariableNames:a2

	    classVariableNames:a3

	    poolDictionaries:a4

	    category:a5

    ].

    newClass := self autoload.

    sel := thisContext selector.

    args := thisContext args.

    newClass notNil ifTrue:[

	^ newClass perform:sel withArguments:args

    ].

    ^ nil

! !

!Autoload class methodsFor:'queries'!

isBehavior

    "return true if the recevier is some kind of class.

     Autoloaded classes are definitely; therefore return true."

    ^ true

!

isBuiltInClass

    "return true if this class is known by the run-time-system.

     Returns false here."

    ^ false

    "Created: 10.12.1995 / 00:28:22 / cg"

    "Modified: 23.4.1996 / 15:55:36 / cg"

!

isLoaded

    "return true, if the class has been loaded; redefined in Autoload;

     see comment there. this allows testing for a class been already loaded."

    ^ (self == Autoload)

!

loadedClasses

    "return the set of classes that were autoloaded"

    ^ LoadedClasses

!

wasAutoloaded:aClass

    "return true, if aClass was autoloaded"

    ^ LoadedClasses notNil and:[LoadedClasses includes:aClass]

! !

!Autoload class methodsFor:'documentation'!

version

! !

Autoload initialize!