JavaClass.st
author cg
Thu, 21 Sep 2000 11:40:55 +0000
changeset 691 8dcc24aeaa95
parent 689 8dff2afd1ead
child 693 2beae7b13cdb
permissions -rw-r--r--
*** empty log message ***

"
 COPYRIGHT (c) 1997 by eXept Software AG
              All Rights Reserved

 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.
"




"{ Package: 'stx:libjava' }"

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 A_ABSTRACT_OR_INTERFACE
		ArgumentConversionErrorSignal OrderOfClassInits'
	poolDictionaries:''
	category:'Java-Classes'
!

!JavaClass class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 1997 by eXept Software AG
              All Rights Reserved

 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.
"



!

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.

    A_ABSTRACT_OR_INTERFACE := A_ABSTRACT bitOr:A_INTERFACE.

    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: / 13.11.1998 / 14:09:52 / cg"
! !

!JavaClass class methodsFor:'instance creation'!

fullName:aString
    self shouldNotImplement.
    ^ self new flags:0; setFullName:aString

!

fullName:aString numStatic:nStatic
    |meta cls s ns nameComponents|

    "/ 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 setAccessFlags:0.
"/    cls setClassVariableString:''.
    cls setInstanceVariableString:''.
    cls category:#java.
    cls setFullName:aString.

    "/ java classes do not really have a category;
    "/ simulate one by separating its name into individual components,
    "/ prepending 'java'"

    nameComponents := aString asCollectionOfSubstringsSeparatedBy:$/.
    nameComponents size > 1 ifTrue:[
        cls category:((nameComponents asStringWith:$/ from:1 to:(nameComponents size - 1))
                            replaceAll:$/ with:$. ).
    ].

    nameComponents size > 1 ifTrue:[
        cls setPackage:((nameComponents copyWithoutLast:1) asStringWith:$/) asSymbol
    ] ifFalse:[
        cls setPackage:aString asSymbol
    ].

    "/ 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.

    nameComponents size > 1 ifTrue:[
        s := '' writeStream.
        s nextPutAll:'JAVA'.
        nameComponents from:1 to:(nameComponents 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:nameComponents 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 failValue|

    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
        ].
        failValue := ''
    ].
    expectedCls := Java classForName:type.
    (arg isKindOf:expectedCls) ifTrue:[
        "/ matches class and subclasses
        ^ arg
    ].
    arg isNil ifTrue:[
        "/ matches any
        ^ arg
    ].
self halt.
    ^ failBlock value:('cannot convert argument to ' , type) value:failValue

    "Created: / 6.11.1998 / 00:46:19 / cg"
    "Modified: / 28.1.1999 / 17:55:17 / 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 :m |
                |aMethod|

                aMethod := m.
                aMethod isWrapped ifTrue:[
                    aMethod := aMethod originalMethod
                ].
                
                ((jSel == sel)
                or:[aMethod name = sel 
                or:[aMethod signatureNameWithoutReturnType = sel]])
                ifTrue:[
                    aMethod numArgs == nargs ifTrue:[
                        staticMethod == (aMethod isStatic) ifTrue:[
                            ^ m
                        ]
                    ]
                ]
            ].

            cls := cls superclass.
        ].
    ].
"/ self halt.
    ^ nil

    "Created: / 17.8.1997 / 18:25:47 / cg"
    "Modified: / 16.11.1998 / 16:46:48 / 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 have 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
    "redefined to find the constructor"

    |m|

    m := super compiledMethodAt:name.
    m isNil ifTrue:[
        name = self lastName ifTrue:[
            ^ super compiledMethodAt:#'<init>()V'
        ].
    ].
    ^ m

    "
     JAVA::java::lang::Object compiledMethodAt:#Object
    "

    "Created: / 24.12.1999 / 02:02:50 / cg"
    "Modified: / 24.12.1999 / 02:04:46 / cg"
!

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
!

javaName
    "the javaname - as seen by a java programmer.
     (with '/'s replaced by dots) extract from the fullName"

    ^ fullName copyReplaceAll:$/ with:$.

    "
     Java allClasses first fullName    
     Java allClasses first name    
     Java allClasses first javaName    
     Java allClasses first javaPackage  
     Java allClasses first package      
    "
!

javaPackage
    "the javaPackage - as seen by a java programmer.
     (with '/'s replaced by dots) extract from the fullName"

    |components|

    components := fullName asCollectionOfSubstringsSeparatedBy:$/.
    components size > 1 ifTrue:[
        ^ (components copyWithoutLast:1) asStringWith:$.
    ].
    ^ fullName

    "
     Java allClasses first fullName    
     Java allClasses first javaPackage  
     Java allClasses first package      
    "
!

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
    "the package (as seen by a smalltalk programmer)
     extract from the fullName, (with '/'s) and prepend 'java:'"

    |components p i|

    i := fullName lastIndexOf:$/.
    p := fullName copyTo:i - 1.
    p size == 0 ifTrue:[
        ^ 'java'
    ].
"/    components := fullName asCollectionOfSubstringsSeparatedBy:$/.
"/    components size > 1 ifTrue:[
"/        p := (components copyWithoutLast:1) asStringWith:$/
"/    ] ifFalse:[
"/        p := fullName
"/    ].

    ^ 'java:' , p

    "
     Java allClasses first fullName   
     Java allClasses first package    
     Java allClasses first javaPackage  
    "
