partial support for getMethod0 & invokeMethod.
Object subclass:#JavaVM
instanceVariableNames:''
classVariableNames:'UnhandledJavaExceptionSignal JavaExceptionSignal
UnimplementedInstructionSignal UnimplementedNativeMethodSignal
BadMessageSignal InternalErrorSignal CallHandlerSignal
FullExceptionTrace StackTrace TraceHistory LockTable
LockTableAccess LibPath SimulatedLibs LoadedLibs
SimulatedNativeLibs LoadedNativeLibs WaitTable WaitTableAccess
JavaWindowGroup KnownWindows DrawOPTrace WindowOPTrace
WindowCreationTrace EventTrace ThreadTrace MonitorTrace
ExceptionTrace InsnCount InsnCounts FileOpenTrace
FileOpenConfirmation FileIOTrace OpenFileTable
CachedNativeMethodTable ExceptionDebug JavaConsoleStream
StandardThreadGroup EnteredMonitorsPerProcess JavaClasses
JavaMethods DUMMY_LONG_HIGHWORD DUMMY_DOUBLE_HIGHWORD NoAudio
FirstWindowCreationSemaphore ScreenUpdaterProcess'
poolDictionaries:''
category:'Java-Support'
!
!JavaVM class methodsFor:'documentation'!
nativeMethods
"
list of all native methods as in jdk1.1.3:
X - implemented
x - implemented with limited functionality
o - implemented as dummy (no functionality)
X (Math::double sin (double))
X (Math::double cos (double))
(Math::double tan (double))
(Math::double asin (double))
(Math::double acos (double))
(Math::double atan (double))
(Math::double exp (double))
X (Math::double log (double))
X (Math::double sqrt (double))
(Math::double IEEEremainder (double double))
X (Math::double ceil (double))
X (Math::double floor (double))
(Math::double rint (double))
(Math::double atan2 (double double))
X (Math::double pow (double double))
X (Class::java.lang.Class forName (java.lang.String))
X (Class::java.lang.Object newInstance ())
(Class::boolean isInstance (java.lang.Object))
(Class::boolean isAssignableFrom (java.lang.Class))
X (Class::boolean isInterface ())
(Class::boolean isArray ())
(Class::boolean isPrimitive ())
X (Class::java.lang.String getName ())
X (Class::java.lang.ClassLoader getClassLoader ())
X (Class::java.lang.Class getSuperclass ())
(Class::java.lang.Class[] getInterfaces ())
(Class::java.lang.Class getComponentType ())
(Class::int getModifiers ())
(Class::java.lang.Object[] getSigners ())
(Class::void setSigners (java.lang.Object[]))
X (Class::java.lang.Class getPrimitiveClass (java.lang.String))
(Class::java.lang.reflect.Field[] getFields0 (int))
(Class::java.lang.reflect.Method[] getMethods0 (int))
(Class::java.lang.reflect.Constructor[] getConstructors0 (int))
(Class::java.lang.reflect.Field getField0 (java.lang.String int))
(Class::java.lang.reflect.Method getMethod0 (java.lang.String java.lang.Class[] int))
(Class::java.lang.reflect.Constructor getConstructor0 (java.lang.Class[] int))
X (InetAddressImpl::java.lang.String getLocalHostName ())
X (InetAddressImpl::void makeAnyLocalAddress (java.net.InetAddress))
X (InetAddressImpl::byte[][] lookupAllHostAddr (java.lang.String))
(InetAddressImpl::java.lang.String getHostByAddr (int))
X (InetAddressImpl::int getInetFamily ())
X (ResourceBundle::java.lang.Class[] getClassContext ())
X (System::void setIn0 (java.io.InputStream))
X (System::void setOut0 (java.io.PrintStream))
X (System::void setErr0 (java.io.PrintStream))
X (System::long currentTimeMillis ())
X (System::void arraycopy (java.lang.Object int java.lang.Object int int))
(System::int identityHashCode (java.lang.Object))
X (System::java.util.Properties initProperties (java.util.Properties))
X (Thread::java.lang.Thread currentThread ())
X (Thread::void yield ())
X (Thread::void sleep (long))
X (Thread::void start ())
X (Thread::boolean isInterrupted (boolean))
X (Thread::boolean isAlive ())
(Thread::int countStackFrames ())
X (Thread::void setPriority0 (int))
X (Thread::void stop0 (java.lang.Object))
X (Thread::void suspend0 ())
X (Thread::void resume0 ())
(Thread::void interrupt0 ())
(String::java.lang.String intern ())
X (Float::int floatToIntBits (float))
X (Float::float intBitsToFloat (int))
(ObjectStreamClass::int getClassAccess (java.lang.Class))
(ObjectStreamClass::java.lang.String[] getMethodSignatures (java.lang.Class))
(ObjectStreamClass::int getMethodAccess (java.lang.Class java.lang.String))
(ObjectStreamClass::java.lang.String[] getFieldSignatures (java.lang.Class))
(ObjectStreamClass::int getFieldAccess (java.lang.Class java.lang.String))
(ObjectStreamClass::java.io.ObjectStreamField[] getFields0 (java.lang.Class))
(ObjectStreamClass::long getSerialVersionUID (java.lang.Class))
(ObjectStreamClass::boolean hasWriteObject (java.lang.Class))
(ObjectInputStream::java.lang.Class loadClass0 (java.lang.Class java.lang.String))
(ObjectInputStream::void inputClassFields (java.lang.Object java.lang.Class int[]))
(ObjectInputStream::java.lang.Object allocateNewObject (java.lang.Class java.lang.Class))
(ObjectInputStream::java.lang.Object allocateNewArray (java.lang.Class int))
(ObjectInputStream::boolean invokeObjectReader (java.lang.Object java.lang.Class))
(SecurityManager::java.lang.Class[] getClassContext ())
X (SecurityManager::java.lang.ClassLoader currentClassLoader ())
(SecurityManager::int classDepth (java.lang.String))
X (SecurityManager::int classLoaderDepth ())
(SecurityManager::java.lang.Class currentLoadedClass0 ())
X (ClassLoader::void init ())
X (ClassLoader::java.lang.Class defineClass0 (java.lang.String byte[] int int))
X (ClassLoader::void resolveClass0 (java.lang.Class))
X (ClassLoader::java.lang.Class findSystemClass0 (java.lang.String))
X (ClassLoader::java.io.InputStream getSystemResourceAsStream0 (java.lang.String))
(ClassLoader::java.lang.String getSystemResourceAsName0 (java.lang.String))
(FileDescriptor::boolean valid ())
(FileDescriptor::void sync ())
X (FileDescriptor::java.io.FileDescriptor initSystemFD (java.io.FileDescriptor int))
X (Object::java.lang.Class getClass ())
X (Object::int hashCode ())
X (Object::java.lang.Object clone ())
X (Object::void notify ())
X (Object::void notifyAll ())
X (Object::void wait (long))
X (FileOutputStream::void open (java.lang.String))
(FileOutputStream::void openAppend (java.lang.String))
X (FileOutputStream::void write (int))
X (FileOutputStream::void writeBytes (byte[] int int))
X (FileOutputStream::void close ())
X (FileInputStream::void open (java.lang.String))
X (FileInputStream::int read ())
X (FileInputStream::int readBytes (byte[] int int))
(FileInputStream::long skip (long))
X (FileInputStream::int available ())
X (FileInputStream::void close ())
(VM::int getState ())
(VM::boolean threadsSuspended ())
(VM::void unsuspendThreads ())
(VM::void unsuspendSomeThreads ())
X (File::boolean exists0 ())
(File::boolean canWrite0 ())
X (File::boolean canRead0 ())
X (File::boolean isFile0 ())
X (File::boolean isDirectory0 ())
(File::long lastModified0 ())
X (File::long length0 ())
(File::boolean mkdir0 ())
(File::boolean renameTo0 (java.io.File))
(File::boolean delete0 ())
(File::boolean rmdir0 ())
X (File::java.lang.String[] list0 ())
(File::java.lang.String canonPath (java.lang.String))
X (File::boolean isAbsolute ())
(ObjectOutputStream::void outputClassFields (java.lang.Object java.lang.Class int[]))
(ObjectOutputStream::boolean invokeObjectWriter (java.lang.Object java.lang.Class))
X (Throwable::void printStackTrace0 (java.lang.Object))
X (Throwable::java.lang.Throwable fillInStackTrace ())
X (Double::long doubleToLongBits (double))
X (Double::double longBitsToDouble (long))
X (Double::double valueOf0 (java.lang.String))
X (Runtime::void exitInternal (int))
(Runtime::void runFinalizersOnExit0 (boolean))
o (Runtime::java.lang.Process execInternal (java.lang.String[] java.lang.String[]))
X (Runtime::long freeMemory ())
X (Runtime::long totalMemory ())
X (Runtime::void gc ())
(Runtime::void runFinalization ())
(Runtime::void traceInstructions (boolean))
(Runtime::void traceMethodCalls (boolean))
X (Runtime::java.lang.String initializeLinkerInternal ())
X (Runtime::java.lang.String buildLibName (java.lang.String java.lang.String))
X (Runtime::int loadFileInternal (java.lang.String))
(WDrawingSurfaceInfo::int lock ())
(WDrawingSurfaceInfo::void unlock ())
(WDrawingSurfaceInfo::int getHWnd ())
(WDrawingSurfaceInfo::int getHBitmap ())
(WDrawingSurfaceInfo::int getPBits ())
(WDrawingSurfaceInfo::int getHDC ())
(WDrawingSurfaceInfo::int getDepth ())
(WDrawingSurfaceInfo::int getHPalette ())
X (WDefaultFontCharset::boolean canConvert (char))
(ColorModel::void deletepData ())
X (WToolkit::void init (java.lang.Thread))
X (WToolkit::void eventLoop ())
(WToolkit::java.awt.image.ColorModel makeColorModel ())
(WToolkit::int getScreenResolution ())
X (WToolkit::int getScreenWidth ())
X (WToolkit::int getScreenHeight ())
(WToolkit::void sync ())
(WToolkit::void beep ())
X (WToolkit::void loadSystemColors (int[]))
(WPrintJob::void end ())
X (WDialogPeer::void create (sun.awt.windows.WComponentPeer))
X (WDialogPeer::void _show ())
X (WDialogPeer::void _hide ())
(WWindowPeer::void toFront ())
(WWindowPeer::void toBack ())
(WWindowPeer::void _setTitle (java.lang.String))
(WWindowPeer::void _setResizable (boolean))
(WWindowPeer::void create (sun.awt.windows.WComponentPeer))
(WWindowPeer::void updateInsets (java.awt.Insets))
(WWindowPeer::java.awt.Component getContainerElement (java.awt.Container int))
X (WCanvasPeer::void create (sun.awt.windows.WComponentPeer))
X (WTextAreaPeer::void create (sun.awt.windows.WComponentPeer))
X (WTextAreaPeer::void insertText (java.lang.String int))
(WTextAreaPeer::void replaceText (java.lang.String int int))
X (WTextComponentPeer::java.lang.String getText ())
X (WTextComponentPeer::void setText (java.lang.String))
X (WTextComponentPeer::int getSelectionStart ())
X (WTextComponentPeer::int getSelectionEnd ())
X (WTextComponentPeer::void select (int int))
X (WTextComponentPeer::void enableEditing (boolean))
X (WComponentPeer::void show ())
X (WComponentPeer::void hide ())
X (WComponentPeer::void enable ())
X (WComponentPeer::void disable ())
(WComponentPeer::java.awt.Point getLocationOnScreen ())
X (WComponentPeer::void reshape (int int int int))
o (WComponentPeer::void handleEvent (java.awt.AWTEvent))
o (WComponentPeer::void _dispose ())
X (WComponentPeer::void _setForeground (int))
X (WComponentPeer::void _setBackground (int))
o (WComponentPeer::void setFont (java.awt.Font))
o (WComponentPeer::void requestFocus ())
o (WComponentPeer::void setCursor (java.awt.Cursor))
o (WComponentPeer::void start ())
(WComponentPeer::void _beginValidate ())
(WComponentPeer::void endValidate ())
o (WComponentPeer::void setZOrderPosition (sun.awt.windows.WComponentPeer))
X (WFramePeer::void setMenuBar0 (sun.awt.windows.WMenuBarPeer))
X (WFramePeer::void create (sun.awt.windows.WComponentPeer))
(WFramePeer::void _setIconImage (sun.awt.image.ImageRepresentation))
o (WFontMetrics::boolean needsConversion (java.awt.Font sun.awt.FontDescriptor))
o (WFontMetrics::int getMFCharSegmentWidth (java.awt.Font sun.awt.FontDescriptor boolean char[] int int byte[] int))
(WFontMetrics::int bytesWidth (byte[] int int))
(WFontMetrics::void init ())
o (WChoicePeer::void select (int))
o (WChoicePeer::void remove (int))
o (WChoicePeer::void addItem (java.lang.String int))
X (WChoicePeer::void reshape (int int int int))
X (WChoicePeer::void create (sun.awt.windows.WComponentPeer))
X (WLabelPeer::void setText (java.lang.String))
o (WLabelPeer::void setAlignment (int))
X (WLabelPeer::void create (sun.awt.windows.WComponentPeer))
X (WMenuItemPeer::void _setLabel (java.lang.String))
X (WMenuItemPeer::void create (sun.awt.windows.WMenuPeer))
X (WMenuItemPeer::void enable (boolean))
(WMenuItemPeer::void _dispose ())
(WMenuPeer::void addSeparator ())
(WMenuPeer::void delItem (int))
X (WMenuPeer::void createMenu (sun.awt.windows.WMenuBarPeer))
(WMenuPeer::void createSubMenu (sun.awt.windows.WMenuPeer))
(WPopupMenuPeer::void createMenu (sun.awt.windows.WComponentPeer))
(WPopupMenuPeer::void _show (java.awt.Event))
(WMenuBarPeer::void addMenu (java.awt.Menu))
(WMenuBarPeer::void delMenu (int))
X (WMenuBarPeer::void create (sun.awt.windows.WFramePeer))
(WCheckboxMenuItemPeer::void setState (boolean))
X (WFileDialogPeer::void show ())
X (WCheckboxPeer::void setState (boolean))
X (WCheckboxPeer::void setCheckboxGroup (java.awt.CheckboxGroup))
(WCheckboxPeer::void setLabel (java.lang.String))
X (WCheckboxPeer::void create (sun.awt.windows.WComponentPeer))
X (WClipboard::void init ())
(WClipboard::void setClipboardText (java.awt.datatransfer.StringSelection))
(WClipboard::java.lang.String getClipboardText ())
(WListPeer::void addItem (java.lang.String int))
(WListPeer::void delItems (int int))
(WListPeer::void select (int))
(WListPeer::void deselect (int))
(WListPeer::void makeVisible (int))
(WListPeer::void setMultipleSelections (boolean))
(WListPeer::void create (sun.awt.windows.WComponentPeer))
(WListPeer::boolean isSelected (int))
o (WScrollbarPeer::void _setValues (int int int int))
(WScrollbarPeer::void setLineIncrement (int))
(WScrollbarPeer::void setPageIncrement (int))
o (WScrollbarPeer::void create (sun.awt.windows.WComponentPeer))
o (ImageRepresentation::void offscreenInit (java.awt.Color))
x (ImageRepresentation::boolean setBytePixels (int int int int java.awt.image.ColorModel byte[] int int))
(ImageRepresentation::boolean setIntPixels (int int int int java.awt.image.ColorModel int[] int int))
x (ImageRepresentation::boolean finish (boolean))
X (ImageRepresentation::void imageDraw (java.awt.Graphics int int java.awt.Color))
x (ImageRepresentation::void imageStretch (java.awt.Graphics int int int int int int int int java.awt.Color))
x (ImageRepresentation::void disposeImage ())
X (WTextFieldPeer::void create (sun.awt.windows.WComponentPeer))
(WTextFieldPeer::void setEchoCharacter (char))
(WScrollPanePeer::void create (sun.awt.windows.WComponentPeer))
(WScrollPanePeer::int getOffset (int))
(WScrollPanePeer::void setInsets ())
(WScrollPanePeer::void setScrollPosition (int int))
(WScrollPanePeer::int _getHScrollbarHeight ())
(WScrollPanePeer::int _getVScrollbarWidth ())
(WScrollPanePeer::void setSpans (int int int int))
(WScrollPanePeer::java.awt.Component getScrollChild ())
(WEmbeddedFramePeer::void create (sun.awt.windows.WComponentPeer))
(WButtonPeer::void setLabel (java.lang.String))
X (WButtonPeer::void create (sun.awt.windows.WComponentPeer))
x (WColor::java.awt.Color getDefaultColor (int))
x (GifImageDecoder::boolean parseImage (int int int int boolean int byte[] byte[] java.awt.image.IndexColorModel))
x (WGraphics::void createFromComponent (sun.awt.windows.WComponentPeer))
x (WGraphics::void createFromGraphics (sun.awt.windows.WGraphics))
(WGraphics::void createFromPrintJob (sun.awt.windows.WPrintJob))
(WGraphics::void createFromHDC (int))
x (WGraphics::void imageCreate (sun.awt.image.ImageRepresentation))
x (WGraphics::void pSetFont (java.awt.Font))
X (WGraphics::void pSetForeground (int))
(WGraphics::void _dispose ())
x (WGraphics::void dispose ())
x (WGraphics::void setPaintMode ())
(WGraphics::void setXORMode (java.awt.Color))
o (WGraphics::java.awt.Rectangle getClipBounds ())
o (WGraphics::void changeClip (int int int int boolean))
(WGraphics::void removeClip ())
X (WGraphics::void clearRect (int int int int))
X (WGraphics::void fillRect (int int int int))
X (WGraphics::void drawRect (int int int int))
(WGraphics::void drawSFChars (char[] int int int int))
x (WGraphics::int drawMFCharsSegment (java.awt.Font sun.awt.FontDescriptor char[] int int int int))
(WGraphics::int drawMFCharsConvertedSegment (java.awt.Font sun.awt.FontDescriptor byte[] int int int))
(WGraphics::void drawBytes (byte[] int int int int))
X (WGraphics::void drawLine (int int int int))
(WGraphics::void copyArea (int int int int int int))
o (WGraphics::void drawRoundRect (int int int int int int))
o (WGraphics::void fillRoundRect (int int int int int int))
X (WGraphics::void drawPolygon (int[] int[] int))
(WGraphics::void drawPolyline (int[] int[] int))
X (WGraphics::void fillPolygon (int[] int[] int))
x (WGraphics::void drawOval (int int int int))
x (WGraphics::void fillOval (int int int int))
x (WGraphics::void drawArc (int int int int int int))
x (WGraphics::void fillArc (int int int int int int))
(WGraphics::void print (sun.awt.windows.WComponentPeer))
(WGraphics::void close (sun.awt.windows.WPrintJob))
(JPEGImageDecoder::void readImage (java.io.InputStream byte[]))
(OffScreenImageSource::void sendPixels ())
"
! !
!JavaVM class methodsFor:'initialization'!
deinitialize
|table|
StandardThreadGroup := nil.
self releaseAllMonitors.
LockTable := nil.
WaitTable := nil.
WaitTableAccess := nil.
JavaWindowGroup := nil.
KnownWindows := nil.
OpenFileTable := nil.
EnteredMonitorsPerProcess := nil.
JavaClasses := nil.
"
JavaVM deinitialize
"
"Modified: / 3.1.1998 / 21:25:27 / cg"
"Created: / 3.1.1998 / 21:28:14 / cg"
!
deinitializeAdditionalJavaProtocol
"install additional java protocol in smalltalk classes, req'd for java programs"
(Object implements:#'clone()Ljava/lang/Object;') ifTrue:[
Class withoutUpdatingChangesDo:[
Object removeSelector:#'clone()Ljava/lang/Object;'.
]
].
"
self deinitializeAdditionalJavaProtocol
"
"Created: / 4.2.1998 / 21:37:10 / cg"
!
initialize
|table|
DUMMY_LONG_HIGHWORD := 1.
DUMMY_DOUBLE_HIGHWORD := 2.
StandardThreadGroup := nil.
NoAudio := true.
"/ NoAudio := false.
JavaConsoleStream := Transcript.
FullExceptionTrace := StackTrace := false.
WindowOPTrace := DrawOPTrace := EventTrace := ThreadTrace := false.
MonitorTrace := ExceptionTrace := FileOpenTrace := FileIOTrace := false.
ExceptionDebug := false.
WindowCreationTrace := false.
FileOpenConfirmation := true.
"/ WindowOPTrace := true.
"/ MonitorTrace := true.
"/ ThreadTrace := true.
UnhandledJavaExceptionSignal := (Signal new) mayProceed:false.
UnhandledJavaExceptionSignal nameClass:self message:#unhandledJavaExceptionSignal.
UnhandledJavaExceptionSignal notifierString:'unhandled java exception'.
JavaExceptionSignal := (Signal new) mayProceed:false.
JavaExceptionSignal nameClass:self message:#javaExceptionSignal.
JavaExceptionSignal notifierString:'java exception'.
UnimplementedInstructionSignal := (Signal new) mayProceed:false.
UnimplementedInstructionSignal nameClass:self message:#unimplementedInstructionSignal.
UnimplementedInstructionSignal notifierString:'unimplemented instruction'.
UnimplementedNativeMethodSignal := (Signal new) mayProceed:false.
UnimplementedNativeMethodSignal nameClass:self message:#unimplementedNativeMethodSignal.
UnimplementedNativeMethodSignal notifierString:'unimplemented native method'.
BadMessageSignal := (Signal new) mayProceed:false.
BadMessageSignal nameClass:self message:#badMessageSignal.
BadMessageSignal notifierString:'invalid message to JAVA object'.
InternalErrorSignal := (Signal new) mayProceed:false.
InternalErrorSignal nameClass:self message:#internalErrorSignal.
InternalErrorSignal notifierString:'internal error'.
CallHandlerSignal := (Signal new) mayProceed:false.
CallHandlerSignal nameClass:self message:#callHandlerSignal.
CallHandlerSignal notifierString:'internal signal'.
"
JavaVM initialize
"
"Created: / 2.1.1998 / 18:02:34 / cg"
"Modified: / 17.1.1998 / 13:21:41 / cg"
!
initializeAdditionalJavaProtocol
"install additional java protocol in smalltalk classes, req'd for java programs"
|cloneCode|
"/ since we use smalltalk Arrays for JavaArray, some
"/ additional (java-) protocol is required.
(Object implements:#'clone()Ljava/lang/Object;') ifFalse:[
Object
compile:'__clone
"this is smalltalk code with a java selector ...
Has been added by JavaVM>>initializeAdditionalJavaProtocol"
^ self shallowCopy'
classified:'java support'
logged:false.
cloneCode := Object compiledMethodAt:#'__clone'.
cloneCode source:'#''clone()Ljava/lang/Object;''
"this is smalltalk code with a java selector ...
Has been added by JavaVM>>initializeAdditionalJavaProtocol"
^ self shallowCopy'.
Class withoutUpdatingChangesDo:[
Object removeSelector:#'__clone'.
Object addSelector:#'clone()Ljava/lang/Object;' withMethod:cloneCode.
]
].
"
self initializeAdditionalJavaProtocol
"
"Modified: / 28.1.1997 / 19:38:58 / stefan"
"Modified: / 22.1.1998 / 21:23:40 / av"
"Created: / 4.2.1998 / 21:35:46 / cg"
"Modified: / 4.2.1998 / 21:42:47 / cg"
!
initializeBaseClasses
"load req'd base classes"
Java classForName:'java.lang.Object'.
Java classForName:'java.lang.Class'.
Java classForName:'java.lang.String'.
Java classForName:'java.lang.System'.
"
self initializeBaseClasses
"
"Created: / 3.1.1998 / 21:13:28 / cg"
!
initializeOpenFileTable
OpenFileTable := OrderedCollection
with:Stdin
with:(JavaConsoleStream ? Stdout)
with:(JavaConsoleStream ? Stderr).
"
JavaVM initializeOpenFileTable
"
"Modified: / 6.8.1997 / 00:40:19 / cg"
"Created: / 2.1.1998 / 18:04:32 / cg"
!
initializePrimitiveClasses
JavaClasses isNil ifTrue:[
JavaClasses := Dictionary new.
].
#(
('byte' 'B' 1)
('short' 'S' 2)
('int' 'I' 4)
('long' 'J' 8)
('boolean' 'Z' 1)
('char' 'C' 2)
('float' 'F' 4)
('double' 'D' 8)
('void' 'V' 0)
) triplesDo:[:nm :sig :len |
|stClass jClass|
"/
"/ create a javaClass for it.
"/
jClass := (Java at:'java.lang.Class') new.
"/ stClass := Class new.
"/ stClass setName:('JavaBase_' , nm) asSymbol.
"/ JavaClasses at:stClass put:jClass.
"/ JavaClasses at:jClass put:stClass.
JavaClasses at:nm put:jClass
].
"
self initializePrimitiveClasses
"
"Modified: / 4.1.1998 / 00:56:05 / cg"
!
initializeSimulatedLibs
"return a collection of native libs which are considered
being already loaded. (used with jdk < 1.2)"
LibPath := #('__builtIn__' '/usr/local/lib' '/usr/local/lib/java').
SimulatedLibs := #('__builtIn__/net'
'__builtIn__/awt'
'__builtIn__/tawt'
'__builtIn__/winawt'
'__builtIn__/jpeg'
'__builtIn__/mmedia'
'__builtIn__/zip'
'__builtIn__/math'
).
"Created: / 4.1.1998 / 19:05:03 / cg"
"Modified: / 27.1.1998 / 18:43:03 / cg"
!
initializeSimulatedNativeLibs
"return a collection of native libs which are considered
being already loaded (used with jdk >= 1.2)"
SimulatedNativeLibs := #(
'/libawt.so'
).
"
self initializeSimulatedNativeLibs
"
"Modified: / 27.1.1998 / 18:43:10 / cg"
!
initializeSystemPropertiesInto:props
|cpu os|
"/ use JAVA compatible cpu-name
cpu := OperatingSystem getCPUType.
cpu = 'i386' ifTrue:[
cpu := 'ix86'
].
os := OperatingSystem getOSType.
os := os asUppercaseFirst.
props at:'java.version' put:'1'.
props at:'java.vendor' put:'eXept Software AG'.
props at:'java.vendor.url' put:'http:://exept.de'.
props at:'java.home' put:(self defaultJAVAHome).
props at:'java.class.version' put:'1'.
props at:'java.class.path' put:(self defaultCLASSPATH).
props at:'os.name' put:os.
props at:'os.arch' put:cpu.
props at:'os.version' put:'1'.
props at:'file.separator' put:(Filename separator asString).
props at:'path.separator' put:':'.
props at:'line.separator' put:(Character cr asString).
props at:'user.name' put:(OperatingSystem getLoginName).
props at:'user.home' put:(OperatingSystem getHomeDirectory).
props at:'user.dir' put:(Filename currentDirectory pathName).
props at:'awt.toolkit' put:(self defaultWindowingToolKit).
props at:'jws.home' put:(self defaultJWSHome).
props at:'hotjava.home' put:(self defaultHotJavaHome).
"/ undocumented ?
props at:'file.encoding.pkg' put:'sun.io'.
"/ suppress copyright view in appletViewer ...
props at:'appletviewer.version' put:'1.1'.
"/ new with jdk 1.2
props at:'java.awt.graphicsenv' put:'sun.awt.X11GraphicsEnvironment'.
props at:'java.awt.fonts' put:'/usr/lib/X11/fonts'.
^ props
"Created: / 3.1.1998 / 14:26:39 / cg"
"Modified: / 28.1.1998 / 22:11:33 / cg"
!
initializeVM
self initializeAdditionalJavaProtocol.
self releaseAllJavaResources.
JavaConsoleStream := Transcript.
Java initAllStaticFields.
Java markAllClassesUninitialized.
self initializeSimulatedLibs. "/ < jdk 1.2
self initializeSimulatedNativeLibs. "/ >= jdk 1.2
self initializeOpenFileTable.
self initializeBaseClasses.
self initializePrimitiveClasses.
(Java classForName:'java.lang.System') classInit.
Java initSystemClass.
ObjectMemory addDependent:self.
"
JavaVM initialize.
JavaVM initializeVM.
"
"Created: / 3.1.1998 / 21:29:09 / cg"
"Modified: / 4.2.1998 / 23:08:06 / cg"
!
initializeVMIfNoEventThreadRunning
(JavaEventThread isNil or:[JavaEventThread isDead]) ifTrue:[
self initializeVM
].
"
JavaVM initializeVMIfNoEventThreadRunning
"
"Modified: / 15.1.1998 / 17:29:34 / cg"
"Created: / 15.1.1998 / 17:32:27 / cg"
!
releaseAllJavaResources
KnownWindows := nil.
JavaWindowGroup := nil.
FirstWindowCreationSemaphore := Semaphore new.
LoadedLibs := nil. "/ gc will reclaim them ...
LoadedNativeLibs := nil. "/ gc will reclaim them ...
ImageStretchCache := nil.
self terminateAllThreads.
self releaseAllMonitors.
self releaseAllWindows.
self releaseAllStreams.
"
JavaVM releaseAllJavaResources
"
"Created: / 7.1.1998 / 22:49:42 / cg"
"Modified: / 28.1.1998 / 23:11:44 / cg"
!
releaseAllMonitors
LockTable := WeakIdentityDictionary new.
LockTableAccess := Semaphore forMutualExclusion.
WaitTable := IdentityDictionary new.
WaitTableAccess := Semaphore forMutualExclusion.
EnteredMonitorsPerProcess := IdentityDictionary new.
"
JavaVM releaseAllMonitors
"
"Created: / 2.1.1998 / 18:04:05 / cg"
"Modified: / 7.1.1998 / 22:58:10 / cg"
!
releaseAllStreams
OpenFileTable notNil ifTrue:[
OpenFileTable do:[:aStream |
aStream notNil ifTrue:[
aStream ~~ Stdin ifTrue:[
aStream ~~ Stdout ifTrue:[
aStream ~~ Stderr ifTrue:[
aStream ~~ JavaConsoleStream ifTrue:[
aStream isExternalStream ifTrue:[
aStream shutDown
]
]
]
]
]
]
]
].
self initializeOpenFileTable.
"
JavaVM releaseAllStreams
"
"Created: / 7.1.1998 / 22:57:04 / cg"
"Modified: / 4.2.1998 / 19:53:11 / cg"
!
releaseAllWindows
KnownWindows notNil ifTrue:[
KnownWindows do:[:aView |
aView destroy
].
KnownWindows := nil.
]
"
self releaseAllWindows
"
"Created: / 7.1.1998 / 22:58:32 / cg"
!
releaseLeftOverMonitors
"release monitors held by dead processes"
|deadProcesses|
deadProcesses := IdentitySet new.
EnteredMonitorsPerProcess keysAndValuesDo:[:p :monitors |
p isDead ifTrue:[
monitors do:[:mon |
Transcript showCR:'release leftover monitor ...'.
mon release
].
deadProcesses add:p.
]
].
deadProcesses do:[:p |
EnteredMonitorsPerProcess removeKey:p
].
"
JavaVM releaseLeftOverMonitors
"
"Created: / 8.1.1998 / 17:29:26 / cg"
"Modified: / 8.1.1998 / 17:38:33 / cg"
!
systemProperties
|props|
props := Dictionary new.
self initializeSystemPropertiesInto:props.
^ props
"Created: / 3.1.1998 / 14:25:58 / cg"
"Modified: / 3.1.1998 / 14:32:38 / cg"
!
terminateAllThreads
Java terminateAllThreads.
JavaEventThread := nil.
"Created: / 8.1.1998 / 17:43:54 / cg"
"Modified: / 15.1.1998 / 17:29:00 / cg"
!
update:something with:aParameter from:changedObject
something == #returnFromSnapshot ifTrue:[
self initializeVM
].
"
JavaVM initializeVM
"
"Modified: / 8.1.1998 / 17:44:16 / cg"
"Created: / 9.1.1998 / 10:30:13 / cg"
! !
!JavaVM class methodsFor:'Signal constants'!
badMessageSignal
^ BadMessageSignal
"Created: / 2.1.1998 / 18:06:52 / cg"
!
callHandlerSignal
^ CallHandlerSignal
"Created: / 2.1.1998 / 18:07:16 / cg"
!
internalErrorSignal
^ InternalErrorSignal
"Created: / 2.1.1998 / 18:07:05 / cg"
!
javaExceptionSignal
^ JavaExceptionSignal
"Created: / 2.1.1998 / 18:05:58 / cg"
!
unhandledJavaExceptionSignal
^ UnhandledJavaExceptionSignal
"Created: / 2.1.1998 / 18:05:19 / cg"
!
unimplementedInstructionSignal
^ UnimplementedInstructionSignal
"Created: / 2.1.1998 / 18:06:15 / cg"
!
unimplementedNativeMethodSignal
^ UnimplementedNativeMethodSignal
"Created: / 2.1.1998 / 18:06:40 / cg"
! !
!JavaVM class methodsFor:'defaults'!
defaultCLASSPATH
|s|
s := '' writeStream.
Java classPath do:[:p |
s size == 0 ifFalse:[
s nextPut:$:
].
s nextPutAll:p.
].
^ s contents
"
self defaultCLASSPATH
"
"Modified: / 6.8.1997 / 00:51:17 / cg"
"Created: / 3.1.1998 / 14:27:21 / cg"
!
defaultHotJavaHome
^ '/usr/local/java/hotjava'.
"Modified: / 5.8.1997 / 04:13:36 / cg"
"Created: / 3.1.1998 / 14:27:34 / cg"
!
defaultJAVAHome
^ Java javaHome
"Modified: / 6.8.1997 / 00:54:44 / cg"
"Created: / 3.1.1998 / 14:27:01 / cg"
!
defaultJWSHome
^ '/usr/local/java/JWS'.
"Modified: / 5.8.1997 / 04:14:34 / cg"
"Created: / 3.1.1998 / 14:27:42 / cg"
!
defaultWindowingToolKit
"/ prefer the windows toolkit ...
(Java classForName:'sun.awt.windows.WToolkit') notNil ifTrue:[
^ 'sun.awt.windows.WToolkit'.
].
(Java classForName:'sun.awt.motif.MToolkit') notNil ifTrue:[
^ 'sun.awt.motif.MToolkit'.
].
^ 'sun.awt.tiny.TinyToolkit'.
"/ ^ 'sun.awt.win32.MToolkit'.
"/ ^ 'sun.awt.motif.MToolkit'.
"
self defaultWindowingToolKit
"
"Created: / 3.1.1998 / 14:27:49 / cg"
"Modified: / 27.1.1998 / 21:52:52 / cg"
!
javaConsole:aStream
JavaConsoleStream := aStream
"
JavaVM javaConsole:Transcript
"
"Modified: / 6.8.1997 / 00:34:13 / cg"
"Created: / 3.1.1998 / 14:27:58 / cg"
!
javaConsoleStream
^ JavaConsoleStream
"Created: / 3.1.1998 / 14:32:16 / cg"
! !
!JavaVM class methodsFor:'fileIO'!
addOpenFile:aStream
OpenFileTable add:aStream.
^ OpenFileTable size - 1.
"Created: / 2.1.1998 / 18:32:59 / cg"
!
getOpenFileAt:idx
^ OpenFileTable at:idx+1 ifAbsent:nil.
"Created: / 2.1.1998 / 18:28:01 / cg"
"Modified: / 2.1.1998 / 18:33:06 / cg"
!
setOpenFile:aStream at:idx
OpenFileTable size < (idx+1) ifTrue:[
OpenFileTable grow:idx+1.
].
OpenFileTable at:idx+1 put:aStream.
"Modified: / 2.1.1998 / 18:33:21 / cg"
! !
!JavaVM class methodsFor:'helpers'!
classForJavaClassObject:aJavaClassObject
"given java.lang.class instance, return the real class for it."
^ JavaClasses at:aJavaClassObject ifAbsent:nil.
"Created: / 23.1.1998 / 17:44:09 / cg"
!
enteredMonitors
|p monitors|
p := Processor activeProcess.
monitors := EnteredMonitorsPerProcess at:p ifAbsent:nil.
monitors isNil ifTrue:[
monitors := OrderedCollection new.
EnteredMonitorsPerProcess at:p put:monitors.
].
^ monitors
"Created: / 2.1.1998 / 21:26:19 / cg"
!
javaClassObjectForClass:aClass
"given a real class, return the corresponding java.lang.class
instance for it."
|jClass|
jClass := JavaClasses at:aClass ifAbsent:nil.
jClass isNil ifTrue:[
"/ class must be initialized (with all of its superclasses ?).
aClass classInit.
JavaClasses at:aClass put:(jClass := (Java at:'java.lang.Class') new).
JavaClasses at:jClass put:aClass.
].
^ jClass
"Created: / 23.1.1998 / 17:43:38 / cg"
"Modified: / 23.1.1998 / 17:46:51 / cg"
!
javaMethodObjectForMethod:aMethod
"given a real method, return the corresponding java.lang.reflect.Method
instance for it."
|jMethod|
jMethod := JavaMethods at:aMethod ifAbsent:nil.
jMethod isNil ifTrue:[
"/ class must be initialized (with all of its superclasses ?).
JavaMethods at:aMethod put:(jMethod := (Java at:'java.lang.reflect.Method') new).
JavaMethods at:jMethod put:aMethod.
].
^ jMethod
"Modified: / 23.1.1998 / 17:46:51 / cg"
"Created: / 9.2.1998 / 15:59:16 / cg"
!
javaThreadForSTProcess:stProcess
|t|
t := Java threads keyAtValue:stProcess ifAbsent:nil.
t == 0 ifTrue:[
^ nil
].
^ t
"Modified: / 26.8.1997 / 19:56:31 / cg"
"Created: / 3.1.1998 / 01:53:41 / cg"
!
methodForJavaMethodObject:aJavaMethodObject
"given java.lang.reflect.Method instance, return the real method for it."
^ JavaMethods at:aJavaMethodObject ifAbsent:nil.
"Created: / 9.2.1998 / 16:01:48 / cg"
!
newThread:name
|thread threadClass i|
threadClass := Java at:'java.lang.Thread'.
thread := (Java at:'java.lang.Thread') basicNew.
thread instVarNamed:'name' put:(Java as_String:name).
thread instVarNamed:'priority' put:(threadClass instVarNamed:'NORM_PRIORITY').
thread instVarNamed:'single_step' put:0.
thread instVarNamed:'daemon' put:0.
thread instVarNamed:'stillborn' put:0.
thread instVarNamed:'target' put:nil.
"/
"/ that on was only temporarily present in JDK1.1.3 (sigh)
"/
(i := thread class instVarOffsetOf:'initial_stack_memory') notNil ifTrue:[
thread instVarAt:i put:0.
].
thread instVarNamed:'group' put:(self standardThreadGroup).
^ thread
"Created: / 3.1.1998 / 01:47:30 / cg"
"Modified: / 27.1.1998 / 00:54:33 / cg"
!
stProcessForJavaThread:jThread
|p|
p := Java threads at:jThread ifAbsent:nil.
p == 0 ifTrue:[
^ nil
].
^ p
"Created: / 2.1.1998 / 21:48:27 / cg"
"Modified: / 3.1.1998 / 01:53:55 / cg"
!
standardThreadGroup
|standardGroup threadClass|
StandardThreadGroup isNil ifTrue:[
threadClass := Java at:'java.lang.Thread'.
standardGroup := (Java at:'java.lang.ThreadGroup') new.
standardGroup instVarNamed:'parent' put:nil.
standardGroup instVarNamed:'name' put:(Java as_String:'main').
standardGroup instVarNamed:'maxPriority' put:(threadClass instVarNamed:'MAX_PRIORITY').
standardGroup instVarNamed:'destroyed' put:0.
standardGroup instVarNamed:'daemon' put:nil.
standardGroup instVarNamed:'vmAllowSuspension' put:0.
standardGroup instVarNamed:'nthreads' put:0.
standardGroup instVarNamed:'ngroups' put:0.
standardGroup instVarNamed:'groups' put:nil.
StandardThreadGroup := standardGroup.
].
^ StandardThreadGroup
"Created: / 3.1.1998 / 01:41:54 / cg"
!
wakeup:anObject
JavaVM releaseAndSignalSemaphoreFor:anObject.
"Created: / 3.1.1998 / 02:29:27 / cg"
"Modified: / 3.1.1998 / 03:08:05 / cg"
!
wakeupAll:anObject
JavaVM releaseAndSignalForAllSemaphoreFor:anObject.
"Created: / 3.1.1998 / 03:07:48 / cg"
"Modified: / 3.1.1998 / 03:08:15 / cg"
! !
!JavaVM class methodsFor:'helpers - awt'!
commonReshapeComponent:nativeContext
|view x y width height ext menu|
view := self viewForWPeer:nativeContext.
x := nativeContext argAt:1.
y := nativeContext argAt:2.
width := nativeContext argAt:3.
height := nativeContext argAt:4.
ext := width@height.
"/ 'pReshape ' print. view print.
"/ ' ' print. x print. '/' print. y print.
"/ ' extent: ' print. ext printNL.
(view isTopView
or:[view isMemberOf:JavaEmbeddedFrameView]) ifTrue:[
"/
"/ dont allow setting the origin
"/
menu := self topViewsMenu:view.
menu notNil ifTrue:[
"/ must add the menus height
height := height + menu height.
ext := width@height.
].
"/ to prevent a view from not being visible/closable
"/ in case Java goes mad ..
(width < 30
or:[height < 10]) ifTrue:[
"/ self halt.
width := 30.
height := 20.
ext := width@height.
].
view extent:ext.
(view isKindOf:ModalBox) ifTrue:[
view preferredExtent:ext
].
"/ adjust non-resizable views min/max
view isTopView ifTrue:[
view minExtent notNil ifTrue:[
view minExtent:ext.
view maxExtent:ext
].
]
] ifFalse:[
(view superView notNil
and:[view superView isTopView]) ifTrue:[
menu := self topViewsMenu:view superView.
menu notNil ifTrue:[
"/ must add menus height to yPos
y := y + menu height.
]
] ifFalse:[
"/ post a configuration event
EventTrace == true ifTrue:[
'JAVA: configure: need event' printCR.
]
].
view origin:x@y extent:ext.
].
^ nil
"Created: / 4.1.1998 / 18:00:52 / cg"
"Modified: / 6.2.1998 / 01:45:46 / cg"
!
createdWindowsView:aView for:aJavaPeer
"this is only sent with the sun.awt.windows toolkit"
aJavaPeer instVarNamed:'pData' put:aView.
JavaWindowGroup isNil ifTrue:[
JavaWindowGroup := WindowGroup new.
JavaWindowGroup isForModalSubview:true.
].
aView windowGroup:JavaWindowGroup.
JavaWindowGroup addView:aView.
KnownWindows isNil ifTrue:[
KnownWindows := IdentityDictionary new.
].
KnownWindows at:aJavaPeer put:aView.
FirstWindowCreationSemaphore signalIf.
"/'*** ' print. aJavaPeer print. ' -> ' print. aView printCR.
"/(aView isKindOf:ModalBox) ifTrue:[
"/ self halt.
"/].
"Created: / 4.1.1998 / 17:57:16 / cg"
"Modified: / 28.1.1998 / 22:40:19 / cg"
!
gcForWGraphics:nativeContext
|jGraphics gc orgX orgY trans|
jGraphics := nativeContext receiver.
gc := jGraphics instVarNamed:'pData'.
trans := gc translation.
orgX := jGraphics instVarNamed:'originX'.
orgY := jGraphics instVarNamed:'originY'.
((orgX ~~ trans x) or:[orgY ~~ trans y]) ifTrue:[
gc translation:orgX@orgY
].
^ gc
"Created: / 8.1.1998 / 00:16:38 / cg"
"Modified: / 25.1.1998 / 11:11:42 / cg"
!
jPeerForView:aView
^ KnownWindows keyAtValue:aView ifAbsent:nil
"Created: / 15.1.1998 / 13:48:01 / cg"
"Modified: / 15.1.1998 / 13:48:43 / cg"
!
pReshape:nativeContext
|jFramePeer view x y width height menu|
jFramePeer := nativeContext receiver.
view := jFramePeer instVarNamed:'pData'.
x := nativeContext argAt:1.
y := nativeContext argAt:2.
width := nativeContext argAt:3.
height := nativeContext argAt:4.
"/ 'pReshape ' print. view print.
"/ ' ' print. x print. '/' print. y print.
"/ ' extent: ' print. width print. '/' print. height printNL.
(view isTopView
or:[view isMemberOf:JavaEmbeddedFrameView]) ifTrue:[
"/
"/ dont allow setting the origin
"/
menu := self topViewsMenu:view.
menu notNil ifTrue:[
"/ must add the menus height
height := height + menu height
].
view extent:width@height.
] ifFalse:[
(view superView notNil
and:[view superView isTopView]) ifTrue:[
menu := self topViewsMenu:view superView.
menu notNil ifTrue:[
"/ must add menus height to yPos
y := y + menu height.
]
].
view origin:x@y extent:width@height.
].
^ nil
"Modified: / 21.8.1997 / 19:34:16 / cg"
"Created: / 7.1.1998 / 21:47:11 / cg"
!
topViewsMenu:view
|idx|
view isTopView ifTrue:[
view subViews size > 0 ifTrue:[
(idx := view subViews findFirst:[:v | v isMemberOf:MenuPanel]) ~~ 0 ifTrue:[
"/ must add the menus height
^ view subViews at:idx
]
].
].
^ nil
"Modified: / 4.8.1997 / 01:23:06 / cg"
"Created: / 4.1.1998 / 18:01:42 / cg"
!
viewForWPeer:nativeContext
|jPeer view pDataIdx|
jPeer := nativeContext receiver.
"/ sigh; pData was renamed to pNativeWidget in jdk1.2 ...
pDataIdx := jPeer class instVarOffsetOf:'pNativeWidget'.
pDataIdx isNil ifTrue:[
"/ ok, we are < 1.2
pDataIdx := jPeer class instVarOffsetOf:'pData'.
].
view := jPeer instVarAt:pDataIdx.
^ view
"Created: / 8.1.1998 / 17:31:25 / cg"
"Modified: / 27.1.1998 / 21:37:43 / cg"
! !
!JavaVM class methodsFor:'helpers - exceptions'!
findJavaHandlerFor:aJavaException
|con method pc hPC|
con := thisContext sender.
[con notNil] whileTrue:[
(con isMemberOf:JavaContext) ifTrue:[
method := con method.
pc := con pc.
(hPC := method handlerFor:aJavaException at:pc) notNil ifTrue:[
con setPC:hPC.
^ con
].
].
con := con sender.
].
^ nil
"Modified: / 5.1.1998 / 00:16:52 / cg"
!
throwArrayIndexOutOfBoundsException:badIndex
|exClass ex|
"/ self
"/ throwExceptionClassName:'java.lang.ArrayIndexOutOfBoundsException'
"/ withMessage:'bad array index: ' , badIndex printString
exClass := Java classForName:'java.lang.ArrayIndexOutOfBoundsException'.
ex := exClass newCleared.
ex perform:#'<init>(I)V' with:badIndex.
self throwException:ex
"Created: / 14.1.1998 / 21:36:05 / cg"
"Modified: / 14.1.1998 / 23:32:52 / cg"
!
throwClassNotFoundException
self
throwExceptionClassName:'java.lang.ClassNotFoundException'
withMessage:'no such class'
"Created: / 4.1.1998 / 22:25:26 / cg"
"Modified: / 7.1.1998 / 15:25:35 / cg"
!
throwClassNotFoundException:className
self
throwExceptionClassName:'java.lang.ClassNotFoundException'
withMessage:'no such class: ' , className
"Created: / 4.1.1998 / 22:26:09 / cg"
"Modified: / 7.1.1998 / 15:25:58 / cg"
!
throwException:aJavaException
|con jMsg msg exClass|
ExceptionTrace ifTrue:[
'JAVA: exception: ' print. aJavaException class fullName printCR.
].
ExceptionDebug ifTrue:[
self halt:('JAVA: exception: ' , aJavaException class fullName).
self internalError:('JAVA: exception: ' , aJavaException class fullName).
].
con := self findJavaHandlerFor:aJavaException.
con isNil ifTrue:[
exClass := aJavaException class.
jMsg := aJavaException instVarNamed:'detailMessage'.
jMsg notNil ifTrue:[
msg := Java as_ST_String:jMsg.
msg := 'Java ' , exClass name , ': ' , msg.
] ifFalse:[
msg := 'Java ' , exClass name
].
"/ for our convenience: skip ST contexts
con := thisContext sender.
[con isNil or:[con isMemberOf:JavaContext]] whileFalse:[
con := con sender
].
con isNil ifTrue:[con := thisContext sender].
"/
"/ no JavaHandler ... let smalltalk handle it
"/
JavaVM javaExceptionSignal
raiseWith:aJavaException
errorString:msg
in:con.
Processor activeProcess terminate.
].
"/
"/ found a java exceptionHandler
"/
con exceptionArg:aJavaException.
con markForException.
con unwindAndRestart.
self halt:'should not be reached'.
Processor activeProcess terminate.
"Created: / 7.1.1998 / 15:28:22 / cg"
"Modified: / 17.1.1998 / 13:09:54 / cg"
!
throwExceptionClassName:aJavaExceptionClassName withMessage:someMessage
|exClass ex|
exClass := Java classForName:aJavaExceptionClassName.
ex := exClass newCleared.
ex perform:#'<init>(Ljava/lang/String;)V' with:(Java as_String:someMessage).
"/ ex := exClass new.
"/ ex instVarNamed:'detailMessage' put:(Java as_String:someMessage).
self throwException:ex
"Created: / 7.1.1998 / 15:25:09 / cg"
"Modified: / 14.1.1998 / 23:38:30 / cg"
!
throwIOExceptionWithMessage:message
self
throwExceptionClassName:'java.io.IOException'
withMessage:message
"Created: / 7.1.1998 / 10:34:24 / cg"
"Modified: / 7.1.1998 / 15:26:25 / cg"
!
throwIllegalAccessException
self
throwExceptionClassName:'java.lang.IllegalAccessException'
withMessage:'illegal access'
"Modified: / 7.1.1998 / 15:25:35 / cg"
"Created: / 14.1.1998 / 23:13:44 / cg"
!
throwInstantiationException
self
throwExceptionClassName:'java.lang.InstantiationException'
withMessage:'cannot instantiate'
"Modified: / 7.1.1998 / 15:25:35 / cg"
"Created: / 14.1.1998 / 23:15:01 / cg"
!
throwInstantiationExceptionFor:aJavaClass
self
throwExceptionClassName:'java.lang.InstantiationException'
withMessage:('cannot instantiate ' , aJavaClass fullName)
"Modified: / 7.1.1998 / 15:25:35 / cg"
"Created: / 14.1.1998 / 23:17:02 / cg"
!
throwNullPointerException
self halt:'null pointer exception'.
self
throwExceptionClassName:'java.lang.NullPointerException'
withMessage:'null pointer'
"Created: / 9.1.1998 / 02:26:08 / cg"
"Modified: / 28.1.1998 / 02:30:09 / cg"
!
throwNumberFormatException
self
throwExceptionClassName:'java.lang.NumberFormatException'
withMessage:'bad number format'
"Modified: / 7.1.1998 / 15:25:35 / cg"
"Created: / 11.1.1998 / 16:08:22 / cg"
! !
!JavaVM class methodsFor:'helpers - io'!
anyStream_close:nativeContext
|jStream fileNo file|
jStream := nativeContext receiver.
fileNo := self validateFileNo:jStream.
fileNo == 0 ifTrue:[
'JAVA: file is already closed' errorPrintCR.
^ self "/ already closed
].
file := self getOpenFileAt:fileNo.
file isNil ifTrue:[
self halt:'invalid fileNo in close'.
self internalError:'invalid fileNo in close'.
^ self
].
"/ should always be bytes
(file ~~ Stdin
and:[file ~~ Stdout
and:[file ~~ Stderr
and:[file ~~ Transcript]]]) ifTrue:[
file close.
].
self setOpenFile:nil at:fileNo.
fileNo := jStream instVarNamed:'fd'.
fileNo isInteger ifFalse:[
"/ JDK 1.1.3
fileNo instVarNamed:'fd' put:0.
] ifTrue:[
"/ JDK 1.0
jStream instVarNamed:'fd' put:0
].
"Modified: / 28.1.1998 / 02:15:24 / cg"
"Created: / 4.2.1998 / 15:22:03 / cg"
!
anyStream_readBytes:nativeContext
|bytes offset count stream nRead|
bytes := nativeContext argAt:1.
offset := nativeContext argAt:2.
count := nativeContext argAt:3.
stream := self validateFile:(nativeContext receiver).
"/ should always be bytes
bytes class isBytes ifFalse:[
self halt.
].
stream == Stdin ifTrue:[
self halt:'reading from standardInput ...'.
^ 0
].
FileIOTrace ifTrue:[
('JAVA: read ' , count printString , ' bytes from ' , stream pathName) infoPrintCR.
].
stream isPositionable ifFalse:[
"/ mhmh - some kind of socket or pipe
stream readWait.
].
Stream readErrorSignal handle:[:ex |
nRead := -1
] do:[
nRead := stream nextAvailableBytes:count into:bytes startingAt:offset+1.
].
nRead == 0 ifTrue:[
stream atEnd ifTrue:[
FileIOTrace ifTrue:[
('JAVA: at EOF ' , nRead printString) infoPrintCR.
].
^ -1
].
].
count ~~ nRead ifTrue:[
FileIOTrace ifTrue:[
('JAVA: only got ' , nRead printString) infoPrintCR.
]
].
^ nRead
"Created: / 4.2.1998 / 15:20:00 / cg"
"Modified: / 4.2.1998 / 19:42:40 / cg"
!
anyStream_writeBytes:nativeContext
|bytes offset count stream|
bytes := nativeContext argAt:1.
offset := nativeContext argAt:2.
count := nativeContext argAt:3.
stream := self validateFile:(nativeContext receiver).
FileIOTrace ifTrue:[
stream isFileStream ifTrue:[
('JAVA: write ' , count printString , ' bytes to ' , stream pathName) infoPrintCR.
] ifFalse:[
stream ~~ Stdout ifTrue:[
stream ~~ Stderr ifTrue:[
('JAVA: write ' , count printString , ' bytes to ' , stream displayString) infoPrintCR.
]
]
]
].
"/ should always be bytes
Stream writeErrorSignal handle:[:ex |
ex return
] do:[
Socket brokenConnectionSignal handle:[:ex |
ex return
] do:[
stream nextPutBytes:count from:bytes startingAt:offset+1
]
].
"Created: / 4.2.1998 / 15:23:58 / cg"
"Modified: / 4.2.1998 / 19:38:26 / cg"
!
fileStreamForReading:name
|fn stream tryAlongClassPath|
fn := name asFilename.
stream := fn readStream.
stream notNil ifTrue:[^ stream].
fn isAbsolute ifFalse:[
"/ if not absolute, try along classPath
"/ This allows classes to open local files (JEdit)
"/ even if they have NOT been loaded by a Java classLoader.
"/ Only do this for image files
"/ (and maybe some other config files in the future),
"/ to avoid security holes.
tryAlongClassPath := false.
(fn hasSuffix:'gif') ifTrue:[
tryAlongClassPath := true.
].
(fn hasSuffix:'jpg') ifTrue:[
tryAlongClassPath := true.
].
tryAlongClassPath ifTrue:[
Java classPath do:[:dirName |
|fn|
(fn := dirName asFilename construct:name) exists ifTrue:[
stream := fn readStream.
stream notNil ifTrue:[^ stream].
]
]
]
].
^ nil.
"Modified: / 15.1.1998 / 13:01:34 / cg"
!
validateFile:javaStream
|fileNo file descriptor|
fileNo := self validateFileNo:javaStream.
fileNo isNil ifTrue:[
"/ self halt:'invalid fileNo in read'.
"/ self internalError:'invalid fileNo in read'.
self throwIOExceptionWithMessage:'invalid fileNo in read'.
^ nil
].
file := self getOpenFileAt:fileNo.
file isNil ifTrue:[
"/ self halt:'invalid fileNo in read'.
"/ self internalError:'invalid fileNo in read'.
self throwIOExceptionWithMessage:'invalid fileNo in read'.
^ nil
].
^ file
"Created: / 4.1.1998 / 16:50:38 / cg"
"Modified: / 4.1.1998 / 17:50:00 / cg"
!
validateFileNo:javaStream
|fileNo file descriptor|
"/ JDK 1.1.3 has fileDescriptor wrapped
"/ JDK 1.0 has it directly as integer
fileNo := javaStream instVarNamed:'fd'.
fileNo isInteger ifFalse:[
descriptor := fileNo.
fileNo := descriptor instVarNamed:'fd'.
].
fileNo isInteger ifFalse:[
"/ self halt:'invalid fileNo in read'.
"/ self internalError:'invalid fileNo in read'.
self throwIOExceptionWithMessage:'invalid fileNo in read'.
^ nil
].
^ fileNo.
"Created: / 4.1.1998 / 17:49:08 / cg"
"Modified: / 13.1.1998 / 14:07:47 / cg"
! !
!JavaVM class methodsFor:'native - java.io'!
_FileDescriptor_initSystemFD:nativeContext
|descriptor fileNo idx myStream|
descriptor := nativeContext argAt:1.
fileNo := nativeContext argAt:2.
fileNo == 0 ifTrue:[
myStream := Stdin
] ifFalse:[
fileNo == 1 ifTrue:[
myStream := JavaConsoleStream ? Stdout
] ifFalse:[
fileNo == 2 ifTrue:[
myStream := JavaConsoleStream ? Stderr
] ifFalse:[
self halt:'invalid fileNo given'.
self internalError:'invalid fileNo given'.
]
]
].
self setOpenFile:myStream at:fileNo.
descriptor instVarNamed:'fd' put:fileNo.
^ descriptor
"Modified: / 27.1.1998 / 18:15:28 / cg"
!
_FileInputStream_available:nativeContext
|file|
file := self validateFile:(nativeContext receiver).
file isNil ifTrue:[
self throwIOExceptionWithMessage:'invalid fileNo in available'.
^ self
].
file isFileStream ifTrue:[
^ file size - file position + 1
].
file atEnd ifTrue:[
^ 0.
].
self halt.
^ 1
"Modified: / 14.1.1998 / 15:12:52 / cg"
!
_FileInputStream_close:nativeContext
^ self anyStream_close:nativeContext
"Created: / 4.1.1998 / 17:45:23 / cg"
"Modified: / 4.2.1998 / 15:20:46 / cg"
!
_FileInputStream_open:nativeContext
|fs fd fn name stream fileNo|
fs := nativeContext receiver.
fd := fs instVarNamed:'fd'.
(fileNo := fd instVarNamed:'fd') ~~ 0 ifTrue:[
fileNo ~~ -1 ifTrue:[
self halt:'file already open'.
self internalError:'file already open'.
^ self.
]
].
name := nativeContext argAt:1.
name := Java as_ST_String:name.
FileOpenTrace ifTrue:[
('JAVA: opening ' , name) infoPrintCR.
].
stream := self fileStreamForReading:name.
stream isNil ifTrue:[
FileOpenTrace ifTrue:[
('JAVA: failed to open ' , name , ' for reading.') infoPrintCR.
].
self throwIOExceptionWithMessage:('cannot open ' , name , ' for reading').
^ self.
].
stream buffered:false.
"/ FileOpenConfirmation ifTrue:[
"/ (self confirm:('JAVA Security check\\Opening ''' , name , ''' for reading.\Grant permission ?') withCRs)
"/ ifFalse:[
"/ self throwIOExceptionWithMessage:('no permission to open ' , name , ' for reading').
"/ ^ self
"/ ]
"/ ].
fileNo := self addOpenFile:stream.
FileOpenTrace ifTrue:[
('JAVA: opened ' , name , ' as FD ' , fileNo printString) infoPrintCR.
].
fd instVarNamed:'fd' put:fileNo.
"Created: / 4.1.1998 / 16:47:12 / cg"
"Modified: / 1.2.1998 / 20:35:16 / cg"
!
_FileInputStream_read:nativeContext
|file byte|
file := self validateFile:(nativeContext receiver).
FileIOTrace ifTrue:[
('JAVA: read 1 byte from ' , file pathName) infoPrintCR.
].
byte := file nextByte.
byte isNil ifTrue:[
^ -1
].
^ byte
"Created: / 5.1.1998 / 02:17:08 / cg"
"Modified: / 5.1.1998 / 02:17:25 / cg"
!
_FileInputStream_readBytes:nativeContext
^ self anyStream_readBytes:nativeContext
"Modified: / 4.2.1998 / 15:23:08 / cg"
!
_FileOutputStream_close:nativeContext
^ self anyStream_close:nativeContext
"Created: / 13.1.1998 / 09:33:16 / cg"
"Modified: / 4.2.1998 / 15:20:53 / cg"
!
_FileOutputStream_open:nativeContext
|fs fd name dir stream fileNo|
fs := nativeContext receiver.
fd := fs instVarNamed:'fd'.
(fd instVarNamed:'fd') ~~ 0 ifTrue:[
self halt:'file already open'.
self internalError:'file already open'.
^ self.
].
name := nativeContext argAt:1.
name := Java as_ST_String:name.
FileOpenTrace ifTrue:[
('JAVA: opening ' , name) infoPrintCR.
].
dir := name asFilename directory pathName.
(PermittedDirectories notNil
and:[PermittedDirectories includes:dir]) ifFalse:[
FileOpenConfirmation ifTrue:[
(self confirm:('JAVA Security check\\Opening ''' , name , ''' for writing.\Grant permission ?') withCRs)
ifFalse:[
self throwIOExceptionWithMessage:('no permission to open ' , name , ' for writing').
^ self
].
(self confirm:('JAVA Security check\\Always permit writes in this directory (''' , dir , ''') ?') withCRs)
ifTrue:[
PermittedDirectories isNil ifTrue:[
PermittedDirectories := Set new
].
PermittedDirectories add:dir.
]
]
].
stream := name asFilename writeStream.
stream isNil ifTrue:[
self throwIOExceptionWithMessage:('cannot open ' , name , ' for writing').
].
fileNo := self addOpenFile:stream.
FileOpenTrace ifTrue:[
('JAVA: opened ' , name , ' as FD ' , fileNo printString , ' for writing') infoPrintCR.
].
fd instVarNamed:'fd' put:fileNo.
"Modified: / 4.2.1998 / 17:16:29 / cg"
!
_FileOutputStream_write:nativeContext
|byte file|
byte := nativeContext argAt:1.
file := self validateFile:(nativeContext receiver).
FileIOTrace ifTrue:[
file isFileStream ifTrue:[
('JAVA: write 1 byte to ' , file pathName) infoPrintCR.
] ifFalse:[
file ~~ Stdout ifTrue:[
file ~~ Stderr ifTrue:[
('JAVA: write 1 byte to ' , file displayString) infoPrintCR.
]
]
]
].
"/ should always be bytes
file nextPutByte:byte
"Created: / 13.1.1998 / 09:32:13 / cg"
"Modified: / 13.1.1998 / 09:32:31 / cg"
!
_FileOutputStream_writeBytes:nativeContext
^ self anyStream_writeBytes:nativeContext
"Modified: / 4.2.1998 / 15:24:20 / cg"
!
_File_canRead0:nativeContext
|file path f|
file := nativeContext receiver.
path := file instVarNamed:'path'.
path notNil ifTrue:[
path := Java as_ST_String:path.
(f := path asFilename) isReadable ifTrue:[
^ 1 "/ TRUE
]
].
^ 0 "/ FALSE
"Created: / 4.1.1998 / 18:09:55 / cg"
"Modified: / 15.1.1998 / 12:10:34 / cg"
!
_File_canWrite0:nativeContext
|file path f|
file := nativeContext receiver.
path := file instVarNamed:'path'.
path notNil ifTrue:[
path := Java as_ST_String:path.
(f := path asFilename) isWritable ifTrue:[
^ 1 "/ TRUE
]
].
^ 0 "/ FALSE
"Modified: / 15.1.1998 / 12:10:34 / cg"
"Created: / 4.2.1998 / 00:19:55 / cg"
!
_File_exists0:nativeContext
|file path f|
file := nativeContext receiver.
path := file instVarNamed:'path'.
path notNil ifTrue:[
path := Java as_ST_String:path.
(f := path asFilename) exists ifTrue:[
^ 1 "TRUE"
]
].
^ 0 "FALSE"
"Created: / 5.1.1998 / 02:07:48 / cg"
"Modified: / 15.1.1998 / 12:10:27 / cg"
!
_File_isAbsolute:nativeContext
|file path f|
file := nativeContext receiver.
path := file instVarNamed:'path'.
path notNil ifTrue:[
path := Java as_ST_String:path.
(f := path asFilename) isAbsolute ifTrue:[
^ 1 "/ TRUE
]
].
^ 0 "/ FALSE
"Modified: / 8.8.1997 / 12:04:05 / cg"
"Created: / 11.1.1998 / 09:54:38 / cg"
!
_File_isDirectory0:nativeContext
|file path f|
file := nativeContext receiver.
path := file instVarNamed:'path'.
path notNil ifTrue:[
path := Java as_ST_String:path.
(f := path asFilename) exists ifTrue:[
f isDirectory ifTrue:[^ 1 "TRUE"]
]
].
^ 0 "FALSE"
"Created: / 7.1.1998 / 10:31:37 / cg"
"Modified: / 15.1.1998 / 12:10:20 / cg"
!
_File_isFile0:nativeContext
|file path f|
file := nativeContext receiver.
path := file instVarNamed:'path'.
path notNil ifTrue:[
path := Java as_ST_String:path.
(f := path asFilename) exists ifTrue:[
f isDirectory ifFalse:[^ 1 "TRUE"]
]
].
^ 0 "/ FALSE
"Created: / 11.1.1998 / 11:40:22 / cg"
"Modified: / 15.1.1998 / 12:10:13 / cg"
!
_File_lastModified0:nativeContext
|file path f|
file := nativeContext receiver.
path := file instVarNamed:'path'.
path notNil ifTrue:[
path := Java as_ST_String:path.
(f := path asFilename) exists ifTrue:[
^ f modificationTime getMilliseconds.
]
].
^ 0
"Modified: / 8.8.1997 / 12:04:13 / cg"
"Created: / 4.2.1998 / 16:50:30 / cg"
!
_File_length0:nativeContext
|file path f|
file := nativeContext receiver.
path := file instVarNamed:'path'.
path notNil ifTrue:[
path := Java as_ST_String:path.
(f := path asFilename) exists ifTrue:[
^ f fileSize
]
].
^ -1
"Created: / 7.1.1998 / 12:18:57 / cg"
"Modified: / 15.1.1998 / 12:10:06 / cg"
!
_File_list0:nativeContext
|file path f files|
file := nativeContext receiver.
path := file instVarNamed:'path'.
path notNil ifTrue:[
path := Java as_ST_String:path.
(f := path asFilename) exists ifTrue:[
f isDirectory ifTrue:[
files := f directoryContents asArray.
files := files collect:[:nm | Java as_String:nm].
^ files
]
]
].
^ nil
"Created: / 14.1.1998 / 21:30:22 / cg"
"Modified: / 14.1.1998 / 21:32:09 / cg"
!
_File_mkdir0:nativeContext
|file path f|
file := nativeContext receiver.
path := file instVarNamed:'path'.
path notNil ifTrue:[
path := Java as_ST_String:path.
FileOpenConfirmation ifTrue:[
(self confirm:('JAVA Security check\\Create directory ''' , path , '''.\Grant permission ?') withCRs)
ifFalse:[
^ 0 "/ FALSE
]
].
f := path asFilename.
OperatingSystem accessDeniedErrorSignal handle:[:ex |
^ 0 "/ FALSE
] do:[
f makeDirectory.
].
f exists ifTrue:[
f isDirectory ifTrue:[^ 1 "TRUE"]
]
].
^ 0 "FALSE"
"Modified: / 15.1.1998 / 12:10:20 / cg"
"Created: / 4.2.1998 / 00:19:05 / cg"
!
_RandomAccessFile_close:nativeContext
^ self anyStream_close:nativeContext
"Created: / 4.2.1998 / 13:26:53 / cg"
"Modified: / 4.2.1998 / 15:21:08 / cg"
!
_RandomAccessFile_length:nativeContext
|file sz|
file := self validateFile:(nativeContext receiver).
FileIOTrace ifTrue:[
('JAVA: length of ' , file pathName) infoPrintCR.
].
sz := file size.
^ sz.
"Created: / 4.2.1998 / 13:27:58 / cg"
!
_RandomAccessFile_open:nativeContext
|fs fd name dir stream fileNo|
fs := nativeContext receiver.
fd := fs instVarNamed:'fd'.
(fd instVarNamed:'fd') ~~ 0 ifTrue:[
self halt:'file already open'.
self internalError:'file already open'.
^ self.
].
name := nativeContext argAt:1.
name := Java as_ST_String:name.
FileOpenTrace ifTrue:[
('JAVA: opening ' , name) infoPrintCR.
].
dir := name asFilename directory pathName.
(PermittedDirectories notNil
and:[PermittedDirectories includes:dir]) ifFalse:[
FileOpenConfirmation ifTrue:[
(self confirm:('JAVA Security check\\Opening ''' , name , ''' for read/write.\Grant permission ?') withCRs)
ifFalse:[
self throwIOExceptionWithMessage:('no permission to open ' , name , ' for writing').
^ self
].
(self confirm:('JAVA Security check\\Always permit writes in this directory (''' , dir , ''') ?') withCRs)
ifTrue:[
PermittedDirectories isNil ifTrue:[
PermittedDirectories := Set new
].
PermittedDirectories add:dir.
]
]
].
stream := name asFilename readWriteStream.
stream isNil ifTrue:[
self throwIOExceptionWithMessage:('cannot open ' , name , ' for writing').
].
fileNo := self addOpenFile:stream.
FileOpenTrace ifTrue:[
('JAVA: opened ' , name , ' as FD ' , fileNo printString , ' for writing') infoPrintCR.
].
fd instVarNamed:'fd' put:fileNo.
"Created: / 4.2.1998 / 00:14:48 / cg"
"Modified: / 4.2.1998 / 17:15:55 / cg"
!
_RandomAccessFile_readBytes:nativeContext
^ self anyStream_readBytes:nativeContext
"Modified: / 4.2.1998 / 15:23:27 / cg"
!
_RandomAccessFile_seek:nativeContext
|file pos|
file := self validateFile:(nativeContext receiver).
FileIOTrace ifTrue:[
('JAVA: seek on ' , file pathName) infoPrintCR.
].
pos := nativeContext argAt:1.
file position:pos+1 "/ ST/X position starts at 1
"Created: / 4.2.1998 / 13:25:38 / cg"
"Modified: / 4.2.1998 / 13:28:12 / cg"
!
_RandomAccessFile_writeBytes:nativeContext
^ self anyStream_writeBytes:nativeContext
"Modified: / 4.2.1998 / 15:24:20 / cg"
"Created: / 4.2.1998 / 15:24:35 / cg"
! !
!JavaVM class methodsFor:'native - java.io - jdk1.2'!
_FileDescriptor_initIDs:nativeContext
"/ introduced with jdk1.2 ... (sigh)
"Created: / 27.1.1998 / 18:16:29 / cg"
!
_FileInputStream_initIDs:nativeContext
"/ introduced with jdk1.2 ... (sigh)
"Created: / 27.1.1998 / 18:15:51 / cg"
!
_FileOutputStream_initIDs:nativeContext
"/ introduced with jdk1.2 ... (sigh)
"Created: / 27.1.1998 / 18:16:40 / cg"
!
_File_canonPath:nativeContext
"/ introduced with jdk1.2 ... (sigh)
|jPath path realPath|
jPath := nativeContext argAt:1.
jPath isNil ifTrue:[^ jPath].
path := Java as_ST_String:jPath.
realPath := path asFilename pathName.
^ Java as_String:realPath
"Created: / 27.1.1998 / 18:35:58 / cg"
"Modified: / 27.1.1998 / 21:36:03 / cg"
!
_File_initIDs:nativeContext
"/ introduced with jdk1.2 ... (sigh)
"Created: / 27.1.1998 / 18:25:19 / cg"
! !
!JavaVM class methodsFor:'native - java.lang'!
_ClassLoader_defineClass0:nativeContext
"create a new class from a given byteArray.
Here, construct a stream on it and pass the work to the
JavaClassReader."
|jClassLoader jName name data offset length inStream newClass
loaderStub jClass|
jClassLoader := nativeContext receiver.
jName := nativeContext argAt:1.
"/ className is now optional ...
"/ jName isNil ifTrue:[
"/ self internalError:'nil name in defineClass'.
"/ ^ nil
"/ ] ifFalse:[
"/ name := Java as_ST_String:jName.
"/ ].
data := nativeContext argAt:2.
offset := nativeContext argAt:3.
length := nativeContext argAt:4.
inStream := data readStream.
inStream position:offset + 1.
inStream readLimit:(offset + length).
"/ loaderStub := Plug new.
"/ loaderStub respondTo:#loadClass: with:[:clsName |
"/ |jName|
"/
"/self halt.
"/ jName := Java as_String:clsName.
"/ "/ jClassLoader loadClass:jName
"/ jClassLoader
"/ perform:#'loadClass(Ljava/lang/String;)Ljava/lang/Class;'
"/ with:jName.
"/ ].
('JAVA: defining class ...') infoPrintCR.
"/ self internalError:'break'.
newClass := JavaClassReader
readStream:inStream
loader:jClassLoader "loaderStub"
loadUnresolved:false.
newClass isNil ifTrue:[
('JAVA: defineClass failed') infoPrintCR.
^ nil.
].
Transcript showCR:('defined class ' , newClass fullName , '.').
newClass classLoader:jClassLoader.
('Java: defined new class: ' , newClass fullName) infoPrintCR.
jClass := self javaClassObjectForClass:newClass.
^ jClass
"Created: / 7.1.1998 / 12:35:10 / cg"
"Modified: / 24.1.1998 / 15:26:21 / cg"
!
_ClassLoader_findSystemClass0:nativeContext
|loader name class jClass|
loader := nativeContext receiver.
name := nativeContext argAt:1.
name := Java as_ST_String:name.
"/ ('JAVA: findSystemClass0 for ' , name , ' loader is ' , loader displayString) infoPrintCR.
loader class == (Java classForName:'java.util.SystemClassLoader') ifTrue:[
Java classForName:name.
].
"/ JavaClassReader classLoaderQuerySignal answer:nil "loader"
"/ do:[
"/ class := Java classForName:name.
"/ JavaClassReader postLoadActions:true.
"/ ].
class := Java at:name.
(class isNil
"or:[class classLoader notNil]") ifTrue:[
"/ self halt:'class: ' , name , ' not found.'.
"/ self internalError:'class: ' , name , ' not found.'.
self
throwExceptionClassName:'java.lang.ClassNotFoundException'
withMessage:'class: ' , name , ' not found.'.
^ nil
].
"/ 'JAVA: findSystemClass0 - loaded: ' infoPrint. class fullName infoPrintCR.
jClass := self javaClassObjectForClass:class.
^ jClass
"Created: / 5.1.1998 / 02:53:04 / cg"
"Modified: / 6.2.1998 / 02:16:50 / cg"
!
_ClassLoader_getSystemResourceAsStream0:nativeContext
|jString rString dir file text data inStream|
jString := nativeContext argAt:1.
rString := Java as_ST_String:jString.
Java classPath do:[:aPath |
(dir := aPath asFilename) exists ifTrue:[
(file := dir construct:rString) exists ifTrue:[
(Java isExcludedFromClassPath:file) ifFalse:[
text := file contents asString.
"/ Copy data from returned buffer into Java byte array.
data := text asByteArray.
"/ Create input stream using byte array
inStream := (Java classForName:'java.io.ByteArrayInputStream') basicNew.
inStream invoke:'<init>([B)V' with:data.
^ inStream.
]
]
]
].
^ nil
"Created: / 8.1.1998 / 16:06:56 / cg"
"Modified: / 27.1.1998 / 21:58:54 / cg"
!
_ClassLoader_init:nativeContext
^ nil
"Created: / 5.1.1998 / 02:04:43 / cg"
!
_ClassLoader_resolveClass0:nativeContext
"resolve a new class as previously created by defineClass0"
|jClassLoader jCls cls loaderStub|
jClassLoader := nativeContext receiver.
jCls := nativeContext argAt:1.
jCls isNil ifTrue:[
self halt.
^ nil
].
cls := JavaClasses at:jCls ifAbsent:nil.
cls isNil ifTrue:[
self halt.
^ nil
].
Transcript showCR:('resolving class ' , cls fullName , ' ...').
JavaClassReader classLoaderQuerySignal answer:jClassLoader
do:[
JavaClassReader postLoadActions:true.
cls constantPool do:[:entry |
(entry isMemberOf:JavaUnresolvedClassConstant) ifTrue:[
self halt:'debugHalt'.
entry preResolve.
self halt:'debugHalt'.
]
]
].
"Created: / 7.1.1998 / 13:12:27 / cg"
"Modified: / 8.1.1998 / 16:13:57 / cg"
!
_Class_forName:nativeContext
"get a java.lang.Class by name"
|jClassName className cls jClass s m c loader|
jClassName := nativeContext argAt:1.
className := Java as_ST_String:jClassName.
(s := nativeContext sender) notNil ifTrue:[
(s isMemberOf:JavaContext) ifTrue:[
c := s method javaClass.
loader := c classLoader.
loader isNil ifTrue:[
"/ self halt.
]
]
].
JavaClassReader classLoaderQuerySignal answer:loader
do:[
cls := Java classForName:className.
].
"/(className startsWith:'sun.awt') ifTrue:[self halt].
"/('classForName: ' , className , ' -> ') print.
"/cls notNil ifTrue:[cls fullName printCR] ifFalse:['nil' printCR].
cls isNil ifTrue:[
ExceptionTrace ifTrue:[
self halt:'no such class:' , className.
].
self throwClassNotFoundException:className.
"/ not proceedable
AbortSignal raise.
"/ not reached
^ self
].
^ self javaClassObjectForClass:cls.
"Modified: / 4.2.1998 / 19:54:04 / cg"
!
_Class_getClassLoader:nativeContext
"get a classes loader"
|loader|
loader := JavaClassReader classLoaderQuerySignal raise.
('JAVA: getClassLoader - ' , loader printString) infoPrintCR.
"/ self unimplementedNativeMethod.
^ loader
"Modified: / 21.8.1997 / 16:32:02 / cg"
"Created: / 5.1.1998 / 02:51:59 / cg"
!
_Class_getMethod0:nativeContext
"get a method, given a name and type spec"
|jClass cls jmName mName mTypes whichAccess argSig sel|
jClass := nativeContext receiver.
cls := JavaClasses at:jClass.
jmName := nativeContext argAt:1.
mName := Java as_ST_String:jmName.
mTypes := nativeContext argAt:2.
whichAccess := nativeContext argAt:3.
argSig := JavaMethod argSignatureFromArgTypeArray:mTypes.
cls methodDictionary keysAndValuesDo:[:sel :mthd |
|i1 i2 jMethod|
JavaMethods notNil ifTrue:[
(jMethod := JavaMethods at:mthd ifAbsent:nil) notNil ifTrue:[
^ jMethod
]
].
mthd name printCR.
mName printCR.
mthd name = mName ifTrue:[
i1 := mthd signature indexOf:$(.
i2 := mthd signature indexOf:$) startingAt:(i1+1).
(mthd signature copyFrom:i1+1 to:i2-1) = argSig ifTrue:[
"/ found it - create a java.lang.reflect.Method for it.
jMethod := (Java at:'java.lang.reflect.Method') new.
jMethod instVarNamed:'clazz' put:jClass.
jMethod instVarNamed:'slot' put:sel.
jMethod instVarNamed:'name' put:jmName.
jMethod instVarNamed:'returnType' put:(self javaClassObjectForClass:mthd returnTypeClass).
JavaMethods isNil ifTrue:[
JavaMethods := IdentityDictionary new
].
JavaMethods at:jMethod put:mthd.
JavaMethods at:mthd put:jMethod.
^ jMethod.
].
].
].
self halt.
self
throwExceptionClassName:'java.lang.NoSuchMethodException'
withMessage:'not yet implemented'.
^ nil.
"Modified: / 13.2.1998 / 15:23:07 / cg"
!
_Class_getName:nativeContext
"get a classes name"
|jClass cls|
jClass := nativeContext receiver.
cls := JavaClasses at:jClass.
^ Java as_String:((cls fullName copyFrom:1) replaceAll:$/ with:$.).
"Modified: / 6.1.1998 / 18:30:52 / cg"
!
_Class_getPrimitiveClass:nativeContext
"get a primitive class by name"
|jClassName className cls|
jClassName := nativeContext argAt:1.
className := Java as_ST_String:jClassName.
JavaClasses isNil ifTrue:[
self initializePrimitiveClasses
].
cls := JavaClasses at:className.
"/ cls := Java classForName:className.
"/ cls isNil ifTrue:[
"/ cls := JavaClasses at:('JavaBase_' , className) asSymbol ifAbsent:nil.
"/ #(
"/ 'boolean' #Boolean
"/ 'float' #ShortFloat
"/ 'double' #Float
"/ 'int' #Integer
"/ 'long' #Integer
"/ 'char' #Character
"/ 'short' #Integer
"/ 'byte' #Integer
"/ 'void' #UndefinedObject
"/ ) pairWiseDo:[:nm :sym |
"/ className = nm ifTrue:[
"/ cls := Smalltalk at:sym.
"/ ]
"/ ].
"/
"/ cls isNil ifTrue:[
"/ self internalError:'class: ' , className , ' not found.'.
"/ ].
"/ ].
^ cls
"Created: / 4.1.1998 / 00:46:03 / cg"
"Modified: / 4.1.1998 / 01:12:27 / cg"
!
_Class_getSuperclass:nativeContext
"return a classes superclass"
|jClass cls superCls|
jClass := nativeContext receiver.
cls := JavaClasses at:jClass.
superCls := cls superclass.
superCls == JavaObject ifTrue:[
^ nil.
].
^ self javaClassObjectForClass:superCls
"Created: / 12.1.1998 / 12:38:36 / cg"
"Modified: / 4.2.1998 / 14:51:22 / cg"
!
_Class_isInstance:nativeContext
"return true, if something is an instance of a class.
(i.e. same as instanceOf - builtin bytecode)"
|jClass cls obj|
obj := nativeContext argAt:1.
obj isNil ifTrue:[^ 0 "FALSE"].
jClass := nativeContext receiver.
cls := JavaClasses at:jClass.
(obj isMemberOf:cls) ifTrue:[^ 1 "TRUE"].
(obj isKindOf:cls) ifTrue:[^ 1 "TRUE"].
cls isBehavior ifTrue:[
cls isInterface ifTrue:[
(obj class hasInterface:cls) ifTrue:[
^ 1 "TRUE"
]
].
^ (obj isKindOf:cls) ifTrue:[1 "TRUE"] ifFalse:[0 "FALSE"]
].
(cls isMemberOf:JavaClassPointerRef) ifTrue:[
"/ must be a pointer to an array of that class
^ (obj isArray) ifTrue:[1 "TRUE"] ifFalse:[0 "FALSE"]
].
(cls isMemberOf:JavaBuiltInClassPointerRef) ifTrue:[
cls arrayClass == obj class ifTrue:[
^ 1 "TRUE"
].
].
(obj isMemberOf:Array) ifTrue:[
obj size == 0 ifTrue:[
^ 1 "TRUE"
].
^ (self _checkCast:(obj at:1) class:(cls deref))
ifTrue:[1 "TRUE"] ifFalse:[0 "FALSE"]
].
self halt.
^ 0 "FALSE".
"Modified: / 9.2.1998 / 14:56:23 / cg"
!
_Class_isInterface:nativeContext
"return true, if this class is an interface"
|jClass cls|
jClass := nativeContext receiver.
cls := JavaClasses at:jClass.
cls isInterface ifTrue:[^ 1 "TRUE"].
^ 0 "FALSE"
"Created: / 12.1.1998 / 12:37:02 / cg"
!
_Class_isPrimitive:nativeContext
"return true, if this class is builtin primitive class
(i.e. byteArray, array, string etc."
|jClass cls|
jClass := nativeContext receiver.
cls := JavaClasses at:jClass.
^ 0 "FALSE"
"Created: / 9.2.1998 / 14:46:07 / cg"
!
_Class_newInstance:nativeContext
"get an instance for a java.lang.Class"
|jClass cls newInst|
jClass := nativeContext receiver.
cls := JavaClasses at:jClass.
cls classInit.
newInst := cls newCleared.
newInst perform:#'<init>()V'.
^ newInst
"Created: / 2.1.1998 / 22:41:38 / cg"
"Modified: / 15.1.1998 / 00:57:37 / cg"
!
_Double_doubleToLongBits:nativeContext
|f i|
f := nativeContext argAt:1.
UninterpretedBytes isBigEndian ifTrue:[
i := f basicAt:8.
i := i bitOr:((f basicAt:7) bitShift:8).
i := i bitOr:((f basicAt:6) bitShift:16).
i := i bitOr:((f basicAt:5) bitShift:24).
i := i bitOr:((f basicAt:4) bitShift:32).
i := i bitOr:((f basicAt:3) bitShift:40).
i := i bitOr:((f basicAt:2) bitShift:48).
i := i bitOr:((f basicAt:1) bitShift:56).
] ifFalse:[
i := f basicAt:1.
i := i bitOr:((f basicAt:2) bitShift:8).
i := i bitOr:((f basicAt:3) bitShift:16).
i := i bitOr:((f basicAt:4) bitShift:24).
i := i bitOr:((f basicAt:5) bitShift:32).
i := i bitOr:((f basicAt:6) bitShift:40).
i := i bitOr:((f basicAt:7) bitShift:48).
i := i bitOr:((f basicAt:8) bitShift:56).
].
^ i.
"Created: / 4.1.1998 / 01:39:12 / cg"
!
_Double_longBitsToDouble:nativeContext
|i aFloat|
i := nativeContext argAt:1.
aFloat := Float new.
UninterpretedBytes isBigEndian ifTrue:[
aFloat basicAt:1 put:((i bitShift:-56) bitAnd:16rFF).
aFloat basicAt:2 put:((i bitShift:-48) bitAnd:16rFF).
aFloat basicAt:3 put:((i bitShift:-40) bitAnd:16rFF).
aFloat basicAt:4 put:((i bitShift:-32) bitAnd:16rFF).
aFloat basicAt:5 put:((i bitShift:-24) bitAnd:16rFF).
aFloat basicAt:6 put:((i bitShift:-16) bitAnd:16rFF).
aFloat basicAt:7 put:((i bitShift:-8) bitAnd:16rFF).
aFloat basicAt:8 put:(i bitAnd:16rFF).
] ifFalse:[
aFloat basicAt:1 put:(i bitAnd:16rFF).
aFloat basicAt:2 put:((i bitShift:-8) bitAnd:16rFF).
aFloat basicAt:3 put:((i bitShift:-16) bitAnd:16rFF).
aFloat basicAt:4 put:((i bitShift:-24) bitAnd:16rFF).
aFloat basicAt:5 put:((i bitShift:-32) bitAnd:16rFF).
aFloat basicAt:6 put:((i bitShift:-40) bitAnd:16rFF).
aFloat basicAt:7 put:((i bitShift:-48) bitAnd:16rFF).
aFloat basicAt:8 put:((i bitShift:-56) bitAnd:16rFF).
].
^ aFloat.
"Created: / 4.1.1998 / 01:45:00 / cg"
!
_Double_valueOf0:nativeContext
|s d|
s := nativeContext argAt:1.
s notNil ifTrue:[
s := Java as_ST_String:s.
d := Float readFrom:s onError:nil.
].
d isNil ifTrue:[
self throwNumberFormatException.
"/ not reached
].
^ d
"Modified: / 8.8.1997 / 12:03:55 / cg"
"Created: / 7.1.1998 / 11:09:43 / cg"
!
_Float_floatToIntBits:nativeContext
|f i|
f := nativeContext argAt:1.
UninterpretedBytes isBigEndian ifTrue:[
i := f basicAt:4.
i := i bitOr:((f basicAt:3) bitShift:8).
i := i bitOr:((f basicAt:2) bitShift:16).
i := i bitOr:((f basicAt:1) bitShift:24).
] ifFalse:[
i := f basicAt:1.
i := i bitOr:((f basicAt:2) bitShift:8).
i := i bitOr:((f basicAt:3) bitShift:16).
i := i bitOr:((f basicAt:4) bitShift:24).
].
^ i.
"Created: / 4.1.1998 / 01:25:50 / cg"
!
_Float_intBitsToFloat:nativeContet
|i aFloat|
i := nativeContet argAt:1.
aFloat := ShortFloat basicNew.
UninterpretedBytes isBigEndian ifTrue:[
aFloat basicAt:1 put:((i bitShift:-24) bitAnd:16rFF).
aFloat basicAt:2 put:((i bitShift:-16) bitAnd:16rFF).
aFloat basicAt:3 put:((i bitShift:-8) bitAnd:16rFF).
aFloat basicAt:4 put:(i bitAnd:16rFF).
] ifFalse:[
aFloat basicAt:1 put:(i bitAnd:16rFF).
aFloat basicAt:2 put:((i bitShift:-8) bitAnd:16rFF).
aFloat basicAt:3 put:((i bitShift:-16) bitAnd:16rFF).
aFloat basicAt:4 put:((i bitShift:-24) bitAnd:16rFF).
].
^ aFloat.
"Created: / 13.1.1998 / 23:03:36 / cg"
"Modified: / 13.1.1998 / 23:05:01 / cg"
!
_Math_atan:nativeContext
"arc tangens"
|dVal|
dVal := nativeContext argAt:1.
(nativeContext argAt:2) ~~ DUMMY_DOUBLE_HIGHWORD ifTrue:[
self halt:'expected double arg'
].
^ dVal arcTan
"Created: / 6.2.1998 / 01:24:12 / cg"
!
_Math_ceil:nativeContext
"ceiling"
|dVal|
dVal := nativeContext argAt:1.
(nativeContext argAt:2) ~~ DUMMY_DOUBLE_HIGHWORD ifTrue:[
self halt:'expected double arg'
].
^ dVal ceilingAsFloat
"Created: / 7.1.1998 / 15:43:00 / cg"
!
_Math_cos:nativeContext
"cosine"
|dVal|
dVal := nativeContext argAt:1.
(nativeContext argAt:2) ~~ DUMMY_DOUBLE_HIGHWORD ifTrue:[
self halt:'expected double arg'
].
^ dVal cos
"Created: / 7.1.1998 / 15:41:30 / cg"
!
_Math_floor:nativeContext
"floor"
|dVal|
dVal := nativeContext argAt:1.
(nativeContext argAt:2) ~~ DUMMY_DOUBLE_HIGHWORD ifTrue:[
self halt:'expected double arg'
].
^ dVal floorAsFloat
"Created: / 7.1.1998 / 19:09:21 / cg"
!
_Math_log:nativeContext
"logarithm"
|dVal|
dVal := nativeContext argAt:1.
(nativeContext argAt:2) ~~ DUMMY_DOUBLE_HIGHWORD ifTrue:[
self halt:'expected double arg'
].
^ dVal log
"Created: / 7.1.1998 / 15:42:19 / cg"
!
_Math_pow:nativeContext
"power"
|dVal1 dVal2|
dVal1 := nativeContext argAt:1.
(nativeContext argAt:2) ~~ DUMMY_DOUBLE_HIGHWORD ifTrue:[
self halt:'expected double arg'
].
dVal2 := nativeContext argAt:3.
(nativeContext argAt:4) ~~ DUMMY_DOUBLE_HIGHWORD ifTrue:[
self halt:'expected double arg'
].
^ dVal1 raisedTo:dVal2
"Modified: / 15.8.1997 / 05:24:27 / cg"
"Created: / 7.1.1998 / 15:44:13 / cg"
!
_Math_sin:nativeContext
"sine"
|dVal|
dVal := nativeContext argAt:1.
(nativeContext argAt:2) ~~ DUMMY_DOUBLE_HIGHWORD ifTrue:[
self halt:'expected double arg'
].
^ dVal sin
"Created: / 7.1.1998 / 15:41:40 / cg"
!
_Math_sqrt:nativeContext
"square root"
|dVal|
dVal := nativeContext argAt:1.
(nativeContext argAt:2) ~~ DUMMY_DOUBLE_HIGHWORD ifTrue:[
self halt:'expected double arg'
].
^ dVal sqrt
"Created: / 7.1.1998 / 15:42:40 / cg"
!
_Method_invoke:nativeContext
"invoke a javaMethod"
|jMethod mthd rec args retVal|
jMethod := nativeContext receiver.
rec := nativeContext argAt:1.
args := nativeContext argAt:2.
mthd := JavaMethods at:jMethod ifAbsent:nil.
mthd isNil ifTrue:[
self halt.
].
"/ check for arguments to match the expected types ...
mthd argSignature keysAndValuesDo:[:index :argSig |
|cls arg|
cls := Java at:argSig.
arg := args at:index.
(arg isKindOf:cls) ifFalse:[
self halt.
]
].
mthd isStatic ifTrue:[
retVal := mthd valueWithReceiver:(mthd javaClass) arguments:args selector:mthd selector.
^ retVal
] ifFalse:[
self halt.
].
self halt.
"Created: / 13.2.1998 / 15:15:28 / cg"
"Modified: / 13.2.1998 / 15:35:54 / cg"
!
_Object_clone:nativeContext
"clone an object"
|o rslt|
o := nativeContext receiver.
rslt := o shallowCopy.
^ rslt
"Created: / 4.1.1998 / 19:39:26 / cg"
!
_Object_getClass:nativeContext
"return an objects class"
|o cls jClass|
o := nativeContext receiver.
cls := o class.
jClass := self javaClassObjectForClass:cls.
^ jClass
"Created: / 6.1.1998 / 18:28:27 / cg"
"Modified: / 23.1.1998 / 17:48:22 / cg"
!
_Object_hashCode:nativeContext
"identityHash"
|o rslt|
o := nativeContext receiver.
rslt := o identityHash.
^ rslt
"Created: / 4.1.1998 / 19:40:26 / cg"
!
_Object_notify:nativeContext
"wakeup"
self wakeup:(nativeContext receiver).
"Created: / 6.1.1998 / 21:09:26 / cg"
!
_Object_notifyAll:nativeContext
self wakeupAll:(nativeContext receiver).
"Created: / 3.1.1998 / 03:06:56 / cg"
!
_Object_wait:nativeMethodContext
"wait"
|tmo handle sema enteredMonitors|
handle := nativeMethodContext receiver.
tmo := nativeMethodContext argAt:1.
"/ DEBUG BEGIN
(nativeMethodContext argAt:2) == DUMMY_LONG_HIGHWORD ifFalse:[
self halt:'expected long arg'
].
"/ DEBUG END
sema := JavaVM semaphoreFor:handle.
"/ temporarily leave all entered monitors.
enteredMonitors := self enteredMonitors.
enteredMonitors size > 0 ifTrue:[
MonitorTrace ifTrue:[
('====> wait - exit ' , enteredMonitors size printString , ' monitors in ' , Processor activeProcess name , ' ...') infoPrintCR.
].
enteredMonitors do:[:handle |
|mon|
mon := LockTable at:handle ifAbsent:nil.
mon isNil ifTrue:[
self halt:'no monitor in wait'.
] ifFalse:[
MonitorTrace ifTrue:[
('====> wait - exit monitor for ' , handle displayString , ' in ' , Processor activeProcess name , ' ...') infoPrintCR.
].
mon exit.
].
].
].
[
ThreadTrace ifTrue:[
('====> thread ' , Processor activeProcess name , ' waiting ...') infoPrintCR.
].
Processor activeProcess state:#javaWait.
tmo = 0 ifTrue:[
sema wait.
] ifFalse:[
sema waitWithTimeout:tmo / 1000.
].
] valueOnUnwindDo: "valueNowOrOnUnwindDo:" [
JavaVM releaseSemaphoreFor:handle.
].
"/ re-enter monitors.
enteredMonitors size > 0 ifTrue:[
MonitorTrace ifTrue:[
('====> wait - reenter ' , enteredMonitors size printString , ' monitors in ' , Processor activeProcess name , ' ...') infoPrintCR.
].
enteredMonitors do:[:handle |
|mon|
LockTableAccess critical:[
mon := LockTable at:handle ifAbsent:nil.
mon isNil ifTrue:[
LockTable at:handle put:(mon := Monitor new)
]
].
MonitorTrace ifTrue:[
('====> wait - reenter monitor for ' , handle displayString , ' in ' , Processor activeProcess name , ' ...') infoPrintCR.
].
mon enter.
]
].
ThreadTrace ifTrue:[
'====> thread continues ...' printCR.
]
"Modified: / 5.2.1998 / 10:26:48 / cg"
!
_Runtime_buildLibName:nativeContext
|jPath jFileName path fileName libName|
jPath := nativeContext argAt:1.
jFileName := nativeContext argAt:2.
path := Java as_ST_String:jPath.
fileName := Java as_ST_String:jFileName.
path = '__builtIn__' ifTrue:[
libName := path , '/' , fileName
] ifFalse:[
libName := path , '/lib' , fileName , '.so'.
].
^ Java as_String:libName.
"Modified: / 8.8.1997 / 12:05:05 / cg"
"Created: / 4.1.1998 / 19:07:14 / cg"
!
_Runtime_execInternal:nativeContext
"Run a unix-command; return a process object."
|cmdAndArgArray envArray cmd jProcessClass jProcess|
"/ cmdAndArgArray := nativeContext argAt:1.
"/ envArray := nativeContext argAt:2.
"/
"/ cmd := cmdAndArgArray at:1.
"/
"/ jProcessClass := Java classForName:'java.lang.UNIXProcess'.
"/ jProcessClass notNil ifTrue:[
"/ jProcess := jProcessClass newCleared.
"/ jProcess
"/ perform:#'<init>([Ljava/lang/String;[Ljava/lang/String;)V'
"/ with:cmdAndArgArray
"/ with:envArray.
"/ ^ jProcess
"/ ].
self throwIOExceptionWithMessage:'Process execution disabled/unimplemented'.
^ nil
"Created: / 15.1.1998 / 01:50:31 / cg"
"Modified: / 15.1.1998 / 02:09:29 / cg"
!
_Runtime_exitInternal:nativeContext
"exit - here, we only shut down java threads"
|enteredMonitors|
(enteredMonitors := self enteredMonitors) size > 0 ifTrue:[
enteredMonitors do:[:handle |
| mon |
mon := LockTable at:handle ifAbsent:nil.
mon isNil ifTrue:[
self halt:'no monitor in exitInternal'.
] ifFalse:[
mon exit.
('====> terminateThread - exit monitor for ' , handle displayString , ' in ' , Processor activeProcess name , ' ...') infoPrintCR.
"/ LockTableAccess critical:[
"/ mon isFree ifTrue:[
"/ LockTable removeKey:handle
"/ ]
"/ ]
].
].
].
"/ JavaVM releaseAllJavaResources.
AbortSignal raise.
self halt.
"Created: / 7.1.1998 / 22:48:51 / cg"
"Modified: / 3.2.1998 / 16:13:39 / cg"
!
_Runtime_freeMemory:nativeContext
"free memory - Returns the number of free bytes"
^ ObjectMemory freeListSpace + ObjectMemory freeSpace
"Created: / 12.1.1998 / 12:59:53 / cg"
!
_Runtime_gc:nativeContext
"Runs the garbage collector.
Ignored, since the ST-gc runs all the time."
^ self
"Modified: / 12.1.1998 / 12:58:32 / cg"
!
_Runtime_initializeLinkerInternal:nativeContext
"init sharedLib linker, return searchPath as javaString"
|path|
"/ mhmh - what is done here ?
path := ''.
LibPath do:[:comp | path size == 0 ifTrue:[
path := path , comp
] ifFalse:[
path := path , ':' , comp
]
].
^ Java as_String:path
"Modified: / 7.8.1997 / 21:17:03 / cg"
"Created: / 4.1.1998 / 17:53:15 / cg"
!
_Runtime_loadFileInternal:nativeContext
"load a sharedLib, return boolean 0 (false) if fail; 1 (true) if ok"
|ret|
ret := self _Runtime_loadFileInternalI:nativeContext.
ret < 0 ifTrue:[ ret := 0 ].
^ ret
"Created: / 4.1.1998 / 19:10:20 / cg"
"Modified: / 4.1.1998 / 19:11:04 / cg"
!
_Runtime_loadFileInternalI:nativeContext
"1.1b3 change; load a sharedLib like 'loadFileInternal',
but return integer:
-1 outOfMemory error
0 failed to load
1 loaded or already loaded (i.e. ok)"
|jLibName libName libHandle|
jLibName := nativeContext argAt:1.
libName := Java as_ST_String:jLibName.
(SimulatedLibs includes:libName) ifTrue:[
"/ ('JAVA: builtIn libLoad simulated: ' , libName) printNL.
^ 1
].
(LoadedLibs notNil and:[LoadedLibs includesKey:libName]) ifTrue:[
"/ ('JAVA: already loaded: ' , libName) printNL.
^ 1
].
libName asFilename exists ifFalse:[
('JAVA: no file to load: ' , libName) printNL.
^ 0
].
(self confirm:'permission to load native library: ' , libName , ' ?') ifFalse:[
^ 0
].
libHandle := ObjectFileLoader loadLibrary:libName.
libHandle isNil ifTrue:[
('JAVA: failed to load: ' , libName) printNL.
^ 0
].
LoadedLibs isNil ifTrue:[
LoadedLibs := Dictionary new.
].
LoadedLibs at:libName put:libHandle.
^ 1
"Created: / 4.1.1998 / 19:10:54 / cg"
"Modified: / 6.2.1998 / 03:11:59 / cg"
!
_Runtime_totalMemory:nativeContext
"free memory - Returns the total number of bytes"
^ ObjectMemory oldSpaceSize + ObjectMemory newSpaceSize
"Created: / 12.1.1998 / 12:59:23 / cg"
!
_SecurityManager_classLoaderDepth:nativeContext
|con depth|
con := thisContext sender.
depth := 1.
[con notNil] whileTrue:[
con receiver == JavaClassReader classLoaderQuerySignal ifTrue:[
con selector == #handle:do: ifTrue:[
depth := depth + 1
]
].
con := con sender.
].
'JAVA: classLoaderDepth -> ' infoPrint. depth infoPrintCR.
^ depth.
"Created: / 13.1.1998 / 09:21:46 / cg"
"Modified: / 13.1.1998 / 09:33:43 / cg"
!
_SecurityManager_currentClassLoader:nativeContext
|loader|
loader := JavaClassReader classLoaderQuerySignal raise.
'JAVA: currentClassLoader -> ' infoPrint. loader displayString infoPrintCR.
^ loader.
"Created: / 13.1.1998 / 09:23:28 / cg"
!
_System_arraycopy:nativeContext
|srcArray srcIdx dstArray dstIdx count|
srcArray := nativeContext argAt:1.
srcIdx := nativeContext argAt:2.
dstArray := nativeContext argAt:3.
dstIdx := nativeContext argAt:4.
count := nativeContext argAt:5.
srcArray class isBytes ifTrue:[
dstArray class isBytes ifFalse:[
self halt:'incompatible arraycopy collections'.
].
dstArray replaceBytesFrom:(dstIdx+1) to:(dstIdx+count) with:srcArray startingAt:(srcIdx+1).
] ifFalse:[
dstArray replaceFrom:(dstIdx+1) to:(dstIdx+count) with:srcArray startingAt:(srcIdx+1).
].
^ nil.
"Created: / 3.1.1998 / 01:56:44 / cg"
"Modified: / 3.1.1998 / 02:01:37 / cg"
!
_System_currentTimeMillis:nativeContext
"return the milliseconds since 1.jan.1970"
|seconds|
^ AbsoluteTime now millisecondDeltaFrom:(AbsoluteTime day:1 month:1 year:1970 hour:1 minutes:0 seconds:0).
"/ seconds := AbsoluteTime now - (AbsoluteTime day:1 month:1 year:1970 hour:1 minutes:0 seconds:0).
"/ ^ seconds * 1000
"Created: / 3.1.1998 / 03:25:50 / cg"
"Modified: / 10.1.1998 / 01:32:24 / cg"
!
_System_initProperties:nativeContext
|props stProps|
props := nativeContext argAt:1.
stProps := self systemProperties.
"/ recursively invoke myself on the Java HashTable.
"/ calling 'put' to stuff in the values ...
stProps keysAndValuesDo:[:key :value |
|keyObj valueObj|
keyObj := Java as_String:key.
valueObj := Java as_String:value.
props
perform:#'put(Ljava/lang/Object;Ljava/lang/Object;)Ljava/lang/Object;'
with:keyObj
with:valueObj.
].
^ props
"Created: / 3.1.1998 / 14:25:22 / cg"
"Modified: / 4.1.1998 / 14:23:18 / cg"
!
_System_setErr0:nativeContext
|stream|
stream := nativeContext argAt:1.
self setOpenFile:(self javaConsoleStream ? Stderr) at:2.
nativeContext receiver instVarNamed:'err' put:stream.
"Created: / 18.3.1997 / 15:02:05 / cg"
"Modified: / 4.1.1998 / 16:21:15 / cg"
!
_System_setIn0:nativeContext
|stream|
stream := nativeContext argAt:1.
self setOpenFile:Stdin at:0.
nativeContext receiver instVarNamed:'in' put:stream.
"Created: / 4.1.1998 / 16:16:38 / cg"
"Modified: / 4.1.1998 / 16:20:44 / cg"
!
_System_setOut0:nativeContext
|stream|
stream := nativeContext argAt:1.
self setOpenFile:(self javaConsoleStream ? Stdout) at:1.
nativeContext receiver instVarNamed:'out' put:stream.
"Created: / 4.1.1998 / 16:18:26 / cg"
"Modified: / 4.1.1998 / 16:20:23 / cg"
!
_Thread_currentThread:nativeMethodContext
|t p prio|
p := Processor activeProcess.
t := self javaThreadForSTProcess:p.
t notNil ifTrue:[
^ t
].
t := self newThread:'main'.
Java threads at:t put:p.
^ t
"Created: / 3.1.1998 / 01:42:28 / cg"
"Modified: / 4.1.1998 / 14:59:13 / cg"
!
_Thread_isAlive:nativeContext
"is it alive ?"
|jThread stProcess|
jThread := nativeContext receiver.
stProcess := JavaVM stProcessForJavaThread:jThread.
stProcess isNil ifTrue:[
ThreadTrace == true ifTrue:[
('JAVA: no stProcess for javaThread: ' , jThread displayString) printNL.
].
^ 0 "FALSE"
].
stProcess isDead ifTrue:[^ 0 "FALSE"].
^ 1 "TRUE"
"Created: / 5.1.1998 / 02:03:51 / cg"
"Modified: / 6.2.1998 / 02:15:01 / cg"
!
_Thread_isInterrupted:nativeContext
"ask if a thread is interrupted (clear interruptState if arg is true)"
|jThread stProcess clearInterrupt rslt|
jThread := nativeContext receiver.
stProcess := self stProcessForJavaThread:jThread.
stProcess isNil ifTrue:[
self halt.
^ 0
].
clearInterrupt := nativeContext argAt:1.
rslt := stProcess isInterrupted ifTrue:[1] ifFalse:[0].
clearInterrupt ~~ 0 ifTrue:[stProcess clearInterruptActions].
^ rslt
"Modified: / 2.1.1998 / 21:49:06 / cg"
"Created: / 7.1.1998 / 18:50:26 / cg"
!
_Thread_resume0:nativeContext
"yield"
|jThread stProcess|
jThread := nativeContext receiver.
stProcess := JavaVM stProcessForJavaThread:jThread.
stProcess isNil ifTrue:[
ThreadTrace == true ifTrue:[
('JAVA: no stProcess for javaThread: ' , jThread displayString) printNL.
].
^ nil "void"
].
stProcess resume
"Created: / 8.1.1998 / 01:06:27 / cg"
"Modified: / 6.2.1998 / 02:15:08 / cg"
!
_Thread_setPriority0:nativeMethodContext
|t p prio|
t := nativeMethodContext receiver.
p := JavaVM stProcessForJavaThread:t.
prio := nativeMethodContext argAt:1.
p isNil ifTrue:[
ThreadTrace == true ifTrue:[
'JAVA [info]: no process yet (in setPriority)' infoPrintCR.
].
^ nil
].
ThreadTrace ifTrue:[
'JAVA [info]: setPrio: ' print. t print. ' pri= ' print. prio print. ' p= ' print. p printNL.
].
^ nil
"Created: / 2.1.1998 / 19:05:55 / cg"
"Modified: / 6.2.1998 / 02:28:18 / cg"
!
_Thread_sleep:nativeContext
"sleep for some milliseconds "
|millis|
(nativeContext argAt:2) ~~ DUMMY_LONG_HIGHWORD ifTrue:[
self internalError:'expected long arg'.
] ifFalse:[
millis := nativeContext argAt:1.
Delay waitForMilliseconds:(millis max:50)
].
"Created: / 7.1.1998 / 15:34:23 / cg"
"Modified: / 13.1.1998 / 13:48:25 / cg"
!
_Thread_start:nativeContext
"start the thread"
|jThread jName name stProcess|
jThread := nativeContext receiver.
(jThread instVarNamed:'priority') < 1 ifTrue:[
self halt.
jThread instVarNamed:'priority' put:1.
].
stProcess := JavaProcess
for:[
[
JavaVM javaExceptionSignal handle:[:ex |
|procName exClass|
procName := stProcess name.
exClass := ex parameter class.
exClass == (Java at:'java.lang.ThreadDeath') ifTrue:[
('JAVA: thread ' , procName , ' terminated') infoPrintCR.
] ifFalse:[
Transcript
showCR:('JAVA: thread '''
, procName
, ''' terminated with exception: '
, exClass name).
].
ex return.
] do:[
jThread perform:#'run()V'.
ThreadTrace == true ifTrue:[
('JAVA: thread ' , stProcess name , ' terminated') infoPrintCR.
].
jThread perform:#'exit()V'.
ThreadTrace == true ifTrue:[
('JAVA: after exit of thread ' , stProcess name) infoPrintCR.
]
]
] valueNowOrOnUnwindDo:[
Java threads removeKey:jThread ifAbsent:[].
]
]
priority:(Processor activePriority).
jName := jThread instVarNamed:'name'.
jName isString ifFalse:[
name := Java as_ST_String:jName.
] ifTrue:[
name := jName
].
"/ kludge - remember the ScreenUpdater ...
name = 'Screen Updater' ifTrue:[
ScreenUpdaterProcess := stProcess.
].
"/ when that process terminates, wakup any waiters
stProcess addExitAction:[self wakeup:jThread].
stProcess name:'JAVA-' , name.
stProcess resume.
Java threads at:jThread put:stProcess.
^ nil
"Created: / 3.1.1998 / 02:05:52 / cg"
"Modified: / 6.2.1998 / 00:55:26 / cg"
!
_Thread_stop0:nativeContext
"terminate a thread"
|jThread stProcess death|
jThread := nativeContext receiver.
stProcess := JavaVM stProcessForJavaThread:jThread.
stProcess isNil ifTrue:[
ThreadTrace == true ifTrue:[
('JAVA: no stProcess for javaThread: ' , jThread displayString) printNL.
].
^ nil "void"
].
death := nativeContext argAt:1.
stProcess
interruptWith:[
JavaVM javaExceptionSignal handle:[:ex |
Processor activeProcess terminate
] do:[
ThreadTrace == true ifTrue:[
('JAVA: thread exit: ' , jThread displayString) infoPrintNL.
].
jThread perform:#'exit()V'.
self throwException:death.
]
].
stProcess resume.
[stProcess isDead] whileFalse:[
stProcess resume.
Delay waitForSeconds:0.1
].
stProcess terminate
"Created: / 8.1.1998 / 13:11:17 / cg"
"Modified: / 6.2.1998 / 02:18:15 / cg"
!
_Thread_suspend0:nativeContext
"yield"
|jThread stProcess|
jThread := nativeContext receiver.
stProcess := JavaVM stProcessForJavaThread:jThread.
stProcess isNil ifTrue:[
ThreadTrace == true ifTrue:[
('JAVA: no stProcess for javaThread: ' , jThread displayString) printNL.
].
^ nil "void"
].
stProcess suspend
"Created: / 8.1.1998 / 01:05:49 / cg"
"Modified: / 6.2.1998 / 02:15:23 / cg"
!
_Thread_yield:nativeContext
"yield"
|jThread stProcess|
jThread := nativeContext receiver.
stProcess := JavaVM stProcessForJavaThread:jThread.
stProcess isNil ifTrue:[
ThreadTrace == true ifTrue:[
('JAVA: no stProcess for javaThread: ' , jThread displayString) printNL.
].
^ nil "void"
].
stProcess == Processor activeProcess ifTrue:[
Processor yield.
] ifFalse:[
self halt.
].
"Created: / 5.1.1998 / 02:03:51 / cg"
"Modified: / 6.2.1998 / 02:15:29 / cg"
!
_Throwable_fillInStackTrace:nativeContext
|exClass exceptionObject list con|
exClass := Java classNamed:'java.lang.Throwable'.
exceptionObject := nativeContext receiver.
"/
"/ debugging only
"/
(exceptionObject isKindOf:(Java classNamed:'java.lang.Throwable')) ifFalse:[
self halt
].
con := thisContext sender.
"/
"/ we are not interrested in all intermediate Exception frames ...
"/
FullExceptionTrace ifFalse:[
"/ first, skip any JavaVM contexts
[con receiver == exceptionObject] whileFalse:[
con := con sender
].
"/ then, all exception-init contexts
[con receiver == exceptionObject] whileTrue:[
con := con sender
].
].
list := OrderedCollection new.
[con notNil] whileTrue:[
(con isKindOf:JavaContext) ifTrue:[
"/ add a copy, in case the context continues with some
"/ cleanup ...
list add:con shallowCopy
].
con := con sender
].
exceptionObject instVarNamed:'backtrace' put:(list asArray).
^ nil.
"Created: / 4.1.1998 / 14:27:40 / cg"
"Modified: / 14.1.1998 / 23:57:51 / cg"
!
_Throwable_printStackTrace0:nativeContext
|out outStream exceptionObject contextList|
outStream := nativeContext argAt:1.
exceptionObject := nativeContext receiver.
contextList := exceptionObject instVarNamed:'backtrace'.
out := self javaConsoleStream.
out cr.
out nextPutLine:'JAVA: stackTrace:'.
contextList do:[:con |
out
nextPutAll:' ';
nextPutAll:(con method javaClass fullName);
nextPutAll:'.';
nextPutAll:(con method selector);
nextPutAll:' [';
nextPutAll:(con method javaClass sourceFile);
nextPutAll:' ';
nextPutAll:(con lineNumber displayString);
nextPutAll:']'.
out cr
].
out nextPutLine:'----------------------------------------------------'
"Created: / 4.1.1998 / 14:27:40 / cg"
"Modified: / 15.1.1998 / 00:14:40 / cg"
! !
!JavaVM class methodsFor:'native - java.lang - jdk1.2'!
_AccessController_beginPrivileged:nativeContext
"/ introduced with jdk1.2
"Created: / 27.1.1998 / 18:18:11 / cg"
!
_AccessController_endPrivileged:nativeContext
"/ introduced with jdk1.2
"Created: / 27.1.1998 / 18:18:32 / cg"
!
_AccessController_getStackAccessControlContext:nativeContext
"/ introduced with jdk1.2
"/ supposed to do more here ...
^ nil
"Created: / 27.1.1998 / 18:22:15 / cg"
!
_ClassLoader$NativeLibrary_load:nativeContext
"/ introduced with jdk1.2 ... (sigh)
|nativeLoader jLibName libName libHandle index|
nativeLoader := nativeContext receiver.
jLibName := nativeContext argAt:1.
libName := Java as_ST_String:jLibName.
(index := SimulatedNativeLibs indexOf:libName) ~~ 0 ifTrue:[
"/ ('JAVA: builtIn nativeLibLoad simulated: ' , libName) printNL.
nativeLoader instVarNamed:'handle' put:index.
^ self "/ void
].
(LoadedNativeLibs notNil
and:[LoadedNativeLibs includesKey:libName]) ifTrue:[
"/ ('JAVA: native library already loaded: ' , libName) printNL.
nativeLoader instVarNamed:'handle' put:(LoadedNativeLibs at:libName).
^ self "/ void
].
(self confirm:'permission to load native library: ' , libName , ' ?') ifFalse:[
^ self
].
self halt.
libName asFilename exists ifFalse:[
('JAVA: no file to load nativeLib: ' , libName) printNL.
^ self "/ void
].
libHandle := ObjectFileLoader loadLibrary:libName.
libHandle isNil ifTrue:[
('JAVA: failed to load nativeLib: ' , libName) printNL.
^ self "/ void
].
LoadedNativeLibs isNil ifTrue:[
LoadedNativeLibs := Dictionary new.
].
LoadedNativeLibs at:libName put:libHandle.
nativeLoader instVarNamed:'handle' put:(LoadedNativeLibs at:libName).
^ self "/ void
"Created: / 27.1.1998 / 18:38:37 / cg"
"Modified: / 6.2.1998 / 03:12:17 / cg"
!
_ClassLoader_initIDs:nativeContext
"/ introduced with jdk1.2 ... (sigh)
"Created: / 27.1.1998 / 18:37:08 / cg"
!
_Component_initIDs:nativeContext
"/ introduced with jdk1.2 ... (sigh)
"Created: / 27.1.1998 / 19:53:29 / cg"
!
_System_getCallerClass:nativeContext
"/ introduced with jdk1.2
|senderContext cls|
senderContext := nativeContext sender.
[senderContext receiver == (Java at:'java.lang.System')] whileTrue:[
senderContext := senderContext sender.
].
senderContext method isStatic ifTrue:[
cls := senderContext receiver
] ifFalse:[
cls := senderContext receiver class
].
cls isJavaClass ifTrue:[
^ self javaClassObjectForClass:cls
].
(cls isMemberOf:(Java at:'java.lang.Class')) ifTrue:[
^ Java at:'java.lang.Class'
].
self halt.
^ nil
"Modified: / 27.1.1998 / 18:33:13 / cg"
!
_Toolkit_initIDs:nativeContext
"/ introduced with jdk1.2 ... (sigh)
"Created: / 27.1.1998 / 19:53:50 / cg"
! !
!JavaVM class methodsFor:'native - java.math'!
_BigInteger_plumbInit:nativeContext
"/ self unimplementedNativeMethod.
"Created: / 12.1.1998 / 12:55:53 / cg"
! !
!JavaVM class methodsFor:'native - java.net'!
_InetAddressImpl_getInetFamily:nativeContext
"/ self unimplementedNativeMethod.
^ 0
"Modified: / 15.8.1997 / 17:04:43 / cg"
"Created: / 5.1.1998 / 02:05:48 / cg"
!
_InetAddressImpl_getLocalHostName:nativeContext
""
|hostName|
hostName := OperatingSystem getHostName.
^ (Java as_String:hostName).
"Modified: / 7.8.1997 / 21:16:55 / cg"
"Created: / 5.1.1998 / 02:07:03 / cg"
!
_InetAddressImpl_lookupAllHostAddr:nativeContext
""
|jAddrImpl jHostName hostName addrBytes|
jAddrImpl := nativeContext receiver.
jHostName := nativeContext argAt:1.
hostName := Java as_ST_String:jHostName.
addrBytes := Socket ipAddressOfHost:hostName.
addrBytes isNil ifTrue:[
addrBytes := #[0 0 0 0] copy
].
^ Array with:addrBytes
"Modified: / 8.8.1997 / 12:04:25 / cg"
"Created: / 7.1.1998 / 18:51:31 / cg"
!
_InetAddressImpl_makeAnyLocalAddress:nativeContext
""
|jAddrImpl jAddr hostName addrBytes address|
jAddrImpl := nativeContext receiver.
jAddr := nativeContext argAt:1.
hostName := OperatingSystem getHostName.
addrBytes := Socket ipAddressOfHost:hostName.
"/ MSB first into an integer.
address := (addrBytes at:1).
address := (address bitShift:8) bitOr:(addrBytes at:2).
address := (address bitShift:8) bitOr:(addrBytes at:3).
address := (address bitShift:8) bitOr:(addrBytes at:4).
jAddr instVarNamed:'hostName' put:(Java as_String:hostName).
jAddr instVarNamed:'address' put:address.
jAddr instVarNamed:'family' put:0.
^ nil
"Modified: / 7.8.1997 / 21:16:57 / cg"
"Created: / 5.1.1998 / 02:06:27 / cg"
!
_PlainSocketImpl_initProto:nativeContext
"Created: / 12.1.1998 / 12:56:52 / cg"
!
_PlainSocketImpl_socketAccept:nativeContext
|jsock fd newJSock sock newSock fileNo|
jsock := nativeContext receiver.
sock := self validateFile:jsock.
sock isNil ifTrue:[
self
throwExceptionClassName:'java.io.IOException'
withMessage:'nil socket in accept'.
^ self.
].
newJSock := nativeContext argAt:1.
fd := newJSock instVarNamed:'fd'.
(fd instVarNamed:'fd') ~~ 0 ifTrue:[
self halt:'file already open'.
self internalError:'file already open'.
self
throwExceptionClassName:'java.io.IOException'
withMessage:'socket already open in socketAccept'.
^ self.
].
FileIOTrace ifTrue:[
'JAVA: socket accept' infoPrintCR
].
newSock := sock accept.
newSock isNil ifTrue:[
self
throwExceptionClassName:'java.io.IOException'
withMessage:'accept failed'.
].
fileNo := self addOpenFile:newSock.
fd instVarNamed:'fd' put:fileNo.
"Created: / 4.2.1998 / 15:26:49 / cg"
"Modified: / 4.2.1998 / 15:45:20 / cg"
!
_PlainSocketImpl_socketAvailable:nativeContext
|jSock sock n|
jSock := nativeContext receiver.
sock := self validateFile:jSock.
sock isNil ifTrue:[
self
throwExceptionClassName:'java.io.IOException'
withMessage:'socketAvailable on closed socket'.
^ self.
].
n := sock numAvailable.
^ n
"Created: / 4.2.1998 / 16:58:49 / cg"
!
_PlainSocketImpl_socketBind:nativeContext
|jsock jaddr port sock hostName ok err|
jsock := nativeContext receiver.
jaddr := nativeContext argAt:1.
port := nativeContext argAt:2.
hostName := jaddr instVarNamed:'hostName'.
hostName isNil ifTrue:[
self halt.
] ifFalse:[
hostName := Java as_ST_String:hostName
].
sock := self validateFile:jsock.
sock notNil ifTrue:[
FileIOTrace ifTrue:[
('JAVA: socket bind to ' , hostName printString, ' port ' , port printString) infoPrintCR
].
ok := sock bindTo:port address:nil "hostName".
ok ifFalse:[
err := OperatingSystem lastErrorString.
Transcript showCR:'sock err: ' , err printString.
self
throwExceptionClassName:'java.io.IOException'
withMessage:'bind failed'.
]
].
"Created: / 4.2.1998 / 15:06:20 / cg"
"Modified: / 4.2.1998 / 15:34:08 / cg"
!
_PlainSocketImpl_socketClose:nativeContext
|jsock sock|
jsock := nativeContext receiver.
sock := self validateFile:jsock.
sock notNil ifTrue:[
FileIOTrace ifTrue:[
'JAVA: close socket' infoPrintCR
].
sock close.
].
"Modified: / 21.8.1997 / 17:09:40 / cg"
"Created: / 25.1.1998 / 20:04:24 / cg"
!
_PlainSocketImpl_socketConnect:nativeContext
|jsock jaddr port sock addr hostName ok|
jsock := nativeContext receiver.
jaddr := nativeContext argAt:1.
port := nativeContext argAt:2.
hostName := jaddr instVarNamed:'hostName'.
hostName notNil ifTrue:[
hostName := Java as_ST_String:hostName
] ifFalse:[
addr := jaddr instVarNamed:'address'.
addr notNil ifTrue:[
hostName := ByteArray new:4.
hostName at:4 put:(addr bitAnd:16rFF).
addr := addr bitShift:-8.
hostName at:3 put:(addr bitAnd:16rFF).
addr := addr bitShift:-8.
hostName at:2 put:(addr bitAnd:16rFF).
addr := addr bitShift:-8.
hostName at:1 put:(addr bitAnd:16rFF).
].
].
hostName isNil ifTrue:[
self halt.
].
sock := self validateFile:jsock.
sock notNil ifTrue:[
FileIOTrace ifTrue:[
('JAVA: socket connect to ' , hostName printString , ' port ' , port printString) infoPrintCR
].
(self confirm:'connect to host: ' , hostName printString , ' - ok ?')
ifFalse:[
self
throwExceptionClassName:'java.io.IOException'
withMessage:'connect permission denied'.
].
ok := sock connectTo:hostName port:port.
ok ifFalse:[
self
throwExceptionClassName:'java.io.IOException'
withMessage:'connect failed'.
]
].
"Created: / 25.1.1998 / 20:02:27 / cg"
"Modified: / 25.1.1998 / 20:57:59 / cg"
!
_PlainSocketImpl_socketCreate:nativeContext
|jsock isStream fd sock fileNo|
jsock := nativeContext receiver.
isStream := (nativeContext argAt:1) == 1.
fd := jsock instVarNamed:'fd'.
(fd instVarNamed:'fd') ~~ 0 ifTrue:[
self halt:'file already open'.
self internalError:'file already open'.
self
throwExceptionClassName:'java.io.IOException'
withMessage:'file already open in socketCreate'.
^ self.
].
FileOpenTrace ifTrue:[
('JAVA: create socket') infoPrintCR.
].
isStream ifTrue:[
sock := Socket newTCP
] ifFalse:[
sock := Socket newUDP
].
sock isNil ifTrue:[
self
throwExceptionClassName:'java.io.IOException'
withMessage:'socketCreate failed'.
].
fileNo := self addOpenFile:sock.
fd instVarNamed:'fd' put:fileNo.
"Created: / 25.1.1998 / 19:59:25 / cg"
"Modified: / 25.1.1998 / 19:59:45 / cg"
!
_PlainSocketImpl_socketListen:nativeContext
|jSock time sock ok|
jSock := nativeContext receiver.
time := nativeContext argAt:1.
sock := self validateFile:jSock.
sock notNil ifTrue:[
FileIOTrace ifTrue:[
('JAVA: socket listen with timeout ' , time printString) infoPrintCR.
].
ok := sock listenWithBacklog:5.
ok ifFalse:[
self
throwExceptionClassName:'java.io.IOException'
withMessage:'listen failed'.
^ self.
].
time ~~ 0 ifTrue:[
sock readWaitWithTimeoutMs:time
]
].
"Created: / 4.2.1998 / 15:17:48 / cg"
"Modified: / 4.2.1998 / 15:18:26 / cg"
!
_SocketInputStream_socketRead:nativeContext
^ self anyStream_readBytes:nativeContext
"Created: / 25.1.1998 / 20:56:53 / cg"
"Modified: / 4.2.1998 / 15:52:31 / cg"
!
_SocketOutputStream_socketWrite:nativeContext
^ self anyStream_writeBytes:nativeContext
"Created: / 25.1.1998 / 21:06:55 / cg"
"Modified: / 4.2.1998 / 15:52:40 / cg"
! !
!JavaVM class methodsFor:'native - java.utils'!
_ResourceBundle_getClassContext:nativeContext
"returns an array filled with the contextChain receivers classes.
What an ugly, messy interface."
|chain con cls jClass|
chain := OrderedCollection new.
con := thisContext sender.
[con notNil] whileTrue:[
(con isMemberOf:JavaContext) ifTrue:[
cls := con receiver class.
cls isMeta ifTrue:[
"/ t'was a static method
cls := cls soleInstance
].
jClass := JavaClasses at:cls ifAbsent:nil.
jClass isNil ifTrue:[
JavaClasses at:cls put:(jClass := (Java at:'java.lang.Class') new).
JavaClasses at:jClass put:cls.
].
chain add:jClass.
].
con := con sender.
].
^ chain asArray
"Created: / 5.1.1998 / 02:47:00 / cg"
"Modified: / 5.1.1998 / 02:49:47 / cg"
! !
!JavaVM class methodsFor:'native - java.utils.zip'!
_Inflater_init:nativeContext
"Created: / 1.2.1998 / 20:14:01 / cg"
!
_Inflater_reset:nativeContext
"Created: / 1.2.1998 / 20:14:13 / cg"
! !
!JavaVM class methodsFor:'native - netscape'!
_MozillaAppletContext_pMochaOnLoad:nativeContext
|id|
id := nativeContext argAt:1.
"/ 'JAVA: MozillaAppletContext_pMochaOnLoad: ' print. id printNL.
^ nil
"Created: / 6.1.1998 / 20:37:13 / cg"
"Modified: / 6.2.1998 / 02:13:09 / cg"
!
_MozillaAppletContext_pShowStatus:nativeContext
|s js|
js := nativeContext argAt:1.
s := Java as_ST_String:js.
self activityNotification:s.
"/ Transcript showCR:s.
^ nil
"Created: / 6.1.1998 / 18:31:34 / cg"
"Modified: / 8.1.1998 / 17:06:13 / cg"
!
_URLStreamHandlerFactory_pInit:nativeContext
"/ self unimplementedNativeMethod.
"Created: / 10.1.1998 / 15:47:24 / cg"
! !
!JavaVM class methodsFor:'native - sun.audio'!
_AudioDevice_audioClose:nativeContext
|device fd stream|
device := nativeContext receiver.
device notNil ifTrue:[
fd := device instVarNamed:'dev'.
(fd notNil and:[fd > 0]) ifTrue:[
stream := self getOpenFileAt:fd.
stream notNil ifTrue:[
stream close.
device instVarNamed:'dev' put:0.
]
]
]
"Created: / 10.1.1998 / 15:45:16 / cg"
"Modified: / 13.1.1998 / 18:08:20 / cg"
!
_AudioDevice_audioOpen:nativeContext
|f stream fileNo|
NoAudio ifTrue:[
^ -1
].
f := '/dev/audio' asFilename.
"/ stream := f readWriteStream.
Stream streamErrorSignal handle:[:ex |
Stream streamErrorSignal handle:[:ex |
stream := nil.
ex return.
] do:[
stream := SoundStream writing.
].
] do:[
stream := SoundStream writing.
].
stream isNil ifTrue:[
f exists ifTrue:[
^ 0
].
^ -1
].
stream setSampleRate:8000.
fileNo := self addOpenFile:stream.
FileOpenTrace ifTrue:[
('JAVA: opened audioDevice as FD ' , fileNo printString) infoPrintCR.
].
^ fileNo
"Created: / 10.1.1998 / 15:45:30 / cg"
"Modified: / 14.1.1998 / 14:57:16 / cg"
!
_AudioDevice_audioWrite:nativeContext
|device fd stream bytes count|
device := nativeContext receiver.
device notNil ifTrue:[
fd := device instVarNamed:'dev'.
(fd notNil and:[fd > 0]) ifTrue:[
stream := self getOpenFileAt:fd.
stream notNil ifTrue:[
bytes := nativeContext argAt:1.
count := nativeContext argAt:2.
stream nextPutBytes:count from:bytes startingAt:1
]
]
]
"Created: / 10.1.1998 / 15:45:16 / cg"
"Modified: / 13.1.1998 / 18:07:20 / cg"
! !
!JavaVM class methodsFor:'native - sun.awt'!
_GifImageDecoder_parseImage:nativeContext
|decoder width height bool1 depth subHdrBytes dstBytes i1 i2 colorModel
stream byte compressedData compressedSize index count data
leftOffs topOffs codeLen flags pixelStore clrModel t buffSize
countGot countGot2|
decoder := nativeContext receiver.
i1 := nativeContext argAt:1.
i2 := nativeContext argAt:2.
width := nativeContext argAt:3.
height := nativeContext argAt:4.
bool1 := nativeContext argAt:5.
depth := nativeContext argAt:6.
subHdrBytes := nativeContext argAt:7.
dstBytes := nativeContext argAt:8.
colorModel := nativeContext argAt:9.
leftOffs := subHdrBytes wordAt:1 MSB:false.
topOffs := subHdrBytes wordAt:3 MSB:false.
width := subHdrBytes wordAt:5 MSB:false.
height := subHdrBytes wordAt:7 MSB:false.
flags := subHdrBytes at:9.
codeLen := subHdrBytes at:10.
stream := decoder instVarNamed:'input'.
pixelStore := decoder instVarNamed:'store'.
buffSize := (width * height // 2) max:4096.
compressedData := ByteArray uninitializedNew:buffSize.
"get compressed data"
index := 1.
count := stream perform:#'read()I'.
[count notNil and:[count > 0]] whileTrue:[
(index + count) > buffSize ifTrue:[
t := ByteArray uninitializedNew:(buffSize * 2).
t replaceFrom:1 to:buffSize with:compressedData startingAt:1.
compressedData := t.
buffSize := buffSize * 2.
].
[count ~~ 0] whileTrue:[
countGot := stream
perform:#'read([BII)I'
with:compressedData
with:index-1
with:count.
countGot > 0 ifTrue:[
count := count - countGot.
index := index + countGot.
] ifFalse:[
count := -1.
]
].
count >= 0 ifTrue:[
count := stream perform:#read.
]
].
compressedSize := index - 1.
data := pixelStore perform:#'allocateLines(I)Ljava/lang/Object;' with:height.
(data isMemberOf:ByteArray) ifFalse:[
self halt.
^ 0.
].
"/ 'GIFReader: decompressing ...' infoPrintCR.
GIFReader
decompressGIFFrom:compressedData
count:compressedSize
into:data
startingAt:1
codeLen:(codeLen + 1).
clrModel := pixelStore instVarNamed:'colormodel'.
pixelStore
perform:#'setPixels(IIII[BII)Z'
withArguments:
(Array
with:0 "/ x
with:0 "/ y
with:width "/ w
with:height "/ h
with:data
with:0 "/ offs
with:width). "/ scanSize
pixelStore perform:#'imageComplete()V'.
"/ perform:#'imageComplete(I)V'
"/ with:((Java at:'java.awt.image.ImageConsumer') instVarNamed:'STATICIMAGEDONE').
"/ self internalError:'breakPoint'.
^ 1 "/ true
"Modified: / 1.2.1998 / 20:54:00 / cg"
!
_ImageRepresentation_disposeImage:nativeContext
|imgRep img|
imgRep := nativeContext receiver.
img := imgRep instVarNamed:'pData'.
(img notNil and:[img ~~ 0]) ifTrue:[
ImageStretchCache notNil ifTrue:[
ImageStretchCache removeKey:img ifAbsent:nil.
]
].
imgRep instVarNamed:'pData' put:0.
"/ self halt.
"Created: / 7.1.1998 / 22:31:46 / cg"
"Modified: / 17.1.1998 / 13:26:55 / cg"
!
_ImageRepresentation_finish:nativeContext
|imgRep bool|
imgRep := nativeContext receiver.
bool := nativeContext argAt:1.
"/ self halt.
"/ 'JAVA: ImageRepresentation_finish ignored for now' infoPrintCR.
^ 1 "/ true
"Created: / 8.1.1998 / 00:11:40 / cg"
"Modified: / 6.2.1998 / 02:12:54 / cg"
!
_ImageRepresentation_imageDraw:nativeContext
|imgRep x y img deviceImage jGraphics gc clr|
imgRep := nativeContext receiver.
img := imgRep instVarNamed:'pData'.
(img isNil or:[img == 0]) ifTrue:[
"/ self halt.
^ self.
].
jGraphics := nativeContext argAt:1.
gc := jGraphics instVarNamed:'pData'.
gc realized ifFalse:[^ self].
x := nativeContext argAt:2.
y := nativeContext argAt:3.
clr := nativeContext argAt:4.
deviceImage := img onDevice:gc device.
deviceImage ~~ img ifTrue:[
imgRep instVarNamed:'pData' put:deviceImage.
].
deviceImage displayOn:gc x:x y:y.
^ 1.
"Created: / 13.1.1998 / 13:32:28 / cg"
"Modified: / 15.1.1998 / 12:21:27 / cg"
!
_ImageRepresentation_imageStretch:nativeContext
|imgRep x1 y1 x2 y2 srcX1 srcY1 w h
img deviceImage jGraphics gc clr stretchWidth stretchHeight|
imgRep := nativeContext receiver.
img := imgRep instVarNamed:'pData'.
(img isNil or:[img == 0]) ifTrue:[
"/ self halt.
^ self.
].
jGraphics := nativeContext argAt:1.
gc := jGraphics instVarNamed:'pData'.
gc realized ifFalse:[^ self].
x1 := nativeContext argAt:2.
y1 := nativeContext argAt:3.
x2 := nativeContext argAt:4.
y2:= nativeContext argAt:5.
srcX1 := nativeContext argAt:6.
srcY1 := nativeContext argAt:7.
w := nativeContext argAt:8.
h := nativeContext argAt:9.
clr := nativeContext argAt:10.
(srcX1 ~~ 0 or:[srcY1 ~~ 0]) ifTrue:[
self halt.
^ self.
].
(w ~~ img width or:[h ~~ img height]) ifTrue:[
self halt.
^ self
].
"/ TODO: remember magnified images somewhere for a while,
"/ to avoid repeated action ...
stretchWidth := (x2-x1).
stretchHeight := (y2-y1).
(stretchWidth == img width
and:[stretchHeight == img height]) ifTrue:[
deviceImage := img onDevice:gc device.
deviceImage ~~ img ifTrue:[
imgRep instVarNamed:'pData' put:deviceImage.
].
] ifFalse:[
ImageStretchCache notNil ifTrue:[
deviceImage := ImageStretchCache at:img ifAbsent:nil.
].
(deviceImage isNil
or:[deviceImage width ~~ stretchWidth
or:[deviceImage height ~~ stretchHeight]]) ifTrue:[
deviceImage := (img magnifiedTo:stretchWidth@stretchHeight) onDevice:gc device.
ImageStretchCache isNil ifTrue:[
ImageStretchCache := WeakIdentityDictionary new.
].
ImageStretchCache at:img put:deviceImage
].
].
deviceImage displayOn:gc x:x1 y:y1
"Created: / 13.1.1998 / 13:32:28 / cg"
"Modified: / 15.1.1998 / 13:14:47 / cg"
!
_ImageRepresentation_offscreenInit:nativeContext
|imgRep jclr w h form screenDevice|
imgRep := nativeContext receiver.
jclr := nativeContext argAt:1.
w := imgRep instVarNamed:'width'.
h := imgRep instVarNamed:'height'.
screenDevice := Screen current.
form := Form width:w height:h depth:(screenDevice depth) on:screenDevice.
imgRep instVarNamed:'pData' put:form.
"/ self halt.
"Created: / 7.1.1998 / 22:31:46 / cg"
"Modified: / 17.1.1998 / 12:36:43 / cg"
!
_ImageRepresentation_setBytePixels:nativeContext
|imgRep x y w h clrModel bytes offs i2
img depth cmap rgbMap opaque transparentColorIndex
scanLineWidth nBytes srcIdx dstIdx|
imgRep := nativeContext receiver.
x := nativeContext argAt:1.
y := nativeContext argAt:2.
w := nativeContext argAt:3.
h := nativeContext argAt:4.
clrModel := nativeContext argAt:5.
bytes := nativeContext argAt:6.
offs := nativeContext argAt:7. "/ offset ??
scanLineWidth := nativeContext argAt:8.
depth := clrModel instVarNamed:'pixel_bits'.
(clrModel instVarNamed:'map_size') ~~ 0 ifTrue:[
rgbMap := clrModel instVarNamed:'rgb'.
cmap := Array new:rgbMap size.
rgbMap
keysAndValuesDo:[:idx :rgb |
cmap at:idx put:(Color rgbValue:(rgb bitAnd:16rFFFFFF))
].
].
opaque := (clrModel instVarNamed:'opaque') ~~ 0.
opaque ifFalse:[
transparentColorIndex := clrModel instVarNamed:'transparent_index'
].
img := imgRep instVarNamed:'pData'.
(img isNil or:[img == 0]) ifTrue:[
(offs ~~ 0 or:[scanLineWidth ~~ w]) ifTrue:[
nBytes := ByteArray new:w*h.
srcIdx := offs+1.
dstIdx := 1.
1 to:h do:[:y |
nBytes replaceFrom:dstIdx to:(dstIdx+w-1) with:bytes startingAt:srcIdx.
srcIdx := srcIdx + scanLineWidth.
dstIdx := dstIdx + w.
].
bytes := nBytes.
].
img := Image width:w height:h depth:depth fromArray:bytes.
cmap notNil ifTrue:[
img colorMap:cmap.
img photometric:#palette
].
opaque ifFalse:[
img mask:(ImageReader
buildMaskFromColor:transparentColorIndex
for:bytes
width:w
height:h)
].
imgRep instVarNamed:'pData' put:img.
] ifFalse:[
self halt.
].
^ 1.
"Created: / 7.1.1998 / 22:31:46 / cg"
"Modified: / 6.2.1998 / 02:50:13 / cg"
!
_ImageRepresentation_setIntPixels:nativeContext
|imgRep x y w h clrModel ints offs scanLineWidth
img depth cmap rgbMap opaque transparentColorIndex
bytes srcIdx dstIdx val red green blue|
imgRep := nativeContext receiver.
x := nativeContext argAt:1.
y := nativeContext argAt:2.
w := nativeContext argAt:3.
h := nativeContext argAt:4.
clrModel := nativeContext argAt:5.
ints := nativeContext argAt:6.
offs := nativeContext argAt:7. "/ offset ??
scanLineWidth := nativeContext argAt:8. "/ scanLineWidth ??
self halt.
opaque := false.
depth := clrModel instVarNamed:'pixel_bits'.
clrModel class == (Java at:'java.awt.image.DirectColorModel') ifTrue:[
] ifFalse:[
(clrModel instVarNamed:'map_size') ~~ 0 ifTrue:[
rgbMap := clrModel instVarNamed:'rgb'.
cmap := Array new:rgbMap size.
rgbMap
keysAndValuesDo:[:idx :rgb |
cmap at:idx put:(Color rgbValue:(rgb bitAnd:16rFFFFFF))
].
].
opaque := (clrModel instVarNamed:'opaque') ~~ 0.
opaque ifFalse:[
transparentColorIndex := clrModel instVarNamed:'transparent_index'
].
].
img := imgRep instVarNamed:'pData'.
(img isNil or:[img == 0]) ifTrue:[
depth == 32 ifTrue:[
"/ temporary kludge - ony use 24 bits/pixel
bytes := ByteArray new:w*h*3.
srcIdx := 1.
dstIdx := 1.
1 to:h do:[:y |
1 to:w do:[:x |
val := ints at:srcIdx.
red := (val bitShift:-16) bitAnd:16rFF.
green := (val bitShift:-8) bitAnd:16rFF.
blue := val bitAnd:16rFF.
bytes at:dstIdx put:red.
bytes at:dstIdx+1 put:green.
bytes at:dstIdx+2 put:blue.
dstIdx := dstIdx + 3.
srcIdx := srcIdx + 1.
].
srcIdx := srcIdx + (scanLineWidth - w).
].
img := Depth24Image width:w height:h depth:24 fromArray:bytes.
] ifFalse:[
img := Image width:w height:h depth:depth fromArray:ints.
].
cmap notNil ifTrue:[
img colorMap:cmap.
img photometric:#palette
] ifFalse:[
img photometric:#rgb
].
opaque ifFalse:[
img mask:(ImageReader
buildMaskFromColor:transparentColorIndex
for:ints
width:w
height:h)
].
imgRep instVarNamed:'pData' put:img.
] ifFalse:[
self halt.
].
^ 1.
"Created: / 1.2.1998 / 17:38:47 / cg"
"Modified: / 6.2.1998 / 02:37:35 / cg"
!
_OffScreenImageSource_sendPixels:nativeContext
"/ self halt.
"Modified: / 16.1.1998 / 18:22:23 / cg"
"Created: / 17.1.1998 / 12:36:25 / cg"
! !
!JavaVM class methodsFor:'native - sun.awt - jdk1.2'!
_ColorModel_initIDs:nativeContext
"/ new with jdk1.2 ...
"Created: / 28.1.1998 / 22:19:23 / cg"
!
_FontDescriptor_initIDs:nativeContext
"/ new with jdk1.2 ...
"Created: / 28.1.1998 / 22:30:52 / cg"
!
_Font_initIDs:nativeContext
"/ new with jdk1.2 ...
"Created: / 27.1.1998 / 21:43:25 / cg"
!
_PackedColorModel_initIDs:nativeContext
"/ new with jdk1.2 ...
"Created: / 28.1.1998 / 22:19:35 / cg"
!
_PlatformFont_initIDs:nativeContext
"/ new with jdk1.2 ...
"Created: / 28.1.1998 / 22:30:41 / cg"
!
_X11GraphicsDevice_getConfigType:nativeContext
"/ new with jdk1.2 ...
|configNr cls|
"/ for now, only one config.
configNr := nativeContext argAt:1.
cls := Java classNamed:'java.awt.GraphicsDevice'.
^ cls instVarNamed:'TYPE_RASTER_SCREEN'.
"Created: / 28.1.1998 / 22:19:05 / cg"
!
_X11GraphicsDevice_getNumConfigs:nativeContext
"/ new with jdk1.2 ...
^ 1
"Created: / 28.1.1998 / 22:13:26 / cg"
"Modified: / 28.1.1998 / 22:14:33 / cg"
!
_X11GraphicsEnvironment_getNumScreens:nativeContext
"/ new with jdk1.2 ...
"/ could return the actual number of screens ...
^ 1
"Created: / 28.1.1998 / 01:50:22 / cg"
"Modified: / 28.1.1998 / 22:12:32 / cg"
!
_X11GraphicsEnvironment_initDisplay:nativeContext
"/ new with jdk1.2 ...
"Created: / 28.1.1998 / 01:50:22 / cg"
! !
!JavaVM class methodsFor:'native - sun.awt.motif - jdk1.2'!
_InputThread_run:nativeContext
self _WToolkit_eventLoop:nativeContext.
"Created: / 28.1.1998 / 22:34:47 / cg"
"Modified: / 28.1.1998 / 22:35:16 / cg"
!
_MComponentPeer_cacheInit:nativeContext
"Created: / 28.1.1998 / 22:22:30 / cg"
!
_MComponentPeer_pInitialize:nativeContext
"Created: / 28.1.1998 / 22:27:25 / cg"
!
_MComponentPeer_setCursor:nativeContext
"Created: / 28.1.1998 / 22:27:35 / cg"
!
_MFramePeer_create:nativeContext
^ self _WFramePeer_create:nativeContext
"Created: / 28.1.1998 / 22:25:44 / cg"
!
_MFramePeer_pHide:nativeContext
^ self _WComponentPeer_hide:nativeContext
"Created: / 28.1.1998 / 22:27:04 / cg"
!
_MFramePeer_pReshape:nativeContext
self commonReshapeComponent:nativeContext
"Created: / 28.1.1998 / 22:28:00 / cg"
"Modified: / 28.1.1998 / 22:29:34 / cg"
!
_MFramePeer_pSetTitle:nativeContext
self _WWindowPeer__setTitle:nativeContext
"Created: / 28.1.1998 / 22:30:23 / cg"
!
_MToolkit_init:nativeContext
"Created: / 28.1.1998 / 22:21:54 / cg"
!
_MToolkit_run:nativeContext
"Created: / 28.1.1998 / 22:22:10 / cg"
! !
!JavaVM class methodsFor:'native - sun.awt.windows'!
_WButtonPeer_create:nativeContext
|jButtonPeer jButton jFrame frame button
lbl|
jButtonPeer := nativeContext receiver.
jButton := jButtonPeer instVarNamed:'target'.
jFrame := nativeContext argAt:1.
frame := jFrame instVarNamed:'pData'.
button := Button in:frame.
button action:[
jButtonPeer invoke:#handleAction.
].
lbl := jButton instVarNamed:'label'.
lbl notNil ifTrue:[
lbl := Java as_ST_String:lbl.
button label:lbl
].
self createdWindowsView:button for:jButtonPeer.
WindowCreationTrace == true ifTrue:[
'WButtonPeer_create: ' print. frame print. ' -> ' print. button printNL.
].
"Created: / 5.1.1998 / 01:53:30 / cg"
"Modified: / 13.1.1998 / 22:09:15 / cg"
!
_WButtonPeer_setLabel:nativeContext
|label jString|
jString := nativeContext argAt:1.
label := self viewForWPeer:nativeContext.
label label:(Java as_ST_String:jString)
"Modified: / 8.1.1998 / 17:35:50 / cg"
"Created: / 1.2.1998 / 17:05:47 / cg"
!
_WCanvasPeer_create:nativeContext
|jCanvasPeer jFrame frame subView|
jCanvasPeer := nativeContext receiver.
jFrame := nativeContext argAt:1.
jFrame isNil ifTrue:[
self halt:'no frame in canvasPeer create'.
self internalError:'no frame in canvasPeer create'.
^ self.
].
frame := jFrame instVarNamed:'pData'.
subView := JavaView in:frame.
subView delegate:self.
subView javaPeer:jCanvasPeer.
self createdWindowsView:subView for:jCanvasPeer.
WindowCreationTrace == true ifTrue:[
'WCanvasPeer_create: ' print. frame print. ' -> ' print. subView printNL.
].
"Created: / 5.1.1998 / 00:59:19 / cg"
"Modified: / 16.1.1998 / 13:40:00 / cg"
!
_WCheckboxPeer_create:nativeContext
|jCheckboxPeer jCheckbox jFrame frame checkBox lbl|
jCheckboxPeer := nativeContext receiver.
jCheckbox := jCheckboxPeer instVarNamed:'target'.
jFrame := nativeContext argAt:1.
frame := jFrame instVarNamed:'pData'.
checkBox := CheckBox in:frame.
checkBox action:[
jCheckboxPeer
perform:#'handleAction(Z)V'
with:(checkBox isOn ifTrue:[1] ifFalse:[0])
].
lbl := jCheckbox instVarNamed:'label'.
lbl notNil ifTrue:[
lbl := Java as_ST_String:lbl.
checkBox label:lbl
].
self createdWindowsView:checkBox for:jCheckboxPeer.
WindowCreationTrace == true ifTrue:[
'WCheckboxPeer_create: ' print. frame print. ' -> ' print. checkBox printNL.
].
"Created: / 7.1.1998 / 21:48:03 / cg"
"Modified: / 15.1.1998 / 12:27:04 / cg"
!
_WCheckboxPeer_setCheckboxGroup:nativeContext
|checkBox jGroup|
checkBox := self viewForWPeer:nativeContext.
jGroup := nativeContext argAt:1.
"Created: / 7.1.1998 / 21:48:47 / cg"
"Modified: / 25.1.1998 / 01:20:42 / cg"
!
_WCheckboxPeer_setState:nativeContext
|checkBox state|
checkBox := self viewForWPeer:nativeContext.
state := nativeContext argAt:1.
state ~~ 0 ifTrue:[
checkBox turnOn
] ifFalse:[
checkBox turnOff
].
"Created: / 7.1.1998 / 21:49:13 / cg"
"Modified: / 25.1.1998 / 01:26:18 / cg"
!
_WChoicePeer_addItem:nativeContext
|jString index comboBox|
comboBox := self viewForWPeer:nativeContext.
jString := nativeContext argAt:1.
index := nativeContext argAt:2.
comboBox model list addLast:(Java as_ST_String:jString).
comboBox model changed:#list.
"Created: / 7.1.1998 / 21:45:12 / cg"
"Modified: / 24.1.1998 / 18:51:32 / cg"
!
_WChoicePeer_create:nativeContext
|jChoicePeer jChoice jFrame frame comboBox|
jChoicePeer := nativeContext receiver.
jChoice := jChoicePeer instVarNamed:'target'.
jFrame := nativeContext argAt:1.
frame := jFrame instVarNamed:'pData'.
comboBox := ComboListView in:frame.
comboBox model:(SelectionInList new list:(OrderedCollection new)).
comboBox action:[:index |
jChoicePeer
perform:#'handleAction(I)V'
with:(comboBox model selectionIndex - 1)
].
self createdWindowsView:comboBox for:jChoicePeer.
WindowCreationTrace == true ifTrue:[
'WChoicePeer_create: ' print. frame print. ' -> ' print. comboBox printNL.
].
"Created: / 7.1.1998 / 21:44:31 / cg"
"Modified: / 28.1.1998 / 23:19:17 / cg"
!
_WChoicePeer_reshape:nativeContext
self pReshape:nativeContext.
^ self.
"Modified: / 15.8.1997 / 15:36:29 / cg"
"Created: / 7.1.1998 / 21:46:18 / cg"
!
_WChoicePeer_select:nativeContext
|comboBox index|
comboBox := self viewForWPeer:nativeContext.
index := nativeContext argAt:1.
comboBox model selectionIndex:(index + 1). "/ JAVA indexing starts at 0
"Created: / 7.1.1998 / 21:45:43 / cg"
"Modified: / 25.1.1998 / 09:55:05 / cg"
!
_WClipboard_init:nativeContext
"/ self halt.
"Modified: / 18.3.1997 / 18:43:18 / cg"
"Created: / 4.1.1998 / 19:03:59 / cg"
!
_WColor_getDefaultColor:nativeContext
|clrIndex jClr clr |
clrIndex := nativeContext argAt:1.
"/ windows defaults:
"/ 1: view background
clrIndex == 1 ifTrue:[
clr := View defaultViewBackgroundColor.
clr isColor ifFalse:[
clr := Color gray:50.
].
].
clrIndex == 2 ifTrue:[
clr := Color black.
].
clr isNil ifTrue:[
self halt.
self internalError:'breakpoint'.
^ nil.
].
clr := clr on:(Screen current).
jClr := (Java classForName:'java.awt.Color') new.
jClr instVarNamed:'pData' put:clr.
jClr instVarNamed:'value' put:(clr rgbValue).
"/ self halt.
^ jClr.
"Created: / 15.8.1997 / 15:38:10 / cg"
"Modified: / 4.1.1998 / 18:06:51 / cg"
!
_WComponentPeer__dispose:nativeContext
|view jPeer|
view := self viewForWPeer:nativeContext.
Object errorSignal catch:[
view destroy.
].
JavaWindowGroup removeView:view.
jPeer := nativeContext receiver.
jPeer instVarNamed:'pData' put:0.
"Created: / 7.1.1998 / 22:36:25 / cg"
"Modified: / 25.1.1998 / 16:43:06 / cg"
!
_WComponentPeer__setBackground:nativeContext
|rgb clr view|
view := self viewForWPeer:nativeContext.
rgb := nativeContext argAt:1.
clr := Color rgbValue:rgb.
"/ self halt.
"/ self internalError:'breakPoint'.
clr := clr on:(view device).
"/ (view superView isMemberOf:JavaEmbeddedFrameView) ifTrue:[
"/ view viewBackground:(view superView viewBackground).
"/ view backgroundPaint:(view superView viewBackground).
"/ ] ifFalse:[
"/ (view isMemberOf:JavaView) ifTrue:[
"/ view viewBackground:clr.
"/ view backgroundPaint:clr.
"/ ]
"/ ].
(view isKindOf:ScrollableView) ifTrue:[
view := view scrolledView
].
view viewBackground:clr.
view backgroundPaint:clr.
"Created: / 4.1.1998 / 18:07:39 / cg"
"Modified: / 15.1.1998 / 13:06:44 / cg"
!
_WComponentPeer__setForeground:nativeContext
|rgb clr view|
view := self viewForWPeer:nativeContext.
rgb := nativeContext argAt:1.
clr := Color rgbValue:rgb.
"/ self halt.
"/ self internalError:'breakPoint'.
clr := clr on:(view device).
view paint:clr.
"Created: / 4.1.1998 / 18:08:13 / cg"
"Modified: / 8.1.1998 / 17:32:45 / cg"
!
_WComponentPeer_disable:nativeContext
|view|
view := self viewForWPeer:nativeContext.
Object errorSignal handle:[:ex |
] do:[
view disable
]
"Created: / 6.1.1998 / 18:26:36 / cg"
"Modified: / 8.1.1998 / 17:32:53 / cg"
!
_WComponentPeer_enable:nativeContext
|view|
view := self viewForWPeer:nativeContext.
Object errorSignal handle:[:ex |
] do:[
view enable
]
"Modified: / 8.1.1998 / 17:32:53 / cg"
"Created: / 13.1.1998 / 23:08:05 / cg"
!
_WComponentPeer_handleEvent:nativeContext
"this is invoked by java, to let a widget handle any event which
was not consumed (eaten) by java.
If the view in question is some ST-widget, forward it.
Ignore for JavaViews."
|view jEv stEv|
view := self viewForWPeer:nativeContext.
view notNil ifTrue:[
(view isKindOf:JavaView) ifFalse:[
jEv := nativeContext argAt:1.
stEv := jEv instVarNamed:'data'.
(stEv notNil and:[stEv ~~ 0]) ifTrue:[
EventTrace == true ifTrue:[
('JAVA: WComponent - handleEvent: ' , stEv type , ' for ' , view printString) infoPrintCR.
].
stEv sendEventWithFocusOn:nil.
^ self.
]
]
].
EventTrace == true ifTrue:[
('JAVA: WComponent - handleEvent ignored') infoPrintCR.
]
"Created: / 6.1.1998 / 21:10:17 / cg"
"Modified: / 6.2.1998 / 00:54:42 / cg"
!
_WComponentPeer_hide:nativeContext
|view|
view := self viewForWPeer:nativeContext.
Object errorSignal handle:[:ex |
] do:[
view beInvisible
]
"Created: / 7.1.1998 / 22:35:32 / cg"
"Modified: / 8.1.1998 / 17:33:08 / cg"
!
_WComponentPeer_requestFocus:nativeContext
|view|
view := self viewForWPeer:nativeContext.
"/ 'getFocus - ' print. view displayString printCR.
view getKeyboardFocus
"Created: / 7.1.1998 / 22:30:03 / cg"
"Modified: / 6.2.1998 / 02:22:17 / cg"
!
_WComponentPeer_reshape:nativeContext
self commonReshapeComponent:nativeContext
"Modified: / 18.3.1997 / 19:30:21 / cg"
"Created: / 4.1.1998 / 18:01:11 / cg"
!
_WComponentPeer_setCursor:nativeContext
|view|
view := self viewForWPeer:nativeContext.
"/ self halt.
"Created: / 5.1.1998 / 01:52:30 / cg"
"Modified: / 25.1.1998 / 01:21:52 / cg"
!
_WComponentPeer_setFont:nativeContext
|view|
view := self viewForWPeer:nativeContext.
"/ self halt.
"Created: / 5.1.1998 / 00:55:17 / cg"
"Modified: / 25.1.1998 / 01:22:19 / cg"
!
_WComponentPeer_setZOrderPosition:nativeContext
|view|
view := self viewForWPeer:nativeContext.
"/ self unimplementedNativeMethod.
"/ self halt.
"/ self internalError:'breakPoint'
"Created: / 4.1.1998 / 17:59:26 / cg"
"Modified: / 25.1.1998 / 01:22:32 / cg"
!
_WComponentPeer_show:nativeContext
|view|
view := self viewForWPeer:nativeContext.
"/ frame views are under my browsers own control
(view isMemberOf:JavaEmbeddedFrameView) ifFalse:[
view beVisible.
view realize.
].
"/ view windowGroup notNil ifTrue:[
"/ windowServer addGroup:(view windowGroup)
"/ ].
^ nil
"/ self halt.
"Created: / 5.1.1998 / 01:26:22 / cg"
"Modified: / 25.1.1998 / 09:54:07 / cg"
!
_WComponentPeer_start:nativeContext
"/ self halt.
"Modified: / 18.3.1997 / 18:43:18 / cg"
"Created: / 5.1.1998 / 00:58:40 / cg"
!
_WDefaultFontCharset_canConvert:nativeContext
^ 1
"Modified: / 21.8.1997 / 15:56:57 / cg"
"Created: / 5.1.1998 / 01:55:47 / cg"
!
_WDialogPeer__hide:nativeContext
|dialog|
dialog := self viewForWPeer:nativeContext.
dialog hide.
"Created: / 7.1.1998 / 22:34:10 / cg"
"Modified: / 8.1.1998 / 17:34:10 / cg"
!
_WDialogPeer__show:nativeContext
|dialog|
dialog := self viewForWPeer:nativeContext.
"/
"/ show does not work (yet); must setup windowgroup
"/ for it to get events ...
"/ dialog show.
dialog realize.
"Created: / 7.1.1998 / 21:52:15 / cg"
"Modified: / 15.1.1998 / 15:57:03 / cg"
!
_WDialogPeer_create:nativeContext
|jDialogPeer dialog|
jDialogPeer := nativeContext receiver.
dialog := ModalBox new.
jDialogPeer instVarNamed:'pData' put:dialog.
self createdWindowsView:dialog for:jDialogPeer.
dialog windowGroup:JavaWindowGroup.
JavaWindowGroup addTopView:dialog.
WindowCreationTrace == true ifTrue:[
'WDialogPeer_create: ' print. dialog printNL.
].
"Created: / 7.1.1998 / 21:51:00 / cg"
"Modified: / 15.1.1998 / 16:12:44 / cg"
!
_WFileDialogPeer_show:nativeContext
|jDialogPeer jDialog dialogView stDialog
title dir pattern f|
jDialogPeer := nativeContext receiver.
jDialog := jDialogPeer instVarNamed:'target'.
dialogView := jDialogPeer instVarNamed:'pData'.
stDialog := FileSelectionBox new.
dir := jDialog instVarNamed:'dir'.
dir notNil ifTrue:[
stDialog directory:(Java as_ST_String:dir).
].
pattern := jDialog instVarNamed:'file'.
pattern notNil ifTrue:[
stDialog pattern:(Java as_ST_String:pattern).
].
title := jDialog instVarNamed:'title'.
title notNil ifTrue:[
stDialog title:(Java as_ST_String:title).
stDialog label:(Java as_ST_String:title).
].
stDialog show.
stDialog accepted ifTrue:[
f := stDialog pathName.
"/ cannot use the one below - it has a builtIn fileSeparator if '\' (sigh)
"/ jDialogPeer perform:#'handleSelected(Ljava/lang/String;)V' with:(Java as_String:f).
jDialog
perform:#'setFile(Ljava/lang/String;)V'
with:(Java as_String:(f asFilename baseName)).
jDialog
perform:#'setDirectory(Ljava/lang/String;)V'
with:(Java as_String:(f asFilename directoryName , Filename separator asString)).
jDialog
perform:#'setVisible(Z)V'
with:0.
] ifFalse:[
jDialogPeer
perform:#'handleCancel()V'
].
"/ self halt.
"Created: / 7.1.1998 / 22:38:45 / cg"
"Modified: / 15.1.1998 / 13:04:05 / cg"
!
_WFontMetrics_getMFCharSegmentWidth:nativeContext
"get multi-font string-segment width.
Not yet supported - use standard strings width"
|jMetrics jFont jFontDescr stFont w
bool1 cp offs lenght bp int1|
jMetrics := nativeContext receiver.
jFont := nativeContext argAt:1.
jFontDescr := nativeContext argAt:2.
bool1 := nativeContext argAt:3.
cp := nativeContext argAt:4.
offs := nativeContext argAt:5.
lenght := nativeContext argAt:6.
bp := nativeContext argAt:7.
int1 := nativeContext argAt:8.
stFont := jFont instVarNamed:'pData'.
(stFont isNil or:[stFont == 0]) ifTrue:[
self halt
].
stFont device isNil ifTrue:[
stFont := stFont on:Display.
jFont instVarNamed:'pData' put:stFont.
].
w := stFont widthOf:cp from:offs+1 to:offs+lenght.
^ w.
"Created: / 5.1.1998 / 01:57:45 / cg"
"Modified: / 13.1.1998 / 23:44:03 / cg"
!
_WFontMetrics_init:nativeContext
|jMetrics jFont stFont widths family name style size|
jMetrics := nativeContext receiver.
jFont := jMetrics instVarNamed:'font'.
family := jFont instVarNamed:'family'.
family := Java as_ST_String:family.
name := jFont instVarNamed:'name'.
name := Java as_ST_String:name.
style := jFont instVarNamed:'style'.
size := jFont instVarNamed:'size'.
stFont := Font family:family size:size.
stFont isNil ifTrue:[
stFont := Font family:'helvetica' size:size.
].
stFont := stFont on:Display.
"/ stFont := jFont instVarNamed:'pData'.
"/ stFont isNil ifTrue:[
"/ self halt
"/ ].
stFont := stFont on:Display.
jFont instVarNamed:'pData' put:stFont.
jMetrics instVarNamed:'ascent' put:stFont ascent.
jMetrics instVarNamed:'descent' put:stFont descent.
jMetrics instVarNamed:'leading' put:0.
jMetrics instVarNamed:'height' put:stFont height.
jMetrics instVarNamed:'maxAscent' put:stFont maxAscent.
jMetrics instVarNamed:'maxDescent' put:stFont maxDescent.
jMetrics instVarNamed:'maxHeight' put:stFont maxHeight.
jMetrics instVarNamed:'maxAdvance' put:stFont maxWidth.
widths := Array new:256.
0 to:255 do:[:i |
widths at:(i+1) put:(stFont widthOf:(Character value:i))
].
jMetrics instVarNamed:'widths' put:widths.
"/ self halt.
"Modified: / 8.8.1997 / 12:06:53 / cg"
"Created: / 5.1.1998 / 01:54:29 / cg"
!
_WFontMetrics_needsConversion:nativeContext
|jFont jFontDescr stFont|
jFont := nativeContext argAt:1.
jFontDescr := nativeContext argAt:2.
stFont := jFont instVarNamed:'pData'.
"/ stFont isNil ifTrue:[
"/ self halt
"/ ].
"/ stFont device isNil ifTrue:[
"/ stFont := stFont on:Display.
"/ jFont instVarNamed:'pData' put:stFont.
"/ ].
"/
^ 0
"Modified: / 17.8.1997 / 17:16:29 / cg"
"Created: / 5.1.1998 / 01:56:42 / cg"
!
_WFramePeer_create:nativeContext
|jFramePeer jFrame frame pDataIdx|
jFramePeer := nativeContext receiver.
"/ for now: a kludge to create an embedded frame for
"/ mozillaFrames
jFrame := jFramePeer instVarNamed:'target'.
(jFrame notNil
and:[(pDataIdx := jFrame class instVarOffsetOf:'pData') notNil])
ifTrue:[
((frame := jFrame instVarAt:pDataIdx) notNil
and:[frame ~~ 0]) ifTrue:[
WindowCreationTrace == true ifTrue:[
'JAVA: targetFrame view already created: ' infoPrintCR.
].
"/ sigh; pData was renamed to pNativeWidget in jdk1.2 ...
pDataIdx := jFramePeer class instVarOffsetOf:'pNativeWidget'.
pDataIdx isNil ifTrue:[
"/ ok, we are < 1.2
pDataIdx := jFramePeer class instVarOffsetOf:'pData'.
].
jFramePeer instVarAt:pDataIdx put:frame.
]
] ifFalse:[
frame := jFramePeer instVarNamed:'pData'
].
(frame notNil and:[frame ~~ 0]) ifTrue:[
WindowCreationTrace == true ifTrue:[
'JAVA: frame view already created: ' infoPrint.
jFramePeer class name infoPrintCR.
].
] ifFalse:[
frame := StandardSystemView new.
self createdWindowsView:frame for:jFramePeer.
JavaWindowGroup addTopView:frame.
].
WindowCreationTrace == true ifTrue:[
'JAVA: WFramePeer_create: ' print. jFramePeer displayString print.
' frame: ' print. frame printNL.
].
"Created: / 4.1.1998 / 17:56:39 / cg"
"Modified: / 6.2.1998 / 02:29:00 / cg"
!
_WFramePeer_setMenuBar0:nativeContext
|frame jMenuBarPeer menuPanel|
frame := self viewForWPeer:nativeContext.
jMenuBarPeer := nativeContext argAt:1.
jMenuBarPeer isNil ifTrue:[
"/ mhmh - JAVA wants to remove the frames menuPanel.
"/ but I have no handle on it (for destroy).
"/ search it in subViews of the frame.
frame subViews copy do:[:v |
(v isKindOf:MenuPanel) ifTrue:[
v destroy
]
]
] ifFalse:[
menuPanel := jMenuBarPeer instVarNamed:'pData'.
menuPanel origin:0.0@0.0 corner:1.0@(menuPanel preferredExtent y).
frame addSubView:menuPanel.
].
^ nil
"Created: / 7.1.1998 / 21:41:35 / cg"
"Modified: / 8.1.1998 / 17:35:04 / cg"
!
_WGraphics_changeClip:nativeContext
|gc x y w h bool|
gc := self gcForWGraphics:nativeContext.
"/ ignored for now;
"/ Clock does incorrect repaints if enabled.
"/ TODO: fix that ...
x := nativeContext argAt:1.
y := nativeContext argAt:2.
w := nativeContext argAt:3.
h := nativeContext argAt:4.
bool := (nativeContext argAt:5) ~~ 0.
"/ gc clipRect:(Rectangle left:x top:y width:w height:h).
"Created: / 6.1.1998 / 20:57:21 / cg"
"Modified: / 25.1.1998 / 12:51:55 / cg"
!
_WGraphics_clearRect:nativeContext
|gc x y w h|
gc := self gcForWGraphics:nativeContext.
"/ gc isNil ifTrue:[^ self].
gc realized ifFalse:[
'JAVA: drawing on unrealized gc - ignored' infoPrintCR.
^ self
].
x := nativeContext argAt:1.
y := nativeContext argAt:2.
w := nativeContext argAt:3.
h := nativeContext argAt:4.
"/ self halt.
"/ self internalError:'breakPoint'.
gc clearRectangleX:x y:y width:w height:h.
"Created: / 8.1.1998 / 00:16:00 / cg"
"Modified: / 8.1.1998 / 00:21:09 / cg"
!
_WGraphics_createFromComponent:nativeContext
|jGraphics jWin view|
jGraphics := nativeContext receiver.
jWin := nativeContext argAt:1.
view := KnownWindows at:jWin ifAbsent:nil.
view isNil ifTrue:[
self halt.
^ self
].
"/ "/ just a consistency check ...
"/ (jWin instVarNamed:'xid') ~~ view ifTrue:[
"/ self halt:'consistency check'
"/ ].
jGraphics instVarNamed:'pData' put:view.
"Created: / 6.1.1998 / 20:55:18 / cg"
"Modified: / 15.1.1998 / 13:49:56 / cg"
!
_WGraphics_createFromGraphics:nativeContext
|jGraphics graphics gc|
jGraphics := nativeContext receiver.
graphics := nativeContext argAt:1.
gc := graphics instVarNamed:'pData'.
jGraphics instVarNamed:'pData' put:gc.
"Created: / 8.1.1998 / 00:47:39 / cg"
"Modified: / 25.1.1998 / 10:57:25 / cg"
!
_WGraphics_dispose:nativeContext
|gc|
gc := self gcForWGraphics:nativeContext.
gc isNil ifTrue:[^ self].
"Created: / 6.1.1998 / 20:58:38 / cg"
"Modified: / 8.1.1998 / 00:19:09 / cg"
!
_WGraphics_drawArc:nativeContext
|gc x y w h startAngle endAngle|
gc := self gcForWGraphics:nativeContext.
"/ gc isNil ifTrue:[^ self].
gc realized ifFalse:[^ self].
x := nativeContext argAt:1.
y := nativeContext argAt:2.
w := nativeContext argAt:3.
h := nativeContext argAt:4.
startAngle := nativeContext argAt:5.
endAngle := nativeContext argAt:6.
DrawOPTrace ifTrue:[
'drawArc x/y= ' print. x print. '@' print. y print.
' w/h= ' print. w print. '@' print. h print.
' startAngle= ' print. startAngle print. ' endAngle= ' print. endAngle printCR.
].
gc
displayArcX:x y:y
width:w height:h
from:startAngle angle:(endAngle - startAngle).
"Created: / 6.1.1998 / 21:00:15 / cg"
"Modified: / 28.1.1998 / 23:23:42 / cg"
!
_WGraphics_drawLine:nativeContext
|gc x y x2 y2|
gc := self gcForWGraphics:nativeContext.
"/ gc isNil ifTrue:[^ self].
gc realized ifFalse:[^ self].
x := nativeContext argAt:1.
y := nativeContext argAt:2.
x2 := nativeContext argAt:3.
y2 := nativeContext argAt:4.
DrawOPTrace ifTrue:[
'drawLine x/y= ' print. x print. '@' print. y print. ' x2/y2= ' print. x2 print. '@' print. y2 printCR.
].
gc displayLineFromX:x y:y toX:x2 y:y2
"Created: / 6.1.1998 / 20:59:27 / cg"
"Modified: / 8.1.1998 / 00:34:23 / cg"
!
_WGraphics_drawMFCharsSegment:nativeContext
|jFont jFontDescr s gc x y offs len|
gc := self gcForWGraphics:nativeContext.
gc realized ifFalse:[^ self].
jFont := nativeContext argAt:1.
jFontDescr := nativeContext argAt:2.
s := nativeContext argAt:3.
offs := nativeContext argAt:4.
len := nativeContext argAt:5.
x := nativeContext argAt:6.
y := nativeContext argAt:7.
DrawOPTrace ifTrue:[
'drawMFCharsSegment x/y= ' print. x print. '@' print. y print. ' s= ' print. s printCR.
].
gc displayString:s from:offs+1 to:offs+len x:x y:y.
^ (gc font onDevice:(gc graphicsDevice)) widthOf:s.
"Created: / 6.1.1998 / 21:01:07 / cg"
"Modified: / 25.1.1998 / 20:45:55 / cg"
!
_WGraphics_drawOval:nativeContext
|gc x y w h|
gc := self gcForWGraphics:nativeContext.
"/ gc isNil ifTrue:[^ self].
gc realized ifFalse:[^ self].
x := nativeContext argAt:1.
y := nativeContext argAt:2.
w := nativeContext argAt:3.
h := nativeContext argAt:4.
true "DrawOPTrace" ifTrue:[
'drawOval x/y= ' print. x print. '@' print. y print.
' w/h= ' print. w print. '@' print. h printCR.
].
gc displayArcX:x y:y width:w height:h from:0 angle:360.
"Created: / 8.1.1998 / 00:44:31 / cg"
"Modified: / 28.1.1998 / 23:24:48 / cg"
!
_WGraphics_drawPolygon:nativeContext
|gc xVector yVector count points|
gc := self gcForWGraphics:nativeContext.
"/ gc isNil ifTrue:[^ self].
gc realized ifFalse:[^ self].
xVector := nativeContext argAt:1.
yVector := nativeContext argAt:2.
count := nativeContext argAt:3.
DrawOPTrace ifTrue:[
'drawPolgon' printCR.
].
points := (1 to:count) collect:[:i | (xVector at:i) @ (yVector at:i)].
gc displayPolygon:points
"Created: / 8.1.1998 / 00:57:28 / cg"
"Modified: / 8.1.1998 / 00:57:49 / cg"
!
_WGraphics_drawRect:nativeContext
|gc x y w h|
gc := self gcForWGraphics:nativeContext.
"/ gc isNil ifTrue:[^ self].
gc realized ifFalse:[^ self].
x := nativeContext argAt:1.
y := nativeContext argAt:2.
w := nativeContext argAt:3.
h := nativeContext argAt:4.
"/ self halt.
"/ self internalError:'breakPoint'.
gc displayRectangleX:x y:y width:w height:h.
"Modified: / 8.1.1998 / 00:34:33 / cg"
"Created: / 8.1.1998 / 00:59:05 / cg"
!
_WGraphics_drawRoundRect:nativeContext
|gc x y w h|
gc := self gcForWGraphics:nativeContext.
"/ gc isNil ifTrue:[^ self].
gc realized ifFalse:[^ self].
x := nativeContext argAt:1.
y := nativeContext argAt:2.
w := nativeContext argAt:3.
h := nativeContext argAt:4.
"/ self halt.
"/ self internalError:'breakPoint'.
gc displayRectangleX:x y:y width:w height:h.
"Modified: / 8.1.1998 / 00:34:33 / cg"
"Created: / 8.1.1998 / 00:59:26 / cg"
!
_WGraphics_fillArc:nativeContext
|gc x y w h startAngle endAngle|
gc := self gcForWGraphics:nativeContext.
"/ gc isNil ifTrue:[^ self].
gc realized ifFalse:[^ self].
x := nativeContext argAt:1.
y := nativeContext argAt:2.
w := nativeContext argAt:3.
h := nativeContext argAt:4.
startAngle := nativeContext argAt:5.
endAngle := nativeContext argAt:6.
DrawOPTrace ifTrue:[
'fillArc x/y= ' print. x print. '@' print. y print.
' w/h= ' print. w print. '@' print. h print.
' startAngle= ' print. startAngle print. ' endAngle= ' print. endAngle printCR.
].
gc fillArcX:x y:y width:w height:h from:startAngle angle:(endAngle - startAngle)
"Created: / 6.1.1998 / 21:11:31 / cg"
"Modified: / 8.1.1998 / 00:33:59 / cg"
!
_WGraphics_fillOval:nativeContext
|gc x y w h|
gc := self gcForWGraphics:nativeContext.
"/ gc isNil ifTrue:[^ self].
gc realized ifFalse:[^ self].
x := nativeContext argAt:1.
y := nativeContext argAt:2.
w := nativeContext argAt:3.
h := nativeContext argAt:4.
DrawOPTrace ifTrue:[
'drawOval x/y= ' print. x print. '@' print. y print.
' w/h= ' print. w print. '@' print. h printCR.
].
gc fillArcX:x y:y width:w height:h from:0 angle:360
"Created: / 8.1.1998 / 00:46:00 / cg"
"Modified: / 8.1.1998 / 00:46:20 / cg"
!
_WGraphics_fillPolygon:nativeContext
|gc xVector yVector count points|
gc := self gcForWGraphics:nativeContext.
"/ gc isNil ifTrue:[^ self].
gc realized ifFalse:[^ self].
xVector := nativeContext argAt:1.
yVector := nativeContext argAt:2.
count := nativeContext argAt:3.
DrawOPTrace ifTrue:[
'fillPolgon' printCR.
].
points := (1 to:count-1) collect:[:i | (xVector at:i) @ (yVector at:i)].
gc fillPolygon:points
"Created: / 8.1.1998 / 00:58:09 / cg"
"Modified: / 25.1.1998 / 11:03:19 / cg"
!
_WGraphics_fillRect:nativeContext
|gc x y w h|
gc := self gcForWGraphics:nativeContext.
"/ gc isNil ifTrue:[^ self].
gc realized ifFalse:[^ self].
x := nativeContext argAt:1.
y := nativeContext argAt:2.
w := nativeContext argAt:3.
h := nativeContext argAt:4.
"/ self halt.
"/ self internalError:'breakPoint'.
gc fillRectangleX:x y:y width:w height:h.
"Created: / 15.8.1997 / 15:43:10 / cg"
"Modified: / 8.1.1998 / 00:34:33 / cg"
!
_WGraphics_fillRoundRect:nativeContext
|gc x y w h|
gc := self gcForWGraphics:nativeContext.
"/ gc isNil ifTrue:[^ self].
gc realized ifFalse:[^ self].
x := nativeContext argAt:1.
y := nativeContext argAt:2.
w := nativeContext argAt:3.
h := nativeContext argAt:4.
"/ self halt.
"/ self internalError:'breakPoint'.
gc displayRectangleX:x y:y width:w height:h.
"Modified: / 8.1.1998 / 00:34:33 / cg"
"Created: / 8.1.1998 / 00:59:36 / cg"
!
_WGraphics_getClipBounds:nativeContext
|gc rect r x y w h|
gc := self gcForWGraphics:nativeContext.
"/ gc isNil ifTrue:[^ self].
rect := (Java classForName:'java.awt.Rectangle') basicNew.
(gc isMemberOf:JavaView) ifTrue:[
r := gc getNextUpdateRectangle.
r isNil ifTrue:[
x := y := 0.
w := (gc width).
h := (gc height).
] ifFalse:[
x := (r left).
y := (r top).
w := (r width).
h := (r height).
]
] ifFalse:[
x := y := 0.
"/ w := h := 9999.
w := (gc width).
h := (gc height).
].
rect instVarNamed:'x' put:x.
rect instVarNamed:'y' put:y.
rect instVarNamed:'width' put:w.
rect instVarNamed:'height' put:h.
"/ 'JAVA: getClipBounds' infoPrintCR.
"/ self halt.
^ rect
"Created: / 6.1.1998 / 20:58:07 / cg"
"Modified: / 17.1.1998 / 12:08:48 / cg"
!
_WGraphics_imageCreate:nativeContext
|jGraphics imgRep|
jGraphics := nativeContext receiver.
imgRep := nativeContext argAt:1.
jGraphics instVarNamed:'pData' put:(imgRep instVarNamed:'pData').
"/ self halt.
"Created: / 11.1.1998 / 16:34:30 / cg"
"Modified: / 17.1.1998 / 12:37:18 / cg"
!
_WGraphics_pSetFont:nativeContext
|gc jFont stFont|
gc := self gcForWGraphics:nativeContext.
jFont := nativeContext argAt:1.
stFont := jFont instVarNamed:'pData'.
(stFont isNil or:[stFont == 0]) ifTrue:[
"/ self halt.
] ifFalse:[
gc font:stFont
].
"Created: / 6.1.1998 / 20:56:47 / cg"
"Modified: / 15.1.1998 / 12:31:20 / cg"
!
_WGraphics_pSetForeground:nativeContext
|gc rgb clr|
gc := self gcForWGraphics:nativeContext.
rgb := nativeContext argAt:1.
clr := Color rgbValue:rgb.
gc paint:clr.
"/ self halt.
"/ self internalError:'breakPoint'.
"Created: / 6.1.1998 / 20:56:14 / cg"
"Modified: / 8.1.1998 / 00:34:51 / cg"
!
_WGraphics_setPaintMode:nativeContext
|gc|
gc := self gcForWGraphics:nativeContext.
gc function:#copy.
true "DrawOPTrace" ifTrue:[
'copyMode' infoPrintCR.
].
"Created: / 8.1.1998 / 00:33:44 / cg"
"Modified: / 28.1.1998 / 23:25:56 / cg"
!
_WGraphics_setXORMode:nativeContext
|gc jColor rgb invColor device|
gc := self gcForWGraphics:nativeContext.
jColor := nativeContext argAt:1.
device := gc graphicsDevice.
"/ "/ on trueColor systems, use the provided
"/ "/ rgb value for inverting.
"/ "/ on palette systems, use white ^ black
"/
"/ device visualType == #TrueColor ifTrue:[
"/ rgb := jColor instVarNamed:'value'.
"/ rgb := rgb bitAnd:16rFFFFFF.
"/ rgb == 0 ifTrue:[
"/ rgb := 16rFFFFFF.
"/ ].
"/ invColor := rgb
"/ ] ifFalse:[
"/ invColor := device blackpixel bitXor:device whitepixel.
"/ ].
invColor := device blackpixel bitXor:device whitepixel.
"/ gc foreground:(Color colorId:invColor)
"/ background:device blackColor.
device
setForeground:invColor background:0
in:gc gcId.
gc function:#xor.
true "DrawOPTrace" ifTrue:[
'xorMode' infoPrintCR.
].
"Created: / 8.1.1998 / 00:36:17 / cg"
"Modified: / 28.1.1998 / 23:45:03 / cg"
!
_WLabelPeer_create:nativeContext
|jLabelPeer jLabel jFrame frame label
lbl|
jLabelPeer := nativeContext receiver.
jLabel := jLabelPeer instVarNamed:'target'.
lbl := jLabel instVarNamed:'text'.
lbl notNil ifTrue:[
lbl := Java as_ST_String:lbl
].
jFrame := nativeContext argAt:1.
frame := jFrame instVarNamed:'pData'.
label := Label in:frame.
lbl notNil ifTrue:[
label label:lbl
].
self createdWindowsView:label for:jLabelPeer.
WindowCreationTrace == true ifTrue:[
'WLabelPeer_create: ' print. frame print. ' -> ' print. label printNL.
].
"Created: / 7.1.1998 / 21:42:31 / cg"
"Modified: / 13.1.1998 / 22:10:47 / cg"
!
_WLabelPeer_setAlignment:nativeContext
|label alignNr|
alignNr := nativeContext argAt:1.
label := self viewForWPeer:nativeContext.
label notNil ifTrue:[
].
"Created: / 7.1.1998 / 21:43:12 / cg"
"Modified: / 8.1.1998 / 17:35:29 / cg"
!
_WLabelPeer_setText:nativeContext
|label jString|
jString := nativeContext argAt:1.
label := self viewForWPeer:nativeContext.
label label:(Java as_ST_String:jString)
"Created: / 7.1.1998 / 21:43:51 / cg"
"Modified: / 8.1.1998 / 17:35:50 / cg"
!
_WListPeer_addItem:nativeContext
|jString index selListView|
selListView := self viewForWPeer:nativeContext.
jString := nativeContext argAt:1.
index := nativeContext argAt:2.
selListView model list addLast:(Java as_ST_String:jString).
selListView model changed:#list.
"Modified: / 24.1.1998 / 18:51:32 / cg"
"Created: / 24.1.1998 / 21:10:05 / cg"
!
_WListPeer_create:nativeContext
|jListPeer jFrame frame selectionInListView|
jListPeer := nativeContext receiver.
jFrame := nativeContext argAt:1.
frame := jFrame instVarNamed:'pData'.
selectionInListView := ScrollableView for:SelectionInListView in:frame.
selectionInListView action:[:index | jListPeer perform:#'handleListChanged(I)V' with:(index - 1)].
selectionInListView doubleClickAction:[:index | jListPeer perform:#'handleAction(I)V' with:(index - 1)].
selectionInListView model:(SelectionInList new list:(OrderedCollection new)).
selectionInListView useIndex:true.
self createdWindowsView:selectionInListView for:jListPeer.
WindowCreationTrace == true ifTrue:[
'WTextAreaPeer_create: ' print. frame print. ' -> ' print. selectionInListView printNL.
].
"Created: / 24.1.1998 / 19:58:54 / cg"
"Modified: / 25.1.1998 / 01:29:40 / cg"
!
_WListPeer_isSelected:nativeContext
|selectionInListView index model|
selectionInListView := self viewForWPeer:nativeContext.
index := nativeContext argAt:1.
(model := selectionInListView model) notNil ifTrue:[
(model selectionIndex == (index + 1)) "/ JAVA indexing starts at 0
ifTrue:[
^ 1
]
].
^ 0.
"Created: / 24.1.1998 / 22:42:31 / cg"
"Modified: / 25.1.1998 / 01:35:32 / cg"
!
_WListPeer_select:nativeContext
|selectionInListView index model|
selectionInListView := self viewForWPeer:nativeContext.
index := nativeContext argAt:1.
(model := selectionInListView model) notNil ifTrue:[
model selectionIndex:(index + 1). "/ JAVA indexing starts at 0
]
"Created: / 24.1.1998 / 22:32:35 / cg"
"Modified: / 25.1.1998 / 01:28:46 / cg"
!
_WListPeer_setMultipleSelections:nativeContext
|selectionInListView onOff|
selectionInListView := self viewForWPeer:nativeContext.
onOff := (nativeContext argAt:1) ~~ 0.
selectionInListView multipleSelectOk:onOff.
"Modified: / 24.1.1998 / 20:01:06 / cg"
!
_WMenuBarPeer_create:nativeContext
|jMenuBarPeer jMenuBar jFrame frame menuBar|
jMenuBarPeer := nativeContext receiver.
jMenuBar := jMenuBarPeer instVarNamed:'target'.
jFrame := nativeContext argAt:1.
frame := jFrame instVarNamed:'pData'.
menuBar := MenuPanel in:frame.
menuBar verticalLayout:false.
menuBar realize.
self createdWindowsView:menuBar for:jMenuBarPeer.
WindowCreationTrace == true ifTrue:[
'WMenuBarPeer_create: ' print. frame print. ' -> ' print. menuBar printNL.
].
"Created: / 7.1.1998 / 21:38:31 / cg"
"Modified: / 25.1.1998 / 13:19:03 / cg"
!
_WMenuItemPeer_create:nativeContext
|jMenuItemPeer jMenuItem jMenuPeer menu item lbl|
jMenuItemPeer := nativeContext receiver.
jMenuItem := jMenuItemPeer instVarNamed:'target'.
jMenuPeer := nativeContext argAt:1.
menu := jMenuPeer instVarNamed:'pData'.
item := menu createAtIndex:nil.
item value:[jMenuItemPeer perform:#'handleAction(I)V' with:0].
lbl := jMenuItem instVarNamed:'label'.
lbl notNil ifTrue:[
lbl := Java as_ST_String:lbl.
item label:lbl
].
jMenuItemPeer instVarNamed:'pData' put:item.
WindowOPTrace == true ifTrue:[
'WMenuItem_create: ' print. menu print. ' -> ' print. item printNL.
].
"Created: / 7.1.1998 / 21:40:44 / cg"
"Modified: / 14.1.1998 / 17:55:01 / cg"
!
_WMenuItemPeer_enable:nativeContext
|jMenuItemPeer item state|
jMenuItemPeer := nativeContext receiver.
item := jMenuItemPeer instVarNamed:'pData'.
state := nativeContext argAt:1.
item enabled:(state == 0) not
"Modified: / 4.8.1997 / 03:05:50 / cg"
"Created: / 7.1.1998 / 22:41:38 / cg"
!
_WMenuPeer_createMenu:nativeContext
|jMenuPeer jMenu jMenuBarPeer menuPanel menu
lbl item|
jMenuPeer := nativeContext receiver.
jMenu := jMenuPeer instVarNamed:'target'.
jMenuBarPeer := nativeContext argAt:1.
menuPanel := jMenuBarPeer instVarNamed:'pData'.
item := menuPanel createAtIndex:nil.
lbl := jMenu instVarNamed:'label'.
lbl notNil ifTrue:[
lbl := Java as_ST_String:lbl.
item label:lbl
].
menu := MenuPanel new.
item submenu:menu.
jMenuPeer instVarNamed:'pData' put:menu.
'createMenuPeer: ' print. menuPanel print. ' -> ' print. menu printNL.
"Created: / 7.1.1998 / 21:39:50 / cg"
"Modified: / 13.1.1998 / 22:11:09 / cg"
!
_WScrollbarPeer__setValues:nativeContext
|scrollBar value visibleAmount min max|
scrollBar := self viewForWPeer:nativeContext.
value := nativeContext argAt:1.
visibleAmount := nativeContext argAt:2.
min := nativeContext argAt:3.
max := nativeContext argAt:4.
(min ~~ 0
or:[max ~~ 100]) ifTrue:[
scrollBar thumb start:min stop:max.
].
scrollBar thumbOrigin:value thumbHeight:visibleAmount.
"Created: / 13.1.1998 / 22:13:57 / cg"
"Modified: / 25.1.1998 / 11:51:14 / cg"
!
_WScrollbarPeer_create:nativeContext
|jScrollbarPeer jScrollbar jFrame frame scrollBar
lbl min max|
jScrollbarPeer := nativeContext receiver.
jScrollbar := jScrollbarPeer instVarNamed:'target'.
jFrame := nativeContext argAt:1.
frame := jFrame instVarNamed:'pData'.
(jScrollbar instVarNamed:'orientation') == 0 "HORIZONTAL" ifTrue:[
scrollBar := HorizontalScrollBar in:frame.
] ifFalse:[
scrollBar := ScrollBar in:frame.
].
min := jScrollbar instVarNamed:'minimum'.
max := jScrollbar instVarNamed:'maximum'.
self createdWindowsView:scrollBar for:jScrollbarPeer.
WindowCreationTrace == true ifTrue:[
'WScrollbarPeer_create: ' print. frame print. ' -> ' print. scrollBar printNL.
].
"Created: / 5.1.1998 / 01:53:30 / cg"
"Modified: / 25.1.1998 / 11:55:14 / cg"
!
_WScrollbarPeer_setLineIncrement:nativeContext
|scrollBar inc|
scrollBar := self viewForWPeer:nativeContext.
inc := nativeContext argAt:1.
"/ scrollBar thumb lineIncrement:inc.
"Created: / 25.1.1998 / 11:52:19 / cg"
!
_WScrollbarPeer_setPageIncrement:nativeContext
|scrollBar inc|
scrollBar := self viewForWPeer:nativeContext.
inc := nativeContext argAt:1.
"/ scrollBar thumb pageIncrement:inc.
"Created: / 25.1.1998 / 11:52:01 / cg"
!
_WTextAreaPeer_create:nativeContext
|jTextAreaPeer jFrame frame editTextView|
jTextAreaPeer := nativeContext receiver.
jFrame := nativeContext argAt:1.
frame := jFrame instVarNamed:'pData'.
editTextView := HVScrollableView for:EditTextView in:frame.
self createdWindowsView:editTextView for:jTextAreaPeer.
WindowCreationTrace == true ifTrue:[
'WTextAreaPeer_create: ' print. frame print. ' -> ' print. editTextView printNL.
].
"Created: / 7.1.1998 / 21:49:49 / cg"
"Modified: / 15.1.1998 / 12:56:18 / cg"
!
_WTextAreaPeer_insertText:nativeContext
|textView pos string jstring|
textView := self viewForWPeer:nativeContext.
jstring := nativeContext argAt:1.
string := Java as_ST_String:jstring.
pos := nativeContext argAt:2.
textView insert:string at:pos.
^ nil
"Created: / 7.1.1998 / 21:50:23 / cg"
"Modified: / 8.1.1998 / 17:36:24 / cg"
!
_WTextComponentPeer_enableEditing:nativeContext
|textView enabled|
textView := self viewForWPeer:nativeContext.
enabled := (nativeContext argAt:1) ~~ 0.
^ textView readOnly:enabled not
"Created: / 5.1.1998 / 01:29:38 / cg"
"Modified: / 25.1.1998 / 16:29:56 / cg"
!
_WTextComponentPeer_getSelectionEnd:nativeContext
|textView|
textView := self viewForWPeer:nativeContext.
^ textView characterPositionOfSelectionEnd
"Created: / 8.1.1998 / 17:41:56 / cg"
"Modified: / 15.1.1998 / 15:47:18 / cg"
!
_WTextComponentPeer_getSelectionStart:nativeContext
|textView|
textView := self viewForWPeer:nativeContext.
^ textView characterPositionOfSelection - 1
"Created: / 15.8.1997 / 15:45:45 / cg"
"Modified: / 15.1.1998 / 15:46:51 / cg"
!
_WTextComponentPeer_getText:nativeContext
|textView string jString|
textView := self viewForWPeer:nativeContext.
string := textView contents asString.
jString := Java as_String:string.
^ jString
"Created: / 6.1.1998 / 21:05:15 / cg"
"Modified: / 8.1.1998 / 17:36:52 / cg"
!
_WTextComponentPeer_select:nativeContext
|textView selStart selEnd|
textView := self viewForWPeer:nativeContext.
selStart := nativeContext argAt:1.
selEnd := nativeContext argAt:2.
selStart == selEnd ifTrue:[
"/ clear selection
textView unselect.
"/ and set caret
textView cursorToCharacterPosition:selStart + 1
] ifFalse:[
"/ change selection
textView selectFromCharacterPosition:selStart+1 to:selEnd
].
"Created: / 15.8.1997 / 15:45:58 / cg"
"Modified: / 15.1.1998 / 21:55:57 / cg"
!
_WTextComponentPeer_setText:nativeContext
|textView string jstring|
textView := self viewForWPeer:nativeContext.
jstring := nativeContext argAt:1.
string := Java as_ST_String:jstring.
textView contents:string.
"Created: / 5.1.1998 / 01:28:23 / cg"
"Modified: / 15.1.1998 / 15:59:57 / cg"
!
_WTextFieldPeer_create:nativeContext
|jTextFieldPeer jFrame frame editField|
jTextFieldPeer := nativeContext receiver.
jFrame := nativeContext argAt:1.
frame := jFrame instVarNamed:'pData'.
editField := EditField in:frame.
self createdWindowsView:editField for:jTextFieldPeer.
editField crAction:[
jTextFieldPeer invoke:#handleAction.
].
WindowCreationTrace == true ifTrue:[
'WTextFieldPeer_create: ' print. frame print. ' -> ' print. editField printNL.
].
"Created: / 5.1.1998 / 01:27:37 / cg"
"Modified: / 25.1.1998 / 20:34:45 / cg"
!
_WTextFieldPeer_setEchoCharacter:nativeContext
|editField char|
editField := self viewForWPeer:nativeContext.
char := nativeContext argAt:1.
editField passwordCharacter:(Character value:char).
"Created: / 25.1.1998 / 16:28:30 / cg"
!
_WToolkit_eventLoop:nativeContext
JavaEventThread := Processor activeProcess.
[
[true] whileTrue:[
AbortSignal handle:[:ex |
ex return
] do:[
self doWindowsEventThread.
]
].
] valueNowOrOnUnwindDo:[
JavaEventThread := nil.
].
"Created: / 6.1.1998 / 21:01:44 / cg"
"Modified: / 15.1.1998 / 19:48:55 / cg"
!
_WToolkit_getScreenHeight:nativeContext
^ Screen current height
"Modified: / 20.3.1997 / 13:50:04 / cg"
"Created: / 13.1.1998 / 09:24:45 / cg"
!
_WToolkit_getScreenResolution:nativeContext
^ Screen current resolution x rounded
"Modified: / 20.3.1997 / 13:50:04 / cg"
"Created: / 17.1.1998 / 21:54:48 / cg"
!
_WToolkit_getScreenWidth:nativeContext
^ Screen current width
"Modified: / 20.3.1997 / 13:50:04 / cg"
"Created: / 13.1.1998 / 09:24:37 / cg"
!
_WToolkit_init:nativeContext
"Created: / 3.1.1998 / 02:30:57 / cg"
!
_WToolkit_loadSystemColors:nativeContext
"/ self halt.
"Modified: / 18.3.1997 / 18:43:26 / cg"
"Created: / 5.1.1998 / 02:19:09 / cg"
!
_WWindowPeer__setResizable:nativeContext
|view onOff|
view := self viewForWPeer:nativeContext.
onOff := (nativeContext argAt:1) == 1.
view isTopView ifTrue:[
onOff ifTrue:[
view minExtent:10@10.
view maxExtent:(Screen current extent).
] ifFalse:[
view minExtent:view extent.
view maxExtent:view extent.
]
] ifFalse:[
(view isMemberOf:JavaEmbeddedFrameView) ifFalse:[
self halt.
]
].
"/ 'JAVA: WWindowPeer_setResizable: ' print. view print. ' yes/no: ' print. onOff printNL.
^ nil
"Created: / 5.1.1998 / 00:57:59 / cg"
"Modified: / 16.1.1998 / 18:08:00 / cg"
!
_WWindowPeer__setTitle:nativeContext
|view jString string|
view := self viewForWPeer:nativeContext.
jString := nativeContext argAt:1.
string := Java as_ST_String:jString.
"/ 'JAVA: WWindowPeer_pSetTitle: ' print. string print. ' ' print. view printNL.
view label:string.
^ nil
"Created: / 5.1.1998 / 00:57:17 / cg"
"Modified: / 8.1.1998 / 17:37:41 / cg"
!
_WWindowPeer_updateInsets:nativeContext
"/ self halt.
"Modified: / 18.3.1997 / 18:43:18 / cg"
"Created: / 4.1.1998 / 18:09:04 / cg"
! !
!JavaVM class methodsFor:'native - sun.awt.windows - jdk1.2'!
_WFramePeer_setTitle:nativeContext
|view jString string|
view := self viewForWPeer:nativeContext.
jString := nativeContext argAt:1.
string := Java as_ST_String:jString.
"/ 'JAVA: WFramePeer_pSetTitle: ' print. string print. ' ' print. view printNL.
view label:string.
^ nil
"Modified: / 8.1.1998 / 17:37:41 / cg"
"Created: / 27.1.1998 / 21:42:57 / cg"
!
_WPanelPeer_calculateInsets:nativeContext
"/ new with jdk1.2 ...
"Created: / 27.1.1998 / 21:40:00 / cg"
! !
!JavaVM class methodsFor:'semaphores & monitors'!
monitorFor:someObject
|mon|
LockTableAccess critical:[
mon := LockTable at:someObject ifAbsent:nil.
mon isNil ifTrue:[
LockTable at:someObject put:(mon := Monitor new)
]
].
^ mon
"Created: / 2.1.1998 / 19:01:52 / cg"
!
releaseAndSignalForAllSemaphoreFor:someObject
|sema|
WaitTableAccess critical:[
sema := WaitTable at:someObject ifAbsent:nil.
"/ sema notNil ifTrue:[
"/ WaitTable removeKey:someObject
"/ ]
].
sema notNil ifTrue:[
sema signalForAll
]
"Created: / 2.1.1998 / 18:21:51 / cg"
"Modified: / 3.2.1998 / 16:11:58 / cg"
!
releaseAndSignalSemaphoreFor:someObject
|sema|
WaitTableAccess critical:[
sema := WaitTable at:someObject ifAbsent:nil.
"/ sema notNil ifTrue:[
"/ WaitTable removeKey:someObject
"/ ]
].
sema notNil ifTrue:[
sema signal
]
"Created: / 2.1.1998 / 18:20:20 / cg"
"Modified: / 3.2.1998 / 16:11:51 / cg"
!
releaseSemaphoreFor:someObject
WaitTableAccess critical:[
WaitTable removeKey:someObject ifAbsent:nil
]
"Created: / 2.1.1998 / 18:17:14 / cg"
"Modified: / 2.1.1998 / 21:52:03 / cg"
!
semaphoreFor:someObject
|sema|
WaitTableAccess critical:[
sema := WaitTable at:someObject ifAbsent:nil.
sema isNil ifTrue:[
WaitTable at:someObject put:(sema := Semaphore new)
]
].
^ sema
"Created: / 2.1.1998 / 18:15:59 / cg"
"Modified: / 2.1.1998 / 18:20:31 / cg"
! !
!JavaVM class methodsFor:'vm support'!
monitorEnter:someObject
| mon thisProcess|
someObject isNil ifTrue:[
self halt
].
mon := self monitorFor:someObject.
MonitorTrace ifTrue:[
('====> entering monitor for ' , someObject displayString , ' in ' , Processor activeProcess name , ' ...') printCR.
].
mon enter.
MonitorTrace ifTrue:[
('====> entered it in ' , Processor activeProcess name , ' ...') printCR.
].
self enteredMonitors add:someObject.
"Created: / 2.1.1998 / 23:44:49 / cg"
"Modified: / 3.1.1998 / 03:05:02 / cg"
!
monitorExit:someObject
| mon thisProcess|
someObject isNil ifTrue:[
self halt
].
mon := self monitorFor:someObject.
MonitorTrace ifTrue:[
('====> leaving monitor for ' , someObject displayString , ' in ' , Processor activeProcess name , ' ...') printCR.
].
mon exit.
MonitorTrace ifTrue:[
('====> left it in ' , Processor activeProcess name , ' ...') printCR.
].
"/ enteredMonitorHandles isNil ifTrue:[
"/ self halt:'oops - no monitor entered'.
"/ ].
self enteredMonitors removeLast ~~ someObject ifTrue:[
self halt:'oops - monitor enter/exit nesting wrong'
].
"Created: / 2.1.1998 / 23:47:28 / cg"
"Modified: / 3.1.1998 / 03:05:18 / cg"
! !
!JavaVM class methodsFor:'windows - events'!
awtEventsForEvent:anEvent javaWindow:jWin
"given an ST/X event, create corresponding AWT event(s) for it"
|jEv jEv1 jEv2
modifiers key keyChar untranslatedKey id
type x y w h view menu
eventArgs clickCount jRect
jKeyEventClass jInputEventClass jMouseEventClass
jWindowEventClass jPaintEventClass jComponentEventClass|
type := anEvent type.
eventArgs := anEvent arguments.
key := 0.
modifiers := 0.
x := 0.
y := 0.
jInputEventClass := Java classForName:'java.awt.event.InputEvent'.
(anEvent isKeyEvent
or:[anEvent isButtonEvent
or:[anEvent isPointerEnterLeaveEvent]]) ifTrue:[
anEvent hasAlt ifTrue:[
modifiers := modifiers bitOr:(jInputEventClass instVarNamed:'ALT_MASK')
].
anEvent hasCtrl ifTrue:[
modifiers := modifiers bitOr:(jInputEventClass instVarNamed:'CTRL_MASK')
].
anEvent hasMeta ifTrue:[
modifiers := modifiers bitOr:(jInputEventClass instVarNamed:'META_MASK')
].
anEvent hasShift ifTrue:[
modifiers := modifiers bitOr:(jInputEventClass instVarNamed:'SHIFT_MASK')
].
anEvent hasButton1 ifTrue:[
modifiers := modifiers bitOr:(jInputEventClass instVarNamed:'BUTTON1_MASK')
].
anEvent hasButton2 ifTrue:[
modifiers := modifiers bitOr:(jInputEventClass instVarNamed:'BUTTON2_MASK')
].
anEvent hasButton3 ifTrue:[
modifiers := modifiers bitOr:(jInputEventClass instVarNamed:'BUTTON3_MASK')
].
anEvent isPointerEnterLeaveEvent ifFalse:[
"/ ST/X does not (yet) record this information
"/ with pointerLeave events.
x := anEvent x.
y := anEvent y.
].
].
anEvent isKeyEvent ifTrue:[
jKeyEventClass := Java classForName:'java.awt.event.KeyEvent'.
key := 0.
keyChar := 0.
key := anEvent key.
key isCharacter ifTrue:[
key := keyChar := key asciiValue
] ifFalse:[
untranslatedKey := anEvent view device keyboardMap keyAtValue:key ifAbsent:key.
untranslatedKey == #Delete ifTrue:[
key := jKeyEventClass instVarNamed:'VK_DELETE' "/ 127
].
untranslatedKey == #BackSpace ifTrue:[
key := jKeyEventClass instVarNamed:'VK_BACK_SPACE' "/ 8
].
untranslatedKey == #Return ifTrue:[
key := jKeyEventClass instVarNamed:'VK_ENTER' "/ 13
].
untranslatedKey == #Tab ifTrue:[
key := jKeyEventClass instVarNamed:'VK_TAB' "/ 9
].
untranslatedKey == #Home ifTrue:[
key := jKeyEventClass instVarNamed:'VK_HOME'
].
untranslatedKey == #End ifTrue:[
key := jKeyEventClass instVarNamed:'VK_END'
].
untranslatedKey == #Prior ifTrue:[
key := jKeyEventClass instVarNamed:'VK_PAGE_UP'
].
key == #EndOfText ifTrue:[
key := jKeyEventClass instVarNamed:'VK_PAGE_DOWN'
].
untranslatedKey == #CursorUp ifTrue:[
key := jKeyEventClass instVarNamed:'VK_UP'
].
untranslatedKey == #CursorDown ifTrue:[
key := jKeyEventClass instVarNamed:'VK_DOWN'
].
untranslatedKey == #CursorLeft ifTrue:[
key := jKeyEventClass instVarNamed:'VK_LEFT'
].
untranslatedKey == #CursorRight ifTrue:[
key := jKeyEventClass instVarNamed:'VK_RIGHT'
].
(#( F1 F2 F3 F4 F5 F6 F7 F8 F9 F10 F11)
includes:untranslatedKey) ifTrue:[
key := jKeyEventClass instVarNamed:('VK_' , untranslatedKey)
].
].
(type == #'keyPress:x:y:') ifTrue:[
id := jKeyEventClass instVarNamed:'KEY_PRESSED'
] ifFalse:[
id := jKeyEventClass instVarNamed:'KEY_RELEASED'
].
jEv := jKeyEventClass newCleared "basicNew".
jEv instVarNamed:'modifiers' put:modifiers.
jEv instVarNamed:'keyCode' put:key.
jEv instVarNamed:'keyChar' put:keyChar.
jEv instVarNamed:'id' put:id.
"/ jEv instVarNamed:'x' put:x.
"/ jEv instVarNamed:'y' put:y.
jEv instVarNamed:'when' put:(OperatingSystem getMillisecondTime).
^ Array with:jEv
].
(anEvent isButtonEvent
or:[anEvent isPointerEnterLeaveEvent]) ifTrue:[
jMouseEventClass := Java classForName:'java.awt.event.MouseEvent'.
clickCount := 1.
(type == #'buttonPress:x:y:') ifTrue:[
id := jMouseEventClass instVarNamed:'MOUSE_PRESSED'.
] ifFalse:[
(type == #'buttonRelease:x:y:') ifTrue:[
id := jMouseEventClass instVarNamed:'MOUSE_RELEASED'.
] ifFalse:[
(type == #'buttonMotion:x:y:') ifTrue:[
(anEvent arguments at:1) == 0 ifTrue:[
id := jMouseEventClass instVarNamed:'MOUSE_MOVED'.
] ifFalse:[
id := jMouseEventClass instVarNamed:'MOUSE_DRAGGED'.
].
] ifFalse:[
"/ (type == #'pointerMotion:x:y:') ifTrue:[
"/ id := jMouseEventClass instVarNamed:'MOUSE_MOVED'.
"/ ] ifFalse:[
(type == #'pointerEnter:x:y:') ifTrue:[
id := jMouseEventClass instVarNamed:'MOUSE_ENTERED'.
] ifFalse:[
(type == #'pointerLeave:') ifTrue:[
id := jMouseEventClass instVarNamed:'MOUSE_EXITED'.
] ifFalse:[
(type == #'buttonMultiPress:x:y:') ifTrue:[
id := jMouseEventClass instVarNamed:'MOUSE_PRESSED'.
clickCount := 2.
] ifFalse:[
self halt.
]
]
"/ ]
]
]
]
].
jEv := jMouseEventClass newCleared "basicNew".
jEv instVarNamed:'modifiers' put:modifiers.
jEv instVarNamed:'id' put:id.
jEv instVarNamed:'x' put:x.
jEv instVarNamed:'y' put:y.
jEv instVarNamed:'when' put:(OperatingSystem getMillisecondTime).
^ Array with:jEv
].
((type == #'exposeX:y:width:height:')
or:[(type == #'graphicExposeX:y:width:height:')
or:[(type == #damage)]]) ifTrue:[
jPaintEventClass := Java classForName:'java.awt.event.PaintEvent'.
jWindowEventClass := Java classForName:'java.awt.event.WindowEvent'.
"/ id := (jPaintEventClass instVarNamed:'PAINT').
id := (jPaintEventClass instVarNamed:'UPDATE').
((type == #'exposeX:y:width:height:')
or:[(type == #'graphicExposeX:y:width:height:')]) ifTrue:[
x := eventArgs at:1.
y := eventArgs at:2.
w := eventArgs at:3.
h := eventArgs at:4.
] ifFalse:[
x := eventArgs left.
y := eventArgs top.
w := eventArgs width.
h := eventArgs height.
].
jRect := (Java classForName:'java.awt.Rectangle') basicNew.
jRect instVarNamed:'x' put:x.
jRect instVarNamed:'y' put:y.
jRect instVarNamed:'width' put:w.
jRect instVarNamed:'height' put:h.
jEv := jPaintEventClass newCleared "basicNew".
jEv instVarNamed:'id' put:id.
jEv instVarNamed:'updateRect' put:jRect.
"/ jEv instVarNamed:'g' put:jWin.
^ Array with:jEv.
].
(type == #'configureX:y:width:height:') ifTrue:[
"/ x := eventArgs at:1.
"/ y := eventArgs at:2.
view := anEvent view.
w := eventArgs at:3.
h := eventArgs at:4.
"/
"/ must change the components extent
"/ is there no cleaner way to do this ?
"/
view isTopView ifTrue:[
"/
"/ sigh - don't include the menu.
"/
menu := self topViewsMenu:view.
menu notNil ifTrue:[
"/ must add the menus height
h := h - menu height
]
].
jWin instVarNamed:'width' put:w.
jWin instVarNamed:'height' put:h.
jComponentEventClass := Java classForName:'java.awt.event.ComponentEvent'.
id := (jComponentEventClass instVarNamed:'COMPONENT_MOVED').
jEv1 := jComponentEventClass newCleared "basicNew".
jEv1 instVarNamed:'id' put:id.
id := (jComponentEventClass instVarNamed:'COMPONENT_RESIZED').
jEv2 := jComponentEventClass newCleared "basicNew".
jEv2 instVarNamed:'id' put:id.
^ Array with:jEv1 with:jEv2.
].
(type == #'focusIn') ifTrue:[
"/ 'focusIn' printCR.
jComponentEventClass := Java classForName:'java.awt.event.FocusEvent'.
id := (jComponentEventClass instVarNamed:'FOCUS_GAINED').
jEv := jComponentEventClass newCleared "basicNew".
jEv instVarNamed:'id' put:id.
^ Array with:jEv.
].
(type == #'focusOut') ifTrue:[
"/ 'focusOut' printCR.
jComponentEventClass := Java classForName:'java.awt.event.FocusEvent'.
id := (jComponentEventClass instVarNamed:'FOCUS_LOST').
jEv := jComponentEventClass newCleared "basicNew".
jEv instVarNamed:'id' put:id.
^ Array with:jEv.
].
(type == #'mapped') ifTrue:[
"/ 'mapped' printCR.
jComponentEventClass := Java classForName:'java.awt.event.ComponentEvent'.
id := (jComponentEventClass instVarNamed:'COMPONENT_SHOWN').
"/ x := eventArgs at:1.
"/ y := eventArgs at:2.
jEv := jComponentEventClass newCleared "basicNew".
jEv instVarNamed:'id' put:id.
^ Array with:jEv.
].
(type == #'unmapped') ifTrue:[
"/ 'unmapped' printCR.
jComponentEventClass := Java classForName:'java.awt.event.ComponentEvent'.
id := (jComponentEventClass instVarNamed:'COMPONENT_HIDDEN').
"/ x := eventArgs at:1.
"/ y := eventArgs at:2.
jEv := jComponentEventClass newCleared "basicNew".
jEv instVarNamed:'id' put:id.
^ Array with:jEv.
].
(type == #terminate) ifTrue:[
jWindowEventClass := Java classForName:'java.awt.event.WindowEvent'.
id := (jWindowEventClass instVarNamed:'WINDOW_CLOSED').
jEv := jWindowEventClass newCleared "basicNew".
jEv instVarNamed:'id' put:id.
^ Array with:jEv.
].
EventTrace == true ifTrue:[
('JAVA: unhandled event:' , type) infoPrintCR.
].
^ nil.
"Created: / 6.1.1998 / 20:38:58 / cg"
"Modified: / 6.2.1998 / 03:07:00 / cg"
!
doWindowsEventThread
"invoked in an endless loop by the WToolkit-eventLoop
native method."
|sensor event more|
JavaWindowGroup isNil ifTrue:[
"/ '*** eventThread: no windowGroup ...' printCR.
FirstWindowCreationSemaphore wait.
"/ Delay waitForSeconds:0.1.
^ self
].
KnownWindows isNil ifTrue:[
"/ '*** eventThread: no views ...' printCR.
FirstWindowCreationSemaphore wait.
"/ Delay waitForSeconds:0.1.
^ self
].
"/ wait for an event to arrive ...
sensor := JavaWindowGroup sensor.
[sensor hasEvents or:[sensor hasDamage]] whileFalse:[
EventTrace ifTrue:[
'*** eventThread waiting ...' printCR.
].
Processor activeProcess state:#eventWait.
sensor eventSemaphore wait.
].
EventTrace ifTrue:[
'*** eventThread event arrived ...' printCR.
].
"/ EventTrace := true
more := true.
[more] whileTrue:[
sensor hasDamage ifTrue:[
EventTrace ifTrue:[
'*** eventThread: damage arrived ...' printCR.
].
event := sensor nextDamage.
] ifFalse:[
event := sensor nextEvent.
].
event isNil ifTrue:[
EventTrace == true ifTrue:[
'*** eventThread: nil event ignored' printCR.
].
^ self
].
more := self processEvent:event
]
"Created: / 6.1.1998 / 21:02:40 / cg"
"Modified: / 6.2.1998 / 03:08:12 / cg"
!
processEvent:event
|evQ jEvents jWToolKit jWinPeer jWin v eventConsumed|
KnownWindows isNil ifTrue:[
^ false
].
v := event view.
jWinPeer := self jPeerForView:v.
jWinPeer isNil ifTrue:[
(v isKindOf:JavaView) ifTrue:[
"/ mhmh - an event for a JavaView,
"/ which has no peer (anyMore ?)
"/ should not happen.
] ifFalse:[
"/ mhmh - an event for a subcomponent of an ST widget.
"/ let it be handled normally.
EventTrace ifTrue:[
('*** eventThread: ' , event type , '-event for unknown java-view - passed to view.') printCR.
].
event sendEventWithFocusOn:nil.
].
^ true
].
"/ change:
"/ in the previous version, events for ST/X widgets (i.e. buttons etc)
"/ where not passed to java, but instead forwarded directly to the widget
"/ by the code below.
"/ This has changed, to pass it to Java, which eventually passes it to the
"/ peer via the handleEvent native method (unless the event got consumed).
"/ This is req'd to let java keep track of keyboard/mouse input for widgets.
false ifTrue:[
"/ "/ most views handle their events themself (being ST/X views) ...
"/
"/ v class ~~ JavaView ifTrue:[
"/"/ v class ~~ StandardSystemView ifTrue:[
"/"/ EventTrace ifTrue:[
"/"/ ('*** eventThread: event handled by view itself (' , v class name , ')') printCR.
"/"/ ].
"/"/ event sendEventWithFocusOn:nil.
"/"/ ^ self.
"/"/ ].
"/ (event type == #'exposeX:y:width:height'
"/ or:[event type == #'graphicsExposeX:y:width:height']) ifTrue:[
"/ "/ send to view, but also handle in JAVA
"/ event sendEventWithFocusOn:nil.
"/ ]
"/ ].
(#(
#'mapped'
#'unmapped'
#'configureX:y:width:height:'
#'exposeX:y:width:height:'
#'graphicsExposeX:y:width:height:'
) includes:event type) ifTrue:[
event sendEventWithFocusOn:nil.
].
].
"/ what a kludge - some events are passed back to
"/ ST via the WComponent-handleEvent native method.
"/ However, repaints are not.
"/ In order to let ST widgets do the drawing,
"/ selectively filter exposeEvents from Java ...
eventConsumed := false.
v class == JavaView ifTrue:[
"/ all events handled by Java ...
] ifFalse:[
eventConsumed := true.
"/ let widget handle it.
event sendEventWithFocusOn:nil.
"/ some are not passed to Java ...
event isDamage ifTrue:[
(v isKindOf:TextView) ifTrue:[
^ true
].
(v isKindOf:Label) ifTrue:[
^ true
].
(v isKindOf:ComboBoxView) ifTrue:[
^ true
].
(v isKindOf:ScrollBar) ifTrue:[
^ self
].
(v isKindOf:Scroller) ifTrue:[
^ self
].
(v isKindOf:MenuPanel) ifTrue:[
^ true
].
].
].
jWin := jWinPeer instVarNamed:'target'.
EventTrace ifTrue:[
('*** eventThread: event (' , event type , ') handled by JAVA: ') infoPrint.
jWinPeer class name infoPrint. ' (' infoPrint.
jWin class name infoPrint. ')' infoPrintCR.
].
"/ create an event
jEvents := self awtEventsForEvent:event javaWindow:jWin.
jEvents isNil ifTrue:[
EventTrace ifTrue:[
('*** eventThread: event ignored: ' , event type) printCR.
].
^ true
].
"/ v superView isNil ifTrue:[
"/ ('*** eventThread: event ignored for topView: ' , event type) printCR.
"/ ^ self
"/ ].
jWToolKit := (Java classForName:'java.awt.Toolkit') invoke:#getDefaultToolkit.
jEvents do:[:jEv |
jEv instVarNamed:'source' put:jWin.
jEv instVarNamed:'consumed' put:0.
eventConsumed ifFalse:[
"/ the first gets the original event as data
jEv instVarNamed:'data' put:event.
eventConsumed := true
].
"/ post it (them) to the event queue
EventTrace == true ifTrue:[
'postEvent to Java ...' printCR.
].
jWToolKit class
invoke:#'postEvent(Ljava/awt/AWTEvent;)V'
with:jEv.
].
^ false
"Created: / 6.1.1998 / 20:36:36 / cg"
"Modified: / 6.2.1998 / 01:45:08 / cg"
! !
!JavaVM class methodsFor:'documentation'!
version
^ '$Header: /home/jv/Projects/SmalltalkX/repositories/cvs/stx/libjava/JavaVM.st,v 1.24 1998/02/13 14:57:13 cg Exp $'
! !
JavaVM initialize!