--- a/src/JavaNativeMethod.st Mon Apr 25 19:32:44 2011 +0000
+++ b/src/JavaNativeMethod.st Sun May 01 12:52:23 2011 +0000
@@ -2,7 +2,7 @@
JavaMethodWithHandler variableSubclass:#JavaNativeMethod
instanceVariableNames:'nativeImplementation'
- classVariableNames:''
+ classVariableNames:'CacheNativeImplementation'
poolDictionaries:''
category:'Languages-Java-Classes'
!
@@ -10,8 +10,35 @@
!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'!
@@ -64,14 +91,117 @@
"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
- |nm sel mthd sender|
+
+ "Called by the VM when a native method is
+ to be executed"
+
+ | sel mthd sender|
(mthd := nativeImplementation) isNil ifTrue:[
- nm := selector copyWithoutLast:signature size.
- sel := ('_' , (javaClass lastName copyReplaceAll:$$ with:$_) , '_' , nm , ':') asSymbol.
+ sel := self searchNativeImplementation.
mthd := (JavaVM class compiledMethodAt:sel).
(mthd isNil or:[mthd isLazyMethod]) ifTrue:[
@@ -85,7 +215,9 @@
perform:sel
with:sender.
].
- nativeImplementation := mthd.
+ CacheNativeImplementation ifTrue:[
+ nativeImplementation := mthd.
+ ]
].
^ mthd
@@ -100,7 +232,7 @@
"
"Modified: / 27-01-2000 / 13:34:53 / cg"
- "Modified: / 10-12-2010 / 15:10:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 30-04-2011 / 23:52:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!JavaNativeMethod class methodsFor:'documentation'!
@@ -114,3 +246,4 @@
! !
JavaNativeMethod initialize!
+