Java.st
author Claus Gittinger <cg@exept.de>
Thu, 24 Nov 2011 12:53:34 +0100
changeset 2267 ee8926ac5ea2
parent 2151 c0b6570c6f9b
child 2279 6f65ccfd7c81
permissions -rw-r--r--
fixed: #version_SVN ($ to ยง)

"
 COPYRIGHT (c) 1996-2011 by Claus Gittinger
 COPYRIGHT (c) 2010-2011 by Jan Vrany, Jan Kurs and Marcel Hlopko
                            SWING Research Group, Czech Technical University in Prague

 Parts of the code written by Claus Gittinger are under following
 license:

 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.

 Parts of the code written at SWING Reasearch Group [1] are MIT licensed:

 Permission is hereby granted, free of charge, to any person
 obtaining a copy of this software and associated documentation
 files (the 'Software'), to deal in the Software without
 restriction, including without limitation the rights to use,
 copy, modify, merge, publish, distribute, sublicense, and/or sell
 copies of the Software, and to permit persons to whom the
 Software is furnished to do so, subject to the following
 conditions:

 The above copyright notice and this permission notice shall be
 included in all copies or substantial portions of the Software.

 THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND,
 EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
 OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
 NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
 HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
 WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
 FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
 OTHER DEALINGS IN THE SOFTWARE.

 [1] Code written at SWING Research Group contain a signature
     of one of the above copright owners.
"
"{ Package: 'stx:libjava' }"

Object subclass:#Java
	instanceVariableNames:''
	classVariableNames:'Classes UnresolvedClassRefs Release ClassPath SourceDirectories
		CacheDirectory JavaHome InternedStrings Java_lang_String
		Java_lang_Class PrettyPrintStyle LastArgumentString Threads
		ExcludedClassPath FailedToLoadClasses SourceCache
		SourceArchiveCache'
	poolDictionaries:''
	category:'Languages-Java-Support'
!

!Java class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 1996-2011 by Claus Gittinger
 COPYRIGHT (c) 2010-2011 by Jan Vrany, Jan Kurs and Marcel Hlopko
                            SWING Research Group, Czech Technical University in Prague

 Parts of the code written by Claus Gittinger are under following
 license:

 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.

 Parts of the code written at SWING Reasearch Group [1] are MIT licensed:

 Permission is hereby granted, free of charge, to any person
 obtaining a copy of this software and associated documentation
 files (the 'Software'), to deal in the Software without
 restriction, including without limitation the rights to use,
 copy, modify, merge, publish, distribute, sublicense, and/or sell
 copies of the Software, and to permit persons to whom the
 Software is furnished to do so, subject to the following
 conditions:

 The above copyright notice and this permission notice shall be
 included in all copies or substantial portions of the Software.

 THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND,
 EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
 OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
 NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
 HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
 WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
 FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
 OTHER DEALINGS IN THE SOFTWARE.

 [1] Code written at SWING Research Group contain a signature
     of one of the above copright owners.

"
!

documentation
"Java class is main entry point or - you might say -
facade to the Java world inside Smalltalk. It also 
serves as configuration entity - e.g. controlling 
classpath, source paths, etc. Java class is responsible
for correct initialization and glueing other classes.
"
! !

!Java class methodsFor:'accessing'!

classForName:aString
    "return a javaClass - either existing or loaded"

    |cls loader|

    cls := self at:aString.
    cls isNil ifTrue:[
        FailedToLoadClasses notNil ifTrue:[
            (FailedToLoadClasses includes:aString) ifTrue:[
"/                ('JAVA [info]: class loading already failed: ' , aString) infoPrintCR.
                ^ nil
            ]
        ].

        "/('JAVA [info]: late class loading: ' , aString) infoPrintCR.
        loader := JavaClassReader classLoaderQuerySignal query.
        loader isNil ifTrue:[
            "/ load using default (ST/X) loader
            cls := JavaClassReader loadClass:aString.
        ] ifFalse:[
            "/ load using a Java class loader
"/            classURL := Java as_URL:('file:' , aString , '.class').
"/            loader loadClass:classURL.
            loader perform:#'loadClass(Ljava/lang/String;)Ljava/lang/Class;'
                with:(Java as_String:aString).

            cls := self at:aString.
        ].
        cls isNil ifTrue:[
            FailedToLoadClasses isNil ifTrue:[
                FailedToLoadClasses := Set new.
            ].
            FailedToLoadClasses add:aString
        ]
    ].
    ^ cls

    "Created: / 18-03-1997 / 16:45:57 / cg"
    "Modified: / 27-04-1998 / 15:00:52 / cg"
    "Modified: / 18-08-2011 / 19:30:50 / jv"
!

classNamed:aString
    ^ self at:aString
!

intern:aJavaString
    |stString internedString|

    stString := self as_ST_String:aJavaString.
    internedString := InternedStrings at:stString ifAbsent:nil.
    internedString isNil ifTrue:[
        InternedStrings at:stString put:aJavaString.
        internedString := aJavaString
    ].
    ^ internedString
!

java_lang_Class
    Java_lang_Class isNil ifTrue:[
        Java_lang_Class := self at:'java.lang.Class'
    ].
    ^ Java_lang_Class

    "Created: 26.3.1997 / 13:42:59 / cg"
    "Modified: 26.3.1997 / 13:46:24 / cg"
!

java_lang_String
    Java_lang_String isNil ifTrue:[
        Java_lang_String := self at:'java.lang.String'
    ].
    ^ Java_lang_String

    "Created: 26.3.1997 / 13:43:17 / cg"
    "Modified: 26.3.1997 / 13:50:21 / cg"
