"
 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'
!

Object 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
    ^ self new reload: oldClass with: newClass

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

!JavaClassReloader methodsFor:'reloading'!

reload: oldClass with: newClass

    | newClassToInstall |

    newClassToInstall := SingleClassReloader new reload: oldClass with: newClass.
    "Also, reload all subclasses - fields may have changed!!"
    newClassToInstall ~~ oldClass ifTrue:[
        oldClass subclassesDo:[:oldSubclass|
            | newSubclass |

            newSubclass := oldSubclass copy.
            newSubclass setSuperclass: newClassToInstall.
            newSubclass instSize: (newClassToInstall instSize + oldSubclass fields size).
            JavaVM registry registerClass: newSubclass.
        ].
    ].
    ^newClassToInstall.

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

!JavaClassReloader::SingleClassReloader methodsFor:'private'!

invalidate

    | anyInvalidated |

    anyInvalidated := false.
    JavaVM registry classesDo:[:class|
        anyInvalidated := anyInvalidated | (self invalidateClass: class).
    ].
    anyInvalidated ifTrue:[ObjectMemory flushCaches].

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

invalidateClass: javaClass

    ^javaClass constantPool invalidateForClass: oldClass name

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

migrate
    "Possibly migrate instances and class. Return the class that should
     be installed in registry afterwards"

    mustMigrateInstances ifTrue:[
        self migrateInstances.
        mustMigrateClass ifTrue:[
            self migrateClass
        ].
        ^newClass.
    ].

    mustMigrateClass ifTrue:[
        self migrateClass.
        ^newClass.
    ].
    self update.
    ^oldClass.

    "Created: / 20-02-2012 / 23:40:03 / Jan Vrany <jan.vrany@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>"
!

update

    "Brute force, copy instvars directly"
    self assert: oldClass class instSize == newClass class instSize.

    1 to: newClass class instSize do:[:i|
        newClass instVarAt: i put: (oldClass instVarAt: i).
    ].

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

!JavaClassReloader::SingleClassReloader methodsFor:'reloading'!

reload

    self prepare.
    self invalidate.
    ^self migrate.

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

reload: oldClassA with: newClassA

    oldClass := oldClassA.
    newClass := newClassA.
    ^ self reload.

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

!JavaClassReloader::SingleClassReloader::FieldMapping class methodsFor:'instance creation'!

old: old new:new

    ^self new old: old new: new.

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

!JavaClassReloader::SingleClassReloader::FieldMapping methodsFor:'accessing'!

new
    ^ new
!

new:something
    new := something.
!

old
    ^ old
!

old:something
    old := something.
!

old:oldArg new:newArg 
    old := oldArg.
    new := newArg.
! !

!JavaClassReloader::SingleClassReloader::FieldMapping methodsFor:'queries'!

mustMigrate
    "Returns true if the field must be migrated, false otherwise"

    | oldD newD |

    (old isNil or:[new isNil]) ifTrue:[ 
        ^ true "Either one is missing, must migrate"
    ].

    old index ~~ new index ifTrue:[
        ^true "Offsets changed, must migrate"
    ].

    oldD := old descriptor.
    newD := new descriptor.

    oldD = newD ifTrue:[
        ^false"Same descriptor, the easy case"
    ].

    (oldD first == $L and: [newD first == $L]) ifTrue:[
        ^false"Both object types, who cares about type safety in Smalltalk?"
    ].

    1 to: (oldD size min: newD size) do:[:i|
        ((oldD at: i) == $L and: [ (newD at: i) == $L ]) ifTrue:[
            ^false"Both object types, who cares about type safety in Smalltalk?"
        ].
        ((oldD at: i) ~~ $[ or: [ (newD at: i) ~~ $[ ]) ifTrue:[
            ^true"Different primitive/array types, must migrate"
        ].
    ].

    ^false

    "Created: / 21-02-2012 / 10:57:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!JavaClassReloader class methodsFor:'documentation'!

version_SVN
    ^ '$Id$'
! !