Class subclass:#JavaClass
instanceVariableNames:'constantPool interfaces accessFlags classLoader fullName
sourceFile binaryFilePath fields initValues staticFields'
classVariableNames:'InitialValuePerType A_OBSOLETE A_INTERFACE A_PUBLIC A_FINAL
A_ABSTRACT A_INITIALIZED A_SMALLTALK
ArgumentConversionErrorSignal OrderOfClassInits'
poolDictionaries:''
category:'Java-Classes'
!
!JavaClass class methodsFor:'documentation'!
documentation
"
fields upTo-and-including accessFlags are known & used by the VM
only add fields after those and keep their order intact.
"
!
examples
"
(Java at:'java.util.Stack') new inspect
(Java at:'java.util.Vector') new inspect
"
! !
!JavaClass class methodsFor:'initialization'!
initialize
"/ those are defined in Java and read from the classFile
A_PUBLIC := 16r000001.
"/ A_PRIVATE := 16r000002.
"/ A_PROTECTED := 16r000004.
A_STATIC := 16r000008.
A_FINAL := 16r000010.
"/ A_SUPER := 16r000020.
"/ A_SYNCHRONIZED := 16r000020.
"/ A_VOLATILE := 16r000040.
"/ A_TRANSIENT := 16r000080.
A_NATIVE := 16r000100.
A_INTERFACE := 16r000200.
A_ABSTRACT := 16r000400.
A_OBSOLETE := 16r008000.
"/ those are local to the ST/X implementation
A_INITIALIZED := 16r100000.
A_SMALLTALK := 16r200000.
InitialValuePerType := IdentityDictionary new.
InitialValuePerType at:$B put:0.
InitialValuePerType at:$C put:0.
InitialValuePerType at:$D put:0.0.
InitialValuePerType at:$F put:(0.0 asShortFloat).
InitialValuePerType at:$I put:0.
InitialValuePerType at:$J put:0.
InitialValuePerType at:$S put:0.
InitialValuePerType at:$Z put:0.
InitialValuePerType at:$L put:nil.
InitialValuePerType at:$[ put:nil.
ArgumentConversionErrorSignal := ErrorSignal newSignal mayProceed:true.
"
JavaClass initialize
"
"Modified: / 5.11.1998 / 18:42:28 / cg"
! !
!JavaClass class methodsFor:'instance creation'!
fullName:aString
self shouldNotImplement.
^ self new flags:0; setFullName:aString
!
fullName:aString numStatic:nStatic
|meta cls fullName parts s ns|
"/ check for a JAVA nameSpace to exist
JAVA isNil ifTrue:[
Namespace name:'JAVA'
].
"create the metaclass first"
meta := Metaclass new.
meta setSuperclass:(self).
meta instSize:(JavaClass instSize + nStatic).
"/ meta setName:(aString , 'class') asSymbol.
"/ meta setClassVariableString:''.
meta flags:(meta flags bitOr:Behavior flagJavaClass).
"/ meta setSuperclass:JavaObject class.
"then let the new meta create the class"
cls := meta new.
cls setSuperclass:JavaObject.
cls instSize:0.
cls setName:('JAVA::' , aString).
cls flags:0.
"/ cls setClassVariableString:''.
cls setInstanceVariableString:''.
cls category:#java.
cls setFullName:aString.
"/ break up the package and create nameSpaces
"/ for each package component.
"/ This allows java.foo.bar to be visible in ST/X
"/ under the name JAVA::java::foo::bar
ns := JAVA.
parts := aString asCollectionOfSubstringsSeparatedBy:$/.
parts size > 1 ifTrue:[
s := '' writeStream.
s nextPutAll:'JAVA'.
parts from:1 to:(parts size - 1) do:[:aPart |
s nextPutAll:'::'.
s nextPutAll:aPart
].
Metaclass confirmationQuerySignal answer:false do:[
Class updateChangeFileQuerySignal answer:false do:[
ns := Namespace fullName:(s contents).
]
]
].
ns isNamespace ifTrue:[
ns at:parts last asSymbol put:cls.
].
"/ for ST/X browsing
Smalltalk at:('JAVA::' , aString) asSymbol put:cls.
^ cls
"Created: / 15.4.1996 / 15:52:55 / cg"
"Modified: / 3.1.1998 / 22:32:25 / cg"
!
name:aString
self shouldNotImplement
"Created: 15.4.1996 / 15:52:55 / cg"
! !
!JavaClass class methodsFor:'constants'!
A_NATIVE
^ A_NATIVE
"Created: / 16.5.1998 / 01:18:43 / cg"
!
A_PUBLIC
^ A_PUBLIC
"Created: / 13.5.1998 / 13:03:18 / cg"
!
A_STATIC
^ A_STATIC
"Created: / 16.5.1998 / 00:02:07 / cg"
! !
!JavaClass class methodsFor:'method lookup'!
canConvertArgsToJava:argArray asSpecifiedIn:argSigSpecArray
"given a smalltalk argument array, return true, if these can be converted to java objects as appropriate."
argArray
with:argSigSpecArray
do:[:arg :type |
self
convertToJava:arg
type:type
ifFail:[:msg :default| ^ false]].
^ true
"Created: / 5.11.1998 / 18:25:05 / cg"
"Modified: / 6.11.1998 / 00:45:58 / cg"
!
convertArgsToJava:argArray asSpecifiedIn:argSigSpecArray numArgs:na
"given a smalltalk argument array, convert to java objects as appropriate.
Currently, only Strings and booleans are converted."
|sigIndex newArgIndex newArgArray|
sigIndex := newArgIndex := 1.
newArgArray := Array new:na.
argArray do:[:arg |
|type newArg|
type := argSigSpecArray at:sigIndex.
sigIndex := sigIndex + 1.
newArg := self convertToJava:arg type:type.
newArgArray at:newArgIndex put:newArg.
newArgIndex := newArgIndex + 1.
(type == #long or:[type == #double]) ifTrue:[
newArgIndex > na ifTrue:[
self halt:'should not happen'
].
newArgArray at:newArgIndex put:nil.
newArgIndex := newArgIndex + 1.
]
].
^ newArgArray
"Created: / 5.11.1998 / 18:30:57 / cg"
"Modified: / 6.11.1998 / 00:45:00 / cg"
!
convertToJava:arg type:type
"given a smalltalk argument, convert to a java object as appropriate."
^ self
convertToJava:arg
type:type
ifFail:[:msg :default |
ArgumentConversionErrorSignal
raiseWith:arg
errorString:msg.
default
]
"Modified: / 5.11.1998 / 18:43:33 / cg"
"Created: / 6.11.1998 / 00:45:13 / cg"
!
convertToJava:arg type:type ifFail:failBlock
"given a smalltalk argument, convert to a java object as appropriate.
Currently, only a few types are converted."
|expectedCls f|
type == #boolean ifTrue:[
arg == true ifTrue:[
^ 1
].
arg == false ifTrue:[
^ 0
].
^ failBlock value:('cannot convert argument to ' , type) value:0
].
type == #int ifTrue:[
arg isInteger ifTrue:[
(arg between:-16r8000000 and:16r7FFFFFFF) ifTrue:[
^ arg
].
^ failBlock value:('integer range; cannot convert argument to ' , type) value:0.
].
^ failBlock value:('cannot convert argument to ' , type) value:0
].
type == #long ifTrue:[
arg isInteger ifTrue:[
(arg between:-16r800000000000000 and:16r7FFFFFFFFFFFFFFF) ifTrue:[
^ arg
].
^ failBlock value:('integer range; cannot convert argument to ' , type) value:0
].
^ failBlock value:('cannot convert argument to ' , type) value:0
].
(type == #float) ifTrue:[
arg isReal ifTrue:[
^ arg asShortFloat
].
^ failBlock value:('cannot convert argument to ' , type) value:0.0.
].
(type == 'java.lang.Float') ifTrue:[
arg isReal ifTrue:[
f := (Java at:'java.lang.Float') new.
f perform:#'<init>(F)V' with:(arg asShortFloat).
self halt.
^ f.
].
^ failBlock value:('cannot convert argument to ' , type) value:0.0.
].
(type == 'java.lang.Double') ifTrue:[
arg isReal ifTrue:[
f := (Java at:'java.lang.Double') new.
f perform:#'<init>(D)V' with:(arg asFloat).
self halt.
^ f.
].
^ failBlock value:('cannot convert argument to ' , type) value:0.0.
].
(type == #double) ifTrue:[
arg isReal ifTrue:[
^ arg asFloat
].
^ failBlock value:('cannot convert argument to ' , type) value:0.0.
].
(type == #char) ifTrue:[
arg isCharacter ifTrue:[
^ arg asciiValue
].
^ failBlock value:('cannot convert argument to ' , type) value:0
].
(type = 'char[]') ifTrue:[
arg isString ifTrue:[
^ arg
].
^ failBlock value:('cannot convert argument to ' , type) value:''
].
(type = 'int[]') ifTrue:[
(arg isArray or:[arg isMemberOf:SignedIntegerArray]) ifTrue:[
^ arg
].
^ failBlock value:('cannot convert argument to ' , type) value:''
].
(type = 'long[]') ifTrue:[
(arg isArray or:[arg isMemberOf:SignedIntegerArray]) ifTrue:[
^ arg
].
^ failBlock value:('cannot convert argument to ' , type) value:''
].
(type = 'float[]') ifTrue:[
(arg isArray or:[arg isMemberOf:FloatArray]) ifTrue:[
^ arg
].
^ failBlock value:('cannot convert argument to ' , type) value:''
].
(type = 'double[]') ifTrue:[
(arg isArray or:[arg isMemberOf:DoubleArray]) ifTrue:[
^ arg
].
^ failBlock value:('cannot convert argument to ' , type) value:''
].
(type endsWith:'[]') ifTrue:[
(arg isArray or:[arg isNil]) ifTrue:[
^ arg
].
^ failBlock value:('cannot convert argument to ' , type) value:''
].
(type = 'java.lang.Object') ifTrue:[
"/ matches any
^ arg
].
(type = 'java.lang.String') ifTrue:[
arg isString ifTrue:[
^ Java as_String:arg
].
^ failBlock value:('cannot convert argument to ' , type) value:''
].
expectedCls := Java classForName:type.
(arg isKindOf:expectedCls) ifTrue:[
"/ matches class and subclasses
^ arg
].
self halt.
^ failBlock value:('cannot convert argument to ' , type) value:nil
"Created: / 6.11.1998 / 00:46:19 / cg"
"Modified: / 11.11.1998 / 02:05:25 / cg"
!
convertToSmalltalk:jObj type:type
"given a java return value, convert to a smalltalk object as appropriate.
Currently, only a few types are converted."
type == #boolean ifTrue:[
jObj == 0 ifTrue:[
^ false
].
^ true
].
type == #void ifTrue:[
^ nil
].
(type = 'java.lang.String') ifTrue:[
^ Java as_ST_String:jObj
].
"/ (type = 'java.lang.Float') ifTrue:[
"/ ^ jObj instVarNamed:'value'
"/ ].
"/ (type = 'java.lang.Double') ifTrue:[
"/ ^ jObj instVarNamed:'value'
"/ ].
(type == #char) ifTrue:[
jObj isInteger ifTrue:[
^ Character value:jObj
].
].
^ jObj
"Created: / 6.11.1998 / 00:49:53 / cg"
"Modified: / 11.11.1998 / 02:08:11 / cg"
!
lookupMethod:selector numArgs:nargs in:aClass static:staticMethod
"lookup a method"
|method cls sel|
sel := selector.
(sel includes:$:) ifTrue:[
sel := sel copyTo:(sel indexOf:$:)-1
].
sel := sel asSymbolIfInterned.
sel notNil ifTrue:[
cls := aClass.
[cls notNil
and:[cls ~~ JavaObject
and:[cls ~~ JavaClass]]] whileTrue:[
cls methodDictionary keysAndValuesDo:[:jSel :aMethod |
((jSel == sel)
or:[aMethod name = sel
or:[aMethod signatureNameWithoutReturnType = sel]])
ifTrue:[
aMethod numArgs == nargs ifTrue:[
staticMethod == (aMethod isStatic) ifTrue:[
^ aMethod
]
]
]
].
cls := cls superclass.
].
].
"/ self halt.
^ nil
"Created: / 17.8.1997 / 18:25:47 / cg"
"Modified: / 4.11.1998 / 17:13:08 / cg"
!
lookupMethods:selector numArgs:nargs in:aClass static:staticMethod
"lookup methods matching a selector.
This is a special entry for doesNotUnderstand redirection
(the caller must select the one method which fits the argument(s) best."
|methods cls sel|
sel := selector.
(sel includes:$:) ifTrue:[
sel := sel copyTo:(sel indexOf:$:)-1
].
sel := sel asSymbolIfInterned.
sel notNil ifTrue:[
cls := aClass.
[cls notNil
and:[cls ~~ JavaObject
and:[cls ~~ JavaClass]]] whileTrue:[
cls methodDictionary keysAndValuesDo:[:jSel :aMethod |
((jSel == sel)
or:[aMethod name = sel
or:[aMethod signatureNameWithoutReturnType = sel]])
ifTrue:[
(nargs isNil
or:[aMethod numArgs == nargs]) ifTrue:[
staticMethod == (aMethod isStatic) ifTrue:[
methods isNil ifTrue:[
methods := OrderedCollection new
].
methods add:aMethod
]
]
]
].
cls := cls superclass.
].
].
^ methods ? #()
"Created: / 4.11.1998 / 19:04:51 / cg"
"Modified: / 4.11.1998 / 19:31:33 / cg"
! !
!JavaClass class methodsFor:'signature parsing'!
initialValueFromSignature:aSignature
"given a signature, return an initializer value"
|s|
s := aSignature readStream.
^ self initialValueFromStream:s.
"
JavaClass initialValueFromSignature:'LObject;'
JavaClass initialValueFromSignature:'B'
JavaClass initialValueFromSignature:'I'
"
!
initialValueFromStream:s
"parse a fieldTypeSpec - see java doc"
|typeChar|
typeChar := s next.
^ InitialValuePerType at:typeChar ifAbsent:nil.
! !
!JavaClass class methodsFor:'special'!
orderOfClassInits
^ OrderOfClassInits
"Created: / 12.11.1998 / 15:35:57 / cg"
!
setInstanceVariableStringFromFields:f in:aClass
|varNames|
varNames := ''.
f do:[:aField |
varNames := varNames , aField name , ' '
].
aClass setInstanceVariableString:varNames.
"Created: 15.4.1996 / 16:42:52 / cg"
!
startRememberingOrderOfClassInits
OrderOfClassInits := OrderedCollection new.
"Created: / 12.11.1998 / 15:26:32 / cg"
"Modified: / 12.11.1998 / 15:29:10 / cg"
! !
!JavaClass methodsFor:'accessing'!
binaryFile
^ binaryFilePath
!
category
"java classes do not really hav a category;
simulate one by separating its name into individual components,
prepending 'java'"
|nameComponents|
nameComponents := fullName asCollectionOfSubstringsSeparatedBy:$/.
nameComponents size <= 1 ifTrue:[
^ 'java' "/ fullName
].
^ ((nameComponents asStringWith:$/ from:1 to:(nameComponents size - 1)))
replaceAll:$/ with:$.
"Modified: 30.7.1997 / 15:35:22 / cg"
!
classLoader
^ classLoader
!
classLoader:aJavaClassLoaderOrNil
classLoader := aJavaClassLoaderOrNil
!
compiledMethodAt:name signature:sig
"lookup the classes methodDictionary"
methodDictionary keysAndValuesDo:[:mFullSelector :aMethod |
aMethod name == name ifTrue:[
aMethod signature == sig ifTrue:[
^ aMethod
]
]
].
^ nil
"Created: 1.8.1997 / 00:01:58 / cg"
!
constantPool
^ constantPool
!
fields
^ fields
!
fullName
^ fullName
!
interfaces
interfaces notNil ifTrue:[
interfaces := interfaces collect:[:clsRef |
clsRef isUnresolved ifTrue:[
clsRef preResolve
] ifFalse:[
clsRef
]
].
].
^ interfaces
!
javaClass
^ self
!
lastName
^ fullName copyFrom:(fullName lastIndexOf:$/)+1
"Created: / 5.11.1998 / 19:16:00 / cg"
!
name
^ name "/ fullName
!
nameSpace
^ JAVA
"Created: 20.1.1997 / 13:04:30 / cg"
!
nameWithoutNameSpacePrefix
^ fullName
"Created: 20.1.1997 / 13:05:30 / cg"
!
nameWithoutPrefix
^ fullName
"Created: 20.1.1997 / 13:06:06 / cg"
!
package
"extract from the fullName"
|components|
components := fullName asCollectionOfSubstringsSeparatedBy:$/.
components size > 1 ifTrue:[
^ (components copyWithoutLast:1) asStringWith:$/
].
^ fullName
"
Java allClasses first fullName
Java allClasses first package
"
!
source
^ Java classSourceOf:self
"
(Java at:'java.awt.Frame') source
(Java at:'ArcTest') source
(Java at:'ArcCanvas') source
"
"Modified: 30.7.1997 / 14:31:01 / cg"
!
sourceFile
^ sourceFile
!
staticFields
^ staticFields
!
typeOfField:aFieldName
fields do:[:aField |
aField name = aFieldName ifTrue:[
^ aField type
]
].
self error:'no such field'
"
(JAVA at:#'java/awt/image/ColorModel') typeOfField:'pixel_bits'
"
"Modified: 21.1.1997 / 22:48:28 / cg"
! !
!JavaClass methodsFor:'adding / removing'!
removeFromSystem
Java removeClass:self
"Created: 12.8.1997 / 02:46:51 / cg"
! !
!JavaClass methodsFor:'browser interface'!
isVisualStartable
"return true, if this is an application class,
which can be started via #open"
"/ if I have a main() method, I am
(self compiledMethodAt:#'main([Ljava/lang/String;)V') notNil ifTrue:[
^ true
].
"/ NEEDS startApplet to work ...
"/ "/ if I inherit from Applet, I am
"/
"/ (self isSubclassOf:(Java at:'java.applet.Applet')) ifTrue:[
"/ ^ true.
"/ ].
^ false
"Modified: / 3.11.1998 / 23:04:59 / cg"
!
open
"start a thread for my main method"
"/ if I have a main, call it ...
(self compiledMethodAt:#'main([Ljava/lang/String;)V') notNil ifTrue:[
^ self startMain
].
"/ otherwise, create a frame and wrap me;
"/ as in:
"/ public static void main(String args[]) {
"/ Frame f = new Frame("myName");
"/ mySelf me = new mySelf();
"/
"/ me.init();
"/ me.start();
"/
"/ f.add("Center", me);
"/ f.setSize(300, 300);
"/ f.show();
"/ }
^ self startApplet
"Created: / 15.1.1998 / 17:18:30 / cg"
"Modified: / 3.11.1998 / 22:51:47 / cg"
!
syntaxHighlighterClass
"return the parser to use for farmatting (prettyPrinting) this class -
this can be redefined in special classes, to get classes with
Lisp, Prolog, ASN1, Basic :-) or whatever syntax."
self == JavaClass ifFalse:[
^ nil
].
^ super syntaxHighlighterClass
"Created: / 22.10.1998 / 00:26:13 / cg"
"Modified: / 22.10.1998 / 00:27:02 / cg"
! !
!JavaClass methodsFor:'compiler interface'!
compilerClass
"return the compiler to use for this class -
this can be redefined in special classes, to get classes with
Lisp, Prolog, ASN1, Basic :-) or whatever syntax."
^ Compiler.
^ JavaCompiler
"Created: 31.7.1997 / 23:03:37 / cg"
"Modified: 4.8.1997 / 16:50:08 / cg"
!
evaluatorClass
"return the compiler to use for expression evaluation for this class -
this can be redefined in special classes, to get classes with
Lisp, Prolog, ASN1, Basic :-) or whatever syntax."
^ Compiler.
^ JavaCompiler
"Created: 31.7.1997 / 23:03:56 / cg"
"Modified: 4.8.1997 / 16:49:14 / cg"
!
parserClass
"return the parser to use for parsing this class -
this can be redefined in special classes, to get classes with
Lisp, Prolog, ASN1, Basic :-) or whatever syntax."
^ Compiler.
^ JavaCompiler
"Created: 31.7.1997 / 23:04:11 / cg"
"Modified: 4.8.1997 / 16:50:18 / cg"
! !
!JavaClass methodsFor:'documentation support'!
htmlDocumentation
^ nil "/ replace by access to javadoc-generated documentation later
"Modified: 22.3.1997 / 14:18:50 / cg"
! !
!JavaClass methodsFor:'executing programs'!
startApplet
|f me stub|
"/ TODO: setup embeddedAppletFrame correctly
"/ (for getParameter to work ...)
"/ create a frame and wrap me;
"/ as in:
"/ public static void main(String args[]) {
"/ Frame f = new Frame("myName");
"/ mySelf me = new mySelf();
"/
"/ me.init();
"/ me.start();
"/
"/ f.add("Center", me);
"/ f.setSize(300, 300);
"/ f.show();
"/ }
f := (Java at:'java.awt.Frame') basicNew.
f perform:#'<init>(Ljava/lang/String;)V' with:(Java as_String:self name).
self halt.
me := self basicNew.
me perform:#'<init>()V'.
self halt.
stub := (Java at:'netscape.applet.EmbeddedAppletFrame') new.
me instVarNamed:'stub' put:stub.
self halt.
me perform:#'init()V'.
me perform:#'start()V'.
self halt.
f perform:#'add(Ljava/lang/String;Ljava/awt/Component;)Ljava/awt/Component;'
with:(Java as_String:'Center')
with:me.
self halt.
f perform:#'setSize(II)V' with:300 with:300.
self halt.
f perform:#'show()V'.
self halt.
"Modified: / 3.11.1998 / 23:04:41 / cg"
!
startMain
"start a thread for my main() method"
Java executeMainOf:self
"Created: / 5.2.1998 / 00:36:06 / cg"
"Modified: / 5.2.1998 / 00:37:15 / cg"
!
startMainWithArgumentString:aCommandLineString
"start a thread for my main() method, passing a string with arguments"
Java executeMainOf:self withArgumentString:aCommandLineString
"Modified: / 5.2.1998 / 00:37:25 / cg"
"Created: / 5.2.1998 / 00:41:15 / cg"
! !
!JavaClass methodsFor:'fileOut'!
basicFileOutDefinitionOn:aStream withNameSpace:nameSpaceBoolean
JavaDecompiler definitionOf:self on:aStream
"Modified: 22.3.1997 / 14:30:28 / cg"
!
fileOut
self warn:'fileOut not yet supported'
"Modified: 22.3.1997 / 14:30:28 / cg"
"Created: 22.3.1997 / 14:35:43 / cg"
! !
!JavaClass methodsFor:'java initialization'!
classInit
"call the classes JAVA clinit function"
|m|
(accessFlags bitAnd:A_INITIALIZED) ~~ 0 ifTrue:[^ self].
accessFlags := accessFlags bitOr:A_INITIALIZED.
superclass ~~ JavaObject ifTrue:[
superclass classInit
].
"/ "/ also, all referenced classes must be ...
"/ constantPool classReferencesDo:[:aClass |
"/ aClass classInit
"/ ].
m := self compiledMethodAt:#'<clinit>()V'.
m notNil ifTrue:[
"/ 'calling clinit() of ' print. self fullName printNL.
[
OrderOfClassInits notNil ifTrue:[
OrderOfClassInits add:self.
].
m
valueWithReceiver:self
arguments:#()
selector:#'<clinit>()V'
search:self class
sender:nil
] valueOnUnwindDo:[
accessFlags := accessFlags bitXor:A_INITIALIZED.
]
] ifFalse:[
"/ self fullName print. ' has no clinit()' printNL.
].
"
JavaVM instructionTrace:true.
JavaVM callTrace:true.
(Java classNamed:'java.lang.String') classInit
(Java classNamed:'java.lang.System') classInit
(Java classNamed:'java/io/FileDescriptor') classInit
(Java classNamed:'java.util.Properties') classInit
"
"Modified: / 12.11.1998 / 15:41:11 / cg"
!
initializeStaticFields
staticFields isNil ifTrue:[^ self].
staticFields do:[:f |
|val type|
(val := f constantValue) isNil ifTrue:[
"/ careful: int/long etc. constants must be initialized
"/ with correct type.
type := f type.
type == #long ifTrue:[
val := 0.
] ifFalse:[type == #int ifTrue:[
val := 0.
] ifFalse:[type == #float ifTrue:[
val := 0.0 asShortFloat
] ifFalse:[type == #double ifTrue:[
val := 0.0
] ifFalse:[type == #byte ifTrue:[
val := 0.
] ifFalse:[type == #char ifTrue:[
val := 0.
] ifFalse:[type == #'unsigned short' ifTrue:[
val := 0.
] ifFalse:[type == #boolean ifTrue:[
val := 0.
]]]]]]]].
].
self instVarNamed:(f name) put:val.
].
! !
!JavaClass methodsFor:'java instance creation'!
initValueFor:instVarName
|idx field|
idx := fields findFirst:[:field | field name = instVarName].
idx == 0 ifTrue:[
superclass ~~ JavaObject ifTrue:[
^ superclass initValueFor:instVarName
].
self halt
] ifFalse:[
field := fields at:idx.
^ field initialValue
].
!
new
"create a new instance, preset its fields,
and call its JAVA init function"
|newJavaObject|
newJavaObject := self newCleared.
newJavaObject perform:#'<init>()V'.
^ newJavaObject
"
(Java classNamed:'java.lang.String') basicNew inspect
(Java classNamed:'java.lang.String') newCleared inspect
(Java classNamed:'java.lang.String') new inspect
"
"Modified: / 4.11.1998 / 18:04:34 / cg"
!
newCleared
"create a new cleared JAVA instance.
Its instVars are cleared to the corresponding typed values;
however, <init> is not invoked for it."
|newJavaObject sz "{ Class: SmallInteger }" |
"/ (self isInterface or:[self isAbstract]) ifTrue:[
(accessFlags bitAnd:(A_INTERFACE bitOr:A_ABSTRACT)) ~~ 0 ifTrue:[
JavaVM throwInstantiationExceptionFor:self.
^ nil
].
newJavaObject := super basicNew.
initValues notNil ifTrue:[
"/ newJavaObject initializeFields:initValues
sz := self instSize.
1 to:sz do:[:i |
newJavaObject instVarAt:i put:(initValues at:i)
].
].
^ newJavaObject
"
(Java classNamed:'java.lang.String') basicNew inspect
(Java classNamed:'java.lang.String') newCleared inspect
(Java classNamed:'java.lang.String') new inspect
"
"Modified: / 14.1.1998 / 23:16:26 / cg"
! !
!JavaClass methodsFor:'message sending'!
doesNotUnderstand:aMessage
"as a courtesy to the smalltalker, try to map static methods as
Smalltalk-class methods"
|r args numArgs methods javaMethod sel anyMethodsFound argType
argSignature newArgs oArgIdx nArgIdx canConvert
retVal|
args := aMessage arguments.
numArgs := args size.
sel := aMessage selector.
methods := JavaClass lookupMethods:sel numArgs:numArgs in:self static:true.
methods size == 1 ifTrue:[
javaMethod := methods first.
"/ there is only one - try that one.
] ifFalse:[
methods size > 1 ifTrue:[
"/ more than one - select the ones that could be used.
methods := methods select:[:aMethod |
|argSignature|
argSignature := aMethod argSignature.
(JavaClass canConvertArgsToJava:args asSpecifiedIn:argSignature)
].
methods size == 1 ifTrue:[
javaMethod := methods first.
]
]
].
javaMethod notNil ifTrue:[
(ArgumentConversionErrorSignal catch:[
args notNil ifTrue:[
args := JavaClass
convertArgsToJava:args
asSpecifiedIn:(javaMethod argSignature)
numArgs:numArgs.
].
]) ifFalse:[
retVal := javaMethod
valueWithReceiver:self "/ (javaMethod javaClass)
arguments:args
selector:(javaMethod selector)
search:self "/ (javaMethod javaClass class)
sender:nil.
^ JavaClass convertToSmalltalk:retVal type:(javaMethod returnType).
].
^ MessageNotUnderstoodSignal
raiseRequestWith:aMessage
errorString:'no method for given argument(s)'
in:thisContext "sender"
].
anyMethodsFound := false.
"/ try all with that name (the number of args could be different ...
methods := JavaClass lookupMethods:sel numArgs:nil in:self static:true.
methods size > 0 ifTrue:[
anyMethodsFound := true.
numArgs > 0 ifTrue:[
methods do:[:methodToTry |
(ArgumentConversionErrorSignal catch:[
newArgs := JavaClass
convertArgsToJava:args
asSpecifiedIn:(methodToTry argSignature)
numArgs:methodToTry numArgs.
]) ifFalse:[
retVal := methodToTry
valueWithReceiver:self "/ (methodToTry javaClass)
arguments:newArgs
selector:(methodToTry selector)
search:self "/ (methodToTry javaClass class)
sender:nil.
^ JavaClass convertToSmalltalk:retVal type:(methodToTry returnType).
].
].
]
].
anyMethodsFound ifTrue:[
methods size == 1 ifTrue:[
javaMethod := methods first.
^ MessageNotUnderstoodSignal
raiseRequestWith:aMessage
errorString:(sel , ' expects ' , javaMethod argSignature size printString , ' argument(s)')
in:thisContext "sender"
].
^ MessageNotUnderstoodSignal
raiseRequestWith:aMessage
errorString:'no method for given argument count or type'
in:thisContext "sender"
].
^ super doesNotUnderstand:aMessage
"Modified: / 6.11.1998 / 00:57:22 / cg"
!
lookupMethodFor:selector
|method cls sel|
sel := selector asSymbolIfInterned.
sel notNil ifTrue:[
cls := self.
[cls notNil] whileTrue:[
method := cls compiledMethodAt:sel.
method notNil ifTrue:[ ^ method ].
cls := cls superclass.
].
].
^ nil
!
performStatic:selector
"send a static message, without args."
|javaMethod sel|
sel := selector asSymbolIfInterned.
sel notNil ifTrue:[
javaMethod := methodDictionary at:sel.
javaMethod notNil ifTrue:[
javaMethod isStatic ifTrue:[
^ javaMethod
valueWithReceiver:self
arguments:#()
]
].
].
^ self doesNotUnderstand:(Message selector:selector)
"Modified: / 15.1.1998 / 00:31:27 / cg"
"Created: / 12.11.1998 / 16:29:20 / cg"
! !
!JavaClass methodsFor:'printOut'!
printNameInHierarchy
"return my name as printed in the hierarchy"
^ self displayString
"Modified: 22.3.1997 / 14:16:55 / cg"
!
printOutOn:aStream
self warn:'printOut not yet supported'
"Created: 22.3.1997 / 14:36:12 / cg"
!
printOutProtocolOn:aStream
self warn:'printOut not yet supported'
"Created: 22.3.1997 / 14:36:28 / cg"
! !
!JavaClass methodsFor:'printing & storing'!
displayString
^ fullName copyReplaceAll:$/ with:$.
"/ ^ 'JAVA-' , name .
"/ ^ name , '(Java)' "/ 'JavaClass(' , name , ')'
"Created: / 15.4.1996 / 16:02:48 / cg"
"Modified: / 18.7.1998 / 22:56:30 / cg"
! !
!JavaClass methodsFor:'private accessing'!
addMethod:m name:name signature:signature
|sel|
sel := (name , signature) asSymbol.
self addSelector:sel withMethod:m.
^ self.
"/ selectorArray isNil ifTrue:[
"/ selectorArray := #().
"/ methodArray := #()
"/ ].
"/ selectorArray := selectorArray copyWith:(name , signature) asSymbol. "/ name.
"/"/ selectorArray := selectorArray copyWith:name asSymbol. "/ name.
"/ methodArray := methodArray copyWith:m
"Created: 15.4.1996 / 16:42:52 / cg"
!
addSelector:newSelector withMethod:newMethod
"redefined to not flush smalltalk caches and send NO smalltalk-class
change notification. Will eventually flush Java caches."
|nargs oldMethod|
oldMethod := self compiledMethodAt:newSelector.
(self primAddSelector:newSelector withMethod:newMethod) ifFalse:[^ false].
^ true
"Created: 20.1.1997 / 13:00:48 / cg"
!
makeObsolete
accessFlags := accessFlags bitOr:A_OBSOLETE
"Created: 7.8.1997 / 19:04:48 / cg"
!
markUninitialized
(accessFlags bitAnd:A_INITIALIZED) ~~ 0 ifTrue:[
accessFlags := accessFlags bitXor:A_INITIALIZED
].
!
setAccessFlags:flags
accessFlags := flags.
"Created: 15.4.1996 / 16:42:52 / cg"
!
setBinaryFilePath:aPathName
binaryFilePath := aPathName
!
setConstantPool:anArray
constantPool := anArray.
"Created: 15.4.1996 / 16:42:52 / cg"
!
setFields:f
|vals|
JavaClass setInstanceVariableStringFromFields:f in:self.
instSize := superclass instSize + f size.
fields := f.
vals := self allInstVarNames
collect:[:nm |
self initValueFor:nm
].
vals isEmpty ifTrue:[
initValues := nil
] ifFalse:[
(vals detect:[:el | el notNil] ifNone:nil) isNil ifTrue:[
initValues := nil
] ifFalse:[
initValues := vals asArray
]
]
"Created: / 15.4.1996 / 16:42:52 / cg"
"Modified: / 6.11.1998 / 01:53:01 / cg"
!
setFullName:aString
|nameComponents|
fullName := aString asSymbol.
nameComponents := aString asCollectionOfSubstringsSeparatedBy:$/.
name := nameComponents last asSymbol.
name := fullName.
"Created: / 15.4.1996 / 16:42:52 / cg"
"Modified: / 5.11.1998 / 19:14:39 / cg"
!
setInterfaces:i
i size > 0 ifTrue:[
interfaces := i
] ifFalse:[
interfaces := nil
]
"Modified: 7.4.1997 / 15:44:53 / cg"
!
setSourceFile:aFilename
sourceFile := aFilename.
"Created: 15.4.1996 / 16:42:52 / cg"
!
setStaticFields:f
JavaClass setInstanceVariableStringFromFields:f in:self class.
staticFields := f.
!
setSuperclass:aClass
|iVars numIvars|
aClass isNil ifTrue:[
super setSuperclass:JavaObject
] ifFalse:[
(aClass isMemberOf:JavaUnresolvedClassConstant) ifTrue:[
self halt.
].
super setSuperclass:aClass.
].
iVars := self instVarNames.
((numIvars := iVars size) > 0) ifTrue:[
(superclass notNil and:[(superclass isMemberOf:JavaUnresolvedClassConstant) not]) ifTrue:[
instSize := superclass instSize + numIvars
] ifFalse:[
instSize := numIvars
]
].
"Created: 15.4.1996 / 16:42:52 / cg"
"Modified: 22.8.1997 / 15:06:45 / cg"
! !
!JavaClass methodsFor:'queries'!
browserClass
"return the browser to use for this class -
this can be redefined in special classes, to get different browsers"
^ SystemBrowser "/ JavaBrowser
"Modified: / 14.10.1998 / 15:28:38 / cg"
!
canBeSubclassed
"return true, if its allowed to create subclasses of the receiver."
self isFinal ifTrue:[^ false].
self isInterface ifTrue:[^ false].
^ true
"Created: / 5.11.1998 / 23:04:50 / cg"
!
hasInterface:aJavaInterface
"return true, if I respond to all methods as
required by the argument, an aJavaInterface"
interfaces size > 0 ifTrue:[
self interfaces do:[:if |
aJavaInterface == if ifTrue:[
^ true
].
]
].
"/ ^ false.
aJavaInterface methodDictionary keysAndValuesDo:[:sel :mthd |
(self canUnderstand:sel) ifFalse:[
^ false.
]
].
^ true
"Modified: / 28.1.1998 / 01:46:16 / cg"
!
isAbstract
"return true, if the receiver is abstract
(i.e. may not have instances)"
^ (accessFlags bitAnd:A_ABSTRACT) ~~ 0
"Modified: / 7.5.1998 / 12:24:42 / cg"
!
isFinal
"return true, if the receiver is final
(i.e. may not be subclassed)"
^ (accessFlags bitAnd:A_FINAL) ~~ 0
"Modified: / 7.5.1998 / 12:24:21 / cg"
!
isInitialized
"return true, if the receiver is initialized"
^ (accessFlags bitAnd:A_INITIALIZED) ~~ 0
"Modified: / 7.5.1998 / 12:23:54 / cg"
!
isInterface
"return true, if the receiver is an interface"
^ (accessFlags bitAnd:A_INTERFACE) ~~ 0
"Modified: / 7.5.1998 / 12:23:39 / cg"
!
isJavaClass
^ self ~~ JavaClass
"Created: 18.3.1997 / 17:48:01 / cg"
!
isObsolete
"return true, if the receiver is obsolete
Java classes are never."
^ (accessFlags bitAnd:A_OBSOLETE) ~~ 0.
"Modified: 7.8.1997 / 19:04:28 / cg"
!
isPublic
"return true, if the receiver is public"
^ (accessFlags bitAnd:A_PUBLIC) ~~ 0
"Modified: / 7.5.1998 / 12:22:44 / cg"
!
isUnresolved
"return true, if the receiver is unresolved;
javaClasses are never; JavaUnresolvedClasses are always"
^ false
"Modified: / 7.5.1998 / 12:23:14 / cg"
!
nameSpacePath
|parts s|
parts := self fullName asCollectionOfSubstringsSeparatedBy:$/.
s := '' writeStream.
s nextPutAll:'JAVA'.
parts from:1 to:(parts size - 1) do:[:aPart |
s nextPutAll:'::'.
s nextPutAll:aPart
].
^ s contents
"
JAVA::java::lang::Object fullName
JAVA::java::lang::Object nameSpacePath
JAVA::java::lang::Object name
"
"Modified: / 19.10.1998 / 20:07:24 / cg"
!
supportsMethodCategories
^ self isJavaClass not
"Created: / 30.7.1997 / 14:58:58 / cg"
"Modified: / 7.5.1998 / 12:25:54 / cg"
!
typeName
^ 'L' , self fullName
"
(Java at:'java.util.Stack') typeName
"
"Modified: / 10.2.1998 / 17:13:26 / cg"
! !
!JavaClass methodsFor:'special'!
arrayClass
self halt.
^ Array
"Created: / 10.11.1998 / 02:07:32 / cg"
"Modified: / 10.11.1998 / 02:10:26 / cg"
!
asClassPointerRef
self halt.
^ self
"Created: / 10.11.1998 / 02:07:01 / cg"
"Modified: / 10.11.1998 / 02:10:30 / cg"
!
deref
^ self
"Created: / 10.11.1998 / 02:08:06 / cg"
!
updateClassRefsFrom:oldClass to:newClass
self == oldClass ifTrue:[
self makeObsolete.
^ self
].
constantPool updateClassRefsFrom:oldClass to:newClass.
interfaces notNil ifTrue:[
interfaces := interfaces collect:[:anInterface |
anInterface == oldClass ifTrue:[
newClass isNil ifTrue:[
nil "/ replace by an unresolvedInterface
] ifFalse:[
newClass
]
] ifFalse:[
anInterface
]
]
]
"Modified: / 4.2.1998 / 22:08:19 / cg"
! !
!JavaClass class methodsFor:'documentation'!
version
^ '$Header: /home/jv/Projects/SmalltalkX/repositories/cvs/stx/libjava/JavaClass.st,v 1.91 1998/11/12 17:02:04 cg Exp $'
! !
JavaClass initialize!