dslinux/user/perl/jpl/JNI Changes Closer.java JNI.pm JNI.xs JNIConfig JNIConfig.Win32 JNIConfig.kaffe JNIConfig.noembed JNIConfig.standard Makefile.PL test.pl typemap typemap.gcc typemap.win32
cayenne
dslinux_cayenne at user.in-berlin.de
Mon Dec 4 18:00:00 CET 2006
Update of /cvsroot/dslinux/dslinux/user/perl/jpl/JNI
In directory antilope:/tmp/cvs-serv17422/jpl/JNI
Added Files:
Changes Closer.java JNI.pm JNI.xs JNIConfig JNIConfig.Win32
JNIConfig.kaffe JNIConfig.noembed JNIConfig.standard
Makefile.PL test.pl typemap typemap.gcc typemap.win32
Log Message:
Adding fresh perl source to HEAD to branch from
--- NEW FILE: JNIConfig.Win32 ---
# Are we using Kaffe?
#
$KAFFE = 0;
# Where are the Java includes?
#
@INCLUDE = ("C:\\jdk1.1.8\\include", "C:\\jdk1.1.8\\include\\win32");
# Are we embedding Perl in Java?
#
$EMBEDDEDPERL = 0;
# Extra C flags
#
$CCFLAGS=" -Z7 -D_DEBUG";
$MYEXTLIB = "C:\\jdk1.1.8\\lib\\javai.lib " .
"$Config{installarchlib}\\CORE\\perlcore.lib " .
"$Config{installarchlib}\\CORE\\perlcapi.lib";
1;
--- NEW FILE: Makefile.PL ---
#!/usr/bin/perl
use ExtUtils::MakeMaker;
use Getopt::Std;
use Config;
$ARCHNAME = $Config{archname};
use File::Basename;
getopts('e'); # embedding?
$CCFLAGS .= $ENV{CCFLAGS} if defined $ENV{CCFLAGS};
# $USE_KAFFE is a boolean that tells us whether or not we should use Kaffe.
# Set by find_includes (it seemed as good a place as any).
# Note that we don't check to see the version of Kaffe is one we support.
# Currently, the only one we support is the one from CVS.
my $USE_KAFFE = 0;
#require "JNIConfig";
if ($^O eq 'solaris') {
$LIBPATH = " -R$Config{archlib}/CORE -L$Config{archlib}/CORE";
} elsif ($^O eq 'MSWin32') {
$LIBPATH = " -L$Config{archlib}\\CORE";
# MSR - added MS VC++ default library path
# bjepson - fixed to support path names w/spaces in them.
push(@WINLIBS, (split"\;",$ENV{LIB}));
grep s/\\$//, @WINLIBS; # eliminate trailing \
grep s/\/$//, @WINLIBS; # eliminate trailing /
$LIBPATH .= join(" ", "", map { qq["-L$_" ] } @WINLIBS);
} else {
$LIBPATH = " -L$Config{archlib}/CORE";
}
#$LIBS = " -lperl";
# Figure out where Java might live
#
# MSR - added JDK 1.3
#
my @JAVA_HOME_GUESSES = qw(/usr/local/java /usr/java /usr/local/jdk117_v3
C:\\JDK1.1.8 C:\\JDK1.2.1 C:\\JDK1.2.2 C:\\JDK1.3 );
my @KAFFE_PREFIX_GUESSES = qw(/usr/local /usr);
if (! defined $ENV{JAVA_HOME}) {
print "You didn't define JAVA_HOME, so I'm trying a few guesses.\n";
print "If this fails, you might want to try setting JAVA_HOME and\n";
print "running me again.\n";
} else {
@JAVA_HOME_GUESSES = ( $ENV{JAVA_HOME} );
}
if (! defined $ENV{KAFFE_PREFIX}) {
print "\nYou didn't define KAFFE_PREFIX, so I'm trying a few guesses.",
"\nIf this fails, and you are using Kaffe, you might want to try\n",
"setting KAFFE_PREFIX and running me again.\n",
"If you want to ignore any possible Kaffe installation, set the\n",
"KAFFE_PREFIX to and empty string.\n\n";
} else {
@KAFFE_PREFIX_GUESSES = ($ENV{KAFFE_PREFIX} eq "") ? () :
( $ENV{KAFFE_PREFIX} );
}
my(@KAFFE_INCLUDE_GUESSES, @KAFFE_LIB_GUESSES);
foreach my $kaffePrefix (@KAFFE_PREFIX_GUESSES) {
push(@KAFFE_INCLUDE_GUESSES, "$kaffePrefix/include/kaffe");
push(@KAFFE_LIB_GUESSES, "$kaffePrefix/lib");
push(@KAFFE_LIB_GUESSES, "$kaffePrefix/lib/kaffe");
}
$guess .= "/include/kaffe";
# Let's find out where jni.h lives
#
my @INCLUDE = find_includes();
if ($^O eq 'MSWin32') {
# MSR - added MS VC++ default include path
push(@INCLUDE,(split"\;",$ENV{INCLUDE}));
grep s/\\$//, @INCLUDE; # remove trailing \
grep s/\/$//, @INCLUDE; # remove trailing \
$INC = join("", map { qq["-I$_" ] } @INCLUDE);
} else {
$INC = join(" -I", ("", @INCLUDE));
}
# Let's find out the name of the Java shared library
#
my @JAVALIBS = find_libs();
# Find out some defines based on the library we are linking to
#
foreach (@JAVALIBS) {
if ( $^O eq 'MSWin32') { # We're on Win32
$INC =~ s#/#\\#g;
$INC =~ s#\\$##;
print $INC, "\n";
$CCFLAGS .= " -DWIN32 -Z7 -D_DEBUG";
$MYEXTLIB = "$libjava";
}
}
$CCFLAGS .= " -DKAFFE" if ($USE_KAFFE);
# Let's find out the path of the library we need to link against.
#
foreach (@JAVALIBS) {
if ($^O eq 'MSWin32') { # We're on Win32
$_ =~ s#/#\\\\#g;
}
my ($libname, $libpath, $libsuffix) = fileparse($_, ("\.so", "\.lib"));
$libname =~ s/^lib//;
if ($^O eq 'solaris') {
$LIBPATH .= " -R$libpath -L$libpath"
} else {
$LIBPATH .= " -L$libpath"
}
$LIBS .= " -l$libname";
}
# Do we need -D_REENTRANT?
if ($LIBPATH =~ /native/) {
print "Looks like native threads...\n";
$CCFLAGS .= " -D_REENTRANT";
}
if ($opt_e) {
print "We're embedding Perl in Java via libPerlInterpreter.so.\n";
eval `../setvars -perl`;
$CCFLAGS .= " -DEMBEDDEDPERL";
$LIBPATH .= " -R$ENV{JPL_HOME}/lib/$ARCHNAME -L$ENV{JPL_HOME}/lib/$ARCHNAME";
$LIBS .= " -lPerlInterpreter";
}
# Needed for JNI.
if ($^O eq 'solaris') {
$LIBS = " -lthread -lc $LIBS"; #-lthread must be first!!!
$CCFLAGS .= " -D_REENTRANT";
}
# MSR - clean up LIBS
$LIBS =~ s/-l$//;
#
# Next, build JNI/Config.pm. This is a superfluous thing for the SUN and
# Microsoft JDKs, but absolutely necessary for Kaffe. I think at some
# point, the Microsoft and SUN implementations should use JNI::Config, too.
#
if (! -d "JNI") {
mkdir("JNI", 0755) || die "Unable to make JNI directory: $!";
}
open(JNICONFIG, ">JNI/Config.pm") || die "Unable to open JNI/Config.pm: $!";
print JNICONFIG "# DO NOT EDIT! Autogenerated by JNI/Makefile.PL\n\n",
"package JNI::Config;\nuse strict;\nuse Carp;\n",
"\nuse vars qw(\$KAFFE \$LIB_JAVA \$CLASS_HOME ",
"\$LIB_HOME);\n\n",
"\$KAFFE = $USE_KAFFE;\n\$LIB_JAVA = \"$JAVALIBS[0]\";\n";
if ($USE_KAFFE) {
my $path = $JAVALIBS[0];
$path =~ s%/(kaffe/)?libkaffevm.so$%%;
print JNICONFIG "\$LIB_HOME = \"$path/kaffe\";\n";
$path =~ s%/lib%%;
print JNICONFIG "\$CLASS_HOME = \"$path/share/kaffe\";\n";
}
print JNICONFIG "\n\n1;\n";
close JNICONFIG;
my %Makefile = (
NAME => 'JNI',
VERSION_FROM => 'JNI.pm',
DEFINE => '',
LINKTYPE => 'dynamic',
INC => $INC,
CCFLAGS => "$Config{ccflags} $CCFLAGS",
($Config{archname} =~ /mswin32.*-object/i ? ('CAPI' => 'TRUE') : ()),
clean => {FILES => "JNI/* JNI"}
);
$Makefile{LIBS} = ["$LIBPATH $LIBS"];
if ($MYEXTLIB) {
$Makefile{MYEXTLIB} = $MYEXTLIB;
}
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
# the contents of the Makefile that is written.
#
WriteMakefile(%Makefile);
if ($USE_KAFFE) {
my $path = $JAVALIBS[0];
$path =~ s%/libkaffevm.so$%%;
print "\n\n***NOTE: be sure to have:\n",
" LD_LIBRARY_PATH=$path\n",
" in your enviornment (or installed as a system dynamic\n",
" library location) when you compile and run this.\n";
}
# subroutine to find a library
#
sub find_stuff {
my ($candidates, $locations) = @_;
my $lib;
$wanted = sub {
foreach my $name (@$candidates) {
if (/$name$/ and ! /green_threads/ and !/include-old/) {
$lib = $File::Find::name;
}
}
};
use File::Find;
foreach my $guess (@$locations) {
next unless -d $guess;
find (\&$wanted, $guess);
}
if (! $lib) {
print "Could not find @$candidates\n";
} else {
print "Found @$candidates as $lib\n\n";
}
return $lib;
}
# Extra lib for Java 1.2
#
# if we want KAFFE, check for it, otherwise search for Java
sub find_libs {
my($libjava, $libawt, $libjvm);
if ($USE_KAFFE) {
$libjava = find_stuff(['libkaffevm.so'], \@KAFFE_LIB_GUESSES);
$libawt = find_stuff(['libawt.so'], \@KAFFE_LIB_GUESSES);
} else {
$libjava = find_stuff(['libjava.so', 'javai.lib', 'jvm.lib'],
\@JAVA_HOME_GUESSES);
$libjvm = find_stuff(['libjvm.so'], \@JAVA_HOME_GUESSES);
$libawt = find_stuff(['libawt.so'], \@JAVA_HOME_GUESSES);
if (defined $libjvm) { # JDK 1.2
my $libhpi = find_stuff(['libhpi.so'], \@JAVA_HOME_GUESSES);
return($libjava, $libjvm, $libhpi, $libawt);
}
}
return($libjava, $libawt);
}
# We need to find jni.h and jni_md.h
#
# Always do find_includes as the first operation, as it has the side effect
# of deciding whether or not we are looking for Kaffe. --bkuhn
sub find_includes {
my @CANDIDATES = qw(jni.h jni_md.h);
my @includes;
sub find_inc {
foreach my $name (@CANDIDATES) {
if (/$name$/) {
my ($hname, $hpath, $hsuffix) =
fileparse($File::Find::name, ("\.h", "\.H"));
unless ($hpath =~ /include-old/) {
print "Found $hname$hsuffix in $hpath\n";
push @includes, $hpath;
}
}
}
}
use File::Find;
foreach my $guess (@KAFFE_INCLUDE_GUESSES) {
next unless -d $guess;
find (\&find_inc, $guess);
}
# If we have found includes, then we are using Kaffe.
if (@includes > 0) {
$USE_KAFFE = 1;
} else {
foreach my $guess (@JAVA_HOME_GUESSES) {
next unless -d $guess;
find (\&find_inc, $guess);
}
}
die "Could not find Java includes!" unless (@includes);
return @includes;
}
--- NEW FILE: JNIConfig ---
eval `$JPL_SRC/setvars -perl`;
$java = $ENV{JAVA_HOME};
$jpl = $ENV{JPL_HOME};
# Where are the Java includes?
#
@INCLUDE = ("$java/include", "$java/include/$^O", "$java/include/genunix");
# Are we embedding Perl in Java?
#
$EMBEDDEDPERL = 1;
1;
--- NEW FILE: Changes ---
Revision history for Perl extension JNI.
0.01 Wed Jun 4 13:16:03 1997
- original version; created by h2xs 1.18
--- NEW FILE: typemap.gcc ---
JavaVM * T_JPTROBJ
JNINativeMethod * T_JPTROBJ
const char * T_PV
const jbyte * T_JMEM
const jchar * T_JMEM
jarray T_JPTROBJ
jboolean T_IV
jboolean * T_JMEM
jbooleanArray T_JPTROBJ
jbyte T_IV
jbyte * T_JMEM
jbyteArray T_JPTROBJ
jchar T_IV
jchar * T_JMEM
jcharArray T_JPTROBJ
jclass T_JPTROBJ
jdouble T_NV
jdouble * T_JMEM
jdoubleArray T_JPTROBJ
jfieldID T_JIDSIG
jfloat T_NV
jfloat * T_JMEM
jfloatArray T_JPTROBJ
jint T_IV
jint * T_JMEM
jintArray T_JPTROBJ
jlong T_NV
jlong * T_JMEM
jlongArray T_JPTROBJ
jmethodID T_JIDSIG
jobject T_JPTROBJ
jobjectArray T_JPTROBJ
jshort T_IV
jshort * T_JMEM
jshortArray T_JPTROBJ
jsize T_IV
jstring T_JSTRING
jthrowable T_JPTROBJ
jvalue * T_JVALUELIST
INPUT
T_JMEM
{
$var = ($type)SvPV($arg,tmplen);
${var}_len_ = (jsize) tmplen / sizeof(${subtype});
}
T_JSTRING
if (SvROK($arg)) {
$var = ($type)(void*)SvIV(SvRV($arg));
}
else
$var = ($type)(*env)->NewStringUTF(env, (char *) SvPV($arg,PL_na))
T_JVALUELIST
if (SvROK($arg)) {
AV* av = (AV*)SvRV($arg);
if (SvTYPE(av) == SVt_PVAV) {
I32 maxarg = AvFILL(av) + 1;
$var = makeargs(sig, AvARRAY(av), maxarg);
}
else
croak(\"$var is not an array reference\");
}
else
croak(\"$var is not a reference\")
T_JIDSIG
{
$var = ($type)SvIV($arg);
sig = (char*)SvPV($arg,PL_na);
}
T_JPTROBJ
if (SvROK($arg) && SvOBJECT(SvRV($arg))) {
IV tmp = SvIV((SV*)SvRV($arg));
$var = ($type) tmp;
}
else
croak(\"$var is not of type ${ntype}\")
OUTPUT
T_JMEM
sv_setpvn((SV*)$arg, (char*)$var, (STRLEN)${var}_len_ * sizeof(${subtype}));
T_JSTRING
{
static HV* ${var}_stashhv_ = 0;
if (!${var}_stashhv_)
${var}_stashhv_ = gv_stashpv("java::lang::String", TRUE);
sv_bless(
sv_setref_iv($arg, Nullch, (IV)(void*)${var}),
${var}_stashhv_);
}
T_JIDSIG
sv_setiv($arg, (IV)(void*)$var);
sv_setpv($arg, (char*)sig);
SvIOK_on($arg);
T_JPTROBJ
sv_setref_pv($arg, \"${ntype}\", (void*)$var);
# basic C types
# int T_IV
# unsigned T_IV
# unsigned int T_IV
# long T_IV
# unsigned long T_IV
# short T_IV
# unsigned short T_IV
# char T_CHAR
# unsigned char T_U_CHAR
# char * T_PV
# unsigned char * T_PV
# caddr_t T_PV
# wchar_t * T_PV
# wchar_t T_IV
# bool_t T_IV
# size_t T_IV
# ssize_t T_IV
# time_t T_NV
# unsigned long * T_OPAQUEPTR
# char ** T_PACKED
# void * T_PTR
# Time_t * T_PV
# SV * T_SV
# SVREF T_SVREF
# AV * T_AVREF
# HV * T_HVREF
# CV * T_CVREF
#
# IV T_IV
# I32 T_IV
# I16 T_IV
# I8 T_IV
# U32 T_U_LONG
# U16 T_U_SHORT
# U8 T_IV
# Result T_U_CHAR
# Boolean T_IV
# double T_DOUBLE
# SysRet T_SYSRET
# SysRetLong T_SYSRET
# FILE * T_IN
# FileHandle T_PTROBJ
# InputStream T_IN
# InOutStream T_INOUT
# OutputStream T_OUT
# bool T_BOOL
#
#############################################################################
# INPUT
# T_SV
# $var = $arg
# T_SVREF
# if (sv_isa($arg, \"${ntype}\"))
# $var = (SV*)SvRV($arg);
# else
# croak(\"$var is not of type ${ntype}\")
# T_AVREF
# if (sv_isa($arg, \"${ntype}\"))
# $var = (AV*)SvRV($arg);
# else
# croak(\"$var is not of type ${ntype}\")
# T_HVREF
# if (sv_isa($arg, \"${ntype}\"))
# $var = (HV*)SvRV($arg);
# else
# croak(\"$var is not of type ${ntype}\")
# T_CVREF
# if (sv_isa($arg, \"${ntype}\"))
# $var = (CV*)SvRV($arg);
# else
# croak(\"$var is not of type ${ntype}\")
# T_SYSRET
# $var NOT IMPLEMENTED
# T_IV
# $var = ($type)SvIV($arg)
# T_INT
# $var = (int)SvIV($arg)
# T_ENUM
# $var = ($type)SvIV($arg)
# T_BOOL
# $var = (int)SvIV($arg)
# T_U_INT
# $var = (unsigned int)SvIV($arg)
# T_SHORT
# $var = (short)SvIV($arg)
# T_U_SHORT
# $var = (unsigned short)SvIV($arg)
# T_LONG
# $var = (long)SvIV($arg)
# T_U_LONG
# $var = (unsigned long)SvIV($arg)
# T_CHAR
# $var = (char)*SvPV($arg,PL_na)
# T_U_CHAR
# $var = (unsigned char)SvIV($arg)
# T_FLOAT
# $var = (float)SvNV($arg)
# T_NV
# $var = ($type)SvNV($arg)
# T_DOUBLE
# $var = (double)SvNV($arg)
# T_PV
# $var = ($type)SvPV($arg,PL_na)
# T_PTR
# $var = ($type)SvIV($arg)
# T_PTRREF
# if (SvROK($arg)) {
# IV tmp = SvIV((SV*)SvRV($arg));
# $var = ($type) tmp;
# }
# else
# croak(\"$var is not a reference\")
# T_REF_IV_REF
# if (sv_isa($arg, \"${type}\")) {
# IV tmp = SvIV((SV*)SvRV($arg));
# $var = *($type *) tmp;
# }
# else
# croak(\"$var is not of type ${ntype}\")
# T_REF_IV_PTR
# if (sv_isa($arg, \"${type}\")) {
# IV tmp = SvIV((SV*)SvRV($arg));
# $var = ($type) tmp;
# }
# else
# croak(\"$var is not of type ${ntype}\")
# T_PTROBJ
# if (sv_derived_from($arg, \"${ntype}\")) {
# IV tmp = SvIV((SV*)SvRV($arg));
# $var = ($type) tmp;
# }
# else
# croak(\"$var is not of type ${ntype}\")
# T_PTRDESC
# if (sv_isa($arg, \"${ntype}\")) {
# IV tmp = SvIV((SV*)SvRV($arg));
# ${type}_desc = (\U${type}_DESC\E*) tmp;
# $var = ${type}_desc->ptr;
# }
# else
# croak(\"$var is not of type ${ntype}\")
# T_REFREF
# if (SvROK($arg)) {
# IV tmp = SvIV((SV*)SvRV($arg));
# $var = *($type) tmp;
# }
# else
# croak(\"$var is not a reference\")
# T_REFOBJ
# if (sv_isa($arg, \"${ntype}\")) {
# IV tmp = SvIV((SV*)SvRV($arg));
# $var = *($type) tmp;
# }
# else
# croak(\"$var is not of type ${ntype}\")
# T_OPAQUE
# $var NOT IMPLEMENTED
# T_OPAQUEPTR
# $var = ($type)SvPV($arg,PL_na)
# T_PACKED
# $var = XS_unpack_$ntype($arg)
# T_PACKEDARRAY
# $var = XS_unpack_$ntype($arg)
# T_CALLBACK
# $var = make_perl_cb_$type($arg)
# T_ARRAY
# $var = $ntype(items -= $argoff);
# U32 ix_$var = $argoff;
# while (items--) {
# DO_ARRAY_ELEM;
# }
# T_IN
# $var = IoIFP(sv_2io($arg))
# T_INOUT
# $var = IoIFP(sv_2io($arg))
# T_OUT
# $var = IoOFP(sv_2io($arg))
##############################################################################
# OUTPUT
# T_SV
# $arg = $var;
# T_SVREF
# $arg = newRV((SV*)$var);
# T_AVREF
# $arg = newRV((SV*)$var);
# T_HVREF
# $arg = newRV((SV*)$var);
# T_CVREF
# $arg = newRV((SV*)$var);
# T_IV
# sv_setiv($arg, (IV)$var);
# T_INT
# sv_setiv($arg, (IV)$var);
# T_SYSRET
# if ($var != -1) {
# if ($var == 0)
# sv_setpvn($arg, "0 but true", 10);
# else
# sv_setiv($arg, (IV)$var);
# }
# T_ENUM
# sv_setiv($arg, (IV)$var);
# T_BOOL
# $arg = boolSV($var);
# T_U_INT
# sv_setiv($arg, (IV)$var);
# T_SHORT
# sv_setiv($arg, (IV)$var);
# T_U_SHORT
# sv_setiv($arg, (IV)$var);
# T_LONG
# sv_setiv($arg, (IV)$var);
# T_U_LONG
# sv_setiv($arg, (IV)$var);
# T_CHAR
# sv_setpvn($arg, (char *)&$var, 1);
# T_U_CHAR
# sv_setiv($arg, (IV)$var);
# T_FLOAT
# sv_setnv($arg, (double)$var);
# T_NV
# sv_setnv($arg, (double)$var);
# T_DOUBLE
# sv_setnv($arg, (double)$var);
# T_PV
# sv_setpv((SV*)$arg, $var);
# T_PTR
# sv_setiv($arg, (IV)$var);
# T_PTRREF
# sv_setref_pv($arg, Nullch, (void*)$var);
# T_REF_IV_REF
# sv_setref_pv($arg, \"${ntype}\", (void*)new $ntype($var));
# T_REF_IV_PTR
# sv_setref_pv($arg, \"${ntype}\", (void*)$var);
# T_PTROBJ
# sv_setref_pv($arg, \"${ntype}\", (void*)$var);
# T_PTRDESC
# sv_setref_pv($arg, \"${ntype}\", (void*)new\U${type}_DESC\E($var));
# T_REFREF
# sv_setrefref($arg, \"${ntype}\", XS_service_$ntype,
# ($var ? (void*)new $ntype($var) : 0));
# T_REFOBJ
# NOT IMPLEMENTED
# T_OPAQUE
# sv_setpvn($arg, (char *)&$var, sizeof($var));
# T_OPAQUEPTR
# sv_setpvn($arg, (char *)$var, sizeof(*$var)), XFree((char *)$var);
# T_PACKED
# XS_pack_$ntype($arg, $var);
# T_PACKEDARRAY
# XS_pack_$ntype($arg, $var, count_$ntype);
# T_DATAUNIT
# sv_setpvn($arg, $var.chp(), $var.size());
# T_CALLBACK
# sv_setpvn($arg, $var.context.value().chp(),
# $var.context.value().size());
# T_ARRAY
# ST_EXTEND($var.size);
# for (U32 ix_$var = 0; ix_$var < $var.size; ix_$var++) {
# ST(ix_$var) = sv_newmortal();
# DO_ARRAY_ELEM
# }
# sp += $var.size - 1;
# T_IN
# {
# GV *gv = newGVgen("$Package");
# if ( do_open(gv, "<&", 2, FALSE, 0, 0, $var) )
# sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
# else
# $arg = &PL_sv_undef;
# }
# T_INOUT
# {
# GV *gv = newGVgen("$Package");
# if ( do_open(gv, "+<&", 3, FALSE, 0, 0, $var) )
# sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
# else
# $arg = &PL_sv_undef;
# }
# T_OUT
# {
# GV *gv = newGVgen("$Package");
# if ( do_open(gv, "+>&", 3, FALSE, 0, 0, $var) )
# sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
# else
# $arg = &PL_sv_undef;
# }
--- NEW FILE: JNI.xs ---
/*
* Copyright 1997, O'Reilly & Associate, Inc.
*
* This package may be copied under the same terms as Perl itself.
*/
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include <stdio.h>
#include <jni.h>
#ifndef PERL_VERSION
# include <patchlevel.h>
# define PERL_REVISION 5
# define PERL_VERSION PATCHLEVEL
# define PERL_SUBVERSION SUBVERSION
#endif
[...3214 lines suppressed...]
#endif
else
croak("unrecognized option: %s", s);
}
if (jpldebug) {
fprintf(stderr, "Creating Java VM...\n");
fprintf(stderr, "Working CLASSPATH: %s\n",
vm_args.classpath);
}
if (JNI_CreateJavaVM(&RETVAL, &jplcurenv, &vm_args) < 0) {
croak("Unable to create instance of JVM");
}
if (jpldebug) {
fprintf(stderr, "Created Java VM.\n");
}
}
}
--- NEW FILE: test.pl ---
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
######################### We start with some black magic to print on failure.
# Change 1..1 below to 1..last_test_to_print .
# (It may become useful if the test is moved to ./t subdirectory.)
BEGIN { $| = 1; print "1..3\n"; }
END {print "not ok 1\n" unless $loaded;}
use JNI;
$loaded = 1;
print "ok 1\n";
######################### End of black magic.
# Insert your test code below (better if it prints "ok 13"
# (correspondingly "not ok 13") depending on the success of chunk 13
# of the test code):
# Simple StringBuffer test.
#
use JPL::AutoLoader;
use JPL::Class 'java::lang::StringBuffer';
$sb = java::lang::StringBuffer->new__s("TEST");
if ($sb->toString____s() eq "TEST") {
print "ok 2\n";
} else {
print "not ok 2\n";
}
# Put up a frame and let the user close it.
#
use JPL::AutoLoader;
use JPL::Class 'java::awt::Frame';
use JPL::Class 'Closer';
$f = java::awt::Frame->new__s("Close Me, Please!");
my $setSize = getmeth("setSize", ["int", "int"], []);
my $addWindowListener = getmeth("addWindowListener",
["java.awt.event.WindowListener"], []);
$f->$addWindowListener( new Closer );
$f->$setSize(200,200);
$f->show();
while (1) {
if (!$f->isVisible____Z) {
last;
}
# Sleep a bit.
#
sleep 1;
}
print "ok 3\n";
--- NEW FILE: JNIConfig.kaffe ---
eval `$JPL_SRC/setvars -perl`;
$java = $ENV{JAVA_HOME};
$jpl = $ENV{JPL_HOME};
# Are we using Kaffe?
#
$KAFFE = 1;
# What is the name of the JVM library?
#
$LIBJVM="kaffevm";
# Where is the JVM library?
#
$LIBLOC="/usr/local/lib";
# Where are the Java includes?
#
#@INCLUDE = ('$java/include', '$java/include/$^O' '$java/include/genunix');
@INCLUDE = ( '/usr/local/include/kaffe');
# Are we embedding Perl in Java?
#
$EMBEDDEDPERL = 0;
1;
--- NEW FILE: JNI.pm ---
package JNI;
use strict;
use Carp;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $AUTOLOAD $JVM @JVM_ARGS $JAVALIB);
require Exporter;
require DynaLoader;
require AutoLoader;
@ISA = qw(Exporter DynaLoader);
@EXPORT = qw(
JNI_ABORT
JNI_COMMIT
JNI_ERR
JNI_FALSE
JNI_H
JNI_OK
JNI_TRUE
GetVersion
DefineClass
FindClass
GetSuperclass
IsAssignableFrom
Throw
ThrowNew
ExceptionOccurred
ExceptionDescribe
ExceptionClear
FatalError
NewGlobalRef
DeleteGlobalRef
DeleteLocalRef
IsSameObject
AllocObject
NewObject
NewObjectA
GetObjectClass
IsInstanceOf
GetMethodID
CallObjectMethod
CallObjectMethodA
CallBooleanMethod
CallBooleanMethodA
CallByteMethod
CallByteMethodA
CallCharMethod
CallCharMethodA
CallShortMethod
CallShortMethodA
CallIntMethod
CallIntMethodA
CallLongMethod
CallLongMethodA
CallFloatMethod
CallFloatMethodA
CallDoubleMethod
CallDoubleMethodA
CallVoidMethod
CallVoidMethodA
CallNonvirtualObjectMethod
CallNonvirtualObjectMethodA
CallNonvirtualBooleanMethod
CallNonvirtualBooleanMethodA
CallNonvirtualByteMethod
CallNonvirtualByteMethodA
CallNonvirtualCharMethod
CallNonvirtualCharMethodA
CallNonvirtualShortMethod
CallNonvirtualShortMethodA
CallNonvirtualIntMethod
CallNonvirtualIntMethodA
CallNonvirtualLongMethod
CallNonvirtualLongMethodA
CallNonvirtualFloatMethod
CallNonvirtualFloatMethodA
CallNonvirtualDoubleMethod
CallNonvirtualDoubleMethodA
CallNonvirtualVoidMethod
CallNonvirtualVoidMethodA
GetFieldID
GetObjectField
GetBooleanField
GetByteField
GetCharField
GetShortField
GetIntField
GetLongField
GetFloatField
GetDoubleField
SetObjectField
SetBooleanField
SetByteField
SetCharField
SetShortField
SetIntField
SetLongField
SetFloatField
SetDoubleField
GetStaticMethodID
CallStaticObjectMethod
CallStaticObjectMethodA
CallStaticBooleanMethod
CallStaticBooleanMethodA
CallStaticByteMethod
CallStaticByteMethodA
CallStaticCharMethod
CallStaticCharMethodA
CallStaticShortMethod
CallStaticShortMethodA
CallStaticIntMethod
CallStaticIntMethodA
CallStaticLongMethod
CallStaticLongMethodA
CallStaticFloatMethod
CallStaticFloatMethodA
CallStaticDoubleMethod
CallStaticDoubleMethodA
CallStaticVoidMethod
CallStaticVoidMethodA
GetStaticFieldID
GetStaticObjectField
GetStaticBooleanField
GetStaticByteField
GetStaticCharField
GetStaticShortField
GetStaticIntField
GetStaticLongField
GetStaticFloatField
GetStaticDoubleField
SetStaticObjectField
SetStaticBooleanField
SetStaticByteField
SetStaticCharField
SetStaticShortField
SetStaticIntField
SetStaticLongField
SetStaticFloatField
SetStaticDoubleField
NewString
GetStringLength
GetStringChars
NewStringUTF
GetStringUTFLength
GetStringUTFChars
GetArrayLength
NewObjectArray
GetObjectArrayElement
SetObjectArrayElement
NewBooleanArray
NewByteArray
NewCharArray
NewShortArray
NewIntArray
NewLongArray
NewFloatArray
NewDoubleArray
GetBooleanArrayElements
GetByteArrayElements
GetCharArrayElements
GetShortArrayElements
GetIntArrayElements
GetLongArrayElements
GetFloatArrayElements
GetDoubleArrayElements
GetBooleanArrayRegion
GetByteArrayRegion
GetCharArrayRegion
GetShortArrayRegion
GetIntArrayRegion
GetLongArrayRegion
GetFloatArrayRegion
GetDoubleArrayRegion
SetBooleanArrayRegion
SetByteArrayRegion
SetCharArrayRegion
SetShortArrayRegion
SetIntArrayRegion
SetLongArrayRegion
SetFloatArrayRegion
SetDoubleArrayRegion
RegisterNatives
UnregisterNatives
MonitorEnter
MonitorExit
GetJavaVM
);
$VERSION = '0.2';
sub AUTOLOAD {
# This AUTOLOAD is used to 'autoload' constants from the constant()
# XS function. If a constant is not found then control is passed
# to the AUTOLOAD in AutoLoader.
my $constname;
($constname = $AUTOLOAD) =~ s/.*:://;
my $val = constant($constname, @_ ? $_[0] : 0);
if ($! != 0) {
if ($! =~ /Invalid/) {
$AutoLoader::AUTOLOAD = $AUTOLOAD;
goto &AutoLoader::AUTOLOAD;
}
else {
croak "Your vendor has not defined JNI macro $constname";
}
}
eval "sub $AUTOLOAD { $val }";
goto &$AUTOLOAD;
}
bootstrap JNI $VERSION;
if (not $JPL::_env_) {
# Note that only Kaffe support only cares about what JNI::Config says
use JNI::Config qw($KAFFE $LD_LIBRARY_PATH $CLASS_HOME $LIB_HOME $JAVA_LIB);
# Win32 and Sun JDK pay attention to $ENV{JAVA_HOME}; Kaffe doesn't
$ENV{JAVA_HOME} ||= "/usr/local/java";
my ($arch, @CLASSPATH);
if ($^O eq 'MSWin32' and (! $JNI::Config::KAFFE) ) {
$arch = 'MSWin32' unless -d "$ENV{JAVA_HOME}/lib/$arch";
@CLASSPATH = split(/;/, $ENV{CLASSPATH});
@CLASSPATH = "." unless @CLASSPATH;
push @CLASSPATH,
"$ENV{JAVA_HOME}\\classes",
"$ENV{JAVA_HOME}\\lib\\classes.zip",
# MSR - added for JDK 1.3
"$ENV{JAVA_HOME}\\jre\\lib\\rt.jar",
# MSR - added to find Closer.class
'.';
$ENV{CLASSPATH} = join(';', @CLASSPATH);
$ENV{THREADS_TYPE} ||= "green_threads";
#$JAVALIB = "$ENV{JAVA_HOME}/lib/$arch/$ENV{THREADS_TYPE}";
# MSR - changed above for JDK 1.3
$JAVALIB = "$ENV{JAVA_HOME}/lib/";
$ENV{LD_LIBRARY_PATH} .= ":$JAVALIB";
push @JVM_ARGS, "classpath", $ENV{CLASSPATH};
print "JVM_ARGS=@JVM_ARGS!\n" if $JPL::DEBUG;
$JVM = GetJavaVM("$JAVALIB/javai.dll", at JVM_ARGS);
} elsif ($^O eq 'MSWin32' and $JNI::Config::KAFFE) {
croak "Kaffe is not yet supported on MSWin32 platform!";
} elsif ($JNI::Config::KAFFE) {
# The following code has to build a classpath for us. It would be
# better if we could have *both* a classpath and a classhome, and
# not have to "guess" at the classpath like this. We should be able
# to send in, say, a classpath of ".", and classhome of
# ".../share/kaffe", and have it build the right classpath. That
# doesn't work. The function initClasspath() in findInJar.c in the
# Kaffe source says: "Oh, you have a classpath, well forget
# classhome!" This seems brain-dead to me. But, anyway, that's why
# I don't use the classhome option on GetJavaVM. I have to build
# the classpath by hand. *sigh*
# -- bkuhn
my $classpath = $ENV{CLASSPATH} || ".";
my %classCheck;
@classCheck{split(/\s*:\s*/, $classpath)} = 1;
foreach my $jarFile (qw(Klasses.jar comm.jar pjava.jar
tools.jar microsoft.jar rmi.jar)) {
$classpath .= ":$JNI::Config::CLASS_HOME/$jarFile"
unless defined $classCheck{"$JNI::Config::CLASS_HOME/$jarFile"};
# Assume that if someone else already put these here, they knew
# what they were doing and have the order right.
}
$classpath = ".:$classpath" unless defined $classCheck{"."};
$ENV{CLASSPATH} = $classpath; # Not needed for GetJavaVM(), since
# we pass it in as a JVM option, but
# something else might expect it.
# (also see comment above)
print STDERR "bkuhn: JNI classpath=$classpath\n";
unshift(@JVM_ARGS, "classpath", $classpath,
"libraryhome", $JNI::Config::LIB_HOME);
# The following line is useless; see comment above.
# "classhome", $JNI::Config::CLASS_HOME);
$JVM = GetJavaVM($JNI::Config::JAVA_LIB, @JVM_ARGS);
} else {
chop($arch = `uname -p`);
chop($arch = `uname -m`) unless -d "$ENV{JAVA_HOME}/lib/$arch";
@CLASSPATH = split(/:/, $ENV{CLASSPATH});
@CLASSPATH = "." unless @CLASSPATH;
push @CLASSPATH,
"$ENV{JAVA_HOME}/classes",
"$ENV{JAVA_HOME}/lib/classes.zip";
$ENV{CLASSPATH} = join(':', @CLASSPATH);
$ENV{THREADS_TYPE} ||= "green_threads";
$JAVALIB = "$ENV{JAVA_HOME}/lib/$arch/$ENV{THREADS_TYPE}";
$ENV{LD_LIBRARY_PATH} .= ":$JAVALIB";
push @JVM_ARGS, "classpath", $ENV{CLASSPATH};
print "JVM_ARGS=@JVM_ARGS!\n" if $JPL::DEBUG;
$JVM = GetJavaVM("$JAVALIB/libjava.so", at JVM_ARGS);
}
}
1;
__END__
=head1 NAME
JNI - Perl encapsulation of the Java Native Interface
=head1 SYNOPSIS
use JNI;
=head1 DESCRIPTION
=head1 Exported constants
JNI_ABORT
JNI_COMMIT
JNI_ERR
JNI_FALSE
JNI_H
JNI_OK
JNI_TRUE
=head1 AUTHOR
Copyright 1998, O'Reilly & Associates, Inc.
This package may be copied under the same terms as Perl itself.
=head1 SEE ALSO
perl(1).
=cut
--- NEW FILE: typemap.win32 ---
JavaVM * T_JPTROBJ
JNINativeMethod * T_JPTROBJ
const char * T_PV
const jbyte * T_JMEM
const jchar * T_JMEM
jarray T_JPTROBJ
jboolean T_IV
jboolean * T_JMEM
jbooleanArray T_JPTROBJ
jbyte T_IV
jbyte * T_JMEM
jbyteArray T_JPTROBJ
jchar T_IV
jchar * T_JMEM
jcharArray T_JPTROBJ
jclass T_JPTROBJ
jdouble T_NV
jdouble * T_JMEM
jdoubleArray T_JPTROBJ
jfieldID T_JIDSIG
jfloat T_NV
jfloat * T_JMEM
jfloatArray T_JPTROBJ
jint T_IV
jint * T_JMEM
jintArray T_JPTROBJ
jlong T_NV
jlong * T_JMEM
jlongArray T_JPTROBJ
jmethodID T_JIDSIG
jobject T_JPTROBJ
jobjectArray T_JPTROBJ
jshort T_IV
jshort * T_JMEM
jshortArray T_JPTROBJ
jsize T_IV
jstring T_JSTRING
jthrowable T_JPTROBJ
jvalue * T_JVALUELIST
INPUT
T_JMEM
{
$var = ($type)SvPV($arg,tmplen);
${var}_len_ = (jsize) tmplen / sizeof(${subtype});
}
T_JSTRING
if (SvROK($arg)) {
$var = ($type)(void*)SvIV(SvRV($arg));
}
else
$var = ($type)env->NewStringUTF((char *) SvPV($arg,PL_na))
T_JVALUELIST
if (SvROK($arg)) {
AV* av = (AV*)SvRV($arg);
if (SvTYPE(av) == SVt_PVAV) {
I32 maxarg = AvFILL(av) + 1;
$var = makeargs(sig, AvARRAY(av), maxarg);
}
else
croak(\"$var is not an array reference\");
}
else
croak(\"$var is not a reference\")
T_JIDSIG
{
$var = ($type)SvIV($arg);
sig = (char*)SvPV($arg,PL_na);
}
T_JPTROBJ
if (SvROK($arg) && SvOBJECT(SvRV($arg))) {
IV tmp = SvIV((SV*)SvRV($arg));
$var = ($type) tmp;
}
else
croak(\"$var is not of type ${ntype}\")
OUTPUT
T_JMEM
sv_setpvn((SV*)$arg, (char*)$var, (STRLEN)${var}_len_ * sizeof(${subtype}));
T_JSTRING
{
static HV* ${var}_stashhv_ = 0;
if (!${var}_stashhv_)
${var}_stashhv_ = gv_stashpv("java::lang::String", TRUE);
sv_bless(
sv_setref_iv($arg, Nullch, (IV)(void*)${var}),
${var}_stashhv_);
}
T_JIDSIG
sv_setiv($arg, (IV)(void*)$var);
sv_setpv($arg, (char*)sig);
SvIOK_on($arg);
T_JPTROBJ
sv_setref_pv($arg, \"${ntype}\", (void*)$var);
# basic C types
# int T_IV
# unsigned T_IV
# unsigned int T_IV
# long T_IV
# unsigned long T_IV
# short T_IV
# unsigned short T_IV
# char T_CHAR
# unsigned char T_U_CHAR
# char * T_PV
# unsigned char * T_PV
# caddr_t T_PV
# wchar_t * T_PV
# wchar_t T_IV
# bool_t T_IV
# size_t T_IV
# ssize_t T_IV
# time_t T_NV
# unsigned long * T_OPAQUEPTR
# char ** T_PACKED
# void * T_PTR
# Time_t * T_PV
# SV * T_SV
# SVREF T_SVREF
# AV * T_AVREF
# HV * T_HVREF
# CV * T_CVREF
#
# IV T_IV
# I32 T_IV
# I16 T_IV
# I8 T_IV
# U32 T_U_LONG
# U16 T_U_SHORT
# U8 T_IV
# Result T_U_CHAR
# Boolean T_IV
# double T_DOUBLE
# SysRet T_SYSRET
# SysRetLong T_SYSRET
# FILE * T_IN
# FileHandle T_PTROBJ
# InputStream T_IN
# InOutStream T_INOUT
# OutputStream T_OUT
# bool T_BOOL
#
#############################################################################
# INPUT
# T_SV
# $var = $arg
# T_SVREF
# if (sv_isa($arg, \"${ntype}\"))
# $var = (SV*)SvRV($arg);
# else
# croak(\"$var is not of type ${ntype}\")
# T_AVREF
# if (sv_isa($arg, \"${ntype}\"))
# $var = (AV*)SvRV($arg);
# else
# croak(\"$var is not of type ${ntype}\")
# T_HVREF
# if (sv_isa($arg, \"${ntype}\"))
# $var = (HV*)SvRV($arg);
# else
# croak(\"$var is not of type ${ntype}\")
# T_CVREF
# if (sv_isa($arg, \"${ntype}\"))
# $var = (CV*)SvRV($arg);
# else
# croak(\"$var is not of type ${ntype}\")
# T_SYSRET
# $var NOT IMPLEMENTED
# T_IV
# $var = ($type)SvIV($arg)
# T_INT
# $var = (int)SvIV($arg)
# T_ENUM
# $var = ($type)SvIV($arg)
# T_BOOL
# $var = (int)SvIV($arg)
# T_U_INT
# $var = (unsigned int)SvIV($arg)
# T_SHORT
# $var = (short)SvIV($arg)
# T_U_SHORT
# $var = (unsigned short)SvIV($arg)
# T_LONG
# $var = (long)SvIV($arg)
# T_U_LONG
# $var = (unsigned long)SvIV($arg)
# T_CHAR
# $var = (char)*SvPV($arg,PL_na)
# T_U_CHAR
# $var = (unsigned char)SvIV($arg)
# T_FLOAT
# $var = (float)SvNV($arg)
# T_NV
# $var = ($type)SvNV($arg)
# T_DOUBLE
# $var = (double)SvNV($arg)
# T_PV
# $var = ($type)SvPV($arg,PL_na)
# T_PTR
# $var = ($type)SvIV($arg)
# T_PTRREF
# if (SvROK($arg)) {
# IV tmp = SvIV((SV*)SvRV($arg));
# $var = ($type) tmp;
# }
# else
# croak(\"$var is not a reference\")
# T_REF_IV_REF
# if (sv_isa($arg, \"${type}\")) {
# IV tmp = SvIV((SV*)SvRV($arg));
# $var = *($type *) tmp;
# }
# else
# croak(\"$var is not of type ${ntype}\")
# T_REF_IV_PTR
# if (sv_isa($arg, \"${type}\")) {
# IV tmp = SvIV((SV*)SvRV($arg));
# $var = ($type) tmp;
# }
# else
# croak(\"$var is not of type ${ntype}\")
# T_PTROBJ
# if (sv_derived_from($arg, \"${ntype}\")) {
# IV tmp = SvIV((SV*)SvRV($arg));
# $var = ($type) tmp;
# }
# else
# croak(\"$var is not of type ${ntype}\")
# T_PTRDESC
# if (sv_isa($arg, \"${ntype}\")) {
# IV tmp = SvIV((SV*)SvRV($arg));
# ${type}_desc = (\U${type}_DESC\E*) tmp;
# $var = ${type}_desc->ptr;
# }
# else
# croak(\"$var is not of type ${ntype}\")
# T_REFREF
# if (SvROK($arg)) {
# IV tmp = SvIV((SV*)SvRV($arg));
# $var = *($type) tmp;
# }
# else
# croak(\"$var is not a reference\")
# T_REFOBJ
# if (sv_isa($arg, \"${ntype}\")) {
# IV tmp = SvIV((SV*)SvRV($arg));
# $var = *($type) tmp;
# }
# else
# croak(\"$var is not of type ${ntype}\")
# T_OPAQUE
# $var NOT IMPLEMENTED
# T_OPAQUEPTR
# $var = ($type)SvPV($arg,PL_na)
# T_PACKED
# $var = XS_unpack_$ntype($arg)
# T_PACKEDARRAY
# $var = XS_unpack_$ntype($arg)
# T_CALLBACK
# $var = make_perl_cb_$type($arg)
# T_ARRAY
# $var = $ntype(items -= $argoff);
# U32 ix_$var = $argoff;
# while (items--) {
# DO_ARRAY_ELEM;
# }
# T_IN
# $var = IoIFP(sv_2io($arg))
# T_INOUT
# $var = IoIFP(sv_2io($arg))
# T_OUT
# $var = IoOFP(sv_2io($arg))
##############################################################################
# OUTPUT
# T_SV
# $arg = $var;
# T_SVREF
# $arg = newRV((SV*)$var);
# T_AVREF
# $arg = newRV((SV*)$var);
# T_HVREF
# $arg = newRV((SV*)$var);
# T_CVREF
# $arg = newRV((SV*)$var);
# T_IV
# sv_setiv($arg, (IV)$var);
# T_INT
# sv_setiv($arg, (IV)$var);
# T_SYSRET
# if ($var != -1) {
# if ($var == 0)
# sv_setpvn($arg, "0 but true", 10);
# else
# sv_setiv($arg, (IV)$var);
# }
# T_ENUM
# sv_setiv($arg, (IV)$var);
# T_BOOL
# $arg = boolSV($var);
# T_U_INT
# sv_setiv($arg, (IV)$var);
# T_SHORT
# sv_setiv($arg, (IV)$var);
# T_U_SHORT
# sv_setiv($arg, (IV)$var);
# T_LONG
# sv_setiv($arg, (IV)$var);
# T_U_LONG
# sv_setiv($arg, (IV)$var);
# T_CHAR
# sv_setpvn($arg, (char *)&$var, 1);
# T_U_CHAR
# sv_setiv($arg, (IV)$var);
# T_FLOAT
# sv_setnv($arg, (double)$var);
# T_NV
# sv_setnv($arg, (double)$var);
# T_DOUBLE
# sv_setnv($arg, (double)$var);
# T_PV
# sv_setpv((SV*)$arg, $var);
# T_PTR
# sv_setiv($arg, (IV)$var);
# T_PTRREF
# sv_setref_pv($arg, Nullch, (void*)$var);
# T_REF_IV_REF
# sv_setref_pv($arg, \"${ntype}\", (void*)new $ntype($var));
# T_REF_IV_PTR
# sv_setref_pv($arg, \"${ntype}\", (void*)$var);
# T_PTROBJ
# sv_setref_pv($arg, \"${ntype}\", (void*)$var);
# T_PTRDESC
# sv_setref_pv($arg, \"${ntype}\", (void*)new\U${type}_DESC\E($var));
# T_REFREF
# sv_setrefref($arg, \"${ntype}\", XS_service_$ntype,
# ($var ? (void*)new $ntype($var) : 0));
# T_REFOBJ
# NOT IMPLEMENTED
# T_OPAQUE
# sv_setpvn($arg, (char *)&$var, sizeof($var));
# T_OPAQUEPTR
# sv_setpvn($arg, (char *)$var, sizeof(*$var)), XFree((char *)$var);
# T_PACKED
# XS_pack_$ntype($arg, $var);
# T_PACKEDARRAY
# XS_pack_$ntype($arg, $var, count_$ntype);
# T_DATAUNIT
# sv_setpvn($arg, $var.chp(), $var.size());
# T_CALLBACK
# sv_setpvn($arg, $var.context.value().chp(),
# $var.context.value().size());
# T_ARRAY
# ST_EXTEND($var.size);
# for (U32 ix_$var = 0; ix_$var < $var.size; ix_$var++) {
# ST(ix_$var) = sv_newmortal();
# DO_ARRAY_ELEM
# }
# sp += $var.size - 1;
# T_IN
# {
# GV *gv = newGVgen("$Package");
# if ( do_open(gv, "<&", 2, FALSE, 0, 0, $var) )
# sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
# else
# $arg = &PL_sv_undef;
# }
# T_INOUT
# {
# GV *gv = newGVgen("$Package");
# if ( do_open(gv, "+<&", 3, FALSE, 0, 0, $var) )
# sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
# else
# $arg = &PL_sv_undef;
# }
# T_OUT
# {
# GV *gv = newGVgen("$Package");
# if ( do_open(gv, "+>&", 3, FALSE, 0, 0, $var) )
# sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
# else
# $arg = &PL_sv_undef;
# }
--- NEW FILE: JNIConfig.standard ---
eval `$JPL_SRC/setvars -perl`;
$java = $ENV{JAVA_HOME};
$jpl = $ENV{JPL_HOME};
# Where are the Java includes?
#
@INCLUDE = ("$java/include", "$java/include/$^O", "$java/include/genunix");
# Are we embedding Perl in Java?
#
$EMBEDDEDPERL = 1;
1;
--- NEW FILE: JNIConfig.noembed ---
eval `$JPL_SRC/setvars -perl`;
$java = $ENV{JAVA_HOME};
$jpl = $ENV{JPL_HOME};
# Are we using Kaffe?
#
$KAFFE = 0;
# What is the name of the JVM library?
#
$LIBJVM="java";
# Where is the JVM library?
#
$LIBLOC="/usr/local/java/lib/i686/green_threads/";
# Where are the Java includes?
#
@INCLUDE = ("$java/include", "$java/include/$^O", "$java/include/genunix");
# Are we embedding Perl in Java?
#
$EMBEDDEDPERL = 0;
1;
--- NEW FILE: typemap ---
JavaVM * T_JPTROBJ
JNINativeMethod * T_JPTROBJ
const char * T_PV
const jbyte * T_JMEM
const jchar * T_JMEM
jarray T_JPTROBJ
jboolean T_IV
jboolean * T_JMEM
jbooleanArray T_JPTROBJ
jbyte T_IV
jbyte * T_JMEM
jbyteArray T_JPTROBJ
jchar T_IV
jchar * T_JMEM
jcharArray T_JPTROBJ
jclass T_JPTROBJ
jdouble T_NV
jdouble * T_JMEM
jdoubleArray T_JPTROBJ
jfieldID T_JIDSIG
jfloat T_NV
jfloat * T_JMEM
jfloatArray T_JPTROBJ
jint T_IV
jint * T_JMEM
jintArray T_JPTROBJ
jlong T_NV
jlong * T_JMEM
jlongArray T_JPTROBJ
jmethodID T_JIDSIG
jobject T_JPTROBJ
jobjectArray T_JPTROBJ
jshort T_IV
jshort * T_JMEM
jshortArray T_JPTROBJ
jsize T_IV
jstring T_JSTRING
jthrowable T_JPTROBJ
jvalue * T_JVALUELIST
INPUT
T_JMEM
{
$var = ($type)SvPV($arg,tmplen);
${var}_len_ = (jsize) tmplen / sizeof(${subtype});
}
T_JSTRING
if (SvROK($arg)) {
$var = ($type)(void*)SvIV(SvRV($arg));
}
else
$var = ($type)(*env)->NewStringUTF(env, (char *) SvPV($arg,PL_na))
T_JVALUELIST
if (SvROK($arg)) {
AV* av = (AV*)SvRV($arg);
if (SvTYPE(av) == SVt_PVAV) {
I32 maxarg = AvFILL(av) + 1;
$var = makeargs(sig, AvARRAY(av), maxarg);
}
else
croak(\"$var is not an array reference\");
}
else
croak(\"$var is not a reference\")
T_JIDSIG
{
$var = ($type)SvIV($arg);
sig = (char*)SvPV($arg,PL_na);
}
T_JPTROBJ
if (SvROK($arg) && SvOBJECT(SvRV($arg))) {
IV tmp = SvIV((SV*)SvRV($arg));
$var = ($type) tmp;
}
else
croak(\"$var is not of type ${ntype}\")
OUTPUT
T_JMEM
sv_setpvn((SV*)$arg, (char*)$var, (STRLEN)${var}_len_ * sizeof(${subtype}));
T_JSTRING
{
static HV* ${var}_stashhv_ = 0;
if (!${var}_stashhv_)
${var}_stashhv_ = gv_stashpv("java::lang::String", TRUE);
sv_bless(
sv_setref_iv($arg, Nullch, (IV)(void*)${var}),
${var}_stashhv_);
}
T_JIDSIG
sv_setiv($arg, (IV)(void*)$var);
sv_setpv($arg, (char*)sig);
SvIOK_on($arg);
T_JPTROBJ
sv_setref_pv($arg, \"${ntype}\", (void*)$var);
# basic C types
# int T_IV
# unsigned T_IV
# unsigned int T_IV
# long T_IV
# unsigned long T_IV
# short T_IV
# unsigned short T_IV
# char T_CHAR
# unsigned char T_U_CHAR
# char * T_PV
# unsigned char * T_PV
# caddr_t T_PV
# wchar_t * T_PV
# wchar_t T_IV
# bool_t T_IV
# size_t T_IV
# ssize_t T_IV
# time_t T_NV
# unsigned long * T_OPAQUEPTR
# char ** T_PACKED
# void * T_PTR
# Time_t * T_PV
# SV * T_SV
# SVREF T_SVREF
# AV * T_AVREF
# HV * T_HVREF
# CV * T_CVREF
#
# IV T_IV
# I32 T_IV
# I16 T_IV
# I8 T_IV
# U32 T_U_LONG
# U16 T_U_SHORT
# U8 T_IV
# Result T_U_CHAR
# Boolean T_IV
# double T_DOUBLE
# SysRet T_SYSRET
# SysRetLong T_SYSRET
# FILE * T_IN
# FileHandle T_PTROBJ
# InputStream T_IN
# InOutStream T_INOUT
# OutputStream T_OUT
# bool T_BOOL
#
#############################################################################
# INPUT
# T_SV
# $var = $arg
# T_SVREF
# if (sv_isa($arg, \"${ntype}\"))
# $var = (SV*)SvRV($arg);
# else
# croak(\"$var is not of type ${ntype}\")
# T_AVREF
# if (sv_isa($arg, \"${ntype}\"))
# $var = (AV*)SvRV($arg);
# else
# croak(\"$var is not of type ${ntype}\")
# T_HVREF
# if (sv_isa($arg, \"${ntype}\"))
# $var = (HV*)SvRV($arg);
# else
# croak(\"$var is not of type ${ntype}\")
# T_CVREF
# if (sv_isa($arg, \"${ntype}\"))
# $var = (CV*)SvRV($arg);
# else
# croak(\"$var is not of type ${ntype}\")
# T_SYSRET
# $var NOT IMPLEMENTED
# T_IV
# $var = ($type)SvIV($arg)
# T_INT
# $var = (int)SvIV($arg)
# T_ENUM
# $var = ($type)SvIV($arg)
# T_BOOL
# $var = (int)SvIV($arg)
# T_U_INT
# $var = (unsigned int)SvIV($arg)
# T_SHORT
# $var = (short)SvIV($arg)
# T_U_SHORT
# $var = (unsigned short)SvIV($arg)
# T_LONG
# $var = (long)SvIV($arg)
# T_U_LONG
# $var = (unsigned long)SvIV($arg)
# T_CHAR
# $var = (char)*SvPV($arg,PL_na)
# T_U_CHAR
# $var = (unsigned char)SvIV($arg)
# T_FLOAT
# $var = (float)SvNV($arg)
# T_NV
# $var = ($type)SvNV($arg)
# T_DOUBLE
# $var = (double)SvNV($arg)
# T_PV
# $var = ($type)SvPV($arg,PL_na)
# T_PTR
# $var = ($type)SvIV($arg)
# T_PTRREF
# if (SvROK($arg)) {
# IV tmp = SvIV((SV*)SvRV($arg));
# $var = ($type) tmp;
# }
# else
# croak(\"$var is not a reference\")
# T_REF_IV_REF
# if (sv_isa($arg, \"${type}\")) {
# IV tmp = SvIV((SV*)SvRV($arg));
# $var = *($type *) tmp;
# }
# else
# croak(\"$var is not of type ${ntype}\")
# T_REF_IV_PTR
# if (sv_isa($arg, \"${type}\")) {
# IV tmp = SvIV((SV*)SvRV($arg));
# $var = ($type) tmp;
# }
# else
# croak(\"$var is not of type ${ntype}\")
# T_PTROBJ
# if (sv_derived_from($arg, \"${ntype}\")) {
# IV tmp = SvIV((SV*)SvRV($arg));
# $var = ($type) tmp;
# }
# else
# croak(\"$var is not of type ${ntype}\")
# T_PTRDESC
# if (sv_isa($arg, \"${ntype}\")) {
# IV tmp = SvIV((SV*)SvRV($arg));
# ${type}_desc = (\U${type}_DESC\E*) tmp;
# $var = ${type}_desc->ptr;
# }
# else
# croak(\"$var is not of type ${ntype}\")
# T_REFREF
# if (SvROK($arg)) {
# IV tmp = SvIV((SV*)SvRV($arg));
# $var = *($type) tmp;
# }
# else
# croak(\"$var is not a reference\")
# T_REFOBJ
# if (sv_isa($arg, \"${ntype}\")) {
# IV tmp = SvIV((SV*)SvRV($arg));
# $var = *($type) tmp;
# }
# else
# croak(\"$var is not of type ${ntype}\")
# T_OPAQUE
# $var NOT IMPLEMENTED
# T_OPAQUEPTR
# $var = ($type)SvPV($arg,PL_na)
# T_PACKED
# $var = XS_unpack_$ntype($arg)
# T_PACKEDARRAY
# $var = XS_unpack_$ntype($arg)
# T_CALLBACK
# $var = make_perl_cb_$type($arg)
# T_ARRAY
# $var = $ntype(items -= $argoff);
# U32 ix_$var = $argoff;
# while (items--) {
# DO_ARRAY_ELEM;
# }
# T_IN
# $var = IoIFP(sv_2io($arg))
# T_INOUT
# $var = IoIFP(sv_2io($arg))
# T_OUT
# $var = IoOFP(sv_2io($arg))
##############################################################################
# OUTPUT
# T_SV
# $arg = $var;
# T_SVREF
# $arg = newRV((SV*)$var);
# T_AVREF
# $arg = newRV((SV*)$var);
# T_HVREF
# $arg = newRV((SV*)$var);
# T_CVREF
# $arg = newRV((SV*)$var);
# T_IV
# sv_setiv($arg, (IV)$var);
# T_INT
# sv_setiv($arg, (IV)$var);
# T_SYSRET
# if ($var != -1) {
# if ($var == 0)
# sv_setpvn($arg, "0 but true", 10);
# else
# sv_setiv($arg, (IV)$var);
# }
# T_ENUM
# sv_setiv($arg, (IV)$var);
# T_BOOL
# $arg = boolSV($var);
# T_U_INT
# sv_setiv($arg, (IV)$var);
# T_SHORT
# sv_setiv($arg, (IV)$var);
# T_U_SHORT
# sv_setiv($arg, (IV)$var);
# T_LONG
# sv_setiv($arg, (IV)$var);
# T_U_LONG
# sv_setiv($arg, (IV)$var);
# T_CHAR
# sv_setpvn($arg, (char *)&$var, 1);
# T_U_CHAR
# sv_setiv($arg, (IV)$var);
# T_FLOAT
# sv_setnv($arg, (double)$var);
# T_NV
# sv_setnv($arg, (double)$var);
# T_DOUBLE
# sv_setnv($arg, (double)$var);
# T_PV
# sv_setpv((SV*)$arg, $var);
# T_PTR
# sv_setiv($arg, (IV)$var);
# T_PTRREF
# sv_setref_pv($arg, Nullch, (void*)$var);
# T_REF_IV_REF
# sv_setref_pv($arg, \"${ntype}\", (void*)new $ntype($var));
# T_REF_IV_PTR
# sv_setref_pv($arg, \"${ntype}\", (void*)$var);
# T_PTROBJ
# sv_setref_pv($arg, \"${ntype}\", (void*)$var);
# T_PTRDESC
# sv_setref_pv($arg, \"${ntype}\", (void*)new\U${type}_DESC\E($var));
# T_REFREF
# sv_setrefref($arg, \"${ntype}\", XS_service_$ntype,
# ($var ? (void*)new $ntype($var) : 0));
# T_REFOBJ
# NOT IMPLEMENTED
# T_OPAQUE
# sv_setpvn($arg, (char *)&$var, sizeof($var));
# T_OPAQUEPTR
# sv_setpvn($arg, (char *)$var, sizeof(*$var)), XFree((char *)$var);
# T_PACKED
# XS_pack_$ntype($arg, $var);
# T_PACKEDARRAY
# XS_pack_$ntype($arg, $var, count_$ntype);
# T_DATAUNIT
# sv_setpvn($arg, $var.chp(), $var.size());
# T_CALLBACK
# sv_setpvn($arg, $var.context.value().chp(),
# $var.context.value().size());
# T_ARRAY
# ST_EXTEND($var.size);
# for (U32 ix_$var = 0; ix_$var < $var.size; ix_$var++) {
# ST(ix_$var) = sv_newmortal();
# DO_ARRAY_ELEM
# }
# sp += $var.size - 1;
# T_IN
# {
# GV *gv = newGVgen("$Package");
# if ( do_open(gv, "<&", 2, FALSE, 0, 0, $var) )
# sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
# else
# $arg = &PL_sv_undef;
# }
# T_INOUT
# {
# GV *gv = newGVgen("$Package");
# if ( do_open(gv, "+<&", 3, FALSE, 0, 0, $var) )
# sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
# else
# $arg = &PL_sv_undef;
# }
# T_OUT
# {
# GV *gv = newGVgen("$Package");
# if ( do_open(gv, "+>&", 3, FALSE, 0, 0, $var) )
# sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
# else
# $arg = &PL_sv_undef;
# }
--- NEW FILE: Closer.java ---
import java.awt.event.*;
import java.awt.*;
public class Closer extends WindowAdapter {
public void windowClosing(WindowEvent e) {
Window w = e.getWindow();
w.dispose();
}
}
More information about the dslinux-commit
mailing list