13 cacheNativeImplementation

    14 

    15     "For details, see #cacheNativeImplementation:"

    16     

    17     ^CacheNativeImplementation

    18 

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

    20 !

    21 

    22 cacheNativeImplementation: aBoolean

    23 

    24     "If set, native implementations are cached, resulting

    25      in better performance when calling native methods.

    26      Hower, no change in native method implemenetaion will

    27      not be visible then, unless #flushAllCachedNativeMethods

    28      is explictely called"

    29 

    30     CacheNativeImplementation := aBoolean

    31 

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

    33 !

    34 

    37 

    38     "By default, do not cache native impls while developing"

    39     CacheNativeImplementation := Smalltalk isStandAloneApp.

    40 

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

    94 !JavaNativeMethod methodsFor:'private'!

    95 

    96 compileNativeImplementation: sel dispatchingTo: oldSel

    97 

    98     | src arg converted |

    99     src := (JavaVM class compiledMethodAt: oldSel) source.

   100     src := src asStringCollection.

   101     (src first includesString: 'aJavaContext') ifTrue:[

   102         arg := 'aJavaContext'

   103     ] ifFalse:[

   104         (src first includesString: 'nativeContext') ifTrue:[

   105             arg := 'nativeContext'

   106         ]

   107     ].

   108     arg ifNotNil:[

   109         src removeFirst asString.

   110         converted := true.

   111     ] ifNil:[

   112         arg := 'nativeContext'.

   113         src := '    self breakPoint: #jv info: ''Convert it to new-style natives''.

   114 

   115                 ^ self ', oldSel, ' nativeContext'.

   116         converted := false.            

   117     ].

   118 

   119     (JavaVM class 

   120         compile:

   121             (self nativeMethodTemplate bindWith:sel with: arg with: src asString)

   122         classified:         

   123             'native - ', ((javaClass javaPackage upTo:$$) replaceAll:$/ with:$. ))

   124         package: JavaVM package.

   125 

   126     converted ifTrue:[

   127         (JavaVM class compiledMethodAt: oldSel) category: 'native - old-style (converted)'

   128     ] ifFalse:[

   129        (JavaVM class compiledMethodAt: oldSel) category:  'native - old-style (FAILED to convert)'

   130     ]

   131 

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

   133     "Modified: / 01-05-2011 / 13:15:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"

   134 !

   135 

   136 compileNativeImplementationStub: sel

   137 

   138     (JavaVM class 

   139         compile:

   140             (self nativeMethodTemplate bindWith:sel with: 'nativeContext' with:('^ UnimplementedNativeMethodSignal raise'))

   141         classified:         

   142             'native - ', ((javaClass javaPackage upTo:$$) replaceAll:$/ with:$.))

   143         package: JavaVM package

   144 

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

   146 !

   147 

   148 nativeMethodTemplate

   149 

   150     ^'%1 %2

   151 

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

   153 

   154     %3'

   155 

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

   157 !

   158 

   159 searchNativeImplementation

   160 

   161     "Returns a SELECTOR of native method implementation.

   162     For now, two naming schemes are used. The onld one uses

   163     just a class name and selector as a name for native method impl.

   164     The new one uses fully qualified class name.

   165     "

   166 

   167     | nm newStyleSel oldStyleSel |

   168     nm := selector copyWithoutLast:signature size.

   169     newStyleSel := ('_' , ((javaClass name copyReplaceAll:$/ with:$_) replaceAll:$$ with:$_), '_' , nm , ':') asSymbol.    

   170     (JavaVM class canUnderstand: newStyleSel) ifTrue:

   171         ["Good, a JavaVM understands new style native selectors"

   172         ^newStyleSel].

   173 

   174     oldStyleSel := ('_' , (javaClass lastName copyReplaceAll:$$ with:$_) , '_' , nm , ':') asSymbol.

   175     (JavaVM class canUnderstand: oldStyleSel) ifTrue:

   176         [

   177         "Convert method on the fly only if Im Jan Vrany

   178          (to avoid confusion of other developers :-)"

   179         OperatingSystem getLoginName = 'jv' ifTrue:[

   180             "OK, old style method has not yet been converted to a newstyle one.

   181             Converts old-style method to a new-style one"

   182             self compileNativeImplementation: newStyleSel dispatchingTo: oldStyleSel.

   183             ^newStyleSel

   184         ] ifFalse:[

   185             ^oldStyleSel

   186         ]].

   187     self compileNativeImplementationStub: newStyleSel.

   188     ^newStyleSel

   189 

   190     "Created: / 30-04-2011 / 23:50:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"

   191     "Modified: / 01-05-2011 / 13:13:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"

   192 ! !

   193 

   249