--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/JavaObject.st Thu Nov 15 22:10:02 2012 +0000
@@ -0,0 +1,483 @@
+"
+ 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' }"
+
+Object subclass:#JavaObject
+ instanceVariableNames:'_lockWord_'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Languages-Java-Classes'
+!
+
+!JavaObject 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
+
+"
+!
+
+documentation
+"
+ 'Proto' class for all Java classes: java.lang.Object inherits
+ from JavaObject class. Methods provided here are provides a 'glue'
+ code necessary to integrate Java objects into Smalltalk world.
+
+ The 'lock' instance variable here is to support Java monitors.
+ It contains either smalltinteger with lockword or a reference to
+ full JavaMonitor.
+
+ [author:]
+ Claus Gittinger
+ Jan Vrany <jan.vrany@fit.cvut.cz>
+
+ [instance variables:]
+ _lockWord_ <SmallInteger|JavaMonitor> either thin-locing lock word
+ or fat-lock (JavaMonitor). The funny name
+ here is to prevent name clashes
+
+ [class variables:]
+
+ [see also:]
+
+"
+! !
+
+!JavaObject class methodsFor:'misc'!
+
+resolveClassRefs
+!
+
+resolveClassRefsIgnoring:setOfClasses
+! !
+
+!JavaObject class methodsFor:'smalltalk interface'!
+
+convertJavaObject:val signature:retValSignature
+^ val.
+
+ retValSignature = 'void' ifTrue:[
+ ^ #void
+ ].
+ retValSignature = 'boolean' ifTrue:[
+ val == 0 ifTrue:[^ false].
+ ^ true
+ ].
+ retValSignature = 'int' ifTrue:[
+ val isInteger ifFalse:[
+ self halt
+ ].
+ ^ val
+ ].
+ retValSignature = 'char[]' ifTrue:[
+ "/ these are ST-strings
+ ^ val
+ ].
+
+ retValSignature = 'char' ifTrue:[
+ "/ these are ST-characters
+ val isInteger ifTrue:[
+ ^ Character value:val
+ ].
+ self halt.
+ ^ val
+ ].
+
+ retValSignature = 'Object' ifTrue:[
+ ^ val
+ ].
+
+ retValSignature = 'String' ifTrue:[
+ ^ Java as_ST_String:val
+ ].
+
+ 'no conversion for: ' print. val class name print. ' to: ' print. retValSignature printNL.
+ ^ val.
+
+ "Modified: 8.8.1997 / 12:07:23 / cg"
+!
+
+javaStringFrom:aString
+ "hard-coding internas of java.lang.String here is bad ..."
+
+ self halt.
+ ^ Java as_String:aString
+
+ "Modified: 7.8.1997 / 21:17:32 / cg"
+!
+
+stringFromJavaString:aJavaString
+ "hard-coding internas of java.lang.String here is bad ..."
+
+ self halt.
+ ^ Java as_ST_String:aJavaString
+
+ "Modified: 8.8.1997 / 12:07:29 / cg"
+! !
+
+!JavaObject methodsFor:'accessing-Java'!
+
+getJavaLockWord
+ "Returns a Java lock word for given object. The returned
+ value is
+ - either SmallInteger that encodes the thinlock
+ - or a fat lock, instance of JavaMonitor
+ "
+
+ "/For nonJava objects, always return fatlock
+
+ ^_lockWord_
+
+ "Created: / 26-08-2012 / 14:03:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+getJavaMonitor
+ "Returns fat JavaMonitor associated with the receiver"
+
+ "/ For Java objects, check if there is allready a thinlock,
+ "/ inflate it and return the fatlock
+
+ _lockWord_ class == SmallInteger ifTrue:[
+ _lockWord_ := JavaVM inflateLockFor: self lockword: _lockWord_.
+ ].
+ ^_lockWord_
+
+ "Created: / 26-08-2012 / 18:35:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+setJavaLockWord: lockWordOrJavaMonitor
+ "Sets a Java lock word for receiver to lockWordOrJavaMonitor.
+ The lockWordOrJavaMonitor must be:
+ - either SmallInteger that encodes the thinlock
+ - or a fat lock, instance of JavaMonitor
+ "
+
+ "/for non-Java objects, store fat lock in LockTable in JavaVM
+
+ ^_lockWord_ := lockWordOrJavaMonitor
+
+ "Created: / 26-08-2012 / 14:07:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!JavaObject methodsFor:'exception handling support'!
+
+catchInDebugger
+ "if set, the debugger will handle this signal in its event loop and will close itself
+ without asking for close-confirmation.
+ This allows for debugged processes to be terminated without a user confirmation dialog
+ (for now, this is used in expecco's hard-terminate function to shut down any open debuggers
+ together with the test-process).
+ Dummy here"
+
+ ^false
+
+ "Created: / 20-08-2012 / 14:15:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+description
+
+ self class isThrowable ifTrue:[
+ ^self getMessage
+ ].
+ ^super description
+
+ "Created: / 20-08-2012 / 14:19:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+isQuerySignal
+
+ ^false
+
+ "Created: / 18-03-2012 / 13:11:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+parent
+ "Required for old instance based exceptions, sigh"
+ ^nil
+
+ "Created: / 18-03-2012 / 13:26:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+signal
+
+ self class isThrowable ifTrue:[
+ ^self class.
+ ].
+ ^super signal
+
+ "Created: / 20-08-2012 / 14:15:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!JavaObject methodsFor:'finalization'!
+
+finalizationLobby
+
+"/ ^super finalizationLobby
+
+ ^JavaVM finalizationLobby "/ Do not use this yet!!
+
+ "Created: / 24-07-2012 / 01:04:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!JavaObject methodsFor:'initialization'!
+
+initialize
+ self perform:#'<init>()V'.
+
+ "Created: / 09-06-2012 / 21:49:37 / Jan Kurs (kursjan@fit.cvut.cz)"
+!
+
+initializeToZero
+ |sz|
+
+ sz := self class instSize.
+ 1 to:sz do:[:i |
+ self instVarAt:i put:0
+ ]
+! !
+
+!JavaObject methodsFor:'inspecting'!
+
+inspectorExtraAttributes
+
+ | attrs nm |
+
+ attrs := super inspectorExtraAttributes.
+ nm := self class name.
+ nm == #'java/lang/reflect/Method' ifTrue:[
+ attrs at:'-method' put: (JavaVM reflection methodForJavaMethodObject: self).
+ ^attrs.
+ ].
+ nm == #'java/lang/Class' ifTrue:[
+ attrs at:'-class' put: (JavaVM reflection classForJavaClassObject: self).
+ ^attrs.
+ ].
+ ^attrs
+
+ "Created: / 04-12-2011 / 19:28:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+
+!JavaObject methodsFor:'printing & storing'!
+
+basicPrintOn: aStream
+ aStream nextPutAll: self class name.
+ aStream nextPut:$@.
+ self identityHash printOn: aStream.
+
+ "Created: / 13-04-2012 / 17:34:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+displayString
+
+ JavaVM booted ifTrue:[
+ | toStringM toString |
+ toStringM := self class lookupSelector: #'toString()Ljava/lang/String;'.
+ (toStringM javaClass name ~~ #'java/lang/Object') ifTrue:[
+ [
+ toString := Java as_ST_String:(self perform:#'toString()Ljava/lang/String;').
+ ] on: Error do: [
+ toString := nil
+ ].
+ ].
+ toString notNil ifTrue:[
+ ^toString
+ ]
+ ].
+ ^String streamContents: [:s|self basicPrintOn: s]
+
+ "Modified: / 04-11-1998 / 18:35:00 / cg"
+ "Modified: / 28-01-2011 / 15:10:05 / Marcel Hlopko <hlopik@gmail.com>"
+ "Modified: / 13-04-2012 / 17:38:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+printOn: aStream
+ |myClassName |
+
+ myClassName := self class name.
+ myClassName == #'java/lang/String' ifTrue:[
+ aStream nextPut:$".
+ aStream nextPutAll: (Java as_ST_String: self).
+ aStream nextPut:$".
+ ^self.
+ ].
+ myClassName == #'java/lang/Class' ifTrue:[
+ super printOn: aStream.
+ aStream nextPut: $(.
+ (JavaVM reflection classForJavaClassObject:self) javaMirror getName printOn: aStream.
+ aStream nextPut: $).
+ ^self.
+ ].
+ myClassName == #'java.lang.reflect.Method' ifTrue:[
+ super printOn: aStream.
+ aStream nextPut: $(.
+ (JavaVM reflection methodForJavaMethodObject:self) printOn: aStream.
+ aStream nextPut: $).
+ ^self.
+ ].
+
+ JavaVM booted ifTrue:[
+ | toString |
+ [ toString := Java as_ST_String:(self perform:#'toString()Ljava/lang/String;').]
+ on: Error do: [ toString := nil ].
+ toString notNil ifTrue:[
+ "/super printOn: aStream.
+ "/aStream nextPut: $(.
+ aStream nextPutAll: toString.
+ "/aStream nextPut: $).
+ ^self.
+ ]
+ ].
+ super printOn: aStream.
+
+ "Created: / 04-12-2011 / 10:29:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!JavaObject methodsFor:'queries'!
+
+isJavaClassRef
+ ^ false
+
+ "Created: / 9.11.1999 / 17:13:37 / cg"
+!
+
+isJavaMethodRef
+ ^ false
+
+ "Created: / 9.11.1999 / 15:43:21 / cg"
+!
+
+isJavaObject
+ ^ true
+
+ "Created: 26.3.1997 / 13:34:17 / cg"
+!
+
+size
+ "What a hack!!!!!!"
+
+ ^(self respondsTo:#'size()I') ifTrue:[
+ self perform:#'size()I'
+ ] ifFalse:[
+ super size.
+ ]
+
+ "Created: / 29-02-2012 / 14:25:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!JavaObject methodsFor:'smalltalk interface'!
+
+lookupMethod:selector numArgs:nargs
+ "lookup a method"
+
+ |method cls sel|
+
+ sel := selector.
+ (sel includes:$:) ifTrue:[
+ sel := sel copyTo:(sel indexOf:$:)-1
+ ].
+
+ sel := sel asSymbolIfInterned.
+ sel notNil ifTrue:[
+ cls := self class.
+ [cls notNil and:[cls ~~ JavaObject]] whileTrue:[
+ cls methodDictionary keysAndValuesDo:[:jSel :aMethod |
+ (jSel == sel ) ifTrue:[
+ ^ aMethod
+ ]
+ ].
+ cls methodDictionary keysAndValuesDo:[:jSel :aMethod |
+ (aMethod name = sel
+ or:[aMethod signatureNameWithoutReturnType = sel]) ifTrue:[
+ aMethod numArgs == nargs ifTrue:[
+ ^ aMethod
+ ]
+ ]
+ ].
+ cls := cls superclass.
+ ].
+ ].
+
+ ^ nil
+
+ "
+ |stack|
+
+ stack := (Java at:'java.util.Stack') basicNew.
+ stack lookupMethod:#'<init>' numArgs:0.
+ "
+ "
+ |stack|
+
+ stack := (Java at:'java.util.Stack') new.
+ stack lookupMethod:#isEmpty numArgs:0.
+ "
+ "
+ |frame|
+
+ frame := (Java at:'java.awt.Frame') new.
+ frame lookupMethod:#'<init> (String)' numArgs:1.
+ "
+
+ "Modified: 22.3.1997 / 00:56:54 / cg"
+! !
+
+!JavaObject methodsFor:'unwind'!
+
+unwindHandlerInContext: aContext
+ "given a context which has been marked for unwind,
+ retrieve the handler block. This method is called when ST
+ exception raises and stack is unwinding. JavaClass instance
+ has an opportunity to clean up monitors"
+
+ ^ JavaVM unwindHandlerForJavaContext: aContext.
+
+ "Created: / 08-11-2011 / 12:25:15 / Marcel Hlopko <hlopkmar@fel.cvut.cz>"
+! !
+
+!JavaObject class methodsFor:'documentation'!
+
+version
+ ^ '$Id$'
+!
+
+version_SVN
+ ^ '$Id$'
+! !
+