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'
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.
"
JavaClass initialize
"
"Modified: / 16.5.1998 / 01:18:48 / 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'!
convertArgsToJava:argArray
"given a smalltalk argument array, convert to java objects as appropriate.
Currently, only Strings and booleans are converted."
|newArgs|
newArgs := argArray copy.
newArgs keysAndValuesDo:[:idx :arg |
arg isString ifTrue:[
newArgs at:idx put:(Java as_String:arg)
] ifFalse:[
arg == true ifTrue:[
newArgs at:idx put:1
] ifFalse:[
arg == false ifTrue:[
newArgs at:idx put:0
]
]
]
].
^ newArgs
"Created: / 9.4.1998 / 21:40:23 / cg"
"Modified: / 4.11.1998 / 17:14:36 / 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'!
setInstanceVariableStringFromFields:f in:aClass
|varNames|
varNames := ''.
f do:[:aField |
varNames := varNames , aField name , ' '
].
aClass setInstanceVariableString:varNames.
"Created: 15.4.1996 / 16:42:52 / 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
!
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.
[
m valueWithReceiver:self arguments:#()
] 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: / 13.1.1998 / 14:43: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 eMsg argType
argSignature newArgs oArgIdx nArgIdx canConvert|
"/ r := thisContext sender receiver.
"/
"/ r isJavaClass ifTrue:[
"/ self halt:'should not happen from within java code'.
"/ ].
"/ r class isJavaClass ifTrue:[
"/ self halt:'should not happen from within java code'.
"/ ].
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 best fit.
"/ first, look for an exact match ...
methods do:[:aMethod |
|argSignature doesMatch|
doesMatch := true.
argSignature := aMethod argSignature.
argSignature keysAndValuesDo:[:i :argType |
|arg|
arg := args at:i.
argType == #int ifTrue:[
(arg isInteger
and:[arg between:-16r8000000 and:16r7FFFFFFF]) ifFalse:[
doesMatch := false
]
] ifFalse:[
argType == #float ifTrue:[
arg isReal ifFalse:[
doesMatch := false
]
] ifFalse:[
self halt
]
]
].
doesMatch ifTrue:[
javaMethod notNil ifTrue:[
self halt:'more than one matching methods'
].
javaMethod := aMethod
]
].
]
].
javaMethod notNil ifTrue:[
args notNil ifTrue:[
args := JavaClass convertArgsToJava:args.
].
^ javaMethod
valueWithReceiver:self
arguments:args
selector:sel
search:nil
sender:nil
].
methods size > 1 ifTrue:[
eMsg := 'no ''' , sel , '''-function for given argument type(s)'
] ifFalse:[
methods := JavaClass lookupMethods:sel numArgs:nil in:self static:true.
methods size > 0 ifTrue:[
methods size == 1 ifTrue:[
javaMethod := methods first.
argSignature := javaMethod argSignature.
(javaMethod numArgs > numArgs
and:[argSignature size == numArgs]) ifTrue:[
"/ try again - may have to add dummy slots for float/long
"/ args ...
canConvert := true.
oArgIdx := 1.
nArgIdx := 1.
newArgs := Array new:javaMethod numArgs.
argSignature do:[:argSig |
|arg|
arg := args at:oArgIdx.
oArgIdx := oArgIdx + 1.
argSig == #double ifTrue:[
arg isReal ifTrue:[
newArgs at:nArgIdx put:arg.
nArgIdx := nArgIdx + 1.
newArgs at:nArgIdx put:nil. "/ dummy double high
nArgIdx := nArgIdx + 1.
] ifFalse:[
canConvert := false.
]
] ifFalse:[
argSig == #long ifTrue:[
arg isInteger ifTrue:[
newArgs at:nArgIdx put:arg.
nArgIdx := nArgIdx + 1.
newArgs at:nArgIdx put:nil. "/ dummy long high
nArgIdx := nArgIdx + 1.
] ifFalse:[
canConvert := false.
]
] ifFalse:[
argSig == #int ifTrue:[
arg isInteger ifTrue:[
newArgs at:nArgIdx put:arg.
] ifFalse:[
canConvert := false.
]
] ifFalse:[
canConvert := false
]
]
].
].
canConvert ifTrue:[
^ javaMethod
valueWithReceiver:self
arguments:newArgs
selector:sel
search:nil
sender:nil
].
].
argSignature size == 1 ifTrue:[
argType := argSignature first printString.
eMsg := '''' , sel , '''-function expects ' , argType , ' as argument'.
] ifFalse:[
eMsg := '''' , sel , '''-function expects ' , argSignature size printString , ' argument(s)'
].
] ifFalse:[
numArgs == 0 ifTrue:[
eMsg := 'no ''' , sel , '''-function without arguments'
] ifFalse:[
eMsg := 'no ''' , sel , '''-function for given number of arguments'
].
].
].
].
eMsg notNil ifTrue:[
^ MessageNotUnderstoodSignal
raiseRequestWith:aMessage
errorString:eMsg
in:thisContext "sender"
].
^ super doesNotUnderstand:aMessage
"Modified: / 4.11.1998 / 21:49:20 / cg"
!
invokeJavaMethod:aJavaMethod interpreter:i sender:aContext selector:sel with:arg1
"invoke a static java method, with 1 argument"
|val|
aJavaMethod numArgs ~~ 1 ifTrue:[
self halt:'argument count'
].
aJavaMethod isStatic ifFalse:[
self halt:'non-static function'
].
i push:arg1.
val := i interpret:aJavaMethod sender:aContext.
^ JavaObject convertJavaObject:val signature:(aJavaMethod retValSignature)
"Created: 17.8.1997 / 18:03:58 / cg"
"Modified: 17.8.1997 / 18:08:27 / cg"
!
invokeStatic:selector
"send a static message, without args."
|method cls sel|
sel := selector asSymbolIfInterned.
sel notNil ifTrue:[
cls := self.
[cls notNil and:[cls ~~ JavaObject]] whileTrue:[
cls methodDictionary keysAndValuesDo:[:sel :aMethod |
"/ aMethod name printNL.
aMethod isStatic ifTrue:[
sel == selector ifTrue:[
^ aMethod valueWithReceiver:self arguments:#()
]
]
].
cls := cls superclass.
].
].
^ self doesNotUnderstand:(Message selector:selector)
"Created: / 5.8.1997 / 14:35:34 / cg"
"Modified: / 15.1.1998 / 00:31:27 / 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
! !
!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
JavaClass setInstanceVariableStringFromFields:f in:self.
instSize := superclass instSize + f size.
fields := f.
initValues := self allInstVarNames collect:[:nm |
self initValueFor:nm
].
initValues isEmpty ifTrue:[
initValues := nil
].
"Created: 15.4.1996 / 16:42:52 / cg"
!
setFullName:aString
|nameComponents|
fullName := aString asSymbol.
nameComponents := aString asCollectionOfSubstringsSeparatedBy:$/.
name := nameComponents last asSymbol
"Created: 15.4.1996 / 16:42:52 / 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"
!
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:'smalltalk interface'!
invoke:selector
"send a message, without args."
|method cls sel|
sel := selector asSymbolIfInterned.
sel notNil ifTrue:[
cls := self.
[cls notNil and:[cls ~~ JavaObject]] whileTrue:[
cls methodDictionary keysAndValuesDo:[:sel :aMethod |
"/ aMethod name printNL.
(aMethod name == selector
or:[aMethod signatureNameWithoutReturnType = selector]) ifTrue:[
aMethod numArgs == 0 ifTrue:[
^ aMethod
valueWithReceiver:self
arguments:#()
"/ ^ self
"/ invokeJavaMethod:aMethod
"/ sender:thisContext
"/ selector:selector
]
]
].
cls := cls superclass.
].
].
^ self doesNotUnderstand:(Message selector:selector)
"
|stack|
stack := (Java at:'java/util/Stack') basicNew.
stack invoke:#'<init>'.
"
"
|stack|
stack := (Java at:'java/util/Stack') basicNew.
stack invoke:#isEmpty.
"
"
|stack|
stack := (Java at:'java/util/Stack') basicNew.
stack invoke:#size.
"
"Created: / 30.7.1997 / 14:06:50 / cg"
"Modified: / 6.1.1998 / 18:21:34 / cg"
! !
!JavaClass ignoredMethodsFor:'smalltalk interface'!
invoke:selector interpreter:i sender:aContext with:arg
"send a message, with 1 arg"
|method cls sel|
method := JavaClass lookupMethod:selector numArgs:1 in:self static:true.
method notNil ifTrue:[
^ self
invokeJavaMethod:method
interpreter:i
sender:aContext
selector:selector
with:arg
].
^ super doesNotUnderstand:(Message selector:selector)
"Created: 17.8.1997 / 18:10:32 / cg"
"Modified: 17.8.1997 / 18:33:52 / cg"
!
invoke:selector signature:signature with:arg
"send a message, with 1 arg1."
|method cls sel sig|
sel := selector asSymbolIfInterned.
sel notNil ifTrue:[
sig := signature asSymbolIfInterned.
sig notNil ifTrue:[
cls := self.
[cls notNil and:[cls ~~ JavaObject]] whileTrue:[
method := cls compiledMethodAt:sel signature:signature.
method notNil ifTrue:[
^ method
valueWithReceiver:self
arguments:(Array with:arg)
"/ ^ self
"/ invokeJavaMethod:method
"/ sender:thisContext
"/ selector:sel
"/ with:arg
].
cls := cls superclass.
].
].
].
^ self doesNotUnderstand:(Message selector:selector)
"
|stack|
stack := (Java at:'java/util/Stack') basicNew.
stack invoke:#'<init>'.
"
"
|stack|
stack := (Java at:'java/util/Stack') basicNew.
stack invoke:#isEmpty.
"
"
|stack|
stack := (Java at:'java/util/Stack') basicNew.
stack invoke:#size.
"
"Created: / 30.7.1997 / 14:13:30 / cg"
"Modified: / 4.1.1998 / 16:32:45 / cg"
!
invoke:selector with:arg
"send a message, with one arg"
|method cls sel|
sel := selector asSymbolIfInterned.
sel notNil ifTrue:[
cls := self.
[cls notNil and:[cls ~~ JavaObject]] whileTrue:[
cls methodDictionary keysAndValuesDo:[:sel :aMethod |
"/ aMethod name printNL.
(sel == selector
or:[aMethod name == selector
or:[aMethod signatureNameWithoutReturnType = selector]]) ifTrue:[
aMethod numArgs == 1 ifTrue:[
^ aMethod
valueWithReceiver:self
arguments:(Array with:arg)
"/ ^ self
"/ invokeJavaMethod:aMethod
"/ sender:thisContext
"/ selector:selector
"/ with:arg
]
]
].
cls := cls superclass.
].
].
^ self doesNotUnderstand:(Message selector:selector)
"Modified: / 6.1.1998 / 21:04:04 / cg"
!
invoke:selector with:arg1 with:arg2
"send a message, with two args"
|method cls sel|
sel := selector asSymbolIfInterned.
sel notNil ifTrue:[
cls := self.
[cls notNil and:[cls ~~ JavaObject]] whileTrue:[
cls methodDictionary keysAndValuesDo:[:sel :aMethod |
"/ aMethod name printNL.
(aMethod name == selector
or:[aMethod signatureNameWithoutReturnType = selector]) ifTrue:[
aMethod numArgs == 2 ifTrue:[
^ self
invokeJavaMethod:aMethod
sender:thisContext
selector:selector
with:arg1
with:arg2
]
]
].
cls := cls superclass.
].
].
^ self doesNotUnderstand:(Message selector:selector)
"Modified: 30.7.1997 / 13:39:15 / cg"
"Created: 30.7.1997 / 14:00:09 / cg"
!
invoke:selector withAll:args
"send a message, with a number of args"
|method cls sel numArgGiven|
numArgGiven := args size.
sel := selector asSymbolIfInterned.
sel notNil ifTrue:[
cls := self.
[cls notNil and:[cls ~~ JavaObject]] whileTrue:[
cls methodDictionary keysAndValuesDo:[:sel :aMethod |
"/ aMethod name printNL.
(aMethod name == selector
or:[aMethod signatureNameWithoutReturnType = selector]) ifTrue:[
aMethod numArgs == numArgGiven ifTrue:[
^ self
invokeJavaMethod:aMethod
sender:thisContext
selector:selector
withAll:args
]
]
].
cls := cls superclass.
].
].
^ self doesNotUnderstand:(Message selector:selector)
"Modified: 30.7.1997 / 13:39:15 / cg"
"Created: 30.7.1997 / 14:00:53 / cg"
! !
!JavaClass methodsFor:'smalltalk interface'!
methodMatching:aSmalltalkSelector
|numArgs cls|
numArgs := aSmalltalkSelector numArgs.
cls := self.
[cls notNil] whileTrue:[
methodDictionary keysAndValuesDo:[:jSelector :aMethod |
aMethod numArgs == numArgs ifTrue:[
aMethod name = aSmalltalkSelector ifTrue:[
^ aMethod
]
]
].
cls := cls superclass
].
^ nil
"Modified: 1.2.1997 / 21:57:36 / cg"
"Created: 1.2.1997 / 21:57:53 / cg"
! !
!JavaClass methodsFor:'special'!
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.84 1998/11/04 20:55:47 cg Exp $'
! !
JavaClass initialize!