--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/JavaNativeMethod.st Thu Nov 15 22:10:02 2012 +0000
@@ -0,0 +1,322 @@
+"
+ 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' }"
+
+JavaMethodWithHandler variableSubclass:#JavaNativeMethod
+ instanceVariableNames:'nativeImplementation nCalls'
+ classVariableNames:'CacheNativeImplementation Verbose'
+ poolDictionaries:''
+ category:'Languages-Java-Classes'
+!
+
+!JavaNativeMethod 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
+
+"
+! !
+
+!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.
+ Verbose := false.
+ "
+Verbose := true.
+"
+
+ "Modified: / 30-04-2011 / 23:35:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (comment): / 03-11-2011 / 10:48:12 / Marcel Hlopko <hlopkmar@fel.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'!
+
+nCalls
+ ^ nCalls ? 0
+
+ "Modified: / 27-10-2012 / 18:05:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+nCallsReset
+ nCalls := 0
+
+ "Modified: / 27-10-2012 / 18:05:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+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
+
+ ^super 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 upTo: $(.
+ 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: / 13-08-2011 / 01:08:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!JavaNativeMethod methodsFor:'vm support'!
+
+nativeMethodInvokation
+ "Called by the VM when a native method is
+ to be executed - old (slow) implementation"
+
+ ^self nativeMethodInvokation: thisContext sender.
+
+ "
+ JavaNativeMethod flushAllCachedNativeMethods"
+
+ "Modified: / 27-01-2000 / 13:34:53 / cg"
+ "Modified: / 03-11-2011 / 10:47:48 / Marcel Hlopko <hlopkmar@fel.cvut.cz>"
+ "Modified: / 27-10-2012 / 15:15:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+nativeMethodInvokation: context
+ "Called by the VM when a native method is
+ to be executed.
+
+ 'context' is the context of being-invoked native method"
+
+ | sel mthd sender |
+ nCalls := (nCalls ? 0) + 1.
+ (mthd := nativeImplementation) isNil ifTrue: [
+ sel := self searchNativeImplementation.
+ mthd := (JavaVM class compiledMethodAt: sel).
+ (mthd isNil or: [ mthd isLazyMethod ]) ifTrue: [
+ sender := context.
+ sender sender selector == #noByteCode ifTrue: [
+ sender := sender sender.
+ sender := sender sender.
+ sender := sender sender.
+ ].
+ ^ JavaVM perform: sel with: sender.
+ ].
+ CacheNativeImplementation ifTrue: [ nativeImplementation := mthd. ]
+ ].
+ Verbose ifTrue: [Logger log: 'Native method invokation: ' , sel severity: #debug facility: #JVM].
+ ^ mthd
+ valueWithReceiver: JavaVM
+ arguments: (Array with: context)
+ selector: selector
+ search: JavaVM class
+ sender: nil
+
+ "
+ JavaNativeMethod flushAllCachedNativeMethods"
+
+ "Created: / 27-10-2012 / 15:13:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 27-10-2012 / 18:02:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!JavaNativeMethod class methodsFor:'documentation'!
+
+version
+ ^ '$Id$'
+!
+
+version_SVN
+ ^ '$Id$'
+
+! !
+
+JavaNativeMethod initialize!