!

prettyPrintStyle
    ^ PrettyPrintStyle

    "Created: 1.8.1997 / 10:37:57 / cg"
!

release

    ^Release

    "Created: / 22-11-2010 / 12:38:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

release: aJavaRelease

    Release := aJavaRelease.

    "
        Java release: JavaRelease openJDK6. 
        Java release: JavaRelease sunJDK6. 
        
    "

    "Created: / 22-11-2010 / 12:38:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 30-11-2010 / 11:54:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

systemPropertyAt:key put:something
    JavaVM systemProperties at:key put:something

    "Created: / 9.1.1999 / 14:49:35 / cg"
!

threads
    Threads isNil ifTrue:[
        Threads := WeakIdentityDictionary new.
    ].
    ^ Threads

    "Created: 26.8.1997 / 19:53:57 / cg"
    "Modified: 26.8.1997 / 19:55:27 / cg"
! !

!Java class methodsFor:'accessing paths'!

addToClassPath:aPath

    | path |
    path := aPath asFilename.

    (aPath asString includes: $*) ifTrue:[
        self addToClassPathFilesMatching: path baseName
             in: path directoryName.
    ] ifFalse:[
        (ClassPath includes:aPath asString) ifFalse:[
            ClassPath add:aPath asString.
            self addToClassPathInRuntime:aPath.
            FailedToLoadClasses := nil
        ]
    ]

    "Created: / 01-08-1997 / 21:10:07 / cg"
    "Modified: / 17-09-1998 / 20:43:55 / cg"
    "Modified: / 07-08-2011 / 14:06:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

addToClassPathFilesMatching: pattern in: path

    | dir |
    dir := path asFilename.
    dir directoryContents do:
        [:fname|
        (fname matches: pattern) ifTrue:
            [| p |
            p := (dir / fname) pathName.
            (ClassPath includes:p) ifFalse:
                [ClassPath add:p.
                self addToClassPathInRuntime:p.
                FailedToLoadClasses := nil]]].

    "Created: / 20-12-2010 / 17:26:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

addToClassPathInRuntime:aPath

    | path file url scl |
    "Java might not be loaded/or initialized, in this case
     there is no no need to inform java about new entry in classpath"

    JavaVM booted ifFalse:[^self].
    scl := (Java classForName:'java.lang.ClassLoader') instVarNamed: #scl.
    scl ifNil:[
        scl := (Java classForName:'java.lang.ClassLoader') perform: #'getSystemClassLoader()Ljava/lang/ClassLoader;'.
    ].
    path := Java as_String: aPath asString.        
    file := (Java at:'java.io.File') new perform: #'<init>(Ljava/lang/String;)V' with: path; yourself.
    url := file perform: #'toURL()Ljava/net/URL;'.
    scl perform: #'addURL(Ljava/net/URL;)V' with: url.

    "Created: / 01-08-1997 / 21:10:07 / cg"
    "Modified: / 17-09-1998 / 20:43:55 / cg"
    "Created: / 07-08-2011 / 14:01:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

addToSourcePath:aPath
    SourceDirectories ifNil:[SourceDirectories := OrderedCollection new].
    (SourceDirectories includes:aPath) ifFalse:[
        SourceDirectories add:aPath
    ]

    "Created: / 02-08-1997 / 14:12:31 / cg"
    "Modified: / 06-02-2011 / 22:51:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

