"{ Package: 'stx:libjava' }"

JavaMethodWithHandler variableSubclass:#JavaNativeMethod
	instanceVariableNames:'nativeImplementation'
	classVariableNames:'CacheNativeImplementation'
	poolDictionaries:''
	category:'Languages-Java-Classes'
!


!JavaNativeMethod class methodsFor:'initialization'!

cacheNativeImplementation

    "For details, see #cacheNativeImplementation:"
    
    ^CacheNativeImplementation

    "Created: / 30-04-2011 / 23:38:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

cacheNativeImplementation: aBoolean

    "If set, native implementations are cached, resulting
     in better performance when calling native methods.
     Hower, no change in native method implemenetaion will
     not be visible then, unless #flushAllCachedNativeMethods
     is explictely called"

    CacheNativeImplementation := aBoolean

    "Created: / 30-04-2011 / 23:38:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

initialize
    self flags:(self flags bitOr:Behavior flagJavaMethod).

    "By default, do not cache native impls while developing"
    CacheNativeImplementation := Smalltalk isStandAloneApp.

    "Modified: / 30-04-2011 / 23:35:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!JavaNativeMethod class methodsFor:'cleanup'!

flushAllCachedNativeMethods
    self allInstancesDo:[:aNativeMethod |
        aNativeMethod nativeImplementation:nil
    ].

    "
     self flushAllCachedNativeMethods
    "

    "Created: / 24.12.1999 / 03:10:38 / cg"
    "Modified: / 24.12.1999 / 03:10:51 / cg"
! !

!JavaNativeMethod methodsFor:'accessing'!

nativeImplementation
    "return the value of the instance variable 'nativeImplementation' (automatically generated)"

    ^ nativeImplementation

    "Created: / 25.9.1999 / 23:08:00 / cg"
!

nativeImplementation:something
    "set the value of the instance variable 'nativeImplementation' (automatically generated)"

    nativeImplementation := something.

    "Created: / 25.9.1999 / 23:08:00 / cg"
!

sourceLineNumber
    ForceByteCodeDisplay == true ifTrue:[ ^ 1].
    lineNumberTable notNil ifTrue:[ ^ lineNumberTable at:2].
    ^1


    "
    ^ (JavaSourceCodeCache new) 
        findLineForMethod:(self selector)
        inClass:javaClass.
    "

    "Modified: / 13-12-2010 / 13:55:55 / Jan Kurs <kurs.jan@post.cz>"
    "Modified: / 13-12-2010 / 23:46:30 / Marcel Hlopko <hlopik@gmail.com>"
    "Created: / 17-12-2010 / 10:34:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!JavaNativeMethod methodsFor:'private'!

compileNativeImplementation: sel dispatchingTo: oldSel

    | src arg converted |
    src := (JavaVM class compiledMethodAt: oldSel) source.
    src := src asStringCollection.
    (src first includesString: 'aJavaContext') ifTrue:[
        arg := 'aJavaContext'
    ] ifFalse:[
        (src first includesString: 'nativeContext') ifTrue:[
            arg := 'nativeContext'
        ]
    ].
    arg ifNotNil:[
        src removeFirst asString.
        converted := true.
    ] ifNil:[
        arg := 'nativeContext'.
        src := '    self breakPoint: #jv info: ''Convert it to new-style natives''.

                ^ self ', oldSel, ' nativeContext'.
        converted := false.            
    ].

    (JavaVM class 
        compile:
            (self nativeMethodTemplate bindWith:sel with: arg with: src asString)
        classified:         
            'native - ', ((javaClass javaPackage upTo:$$) replaceAll:$/ with:$. ))
        package: JavaVM package.

    converted ifTrue:[
        (JavaVM class compiledMethodAt: oldSel) category: 'native - old-style (converted)'
    ] ifFalse:[
       (JavaVM class compiledMethodAt: oldSel) category:  'native - old-style (FAILED to convert)'
    ]

    "Created: / 01-05-2011 / 00:08:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 01-05-2011 / 13:15:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

compileNativeImplementationStub: sel

    (JavaVM class 
        compile:
            (self nativeMethodTemplate bindWith:sel with: 'nativeContext' with:('^ UnimplementedNativeMethodSignal raise'))
        classified:         
            'native - ', ((javaClass javaPackage upTo:$$) replaceAll:$/ with:$.))
        package: JavaVM package

    "Created: / 01-05-2011 / 00:08:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

nativeMethodTemplate

    ^'%1 %2

    <javanative: ''', javaClass name , ''' name: ''', (selector copyWithoutLast:signature size), '''>

    %3'

    "Created: / 01-05-2011 / 00:12:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

searchNativeImplementation

    "Returns a SELECTOR of native method implementation.
    For now, two naming schemes are used. The onld one uses
    just a class name and selector as a name for native method impl.
    The new one uses fully qualified class name.
    "

    | nm newStyleSel oldStyleSel |
    nm := selector copyWithoutLast:signature size.
    newStyleSel := ('_' , ((javaClass name copyReplaceAll:$/ with:$_) replaceAll:$$ with:$_), '_' , nm , ':') asSymbol.    
    (JavaVM class canUnderstand: newStyleSel) ifTrue:
        ["Good, a JavaVM understands new style native selectors"
        ^newStyleSel].

    oldStyleSel := ('_' , (javaClass lastName copyReplaceAll:$$ with:$_) , '_' , nm , ':') asSymbol.
    (JavaVM class canUnderstand: oldStyleSel) ifTrue:
        [
        "Convert method on the fly only if Im Jan Vrany
         (to avoid confusion of other developers :-)"
        OperatingSystem getLoginName = 'jv' ifTrue:[
            "OK, old style method has not yet been converted to a newstyle one.
            Converts old-style method to a new-style one"
            self compileNativeImplementation: newStyleSel dispatchingTo: oldStyleSel.
            ^newStyleSel
        ] ifFalse:[
            ^oldStyleSel
        ]].
    self compileNativeImplementationStub: newStyleSel.
    ^newStyleSel

    "Created: / 30-04-2011 / 23:50:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 01-05-2011 / 13:13:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!JavaNativeMethod methodsFor:'vm support'!

nativeMethodInvokation

    "Called by the VM when a native method is
     to be executed"

    | sel mthd sender|

    (mthd := nativeImplementation) isNil ifTrue:[
        sel := self searchNativeImplementation.

        mthd := (JavaVM class compiledMethodAt:sel).
        (mthd isNil or:[mthd isLazyMethod]) ifTrue:[
            sender := thisContext sender.
            sender sender selector == #noByteCode ifTrue:[
                sender := sender sender.
                sender := sender sender.
                sender := sender sender.
            ].
            ^ JavaVM 
                perform:sel
                with:sender.
        ].
        CacheNativeImplementation ifTrue:[
            nativeImplementation := mthd.
        ]
    ].

    ^ mthd
        valueWithReceiver:JavaVM
        arguments:(Array with:thisContext sender)
        selector:selector
        search:JavaVM class
        sender:nil

"
JavaNativeMethod flushAllCachedNativeMethods
"

    "Modified: / 27-01-2000 / 13:34:53 / cg"
    "Modified: / 30-04-2011 / 23:52:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!JavaNativeMethod class methodsFor:'documentation'!

version
    ^ '$Id$'
!

version_SVN
    ^ '$Id$'
! !

JavaNativeMethod initialize!