"

 COPYRIGHT (c) 1996-2011 by Claus Gittinger

 New code and modifications done at SWING Research Group [1]:

 COPYRIGHT (c) 2010-2011 by Jan Vrany, Jan Kurs and Marcel Hlopko

                            SWING Research Group, Czech Technical University in Prague

 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.

 [1] Code written at SWING Research Group contains a signature

     of one of the above copright owners. For exact set of such code,

     see the differences between this version and version stx:libjava

     as of 1.9.2010

"

"{ Package: 'stx:libjava' }"

Object subclass:#JavaClassReloader

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	category:'Languages-Java-Support'

!

Notification subclass:#RecompileRequest

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	privateIn:JavaClassReloader

!

Notification subclass:#ReloadRequest

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	privateIn:JavaClassReloader

!

JavaClassReloader subclass:#SingleClassReloader

	instanceVariableNames:'oldClass newClass mustMigrateInstances mustMigrateClass

		instFieldMapping staticFieldMapping'

	classVariableNames:''

	poolDictionaries:''

	privateIn:JavaClassReloader

!

Object subclass:#FieldMapping

	instanceVariableNames:'old new'

	classVariableNames:''

	poolDictionaries:''

	privateIn:JavaClassReloader::SingleClassReloader

!

!JavaClassReloader class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1996-2011 by Claus Gittinger

 New code and modifications done at SWING Research Group [1]:

 COPYRIGHT (c) 2010-2011 by Jan Vrany, Jan Kurs and Marcel Hlopko

                            SWING Research Group, Czech Technical University in Prague

 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.

 [1] Code written at SWING Research Group contains a signature

     of one of the above copright owners. For exact set of such code,

     see the differences between this version and version stx:libjava

     as of 1.9.2010

"

!

documentation

"

    A main workhorse for reloading (updating) java classes

    in running system.

    [author:]

        Jan Vrany <jan.vrany@fit.cvut.cz>

    [instance variables:]

    [class variables:]

    [see also:]

"

! !

!JavaClassReloader class methodsFor:'reloading'!

reload: oldClass with: newClass

    "Update old class to match the definition of newClass"

    ^ self new reload: oldClass with: newClass

    "Created: / 20-02-2012 / 23:29:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified (comment): / 14-09-2013 / 15:51:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!JavaClassReloader class methodsFor:'reloading-requests'!

requestRecompile: aJavaClass

    RecompileRequest newException

        parameter: aJavaClass;

        raiseRequest

    "Created: / 08-10-2013 / 19:26:20 / Marcel Hlopko <marcel.hlopko@fit.cvut.cz>"

    "Modified: / 13-10-2013 / 20:40:09 / Marcel Hlopko <marcel.hlopko@fit.cvut.cz>"

    "Modified: / 15-10-2013 / 01:19:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

requestReload: aJavaClass

    ReloadRequest newException

        parameter: aJavaClass;

        raiseRequest

    "Created: / 08-10-2013 / 19:26:12 / Marcel Hlopko <marcel.hlopko@fit.cvut.cz>"

    "Modified: / 15-10-2013 / 01:19:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!JavaClassReloader methodsFor:'reloading'!

reload: oldClass with: newClass

    | newClassToInstall recompileRequests reloadRequests |

    reloadRequests := Set new.

    recompileRequests := Set new.

    [

        newClassToInstall := SingleClassReloader new reload: oldClass with: newClass.

        "Also, reload all subclasses - fields may have changed!!"

        newClassToInstall ~~ oldClass ifTrue: [

            oldClass mergeVersionsWith: newClassToInstall.

            oldClass subclassesDo:[:oldSubclass|

                | newSubclass |

                newSubclass := oldSubclass copy.

                newSubclass setSuperclass: newClassToInstall.

                newSubclass instSize: (newClassToInstall instSize + oldSubclass fields size).

                self requestReload: newSubclass.

            ].

        ].

    ] on: RecompileRequest do:[:recompileRequest |

        "/ Catch all recompile requests

        (recompileRequests contains:[:each | each parameter == recompileRequest parameter]) ifFalse:[

            recompileRequests add: recompileRequest 

        ].

        recompileRequest proceed.

    ] on: ReloadRequest do:[:reloadRequest |

        "/ Catch all reload requests

        (reloadRequests contains:[:each | each parameter == reloadRequest parameter]) ifFalse:[

            reloadRequests add: reloadRequest 

        ].

        reloadRequest proceed.

    ].

    "/ Remove all reload request for classes for which there have been

    "/ recompile request as recompile implies reload...

    reloadRequests := reloadRequests reject:[:each | recompileRequests contains:[:eachRecompile | each parameter == eachRecompile parameter]].

    "/ Now execute all deferred recompile/reload requests.

    recompileRequests do:[:each | each recompile ].

    reloadRequests do:[:each | each reload ].

    ^newClassToInstall.

    "Created: / 04-04-2012 / 01:32:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 13-10-2013 / 20:52:58 / Marcel Hlopko <marcel.hlopko@fit.cvut.cz>"

    "Modified: / 15-10-2013 / 01:16:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