!

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"
! !

!JavaClass methodsFor:'compiler interface'!

browserClass
    "return the browser to use for this class - 
     this can be redefined in special classes, to get different browsers"

"/    ^ JavaBrowser
    ^ super browserClass.

    "Modified: / 14.10.1998 / 15:28:38 / cg"
!

compilerClass
    "return the compiler to use for this class - 
     this can be redefined in special classes, to compile classes with
     Lisp, Prolog, ASN1, Basic :-) or whatever syntax."

    ^ JavaCompiler ? Compiler
!

evaluatorClass
    "return the compiler to use for expression evaluation for this class - 
     this can be redefined in special classes, to evaluate expressions with
     Lisp, Prolog, ASN1, Basic :-) or whatever syntax."

    ^ JavaParser ? Parser.

!

parserClass
    "return the parser to use for parsing this class - 
     this can be redefined in special classes, to parse classes with
     Lisp, Prolog, ASN1, Basic :-) or whatever syntax."

    ^ JavaParser ? Parser.

!

syntaxHighlighterClass
    "return the class to use for syntaxHighlighting (prettyPrinting) this class - 
     this can be redefined in special classes, to highlight classes with
     Lisp, Prolog, ASN1, Basic :-) or whatever syntax."

    ^ JavaSyntaxHighlighter "/ ? SyntaxHighlighter
! !

!JavaClass methodsFor:'compiling'!

recompileMethodsAccessingGlobal:aGlobalKey
    "/ dummy for now

    "Created: / 9.11.1999 / 16:42:09 / 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"

    ^ self startMainWithArgumentString:nil

    "Modified: / 30.12.1998 / 20:24:58 / cg"
!

startMainWithArgumentString:aCommandLineString
    "start a thread for my main() method, passing a string with arguments"

    |p|

    p := Java javaProcessForMainOf:self argumentString:aCommandLineString.
    p notNil ifTrue:[
        p resume.
        Object abortSignal handle:[:ex |
p == JavaVM javaScreenUpdaterThread ifTrue:[self halt].
p == JavaVM javaEventQueueThread ifTrue:[self halt].
            p terminate.
            ex reject.
        ] do:[
            p waitUntilTerminated
        ].
    ]

    "Modified: / 24.12.1999 / 02:35:04 / 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 }" |

    (accessFlags bitAnd:A_ABSTRACT_OR_INTERFACE) ~~ 0 ifTrue:[
        JavaVM throwInstantiationExceptionFor:self.
        ^ nil
    ].

    newJavaObject := super basicNew.
    initValues notNil ifTrue:[
        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: / 13.11.1998 / 14:10:45 / cg"
!

newWith_String:argString
    "create a new instance, preset its fields,
     and call its JAVA init function passing a String arg"

    |newJavaObject|

    newJavaObject := self newCleared.
    newJavaObject 
        perform:#'<init>(Ljava/lang/String;)V' 
        with:(Java as_String:argString).
    ^ newJavaObject

    "
     ((Java classNamed:'java.lang.ArrayStoreException') newWith_String:'foo') inspect
    "

    "Modified: / 4.11.1998 / 18:04:34 / cg"
    "Created: / 13.11.1998 / 14:17:01 / cg"
!

newWith_int:arg
    "create a new instance, preset its fields,
     and call its JAVA init function passing an int arg"

    |newJavaObject|

    newJavaObject := self newCleared.
    newJavaObject perform:#'<init>(I)V' with:arg.
    ^ newJavaObject

    "
     ((Java classNamed:'java.lang.Integer') newWith_int:123) inspect
    "

    "Modified: / 4.11.1998 / 18:04:34 / cg"
    "Created: / 13.11.1998 / 14:17:01 / 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"
!

performStatic:selector with:arg
    "send a static message, with one args."

    |javaMethod sel|

    sel := selector asSymbolIfInterned.
    sel notNil ifTrue:[
        javaMethod := methodDictionary at:sel.
        javaMethod notNil ifTrue:[
            javaMethod isStatic ifTrue:[
                ^ javaMethod 
                    valueWithReceiver:self 
                    arguments:(Array with:arg)
            ]
        ].
    ].

    ^ self doesNotUnderstand:(Message selector:selector argument:arg)

    "Modified: / 15.1.1998 / 00:31:27 / cg"
    "Created: / 10.12.1998 / 21:50:29 / 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'!

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
            ].
        ]
    ].
    superclass isJavaClass ifTrue:[
        ^ superclass hasInterface:aJavaInterface
    ].
    ^ 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"
!

isJavaMethodRef
    ^ false

    "Created: / 9.11.1999 / 15:42:10 / 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"
!

nameInBrowser
    "return a nameString as shown in browsers"

    ^ self name copyReplaceAll:$/ with:$.
!

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: / 8.1.1999 / 14:11:34 / cg"
!

asClassPointerRef
"/ self halt.
     ^ self

    "Created: / 10.11.1998 / 02:07:01 / cg"
    "Modified: / 8.1.1999 / 14:11:26 / 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.118 2000/09/21 11:40:55 cg Exp $'
! !
JavaClass initialize!