cacheDirectory

    CacheDirectory ifNil:[
        CacheDirectory := Filename homeDirectory / '.smalltalk' / 'libjava' / 'caches' /
            (((Smalltalk at:#stx_libjava) svnRepositoryUrlBase copyReplaceAll:$/ with:$_) replaceAll:$: with:$_)
    ].
    ^CacheDirectory

    "Created: / 08-04-2011 / 15:02:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 08-04-2011 / 16:58:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

classPath

    | CLASSPATH |
    CLASSPATH := ((OperatingSystem getEnvironment: 'CLASSPATH') ? '') 
        tokensBasedOn: OperatingSystem pathSeparator.

    ^
        "for testing only"
        "/Release classPath,
        (Array 
            with: ((Smalltalk packageDirectoryForPackageId:'stx:libjava') / 'java' / 'libjava-projects' / 'Conversion' / 'bin' ) pathName
            with: ((Smalltalk packageDirectoryForPackageId:'stx:libjava') / 'java' / 'libjava-support' / 'bin' ) pathName
        ),

        (ClassPath ? #()),
            CLASSPATH

    "
        Java classPath
    "

    "Created: / 07-02-1997 / 19:23:45 / cg"
    "Modified: / 12-08-2011 / 08:57:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

classPath:aCollectionOfPaths
    ClassPath := aCollectionOfPaths asOrderedCollection.
    FailedToLoadClasses := nil

    "Created: / 7.2.1997 / 19:23:45 / cg"
    "Modified: / 17.9.1998 / 20:44:09 / cg"
!

effectiveClassPath

    ^self release classPath , self classPath

    "
    Java effectiveClassPath
    "

    "Created: / 22-11-2010 / 13:03:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 17-01-2011 / 09:44:16 / kursjan <kursjan@fit.cvut.cz>"
    "Modified: / 12-08-2011 / 08:57:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

effectiveSourceDirectories

    ^Release sourcePath ,
        (SourceDirectories ? #())

    "
        Java effectiveSourceDirectories 
    "

    "Created: / 30-11-2010 / 11:53:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

excludedClassPath
    ^ ExcludedClassPath

    "Modified: / 7.2.1997 / 19:23:55 / cg"
    "Created: / 27.1.1998 / 21:57:13 / cg"
!

isExcludedFromClassPath:fileName
    |nm|

    nm := fileName asFilename pathName.
    ExcludedClassPath do:[:excludedPath |
        (nm startsWith:excludedPath) ifTrue:[^ true].
    ].
    ^ false

    "Created: / 27.1.1998 / 22:00:40 / cg"
!

javaHome
    ^ JavaHome ifNil:[Release javaHome]

    "Created: / 06-08-1997 / 00:53:19 / cg"
    "Modified: / 22-11-2010 / 12:39:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

javaHome:aPath

    <resource: #obsolete>

    self obsoleteMethodWarning: 'javaHome is now controlled by java release'.

    JavaHome := aPath

    "Created: / 06-08-1997 / 00:53:23 / cg"
    "Modified: / 22-11-2010 / 12:40:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

newJavaHome:newJavaHome
    self javaHome:newJavaHome.

!

removeFromClassPath:aPath
    (ClassPath includes:aPath) ifTrue:[
        ClassPath remove:aPath
    ]

    "Modified: 7.2.1997 / 19:23:55 / cg"
    "Created: 1.8.1997 / 21:10:21 / cg"
!

removeFromSourcePath:aPath
    (SourceDirectories includes:aPath) ifTrue:[
        SourceDirectories remove:aPath
    ]

    "Modified: 7.2.1997 / 19:23:55 / cg"
    "Created: 2.8.1997 / 14:13:01 / cg"
!

sourceDirectories
    ^ SourceDirectories
!

sourceDirectories:aCollectionOfPaths
    SourceDirectories := aCollectionOfPaths asOrderedCollection

    "
     Java
        sourceDirectories:#(
                            '/phys/ibm3/java/src'
                           )
    "


!

sourcePath
    ^ SourceDirectories

    "Created: / 16.1.1998 / 13:26:55 / cg"
! !

!Java class methodsFor:'change & update'!

update: what with: param from: sender

    what == #restarted ifTrue:[
        self reinitialize.
    ]

    "Created: / 14-12-2010 / 21:00:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!Java class methodsFor:'class initialization'!

initAllClasses
    |system|

    FailedToLoadClasses := nil.
    self initAllStaticFields.

    system := self classForName:'java.lang.System'.
    system isInitialized ifFalse:[
        self initSystemClass.
    ].

    self allClassesDo:[:cls |
       cls isInitialized ifFalse:[
           cls classInit
       ]
    ]

     "
      Java initAllClasses
     "

    "Modified: / 27.11.1998 / 00:33:05 / cg"
!

initAllStaticFields
     self allClassesDo:[:cls |
        cls initializeStaticFields
     ]

!

initSystemClass
    |system|

    system := Java at:'java.lang.System'.
    system isNil ifTrue:[
"/        JavaVM initializeVM.
"/        system := Java at:'java.lang.System'.
"/        system isNil ifTrue:[
        self warn:'JavaVM: no ''' , 'java.lang.System' allBold , ''' class.'.
"/            self error:'no ''java.lang.System'' class'.
            ^ self
"/        ].
    ].

    system classInit.
    (system implements:#'initializeSystemClass()V') ifTrue:[
        system perform: "invokeStatic:" #'initializeSystemClass()V'.
    ].

    "
     Java initSystemClass

     (Java at:'java.lang.System') 
        perform:#'getProperty(Ljava/lang/String;)Ljava/lang/String;'
        with:(Java as_String:'java.home')
    "

    "Modified: / 10.11.1998 / 12:39:58 / cg"
!

initialize
    JavaNativeMethod flushAllCachedNativeMethods.

    InternedStrings := Dictionary new.
    FailedToLoadClasses := nil.

    ClassPath := OrderedCollection new. 
    ExcludedClassPath := OrderedCollection new.

    SourceCache := CacheDictionary new: 32.
    SourceArchiveCache := CacheDictionary new: 32.

    self initializeRelease. "lazy initialization of Release"

    self initializePrettyPrintStyle.

    ObjectMemory addDependent: self.

    "
     Java flushAllJavaResources.   
     Java initialize.
     JavaVM initializeVM
     Java classPath inspect
    "

    "Modified: / 06-11-2001 / 09:24:12 / cg"
    "Created: / 03-10-2010 / 15:54:02 / Jan Kurs <kurs.jan@post.cz>"
    "Modified: / 15-10-2010 / 17:37:20 / Jan Kurs <kurs.jan@post.cz>"
    "Modified: / 10-02-2011 / 23:08:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

initializeForNewClassPath:directoriesToSearch
    |jClasses jHome jSources|

    jClasses := OrderedCollection new.

    directoriesToSearch do:[:aPath | 
        |dir libDir toAdd|

        dir := aPath asFilename.
        (jHome isNil and:[dir exists]) ifTrue:[
            ((dir hasSuffix:'jar')
            or:[dir hasSuffix:'zip']) ifTrue:[
                toAdd := dir pathName.
            ] ifFalse:[

                "/ there must be either a classes directory,
                "/ or a classes.zip file ...
                (libDir := dir construct:'lib') exists ifTrue:[
                    ((libDir construct:'classes') exists 
                    and:[(libDir construct:'classes') isDirectory]) ifTrue:[
                        jHome := aPath.
                        toAdd := (libDir constructString:'classes').
                    ] ifFalse:[
                        (libDir construct:'classes.zip') exists ifTrue:[
                            jHome := aPath.
                            toAdd := (libDir constructString:'classes.zip').
                        ] ifFalse:[
                            (libDir construct:'rt.jar') exists ifTrue:[
                                jHome := aPath.
                                toAdd := (libDir constructString:'rt.jar').
                            ].
                            (libDir construct:'rt.zip') exists ifTrue:[
                                jHome := aPath.
                                toAdd := (libDir constructString:'rt.zip').
                            ] 
                        ]
                    ]
                ] ifFalse:[
                    ((dir construct:'classes') exists 
                    and:[(dir construct:'classes') isDirectory]) ifTrue:[
                        jHome := aPath.
                        toAdd := (dir constructString:'classes').
                    ] ifFalse:[
                        (dir construct:'classes.zip') exists ifTrue:[
                            jHome := aPath.
                            toAdd := (dir constructString:'classes.zip').
                        ] ifFalse:[
                            (dir construct:'rt.zip') exists ifTrue:[
                                jHome := aPath.
                                toAdd := (dir constructString:'rt.zip').
                            ] 
                        ]
                    ]
                ].
            ].
        ].
        toAdd notNil ifTrue:[
            Transcript showCR:'Adding to classPath: ' , toAdd.
            jClasses add:toAdd.
        ].
    ].

    self javaHome:jHome.
    self classPath:(jClasses collect:[:f | f asFilename name]).
    jHome isNil ifTrue:[
        Transcript showCR:'no java home directory found'.
    ] ifFalse:[
        jHome := jHome asFilename.
        Transcript showCR:'Found javaHome in: ' , jHome pathName.

        (jSources := jHome construct:'source') exists ifFalse:[
            (jSources := jHome construct:'src') exists ifFalse:[
                (jSources := jHome construct:'sources') exists ifFalse:[
                    (jSources := jHome construct:'src.zip') exists ifFalse:[
                        jSources := nil.
                    ]
                ]
            ]
        ].

        jSources isNil ifTrue:[
            Transcript showCR:'no java source directory found'.
        ] ifFalse:[
            Transcript showCR:'Found javaSources in: ' , jSources pathName.
            self sourceDirectories:(Array with:jSources pathName).
        ].
    ].

    "
     self initializeForNewClassPath:(Java classPath)
     self initializeForNewClassPath:(Array with:'/home/java/jdk113')
    "

    "Modified: / 03-10-2010 / 15:49:02 / Jan Kurs <kurs.jan@post.cz>"
    "Modified: / 19-10-2010 / 10:49:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

initializePrettyPrintStyle
    PrettyPrintStyle := IdentityDictionary new.
    PrettyPrintStyle  at:#accessAttribute put:(#color -> (Color red:0 green:0 blue:25)).
    PrettyPrintStyle  at:#className       put:(Array with:(#color -> Color black) with:#bold).
    PrettyPrintStyle  at:#methodName      put:(Array with:(#color -> Color black) with:#bold).
    PrettyPrintStyle  at:#code            put:(#color -> Color black).


     "
      Java initializePrettyPrintStyle
     "

    "Created: 1.8.1997 / 11:08:43 / cg"
    "Modified: 1.8.1997 / 11:09:58 / cg"
!

initializeRelease

    Release ifNil:[Release := JavaRelease any].

    "
        Release := nil. 
        self initializeRelease.
        Release
    "

    "Created: / 22-11-2010 / 13:41:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

reinitAllClasses
     self markAllClassesUninitialized.
     self initAllClasses

     "
      Java reinitAllClasses
     "

    "Modified: / 4.1.1998 / 00:34:29 / cg"
!

reinitialize
    "/ all JavaThreads are lost on a restart (for now)

    FailedToLoadClasses := nil.
    Threads := nil.

    "Kludge"
    JavaMethod reinitialize.
    JavaMethodWithException reinitialize.    
    JavaMethodWithHandler reinitialize.
    JavaNativeMethod reinitialize.
    JavaNativeMethod flushAllCachedNativeMethods.


    "
     Java reinitialize
    "

    "Created: / 26-08-1997 / 20:07:00 / cg"
    "Modified: / 27-04-1998 / 14:57:23 / cg"
    "Modified: / 14-12-2010 / 21:30:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

startupJavaSystem
    |javaEventThread haveEventThread haveScreenUpdater|

    FailedToLoadClasses := nil.

    "/
    "/ check if already running
    "/

    haveEventThread := true.
    javaEventThread := JavaVM javaEventThread.
    (javaEventThread isNil or:[javaEventThread isDead]) ifTrue:[
        haveEventThread := false
    ].

    haveScreenUpdater := false.
    haveEventThread ifTrue:[
        self threads do:[:aJavaThread |
            aJavaThread name = 'JAVA-Screen Updater' ifTrue:[
                aJavaThread isDead ifFalse:[
                    "/ already running
                    haveScreenUpdater := true
                ]
            ]
        ].
    ].

    (haveEventThread and:[haveScreenUpdater]) ifTrue:[
        ^ self
    ].

    JavaClass orderOfClassInits isNil ifTrue:[
        "/ the very first start ...
        'JAVA [info]: (re)initializing JAVA environment completely ...' infoPrintCR.

        JavaVM initializeVM.
    ] ifFalse:[
        JavaVM initializeVMIfNoEventThreadRunning
    ].    
    'JAVA [info]: done JAVA initialization.' infoPrintCR.

    "
     Java startupJavaSystem
    "

    "Modified: / 24.12.1999 / 01:37:49 / cg"
!

terminateAllThreads
    |myself threadsToKill|

    Threads isNil ifTrue:[
        ^ self
    ].

    myself := Processor activeProcess.

    threadsToKill := IdentitySet new.
    Threads do:[:aJavaThread |
        aJavaThread ~~ myself ifTrue:[
            (aJavaThread isNil or:[aJavaThread == 0]) ifFalse:[
                (aJavaThread isMemberOf:JavaProcess) ifTrue:[
                    aJavaThread isDead ifFalse:[
                        threadsToKill add:aJavaThread
                    ]
                ]
            ]
        ]
    ].
    threadsToKill do:[:aThread |
aThread == JavaVM javaScreenUpdaterThread ifTrue:[self halt].
aThread == JavaVM javaEventQueueThread ifTrue:[self halt].
        aThread terminate
    ].
    Threads := nil.

    "
     Java terminateAllThreads
    "

    "Created: / 26.8.1997 / 19:57:40 / cg"
    "Modified: / 24.12.1999 / 02:34:53 / cg"
! !

!Java class methodsFor:'enumerating'!

allClasses
    ^ Classes ? #()

    "
    |if|

    if := Java at:'java.awt.GraphicsEnvironment'.
    Java allClasses select:[:aClass |
                                aClass hasInterface:if
                            ]
    "

    "Modified: / 28.1.1998 / 01:42:04 / cg"
!

allClassesDo:aBlock
    Classes notNil ifTrue:[
        Classes do:aBlock
    ]
! !

!Java class methodsFor:'object conversions'!

as_Float:aNumber
    "convert an ST-float into a Java Float"

    |i|

    i := (Java at:'java.lang.Float') new.
    i perform:#'<init>(F)V' with:(aNumber asShortFloat).
    ^ i

    "
     Java as_Float:1
     Java as_Float:3.14159
    "

    "Created: 7.8.1997 / 21:21:13 / cg"
    "Modified: 7.8.1997 / 21:22:05 / cg"
!

as_Hashtable:aDictionary
    "given a smalltalk dictionary, create and return
     a Java hashTable for it"

    |hashTable|

    hashTable := (self classForName:'java.util.Hashtable') new.
    aDictionary keysAndValuesDo:[:k :v |
        |sk sv jk jv|

        (sk := k) isSymbol ifTrue:[
            sk := sk asString
        ].
        (sv := v) isSymbol ifTrue:[
            sv := sv asString
        ].
        jk := self as_Object:sk.
        jv := self as_Object:sv.

        hashTable 
            perform:#'put(Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object;'    
            with:jk
            with:jv.
    ].
    ^ hashTable

    "
     Java as_Hashtable:(Dictionary new
                           at:'hello' put:'Hallo';
                           at:'world' put:'Welt';       
                           yourself)
    "

    "Modified: / 14.1.1998 / 17:02:13 / cg"
!

as_Integer:anInteger
    "convert an ST-integer into a Java Integer"

    |i|

    i := (Java at:'java.lang.Integer') new.
    i perform:#'<init>(I)V' with:anInteger.
    ^ i

    "
     Java as_Integer:1
    "

    "Modified: 7.8.1997 / 21:19:37 / cg"
    "Created: 7.8.1997 / 21:21:13 / cg"
!

as_Object:anObject
    "convert an ST-Object into a Java Object"

    anObject isString ifTrue:[
        ^ self as_String:anObject
    ].
    anObject isInteger ifTrue:[
        ^ self as_Integer:anObject
    ].

    self halt.

    "
     Java as_Object:'hello world'
    "

    "Created: 7.8.1997 / 21:15:38 / cg"
    "Modified: 7.8.1997 / 21:20:07 / cg"
!

as_ST_String: aJavaString 
    "hard-coding internas of java.lang.String here is bad ..."
    
    | str  count  offs  start  stop |

    aJavaString isNil ifTrue: [ ^ nil ].
    
    "/ count := aJavaString instVarNamed:'count'.
    
    count := aJavaString instVarAt: 3.
    
    "/ str := aJavaString instVarNamed:'value'
    
    str := aJavaString instVarAt: 1.
    str size == count 
        ifTrue: 
            [ "cos I don't see any reason to do this"
            "/ ^ str asOneByteString.
            ^ str ].
    
    "/ offs := (aJavaString instVarNamed:'offset').
    
    offs := aJavaString instVarAt: 2.
    
    "/ start := offs + 1.
    
    start := offs + 1.
    
    "/ stop := start + (aJavaString instVarNamed:'count') - 1.
    
    stop := start + count - 1.
    
    "/ ^ ((aJavaString instVarNamed:'value') copyFrom:start to:stop) asString
    
    ^ (str copyFrom: start to: stop) asOneByteString

    "Created: / 08-08-1997 / 12:02:55 / cg"
    "Modified: / 04-01-1999 / 23:55:08 / cg"
    "Modified: / 22-03-2011 / 17:21:19 / Marcel Hlopko <hlopkmar@fel.cvut.cz>"
    "Modified: / 10-08-2011 / 23:32:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

as_String:aString
    "convert an ST-String into a Java String"

    "hard-coding internas of java.lang.String here is bad ..."

    |s|

    s := Java_lang_String basicNew.
    s instVarNamed:'value'  put: aString.
    s instVarNamed:'offset' put: 0.
    s instVarNamed:'count'  put: aString size.
    s instVarNamed:'hash'   put: 0.
    ^ s

    "
     Java as_String:'hello world'
    "

    "Created: / 07-08-1997 / 21:15:49 / cg"
    "Modified: / 03-02-2011 / 23:33:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

as_URL:aString
    "convert an ST-String into a Java String"

    "hard-coding internas of java.lang.String here is bad ..."

    |u s|

    s := aString.

    "/ kludge for volume
    OperatingSystem isMSDOSlike ifTrue:[
        ((s size > 1) and:[(s at:2) == $:]) ifTrue:[
            s := 'file:' , (s copy at:2 put:$|)
        ]
    ].
    u := (self at:'java.net.URL') newCleared.
    u perform:#'<init>(Ljava/lang/String;)V' with:(self as_String:s).
    ^ u

    "
     Java as_URL:'http://www.altavista.com'
     Java as_URL:'file:/foo/bar'
    "

    "Created: / 7.8.1997 / 21:15:49 / cg"
    "Modified: / 25.9.1999 / 22:22:21 / cg"
! !

!Java class methodsFor:'queries'!

smalltalkClassFor:typeRef
self halt.
"/    (typeString startsWith:'[[') ifTrue:[
"/        ^ Array
"/    ].
"/    (typeString startsWith:'[F') ifTrue:[
"/        ^ FloatArray
"/    ].
    self halt.

    "Modified: 7.4.1997 / 13:33:46 / cg"
!

smalltalkDerefType:typeString
    (typeString startsWith:'[') ifTrue:[
        ^ typeString copyFrom:2
    ].
    self halt.

    "Modified: 7.4.1997 / 13:13:24 / cg"
! !

!Java class methodsFor:'registering java classes'!

at:aJavaName
    "search & return for a class by name;
     if there is no such class, return nil.
     The argument, aJavaName may be either an internal name
     (sep'd by slashes) or an external name (sep'd by periods).
     The 'java/lang' standard packages prefix may be ommitted."

    |sym nm cls|

    Classes isNil ifTrue:[^ nil].

    sym := aJavaName asSymbolIfInterned.
    sym notNil ifTrue:[
        cls := Classes at:sym ifAbsent:nil.
        cls notNil ifTrue:[^ cls].
    ].

    nm := aJavaName.
    (nm includes:$.) ifTrue:[
        nm := (nm asString copyReplaceAll:$. with:$/).
        sym := nm asSymbolIfInterned.
        sym notNil ifTrue:[
            cls := Classes at:sym ifAbsent:nil.
            cls notNil ifTrue:[^ cls].
        ].
    ].
        
    (nm includes:$/) ifFalse:[
        "/
        "/ try java.lang.Foo
        "/
        nm := 'java/lang/' , nm.
        sym := nm asSymbolIfInterned.
        sym notNil ifTrue:[
            cls := Classes at:sym ifAbsent:nil.
            cls notNil ifTrue:[^ cls].
        ].
    ].

    ^ nil

    "
     Java at:'java/lang/String' 
     Java at:'java.lang.String'
     Java at:'String'          
     Java at:'System'            
     Java at:'Foo'               
    "

    "Modified: / 18.7.1998 / 22:55:16 / cg"
!

at:aJavaName put:aJavaClass
    |nameSymbol oldClass|

    Classes isNil ifTrue:[
        Classes := IdentityDictionary new.
    ].

    nameSymbol := aJavaName asSymbol.
    (Classes includesKey:nameSymbol) ifTrue:[
        oldClass := Classes at:nameSymbol.
        oldClass == aJavaClass ifTrue:[
            ^ self
        ].
        ('JAVA: class ' , aJavaName , ' is already loaded') infoPrintCR.
        self updateClassRefsFrom:oldClass to:aJavaClass.
    ].

    Classes at:nameSymbol put:aJavaClass.
    nameSymbol == #'java/lang/String' ifTrue:[
        Java_lang_String := aJavaClass
    ].

"/    UnresolvedClassRefs notNil ifTrue:[
"/        UnresolvedClassRefs do:[:toResolve |
"/        ]
"/    ].

    self changed:#classes

    "Created: 17.4.1996 / 23:29:31 / cg"
    "Modified: 7.8.1997 / 19:15:58 / cg"
!

flushAllJavaResources
    self flushClasses.

    SourceCache := CacheDictionary new: 32.
    SourceArchiveCache := CacheDictionary new: 32.

    ObjectMemory allObjectsDo:[:someObject |
        someObject isBehavior ifTrue:[
            someObject isJavaClass ifTrue:[
                someObject setConstantPool:nil.
                someObject setInterfaces:nil.
                someObject setMethodDictionary:(MethodDictionary new).
                'JAVA [info]: flushing ' print. someObject fullName printCR.
            ]
        ].
    ].
    JavaClass flushClassesInitOrder.

    self flushClasses

    "
     Java flushAllJavaResources
    "

    "Modified: / 06-11-2001 / 09:49:37 / cg"
    "Modified: / 26-07-2011 / 17:59:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

flushClasses
    Classes := UnresolvedClassRefs := nil.
    Smalltalk keys copy do:[:aKey | 
        (aKey startsWith:'JAVA::') ifTrue:[ Smalltalk removeKey:aKey ]
    ].
    Smalltalk removeKey:#'JAVA'.

    Java_lang_String := Java_lang_Class := nil.
    JavaVM releaseAllJavaResources.
    JavaUnresolvedConstant flushPatchLists.
    Debugger == DebugView ifTrue:[Debugger newDebugger].
    ObjectMemory flushCaches.

    "
     Java flushClasses
    "

    "Modified: / 6.11.2001 / 09:47:49 / cg"
!

markAllClassesUninitialized
    self allClassesDo:[:aJavaClass |
        aJavaClass markUninitialized
    ].

    "
     Java markAllClassesUninitialized
    "
!

rememberUnresolved:anUnresolvedClassRef
    ('JAVA: remember unresolved class: ' , anUnresolvedClassRef fullName) infoPrintCR.

    UnresolvedClassRefs isNil ifTrue:[
        UnresolvedClassRefs := Dictionary new.
    ].
    UnresolvedClassRefs 
        at:anUnresolvedClassRef fullName
        put:anUnresolvedClassRef

    "Created: / 18.4.1996 / 00:05:31 / cg"
    "Modified: / 19.10.1998 / 20:57:44 / cg"
!

removeClass:aJavaClass
    "/ remove it from myself

    |javaName sym nm cls p ns|

    javaName := aJavaClass fullName.

    sym := javaName asSymbolIfInterned.
    sym notNil ifTrue:[
        cls := Classes at:sym ifAbsent:nil.
    ].
    cls isNil ifTrue:[
        nm := javaName.
        (nm includes:$.) ifTrue:[
            "/
            "/ try pckg/.../name
            "/
            nm := (nm asString copyReplaceAll:$. with:$/).
            sym := nm asSymbolIfInterned.
            sym notNil ifTrue:[
                cls := Classes at:sym ifAbsent:nil.
            ].
        ].
    ].
    (cls notNil and:[cls == aJavaClass]) ifTrue:[
        Classes removeKey:sym.
        self updateClassRefsFrom:aJavaClass to:nil.
    ].
    Smalltalk removeKey:('JAVA::' , javaName) asSymbol.
    Smalltalk removeKey:javaName asSymbol.
    Smalltalk removeKey:((javaName , '') copy replaceAll:$/ with:$.) asSymbol.

    "/ remove myself from the JAVA::-::-:: namespace
    "/ (which exists for convenient smalltalk access only)

    p := aJavaClass nameSpacePath.
    p knownAsSymbol ifTrue:[
        ns := Smalltalk at:p asSymbol.
        (ns notNil and:[ns isNameSpace]) ifTrue:[
            Smalltalk removeKey:(p , '::' , aJavaClass lastName) asSymbol
        ]
    ].

    "Modified: / 19.10.1998 / 20:58:49 / cg"
!

unresolvedClassRefFor:aClassName
    UnresolvedClassRefs isNil ifTrue:[^ nil].
    ^ UnresolvedClassRefs at:aClassName ifAbsent:nil.

    "Modified: / 19.10.1998 / 20:56:46 / cg"
!

updateClassRefsFrom:oldClass to:newClass
    "update all references to oldClass to now refer to newClass.
     sent, when a class is reloaded"

    newClass notNil ifTrue:[
        "/
        "/ kludge: the new class might have been resolved with the oldClass ...
        "/
        newClass constantPool 
            updateClassRefsFrom:oldClass to:newClass.
    ].

    self allClassesDo:[:aJavaClass |
        aJavaClass updateClassRefsFrom:oldClass to:newClass
    ].

    "Created: 26.3.1997 / 13:49:20 / cg"
    "Modified: 12.8.1997 / 03:04:44 / cg"
! !

!Java class methodsFor:'source management'!

classSource:filename package:package in:dirOrZipFile 
    |fn zar f |

    fn := dirOrZipFile asFilename.
    fn isDirectory 
        ifTrue:
            [ package notNil 
                ifTrue:[ (f:= fn / package / filename) exists ifTrue:[ ^ f contents asString ]. ].
            (f := fn / filename) exists ifTrue:[ ^ f contents asString ]. ]
        ifFalse:
            [ (dirOrZipFile last == $p and: [fn hasSuffix:'zip'])
                ifTrue:
                    [ zar := SourceArchiveCache 
                                at: dirOrZipFile 
                                ifAbsentPut:[ZipArchive oldFileNamed:fn pathName].
                    zar notNil 
                        ifTrue:
                            [   package notNil 
                                ifTrue:[ 
                                    OperatingSystem fileSeparator ~~ $/ ifTrue: [ 
                                        f := (package copyReplaceAll: OperatingSystem fileSeparator with: $/) , '/' , filename
                                    ] ifFalse:[
                                        f := package , '/' , filename.
                                    ]]                                
                                ifFalse:[ f := filename].
                            (zar findMember: f) ifNotNil:
                                [          
                                    "Kludge because of broken ZipArchive"
                                    |  cache |
                                    cache := Java cacheDirectory / Release name / 'src'.
                                    cache exists ifFalse:[cache recursiveMakeDirectory].
                                    (cache / f) exists ifTrue:[^(cache / f) contents asString].
                                    OperatingSystem 
                                        executeCommand:('unzip "%1" "%2"' bindWith: fn asAbsoluteFilename asString 
                                                            with: f asString)
                                        inDirectory: cache asString.
                                    (f := cache / f) exists ifTrue:[^f contents asString]
                                ]
                            ]]].            

    ^ nil

    "
        Java classSource: 'Object.java' package:'java/lang' in:'/home/jv/Projects/JavaX/java-6-openjdk/src'
        Java classSource: 'Object.java' package:'java/lang' in:'/usr/lib/jvm/java-6-openjdk/src.zip'

    "

    "Modified: / 29-03-1998 / 21:46:40 / cg"
    "Created: / 30-11-2010 / 12:32:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 08-04-2011 / 15:01:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

classSourceOf:aClass
    |package dirName binary sourceFileName sourceFile loader codeBaseURL protocol codeBaseURLIdx src|

    aClass isNil ifTrue:[
        ^ nil
    ].
    "/ look at the cache"
    SourceCache at: aClass ifPresent: [:src|^src].

    "/ first, look in the directory, where the binary
    "/ was loaded from.

    binary := aClass binaryFile.
    binary notNil ifTrue:[
        binary := binary asFilename.
        aClass sourceFile notNil ifTrue:[
            sourceFileName := binary directory constructString:(aClass sourceFile).
            sourceFileName asFilename exists ifFalse:[
                sourceFileName := nil.
            ]
        ].
        sourceFileName isNil ifTrue:[
            sourceFileName := binary withSuffix:'java'.
        ].
        sourceFile := sourceFileName asFilename.
    ] ifFalse:[
        "/ maybe it was loaded by a java classLoader ...
        (loader := aClass classLoader) notNil ifTrue:[
            codeBaseURLIdx := loader class instVarOffsetOf:'codeBaseURL'.
            codeBaseURLIdx notNil ifTrue:[
                (codeBaseURL := loader instVarAt:codeBaseURLIdx) notNil ifTrue:[
                    (protocol := codeBaseURL instVarNamed:'protocol') notNil ifTrue:[
                        (Java as_ST_String:protocol) = 'file' ifTrue:[
                            dirName := Java as_ST_String:(codeBaseURL instVarNamed:'file').
                            dirName := dirName asFilename.
                            dirName exists ifTrue:[
                                aClass sourceFile notNil ifTrue:[
                                    sourceFile := sourceFileName := dirName construct:aClass sourceFile.
                                ]
                            ]
                        ]
                    ]
                ]
            ]
        ]
    ].
    sourceFile notNil ifTrue:[
        sourceFile exists ifFalse:[
            binary notNil ifTrue:[
                sourceFileName := binary withSuffix:'jav'.
                sourceFile := sourceFileName asFilename.
                sourceFile exists ifFalse:[
                    sourceFileName := binary withSuffix:'JAV'.
                    sourceFile := sourceFileName asFilename.
                    sourceFile exists ifFalse:[
                        sourceFileName := binary withSuffix:'JAVA'.
                        sourceFile := sourceFileName asFilename.
                    ].
                ].
            ]
        ].
    ].

    "/ special case: there were multiple classes in a single
    "/ source file.

    (binary notNil and:[aClass sourceFile notNil]) ifTrue:[
        binary withoutSuffix baseName ~= aClass sourceFile asFilename withoutSuffix baseName ifTrue:[
            'JAVA: trouble extracting fileName: ' infoPrint.
            binary withoutSuffix baseName print. ' vs. ' infoPrint.
            aClass sourceFile asFilename withoutSuffix baseName infoPrintCR.
        ].
    ].

    "/ if that fails, look in standard places

    (sourceFile isNil or:[sourceFile exists not]) ifTrue:[
        sourceFile := aClass sourceFile.
        package := aClass javaPackageAsDirname.
        self effectiveSourceDirectories do:[:dir|
            src := self classSource: sourceFile package: package in: dir.
            src ifNotNil:[^src]
        ]


    ].
    sourceFile isFilename ifFalse:[^nil].
    ^ (sourceFile contentsOfEntireFile).

    "
        Java classSourceOf: JAVA::java::lang::Object
    "

    "Modified: / 27-01-1999 / 20:40:30 / cg"
    "Modified: / 10-02-2011 / 23:10:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!Java class methodsFor:'starting apps'!

javaProcessForMainOf:aJavaClass
    "ask for a commandLine, create a java process to invoke
     its main and return it. The process is not scheduled for
     execution."

    ^ self javaProcessForMainOf:aJavaClass argumentString:nil

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

javaProcessForMainOf:aJavaClass argumentString:argStringIn
    "create a java process, ready to invoke the classes main
     method. Returns the process - ready to run but not yet resumed"

    |p argStringArray argString stdInReplacement alreadyAskedForStdin|

    argString := argStringIn.
    argString isNil ifTrue:[
        argString := Dialog 
                    request:'argument string:' 
                    initialAnswer:LastArgumentString ? ''
                    onCancel:nil.
        argString isNil ifTrue:[^ nil].

        LastArgumentString := argString.
    ].

    JavaVM initializeVMIfNoEventThreadRunning.
    (Java at:'java.lang.System') instVarNamed:'security' put:nil.

    argString isEmpty ifTrue:[
        argStringArray := #()
    ] ifFalse:[
        argStringArray := argString asCollectionOfWords collect:[:s | Java as_String:s] as:Array.
    ].

    p := JavaProcess 
            for:[
                    "/ if the program reads from stdin, let user provide a file
                    "/ for it.
                    JavaVM stdinReplacementFileQuerySignal handle:[:ex |
                        |fn|

                        alreadyAskedForStdin == true ifFalse:[
                            fn := Dialog 
                                    requestFileName:'Program reads from Stdin - give inputFile or cancel for EOF'
                                    default:nil
                                    fromDirectory:(FileSelectionBox lastFileSelectionDirectory).
                            fn notNil ifTrue:[
                                stdInReplacement := fn asFilename readStream.
                            ].
                            alreadyAskedForStdin := true.
                        ].
                        ex proceedWith:stdInReplacement
                    ] do:[
                        aJavaClass 
                            performStatic:#'main([Ljava/lang/String;)V'
                            with:argStringArray.
                    ]
                ]
            priority:(Processor activePriority - 1).

    p name:(aJavaClass fullName , '::main()').
    p restartable:true.
    ^ p

    "Created: / 15.8.1997 / 04:41:20 / cg"
    "Modified: / 24.12.1999 / 01:50:21 / cg"
! !

!Java class methodsFor:'documentation'!

version
    ^ '$Id: Java.st,v 1.134 2011-08-18 18:42:48 vrany Exp $'
!

version_SVN
    ^ '$Id: Java.st,v 1.134 2011-08-18 18:42:48 vrany Exp $'
! !

Java initialize!