unload: oldClass

    oldClass subclassesDo:[:cls | 

        JavaVM registry unregisterClass: cls 

    ].

    JavaVM registry allClassesDo:[:cls|        

        "/ JV: Q: Should we remove all users of the interface? Let's do it, but not

        "/        sure if that's necessary/desirable

        | ifaces |

        ifaces := cls getInterfaces.

        ifaces notNil ifTrue:[

            (ifaces  anySatisfy:[:ref|

                    ref isJavaClass ifTrue:[

                        ref == oldClass

                    ] ifFalse:[

                        ref name =  oldClass binaryName

                    ]

            ]) ifTrue:[

                JavaVM registry unregisterClass: cls

            ].

        ].

        cls constantPool invalidateForClass: oldClass binaryName

    ]

    "Created: / 14-09-2013 / 15:53:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 09-04-2014 / 18:43:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!JavaClassReloader methodsFor:'reloading-requests'!

requestRecompile:aJavaClass

    ^ self class requestRecompile:aJavaClass

!

requestReload:aJavaClass

    ^ self class requestReload:aJavaClass

! !

!JavaClassReloader::RecompileRequest methodsFor:'default actions'!

defaultAction

    "the default action is to return the default value.

     Subclasses may redefine this"

    ^ self recompile

    "Created: / 15-10-2013 / 00:31:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

recompile

    JavaCompiler recompile: self parameter

    "Created: / 15-10-2013 / 00:48:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!JavaClassReloader::ReloadRequest methodsFor:'default actions'!

defaultAction

    "the default action is to return the default value.

     Subclasses may redefine this"

    ^ self reload

    "Created: / 15-10-2013 / 00:37:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

reload

    JavaVM registry registerClass: self parameter.

    "Created: / 15-10-2013 / 00:49:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!JavaClassReloader::SingleClassReloader methodsFor:'private'!

