--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/JavaLookup.st Sat Feb 11 19:24:18 2012 +0000
@@ -0,0 +1,673 @@
+"
+ Copyright (c) 2010-2011 Jan Vrany, Jan Kurs & Marcel Hlopko,
+ SWING Research Group, Czech Technical University
+ in Prague
+
+ Permission is hereby granted, free of charge, to any person
+ obtaining a copy of this software and associated documentation
+ files (the 'Software'), to deal in the Software without
+ restriction, including without limitation the rights to use,
+ copy, modify, merge, publish, distribute, sublicense, and/or sell
+ copies of the Software, and to permit persons to whom the
+ Software is furnished to do so, subject to the following
+ conditions:
+
+ The above copyright notice and this permission notice shall be
+ included in all copies or substantial portions of the Software.
+
+ THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND,
+ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
+ OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+ HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+ FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
+ OTHER DEALINGS IN THE SOFTWARE.
+"
+"{ Package: 'stx:libjava' }"
+
+Lookup subclass:#JavaLookup
+ instanceVariableNames:'s2j j2s'
+ classVariableNames:'Instance'
+ poolDictionaries:''
+ category:'Languages-Java-Interop'
+!
+
+Lookup subclass:#Java2Smalltalk
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:JavaLookup
+!
+
+Lookup subclass:#Smalltalk2Java
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:JavaLookup
+!
+
+!JavaLookup class methodsFor:'documentation'!
+
+copyright
+"
+ Copyright (c) 2010-2011 Jan Vrany, Jan Kurs & Marcel Hlopko,
+ SWING Research Group, Czech Technical University
+ in Prague
+
+ Permission is hereby granted, free of charge, to any person
+ obtaining a copy of this software and associated documentation
+ files (the 'Software'), to deal in the Software without
+ restriction, including without limitation the rights to use,
+ copy, modify, merge, publish, distribute, sublicense, and/or sell
+ copies of the Software, and to permit persons to whom the
+ Software is furnished to do so, subject to the following
+ conditions:
+
+ The above copyright notice and this permission notice shall be
+ included in all copies or substantial portions of the Software.
+
+ THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND,
+ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
+ OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+ HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+ FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
+ OTHER DEALINGS IN THE SOFTWARE.
+
+"
+! !
+
+!JavaLookup class methodsFor:'instance creation'!
+
+cleanup
+
+ Instance := nil.
+
+ "Modified: / 25-02-2011 / 14:45:03 / kursjan <kursjan@fit.cvut.cz>"
+ "Created: / 19-09-2011 / 23:25:08 / Jan Kurs <kursjan@fit.cvut.cz>"
+ "Modified: / 15-12-2011 / 23:05:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+instance
+
+ Instance isNil ifTrue:[
+ Instance := self basicNew initialize
+ ].
+ ^Instance
+
+ "Modified: / 25-02-2011 / 14:45:03 / kursjan <kursjan@fit.cvut.cz>"
+ "Created: / 19-09-2011 / 23:20:49 / Jan Kurs <kursjan@fit.cvut.cz>"
+ "Modified: / 15-12-2011 / 23:05:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+new
+ ^ self shouldNeverBeSent.
+
+ "Created: / 25-02-2011 / 14:44:43 / kursjan <kursjan@fit.cvut.cz>"
+ "Modified: / 29-08-2011 / 21:10:12 / Jan Kurs <kursjan@fit.cvut.cz>"
+! !
+
+!JavaLookup methodsFor:'initialization'!
+
+initialize
+ "Invoked when a new instance is created."
+
+ s2j := Smalltalk2Java new.
+ j2s := Java2Smalltalk new.
+
+ "Modified: / 15-12-2011 / 23:06:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!JavaLookup methodsFor:'lookup'!
+
+lookupMethodForSelector:selector directedTo:initialSearchClass for:aReceiver withArguments:argArrayOrNil from:sendingContext ilc: ilcCache
+
+ "Invoked by the VM to ask me for a method to call.
+ The arguments are: the selector, receiver and arguments,
+ the class to start the search in (for here-, super and directed sends)
+ the sending context and the inline/poly cache (instance of
+ PolymorphicInlineCache). "
+
+ | m |
+ m := super lookupMethodForSelector:selector directedTo:initialSearchClass for:aReceiver withArguments:argArrayOrNil from:sendingContext ilc: ilcCache.
+ m notNil ifTrue: [ ^ m ].
+
+ sendingContext programmingLanguage isSmalltalk ifTrue:[
+ aReceiver class theNonMetaclass programmingLanguage isJava ifTrue:[
+ ^s2j lookupMethodForSelector:selector directedTo:initialSearchClass for:aReceiver withArguments:argArrayOrNil from:sendingContext ilc: ilcCache.
+ ]
+ ].
+
+ sendingContext programmingLanguage isJava ifTrue:[
+ aReceiver class programmingLanguage isSmalltalk ifTrue:[
+ ^j2s lookupMethodForSelector:selector directedTo:initialSearchClass for:aReceiver withArguments:argArrayOrNil from:sendingContext ilc: ilcCache.
+ ]
+ ].
+
+ ^nil
+
+ "Created: / 01-10-2011 / 13:18:40 / Jan Kurs <kursjan@fit.cvut.cz>"
+ "Created: / 15-12-2011 / 23:11:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!JavaLookup::Java2Smalltalk methodsFor:'lookup'!
+
+lookupMethodForSelector:selector directedTo:initialSearchClass for:receiver withArguments:argArrayOrNil from:sendingContext ilc: ilc
+
+ | d m |
+
+ d := JavaDescriptor readFrom: (selector readStream skipThrough: $(; backStep; yourself).
+ m := self lookupMethodForSelector: selector directedTo: initialSearchClass numArguments: d numArgs.
+ m notNil ifTrue: [
+ m := self compileProxyWithSelector: selector descriptor: d in: receiver class calling: m.
+ ilc notNil ifTrue:[ilc bindTo: m forClass: receiver class].
+ ^m.
+ ] ifFalse:[
+ ^ nil
+ ]
+
+ "Created: / 06-09-2011 / 22:04:04 / Jan Kurs <kursjan@fit.cvut.cz>"
+ "Modified: / 09-10-2011 / 22:59:18 / kursjan <kursjan@fit.cvut.cz>"
+ "Created: / 19-11-2011 / 12:37:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+lookupMethodForSelector:jselector directedTo:initialSearchClass numArguments: nArgs
+
+ | name cls |
+
+ name := jselector upTo: $(.
+
+ "Pass 1: Search for explicitly annotated method"
+ cls := initialSearchClass.
+ [ cls notNil ] whileTrue:[
+ cls methodDictionary keysAndValuesDo:[:sel :mthd|
+ | jdescriptor |
+
+ mthd numArgs == nArgs ifTrue:[
+ (jdescriptor := mthd annotationAt: #javaselector:) notNil ifTrue:[
+ jdescriptor arguments first == jselector ifTrue: [
+ ^mthd
+ ]
+ ].
+ ]
+ ].
+ cls := cls superclass.
+ ].
+
+ "Pass 2: Search for method with matching name"
+ cls := initialSearchClass.
+ [ cls notNil ] whileTrue:[
+ cls methodDictionary keysAndValuesDo:[:sel :mthd|
+ mthd numArgs == nArgs ifTrue:[
+ (sel startsWith: name) ifTrue:[
+ ^mthd
+ ]
+ ]
+ ].
+ cls := cls superclass.
+ ].
+
+ ^nil
+
+ "Created: / 16-12-2011 / 00:00:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!JavaLookup::Java2Smalltalk methodsFor:'utilities'!
+
+addSelector:selector withMethod:proxy toClass:class
+
+ ProxyMethod installProxies ifTrue:[
+ Class withoutUpdatingChangesDo:[
+ class addSelector:selector withMethod:proxy.
+ ]
+ ]
+
+ "Modified: / 23-12-2011 / 13:09:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+compileProxyWithSelector:selector descriptor:descriptor in:class calling:callee
+ |compiler proxy body|
+
+ compiler := ProxyMethodCompiler new.
+ body := compiler newJavaMethodInvocation:callee.
+ body descriptor:descriptor.
+ proxy := compiler
+ compile:body
+ arguments:callee numArgs
+ selector: selector.
+"/ JK: do nod add here
+"/ self
+"/ addSelector:selector
+"/ withMethod:proxy
+"/ toClass:class.
+ ^ proxy
+
+ "Created: / 14-12-2011 / 20:48:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 01-01-2012 / 19:33:45 / kursjan <kursjan@fit.cvut.cz>"
+! !
+
+!JavaLookup::Smalltalk2Java methodsFor:'lookup'!
+
+lookupMethodForSelector:selector directedTo:initialSearchClass for:receiver withArguments:argArrayOrNil from:sendingContext ilc: ilc
+ "
+ As a courtesy to a Smalltalker, try to map smalltalk selectors to a java ones.
+ Returns JavaMethodDescriptor or nil.
+ "
+ | name nameSizePlusOne candidates finder static cls m |
+
+ name := selector upTo: $:.
+ nameSizePlusOne := name size + 1.
+ static := receiver isBehavior.
+ candidates := OrderedCollection new.
+ finder := [:cls|
+ cls methodDictionary keysAndValuesDo:[:sel :mthd|
+ (mthd mclass ~~ ProxyMethod
+ and:[((sel size >= nameSizePlusOne) and:[(sel at: nameSizePlusOne) == $( and:[(sel startsWith: name)]])
+ and:[mthd descriptor numArgs == argArrayOrNil size]]) ifTrue:[
+ candidates add: mthd
+ ]
+ ]
+ ].
+
+ cls := initialSearchClass theNonMetaclass.
+ static ifTrue:[
+ finder value: cls
+ ] ifFalse:[
+ [ cls notNil and:[cls ~~ JavaObject] ] whileTrue:[
+ finder value: cls.
+ cls := cls superclass.
+ ]
+ ].
+
+ candidates notEmpty ifTrue:[
+ m := self compileProxyWithSelector: selector in: receiver class calling: candidates.
+ ilc notNil ifTrue:[ilc bindTo: m forClass: receiver class].
+
+ "Install the proxy"
+ self addSelector: selector withMethod: m toClass: receiver class.
+
+ ^m.
+ ].
+ ^nil
+
+ "Created: / 21-02-2011 / 13:38:55 / kursjan <kursjan@fit.cvut.cz>"
+ "Modified: / 29-08-2011 / 20:38:21 / kursjan"
+ "Modified: / 20-09-2011 / 00:03:48 / Jan Kurs <kursjan@fit.cvut.cz>"
+ "Modified (format): / 25-09-2011 / 21:08:45 / Jan Kurs <kursjan@fit.cvut.cz>"
+ "Created: / 19-11-2011 / 13:03:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 01-01-2012 / 17:41:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 01-01-2012 / 19:58:59 / kursjan <kursjan@fit.cvut.cz>"
+ "Modified (comment): / 02-01-2012 / 10:35:25 / kursjan <kursjan@fit.cvut.cz>"
+! !
+
+!JavaLookup::Smalltalk2Java methodsFor:'lookup (old)'!
+
+old_lookupMethodForSelector:selector directedTo:initialSearchClass for:receiver withArguments:argArrayOrNil from:sendingContext ilc: ilc
+ "
+ As a courtesy to a Smalltalker, try to map smalltalk selectors to a java ones.
+ Returns JavaMethodDescriptor or nil.
+ "
+ |descriptor candidate static cls m |
+
+ static := receiver isBehavior.
+ descriptor := JavaMethodDescriptor
+ name: (selector upTo:$:)
+ parameters: (argArrayOrNil ? #() collect:[:a|
+ (a class isString and: [JavaVM booted]) ifTrue:[
+ JavaFieldDescriptorWithUnionType new
+ addDescriptor: (JavaFieldDescriptor javaClass: a class);
+ addDescriptor: (JavaFieldDescriptor javaClass: (Java classForName: 'java.lang.String'));
+ yourself.
+ ] ifFalse:[
+ JavaFieldDescriptor javaClass: a class
+ ]
+ ]).
+ cls := initialSearchClass theNonMetaclass.
+ [ cls notNil and:[cls ~~ JavaObject] ] whileTrue:[
+ cls methodsDo:[:mthd|
+ "/(mthd selector startsWith: 'foo') ifTrue:[self breakPoint: #jv].
+ (mthd class ~~ ProxyMethod and:[mthd isStatic == static and:[descriptor match: mthd descriptor]]) ifTrue:[
+ candidate isNil ifTrue:[
+ candidate := mthd
+ ] ifFalse:[
+ candidate descriptorSymbol ~~ mthd descriptorSymbol ifTrue:[
+ "Hm, hm, two matching methods with different descriptors means
+ ambiguity...raise an error"
+
+ "Bit hacky - NamespaceAwareLookup already has method to generate
+ ambigouous send trampouline..."
+ ^NamespaceAwareLookup instance ambiguousMessageSend: selector withArgs: argArrayOrNil
+ ]
+ ].
+ ]
+ ].
+ cls := cls superclass.
+ ].
+ candidate notNil ifTrue:[
+ m := self compileProxyWithSelector: selector descriptor: descriptor in: receiver class calling: candidate.
+ ilc notNil ifTrue:[ilc bindTo: m forClass: receiver class].
+ ^m.
+ ].
+ ^nil
+
+ "Created: / 21-02-2011 / 13:38:55 / kursjan <kursjan@fit.cvut.cz>"
+ "Modified: / 11-04-2011 / 20:19:50 / kursjan <kursjan@fit.cvut.cz>"
+ "Modified: / 29-08-2011 / 20:38:21 / kursjan"
+ "Modified: / 20-09-2011 / 00:03:48 / Jan Kurs <kursjan@fit.cvut.cz>"
+ "Modified (format): / 25-09-2011 / 21:08:45 / Jan Kurs <kursjan@fit.cvut.cz>"
+ "Created: / 16-12-2011 / 23:05:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!JavaLookup::Smalltalk2Java methodsFor:'matching'!
+
+descriptorForJavaSelector:arg
+ ^ MessageDescription new
+ parserClass: JavaSelectorParser;
+ selector: arg;
+ yourself.
+
+ "Created: / 29-08-2011 / 20:41:48 / Jan Kurs <kursjan@fit.cvut.cz>"
+!
+
+descriptorForSmalltalkSelector:selector arguments: args
+ ^ MessageDescription new
+ parserClass: SmalltalkSelectorParser;
+ runtimeArguments: args;
+ selector: selector;
+ yourself.
+
+ "Created: / 29-08-2011 / 21:44:06 / Jan Kurs <kursjan@fit.cvut.cz>"
+!
+
+findBestMatchOf: smalltalkMethod in: javaMethods
+ | methods |
+ javaMethods size = 1 ifTrue: [
+ ^ javaMethods first.
+ ].
+ javaMethods size = 0 ifTrue: [
+ ^ nil
+ ].
+
+ methods := javaMethods select: [:m |
+ m argSize = smalltalkMethod argSize.
+ ].
+ methods size = 1 ifTrue: [
+ ^ methods first.
+ ].
+
+ methods := methods select: [:m |
+ self javaMatches: m argTypes to: smalltalkMethod args.
+ ].
+ methods size = 1 ifTrue: [
+ ^ methods first.
+ ].
+
+ methods size = 0 ifTrue: [
+ ^ nil.
+ ].
+
+ ^ Error raiseErrorString: 'Ambiguous selector: ', smalltalkMethod name.
+
+ "Created: / 29-08-2011 / 20:50:14 / Jan Kurs <kursjan@fit.cvut.cz>"
+!
+
+javaMatches: jArgs to: sArgs
+
+ 1 to: jArgs size do: [ :i |
+ ((JavaTypeBox typeBoxForJava: (jArgs at: i)) smalltalkType = ((sArgs at: i) className)) ifFalse: [ ^ false ].
+ ].
+ ^ true.
+
+ "Created: / 29-08-2011 / 21:21:37 / Jan Kurs <kursjan@fit.cvut.cz>"
+!
+
+javaSelectorsFor:class
+ | selectors cls static |
+ cls := class.
+ selectors := IdentitySet new.
+ self breakPoint: #jk info: 'determine static based on class'.
+ static := false.
+
+ [cls = JavaObject] whileFalse: [
+ cls methodDictionary keysAndValuesDo: [:k :v |
+ (v isJavaMethod and: [v isStatic = static]) ifTrue: [
+ selectors add: k.
+ ].
+ ].
+ cls := cls superclass.
+ ].
+ ^ selectors.
+
+ "Created: / 06-09-2011 / 22:20:34 / Jan Kurs <kursjan@fit.cvut.cz>"
+! !
+
+!JavaLookup::Smalltalk2Java methodsFor:'utilities'!
+
+addSelector:selector withMethod:proxy toClass:class
+
+ ProxyMethod installProxies ifTrue:[
+ Class withoutUpdatingChangesDo:[
+ class addSelector:selector withMethod:proxy.
+ ]
+ ]
+
+ "Modified: / 23-12-2011 / 13:09:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Created: / 01-01-2012 / 17:41:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+compileProxyWithSelector:selector in:class calling:methods
+ "For given set of methods, create a dispatching proxy with given selector.
+ This method performs typechecks on arguments and dispatch to proper method"
+
+ |compiler proxy body fallback|
+
+ compiler := ProxyMethodCompiler new.
+ fallback := self
+ fallbackWithSelector:class
+ in:selector
+ calling:methods
+ compiler:compiler.
+ "Generate and install dispatching tree..."
+ selector numArgs == 0 ifTrue:[
+ "If method has no arguments, no dynamic method dispatch is
+ required. Therefore, no fallback is needed. In theory, there is
+ no need for proxy method at all..."
+ self assert:methods size == 1.
+ body := compiler newJavaMethodInvocation:methods anyOne.
+ ] ifFalse:[
+ "JV@2012-01-01: Based on discussion with JK, if there is no overloaded method
+ DO NOT compile guard, call the method directly. We'll see..."
+ methods size == 1 ifTrue:[
+ body := (compiler newJavaMethodInvocation:methods anElement).
+ ] ifFalse:[
+ "For every method, create a guard and add it"
+ body := fallback.
+ ]
+ ].
+
+ "/Create and install proxy
+
+ proxy := compiler
+ compile:body
+ arguments:methods anyOne descriptor numPhysicalArgs
+ selector:selector.
+
+"/ self halt.
+"/ JK: do NOT install here, just compile and return the proxy. Let someone else to install
+"/ self
+"/ addSelector:selector
+"/ withMethod:proxy
+"/ toClasS:class.
+
+ ^ proxy
+
+ "Created: / 16-12-2011 / 23:21:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 30-12-2011 / 14:44:11 / kursjan <kursjan@fit.cvut.cz>"
+ "Modified: / 03-01-2012 / 22:15:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+compileProxyWithSelector: selector in: class calling: methods receiver: receiver arguments: arguments
+ "For given receiver and arguments, selects apropriate method from methods
+ and compile guard"
+
+ | compiler method proxy condition invocation fallback guard |
+
+ compiler := ProxyMethodCompiler new.
+
+ proxy := class compiledMethodAt: selector.
+ proxy notNil ifTrue:[
+ fallback := proxy body
+ ] ifFalse:[
+ fallback := self fallbackWithSelector: selector in: class calling: methods compiler: compiler.
+ ].
+
+ method := self selectMethodFrom: methods arguments: arguments.
+ invocation := compiler newJavaMethodInvocation:method.
+
+ condition := nil.
+ arguments withIndexDo:[:arg :index|
+ condition isNil ifTrue:[
+ condition := compiler newTypeCheck: arg class argument: index.
+ ] ifFalse:[
+ condition := condition and: (compiler newTypeCheck: arg class argument: index).
+ ].
+ ].
+
+ guard := compiler newGuard
+ condition: condition;
+ action: invocation;
+ fallback: fallback;
+ yourself.
+
+ proxy := compiler
+ compile:guard
+ arguments:methods anyOne descriptor numPhysicalArgs
+ selector:selector.
+
+ self
+ addSelector:selector
+ withMethod:proxy
+ toClass:class.
+
+ "Created: / 03-01-2012 / 22:14:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+fallbackWithSelector:selector in:class calling:methods compiler:compiler
+ ^ compiler
+ newJavaBlockInvocation:[:receiver :arguments |
+ self
+ compileProxyWithSelector:selector
+ in:class
+ calling:methods
+ receiver:receiver
+ arguments:arguments.
+ "/self breakPoint:#jv.
+ receiver perform:selector withArguments:arguments.
+ ]
+
+ "Modified: / 04-01-2012 / 21:35:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+selectMethodFrom: methods arguments: arguments
+
+ | candidates |
+
+ candidates := methods.
+ arguments withIndexDo:[:arg :index|
+ | cls |
+
+ cls := arg class.
+ candidates := candidates select:[:m|
+ self type: cls matches: (m descriptor parameters at: index) javaClass
+ ].
+ ].
+
+ candidates size == 0 ifTrue:[
+ self halt: 'Unfinished - no matching method'
+ ].
+ candidates size == 1 ifTrue:[
+ ^candidates anElement
+ ].
+
+ self halt: 'Unfinished - ambiguous'
+
+ "Created: / 03-01-2012 / 21:40:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+type: actual matches: formal
+ "Return true, if actual (parameter) type matches given formal (parameter) type"
+
+ formal isJavaPrimitiveType ifTrue:[
+ ^ actual == formal.
+ ].
+
+ actual isJavaPrimitiveType ifTrue:[
+ ^ formal isJavaWrapperClass and:[
+ formal javaWrappedClass == actual.
+ ]
+ ].
+
+ ^JavaVM canCast: actual to: formal
+
+ "Created: / 03-01-2012 / 22:36:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!JavaLookup::Smalltalk2Java methodsFor:'utilities (old)'!
+
+old_compileProxyWithSelector: selector descriptor: descriptor in: class calling: callee
+
+ | proxy invocation fallback |
+
+ "This method might (indirectly) be invoked by guarded method itself,
+ when all guards fails and method gets recompiled during fallback action.
+ In that case, we should not throw away existing proxy, but just extend it."
+
+ proxy := class compiledMethodAt: selector.
+ proxy isNil ifTrue:[
+ "No method exists, create one..."
+ proxy := ProxyMethod new.
+ proxy numberOfArgs: callee descriptor numPhysicalArgs.
+ proxy source:'I''m a proxy method, please inspect my body'.
+ "Create default fallback"
+ fallback := ProxyMethod newJavaBlockInvocation: [ self halt: 'Launch recompile, not yet implemented'].
+ "Install it..."
+ Class withoutUpdatingChangesDo:[
+ class addSelector: selector withMethod: proxy.
+ ]
+ ] ifFalse:[
+ "Method already exists, then the fallback is currently
+ installed body"
+ fallback := proxy body.
+ ].
+
+ "Now, create and install a node that invokes given method"
+ callee numArgs == 0 ifTrue:[
+ "If method has no arguments, no dynamic method dispatch is
+ required. Therefore, no fallback is needed. In theory, there is
+ no need for proxy method at all..."
+ self assert: descriptor numArgs size == 0.
+ invocation := ProxyMethod newJavaMethodInvocation: callee.
+ "Install it"
+ proxy body: invocation
+ ] ifFalse:[
+ "Create a guard"
+ invocation := ProxyMethod newGuard.
+ invocation condition: callee descriptor guardCondition.
+ invocation action: (ProxyMethod newJavaMethodInvocation: callee).
+ invocation fallback: fallback.
+ "Install it"
+ proxy addGuard: invocation.
+ ].
+ "/Finally, return the method
+ ^ proxy
+
+ "Created: / 16-12-2011 / 23:06:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!JavaLookup class methodsFor:'documentation'!
+
+version_SVN
+ ^ '$Id$'
+! !