invalidate

    | anyInvalidated |

    anyInvalidated := false.

    JavaVM registry allClassesDo:[:class|

        anyInvalidated := (self invalidateClass: class) | anyInvalidated.

    ].

    anyInvalidated ifTrue:[ObjectMemory flushCaches].

    "

    Eclipse Compiler for Java is too smart - when a field is not accessible, it doesn't generate

    GETFIELD instructions, it generates ATHROW which throws stx.libjava.tools.compiler.CompileError

    (originally, it throws java.lang.Error, but we hacked it - see CompilerError static initializer.

    Here we recompile all classes with CompileError - just to be safe.

    "

    "/JavaCompiler recompileErroneousClassesReferringTo: newClass ignoring: oldClass.

    "Created: / 21-02-2012 / 09:47:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 02-10-2013 / 23:27:59 / Marcel Hlopko <marcel.hlopko@fit.cvut.cz>"

    "Modified: / 09-04-2014 / 18:43:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

invalidateClass: javaClass 

    ^ javaClass ~~ oldClass and:[javaClass constantPool invalidateForClass: oldClass binaryName]

    "Created: / 21-02-2012 / 09:58:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified (format): / 13-10-2013 / 20:43:57 / Marcel Hlopko <marcel.hlopko@fit.cvut.cz>"

    "Modified: / 17-10-2013 / 02:34:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

migrate

    "Possibly migrate instances and class. Return the class that should

     be installed in registry once reloader finishes his job.

     At this point, all references are already invalidated (see #reload)

     "

    mustMigrateInstances ifTrue:[

        self migrateInstances.

        mustMigrateClass ifTrue:[

            self migrateClass

        ].

        ^newClass.

    ].

    mustMigrateClass ifTrue:[

        self migrateClass.

        ^newClass.

    ].

    self updateOldClass.

    ^oldClass.

    "Created: / 20-02-2012 / 23:40:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified (comment): / 16-12-2012 / 17:39:26 / Marcel Hlopko <marcel.hlopko@fit.cvut.cz>"

!

migrateClass

    "/self error:'Not yet supported'

    "Created: / 21-02-2012 / 11:04:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

migrateInstance: object

    self assert: object class == oldClass.

    "Created: / 30-03-2012 / 19:42:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

migrateInstances

    oldClass allInstancesDo:[:i|

        self migrateInstance:i.

    ].

    "Created: / 21-02-2012 / 11:04:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

prepare

    "Analyze and prepare data for reloading" 

    self prepareInstFieldMapping.

    self prepareStaticFieldMapping.

    "Created: / 20-02-2012 / 23:40:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

prepareFieldMap: fields

    | map |

    map := Dictionary new.

    fields do:[ :field | map at: field name put: field ].

    ^map

    "Created: / 21-02-2012 / 09:42:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

prepareInstFieldMapping

    "Scans both old and new class inst fields and create a mapping.

     Sets mustMigrateInstances"

    | newFields |

    mustMigrateInstances := false.

    instFieldMapping := Set new.

    newFields := self prepareFieldMap: newClass allFields.

    oldClass fields do:[:old|

        | new mapping |

        new := newFields at: old name ifAbsent:[nil].

        new notNil ifTrue:[ newFields removeKey: old name ].

        mapping := FieldMapping old: old new: new.

        mustMigrateInstances := mustMigrateInstances or:[mapping mustMigrate].

        instFieldMapping add: mapping.

    ].

    "Remaining fields are new, i.e., does not exist in

     old class. Add them to the mapping"

    newFields do:[:new|

        instFieldMapping add: (FieldMapping old: nil new: new).

        mustMigrateInstances := true

    ].

    "Created: / 21-02-2012 / 09:32:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

prepareStaticFieldMapping

    "Scans both old and new class inst fields and create a mapping.

     Sets mustMigrateInstances"

    | newFields |

    mustMigrateClass := false.

    staticFieldMapping := Set new.

    newFields := self prepareFieldMap: newClass allStaticFields.

    oldClass staticFields do:[:old|

        | new mapping |

        new := newFields at: old name ifAbsent:[nil].

        new notNil ifTrue:[ newFields removeKey: old name ].

        mapping := FieldMapping old: old new: new.

        mustMigrateClass:= mustMigrateClass or:[mapping mustMigrate].

        staticFieldMapping add: mapping.

    ].

    "Remaining fields are new, i.e., does not exist in

     old class. Add them to the mapping"

    newFields do:[:new|

        staticFieldMapping add: (FieldMapping old: nil new: new).

        mustMigrateClass:= true

    ].

    "Created: / 21-02-2012 / 09:45:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

updateOldClass

    "At this point we know that both classes have same layout. So we can

     simply copy methods and other info from new class to old one. 

     References must be flushed anyway!! We need to copy constant pool over,

     indices may have changed. And we will copy fields as well, types may

     have been generalized.

     Also, here we also track method added and removed and if either

     one is an overload, request recompile of all dependent classes.

    "

    | oldMethods oldMethodsRemoved newMethods newMethodsAdded |

    oldMethods := oldClass methodDictionary.

    oldMethodsRemoved := oldMethods values asSet.

    newMethods := newClass methodDictionary copy.

    newMethodsAdded := Set new.

    newMethods keysDo:[:selector|

        | oldM newM |

        oldM := oldMethods at: selector ifAbsent:[nil].

        newM := newMethods at: selector.

        oldM notNil ifTrue:[

            oldMethodsRemoved remove: oldM.

            (oldM canBeUpdatedFrom: newM) ifTrue:[

                oldM class == newM class ifTrue:[

                    oldM updateFrom: newM.

                ].

                newMethods at: selector put: oldM.

            ]

        ] ifFalse:[

            newMethodsAdded add: newM.

        ].

    ].

    newMethods do:[:m|m setJavaClass: oldClass].

    oldClass setAttributes: newClass attributes.

    oldClass annotations: newClass annotations.

    oldClass setMethodDictionary: newMethods.

    oldClass setConstantPool: newClass constantPool.

    oldClass setSource: newClass sourceString.

    oldClass setClassfileBytes: newClass classfileBytes.

    oldClass setFields: newClass fields.

    oldClass setStaticFields: newClass staticFields.

    "Flush all proxies, they mau refer to old static methods"

    oldClass class setMethodDictionary: MethodDictionary new.

    oldMethodsRemoved do:[:oldMRemoved |

        oldMRemoved isJavaMethod ifTrue:[

            self requestRecompileSendersOf: oldMRemoved.

        ].

    ].

    newMethodsAdded do:[:newMAdded |

        | overloads name |

        newMAdded isStatic ifFalse:[

            overloads := Set new.

            name := newMAdded name.

            self withAllSuperclassesAndInterfacesOf: newMAdded javaClass do:[:cls|

                cls methodDictionary keysAndValuesDo:[:selector :method |

                    (method ~~ newMAdded and:[method isStatic not and:[method name = name]]) ifTrue:[

                        overloads add: method.

                    ].

                ].

            ].

            overloads do:[:overloadedM |

                self requestRecompileSendersOf: overloadedM.

            ].

        ]

    ].

    "Created: / 16-12-2012 / 17:36:52 / Marcel Hlopko <marcel.hlopko@fit.cvut.cz>"

    "Modified: / 12-10-2013 / 19:20:03 / Marcel Hlopko <marcel.hlopko@fit.cvut.cz>"

    "Modified: / 28-10-2013 / 11:38:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!JavaClassReloader::SingleClassReloader methodsFor:'private-helpers'!

withAllSuperclassesAndInterfacesOf: aJavaClass do: aBlock

    | queue seen |

    queue := OrderedCollection with: aJavaClass.

    seen := Set new.

    [ queue isEmpty ] whileFalse:[

        | cls |

        cls := queue removeFirst.

        (seen includes: cls) ifFalse:[

            seen add: cls.

            aBlock value: cls.

            queue addAll: cls interfaces.

            cls superclass ~~ JavaObject ifTrue:[

                queue add: cls superclass.

            ].