+ pas2jni - an utility to generates a JNI (Java Native Interface) bridge for a Pascal code. Then the Pascal code (including classes and other advanced features) can be easily used in Java programs.

git-svn-id: http://svn.freepascal.org/svn/fpc/trunk@24137 3ad0048d-3df7-0310-abae-a5850022a9f2

1 files changed, 2156 insertions, 0 deletions

diff --git a/utils/pas2jni/writer.pas b/utils/pas2jni/writer.pas
new file mode 100644
index 0000000000..984b15d3eb
--- /dev/null
+++ b/utils/pas2jni/writer.pas
@@ -0,0 +1,2156 @@
+{
+    pas2jni - JNI bridge generator for Pascal.
+
+    Copyright (c) 2013 by Yury Sidorov.
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************}
+
+unit writer;
+
+{$mode objfpc}{$H+}
+
+interface
+
+{$define DEBUG}
+
+{$ifdef DEBUG}
+{$ASSERTIONS ON}
+{$endif}
+
+uses
+  Classes, SysUtils, def, contnrs, PPUParser;
+
+const
+  MaxMethodPointers = 10000;
+
+type
+  { TTextOutStream }
+
+  TTextOutStream = class(TFileStream)
+  private
+    FIndent: integer;
+    FIndStr: string;
+    procedure SetIndednt(const AValue: integer);
+  public
+    procedure Write(const s: ansistring); overload;
+    procedure WriteLn(const s: ansistring = ''; ExtraIndent: integer = 0);
+    procedure IncI;
+    procedure DecI;
+    property Indent: integer read FIndent write SetIndednt;
+    property SIndent: string read FIndStr;
+  end;
+
+  { TWriter }
+
+  TWriter = class
+  private
+    Fjs, Fps: TTextOutStream;
+    FClasses: TStringList;
+    FPkgDir: string;
+    FUniqueCnt: integer;
+    FThisUnit: TUnitDef;
+
+    function DoCheckItem(const ItemName: string): TCheckItemResult;
+
+    procedure ProcessRules(d: TDef; const Prefix: string = '');
+    function GetUniqueNum: integer;
+    function DefToJniType(d: TDef; var err: boolean): string;
+    function DefToJniSig(d: TDef): string;
+    function DefToJavaType(d: TDef): string;
+    function GetJavaClassPath(d: TDef; const AClassName: string = ''): string;
+    function JniToPasType(d: TDef; const v: string; CheckNil: boolean): string;
+    function PasToJniType(d: TDef; const v: string): string;
+    function GetTypeInfoVar(ClassDef: TDef): string;
+    function GetClassPrefix(ClassDef: TDef; const AClassName: string = ''): string;
+    function IsJavaSimpleType(d: TDef): boolean;
+    function GetProcDeclaration(d: TProcDef; const ProcName: string = ''): string;
+    function GetJavaProcDeclaration(d: TProcDef; const ProcName: string = ''): string;
+    function GetJniFuncType(d: TDef): string;
+    function GetJavaClassName(cls: TDef; it: TDef): string;
+    procedure RegisterPseudoClass(d: TDef);
+    function GetPasIntType(Size: integer): string;
+//    procedure AddCustomProc(ParentDef: TDef; const JniName, Name: string; RetType: TBasicType; const Params: array of TBasicType);
+    function AddCustomProc(ParentDef: TDef; const JniName, Name: string; RetType: TBasicType; const Params: array of TBasicType): TProcDef;
+    procedure AddNativeMethod(ParentDef: TDef; const JniName, Name, Signature: string);
+    function GetProcSignature(d: TProcDef): string;
+    procedure EHandlerStart;
+    procedure EHandlerEnd(const EnvVarName: string; const ExtraCode: string = '');
+
+    procedure WriteClassInfoVar(d: TDef);
+    procedure WriteComment(d: TDef; const AType: string);
+    procedure WriteClass(d: TDef; PreInfo: boolean);
+    procedure WriteProc(d: TProcDef; Variable: TVarDef = nil; AParent: TDef = nil);
+    procedure WriteVar(d: TVarDef; AParent: TDef = nil);
+    procedure WriteConst(d: TConstDef);
+    procedure WriteEnum(d: TDef);
+    procedure WriteProcType(d: TProcDef; PreInfo: boolean);
+    procedure WriteSet(d: TSetDef);
+    procedure WriteUnit(u: TUnitDef);
+    procedure WriteOnLoad;
+  public
+    SearchPath: string;
+    LibName: string;
+    JavaPackage: string;
+    Units: TStringList;
+    OutPath: string;
+    JavaOutPath: string;
+    IncludeList: TStringList;
+    ExcludeList: TStringList;
+
+    constructor Create;
+    destructor Destroy; override;
+    procedure ProcessUnits;
+  end;
+
+implementation
+
+const
+  JNIType: array[TBasicType] of string =
+    ('', 'jshort', 'jbyte', 'jint', 'jshort', 'jlong', 'jint', 'jlong', 'jfloat', 'jdouble', 'jstring',
+     'jstring', 'jboolean', 'jchar', 'jchar', 'jint', 'jlong', 'jstring');
+  JNITypeSig: array[TBasicType] of string =
+    ('V', 'S', 'B', 'I', 'S', 'J', 'I', 'J', 'F', 'D', 'Ljava/lang/String;', 'Ljava/lang/String;',
+     'Z', 'C', 'C', 'I', 'J', 'Ljava/lang/String;');
+  JavaType: array[TBasicType] of string =
+    ('void', 'short', 'byte', 'int', 'short', 'long', 'int', 'long', 'float', 'double', 'String',
+     'String', 'boolean', 'char', 'char', 'int', 'long', 'String');
+
+  TextIndent = 2;
+
+  ExcludeStd: array[1..43] of string = (
+    'classes.TStream.ReadComponent', 'classes.TStream.ReadComponentRes', 'classes.TStream.WriteComponent', 'classes.TStream.WriteComponentRes',
+    'classes.TStream.WriteDescendent', 'classes.TStream.WriteDescendentRes', 'classes.TStream.WriteResourceHeader', 'classes.TStream.FixupResourceHeader',
+    'classes.TStream.ReadResHeader', 'classes.TComponent.WriteState', 'classes.TComponent.ExecuteAction', 'classes.TComponent.UpdateAction',
+    'classes.TComponent.GetEnumerator', 'classes.TComponent.VCLComObject', 'classes.TComponent.DesignInfo', 'classes.TComponent.Destroying',
+    'classes.TComponent.FreeNotification', 'classes.TComponent.RemoveFreeNotification', 'classes.TComponent.FreeOnRelease', 'classes.TComponent.SetSubComponent',
+    'system.TObject.newinstance', 'system.TObject.FreeInstance', 'system.TObject.SafeCallException', 'system.TObject.InitInstance',
+    'system.TObject.CleanupInstance', 'system.TObject.ClassInfo', 'system.TObject.AfterConstruction', 'system.TObject.BeforeDestruction',
+    'system.TObject.GetInterfaceEntry', 'system.TObject.GetInterfaceTable', 'system.TObject.MethodAddress', 'system.TObject.MethodName',
+    'system.TObject.FieldAddress', 'classes.TComponent.ComponentState', 'classes.TComponent.ComponentStyle', 'classes.TList.GetEnumerator',
+    'classes.TList.List', 'classes.TList.FPOAttachObserver', 'classes.TList.FPODetachObserver', 'classes.TList.FPONotifyObservers',
+    'classes.TPersistent.FPOAttachObserver', 'classes.TPersistent.FPODetachObserver', 'classes.TPersistent.FPONotifyObservers'
+  );
+
+  ExcludeDelphi7: array[1..25] of string = (
+    'system.TObject.StringMessageTable', 'system.TObject.GetInterfaceEntryByStr', 'system.TObject.UnitName', 'system.TObject.Equals',
+    'system.TObject.GetHashCode', 'system.TObject.ToString','classes.TStream.ReadByte', 'classes.TStream.ReadWord',
+    'classes.TStream.ReadDWord', 'classes.TStream.ReadQWord', 'classes.TStream.ReadAnsiString', 'classes.TStream.WriteByte',
+    'classes.TStream.WriteWord', 'classes.TStream.WriteDWord', 'classes.TStream.WriteQWord', 'classes.TStream.WriteAnsiString',
+    'classes.TCollection.Exchange', 'classes.TStrings.Equals', 'classes.TStrings.GetNameValue', 'classes.TStrings.ExtractName',
+    'classes.TStrings.TextLineBreakStyle', 'classes.TStrings.StrictDelimiter', 'classes.TStrings.GetEnumerator', 'classes.TStringList.OwnsObjects',
+    'classes.TList.AddList'
+  );
+
+  SUnsupportedType = '<unsupported type>';
+
+function JniCaliing: string;
+begin
+  Result:='{$ifdef windows} stdcall {$else} cdecl {$endif};';
+end;
+
+{ TTextOutStream }
+
+procedure TTextOutStream.SetIndednt(const AValue: integer);
+begin
+  if FIndent = AValue then exit;
+  FIndent:=AValue;
+  SetLength(FIndStr, FIndent*TextIndent);
+  if FIndent > 0 then
+    FillChar(FIndStr[1], FIndent*TextIndent, ' ');
+end;
+
+procedure TTextOutStream.Write(const s: ansistring);
+begin
+  WriteBuffer(PChar(s)^, Length(s));
+end;
+
+procedure TTextOutStream.WriteLn(const s: ansistring; ExtraIndent: integer);
+begin
+  if s = '' then
+    Write(LineEnding)
+  else begin
+    Indent:=Indent + ExtraIndent;
+    try
+      Write(FIndStr + s + LineEnding);
+    finally
+      Indent:=Indent - ExtraIndent;
+    end;
+  end;
+end;
+
+procedure TTextOutStream.IncI;
+begin
+  Indent:=Indent + 1;
+end;
+
+procedure TTextOutStream.DecI;
+begin
+  if Indent > 0  then
+    Indent:=Indent - 1;
+end;
+
+type
+  { TClassInfo }
+  TClassInfo = class
+  public
+    Def: TDef;
+    Funcs: TObjectList;
+    IsCommonClass: boolean;
+    constructor Create;
+    destructor Destroy; override;
+  end;
+
+  TProcInfo = class
+  public
+    Name: string;
+    JniName: string;
+    JniSignature: string;
+  end;
+
+{ TClassInfo }
+
+constructor TClassInfo.Create;
+begin
+  Funcs:=TObjectList.Create(True);
+end;
+
+destructor TClassInfo.Destroy;
+begin
+  Funcs.Free;
+  inherited Destroy;
+end;
+
+{ TWriter }
+
+function TWriter.DefToJniType(d: TDef; var err: boolean): string;
+begin
+  if d = nil then begin
+    Result:=SUnsupportedType;
+    err:=True;
+  end
+  else begin
+    if not d.IsUsed then begin
+      Result:='<excluded type> ' + d.Name;
+      err:=True;
+    end
+    else
+      case d.DefType of
+        dtType:
+          Result:=JNIType[TTypeDef(d).BasicType];
+        dtClass, dtRecord, dtEnum:
+          Result:='jobject';
+        dtProcType:
+          if poMethodPtr in TProcDef(d).ProcOpt then
+            Result:='jobject'
+          else begin
+            Result:=SUnsupportedType + ' ' + d.Name;
+            err:=True;
+          end;
+        dtSet:
+          if TSetDef(d).Size <= 4 then
+            Result:='jobject'
+          else begin
+            Result:=SUnsupportedType + ' ' + d.Name;
+            err:=True;
+          end;
+        else begin
+          Result:=SUnsupportedType + ' ' + d.Name;
+          err:=True;
+          d.SetNotUsed;
+        end;
+    end;
+  end;
+end;
+
+function TWriter.DoCheckItem(const ItemName: string): TCheckItemResult;
+begin
+  if IncludeList.IndexOf(ItemName) >= 0 then
+    Result:=crInclude
+  else
+    if ExcludeList.IndexOf(ItemName) >= 0 then
+      Result:=crExclude
+    else
+      Result:=crDefault;
+end;
+
+procedure TWriter.ProcessRules(d: TDef; const Prefix: string);
+var
+  i: integer;
+  s: string;
+begin
+  s:=Prefix + d.Name;
+  i:=IncludeList.IndexOf(s);
+  if i >= 0 then begin
+    i:=ptruint(IncludeList.Objects[i]);
+    if (i = 0) or (d.Count = i - 1) then
+      d.IsUsed:=True;
+  end
+  else
+    if ExcludeList.IndexOf(s) >= 0 then begin
+      d.SetNotUsed;
+    end;
+  if not (d.DefType in [dtUnit, dtClass, dtRecord]) then
+    exit;
+  s:=s + '.';
+  for i:=0 to d.Count - 1 do
+    ProcessRules(d[i], s);
+end;
+
+function TWriter.GetUniqueNum: integer;
+begin
+  Inc(FUniqueCnt);
+  Result:=FUniqueCnt;
+end;
+
+function TWriter.DefToJniSig(d: TDef): string;
+begin
+  if d = nil then
+    Result:=SUnsupportedType
+  else
+    case d.DefType of
+      dtType:
+        Result:=JNITypeSig[TTypeDef(d).BasicType];
+      dtClass, dtRecord, dtProcType, dtSet, dtEnum:
+        Result:='L' + GetJavaClassPath(d) + ';';
+      else
+        Result:=SUnsupportedType;
+    end;
+end;
+
+function TWriter.DefToJavaType(d: TDef): string;
+begin
+  if d = nil then
+    Result:=SUnsupportedType
+  else
+    case d.DefType of
+      dtType:
+        Result:=JavaType[TTypeDef(d).BasicType];
+      dtClass, dtRecord, dtProcType, dtSet, dtEnum:
+        Result:=d.Name;
+      else
+        Result:=SUnsupportedType;
+  end;
+end;
+
+function TWriter.GetJavaClassPath(d: TDef; const AClassName: string): string;
+var
+  n: string;
+begin
+  if AClassName = '' then
+    n:=d.AliasName
+  else
+    n:=AClassName;
+  Result:=StringReplace(JavaPackage, '.', '/', [rfReplaceAll]);
+  if Result <> '' then
+    Result:=Result + '/';
+  if d.DefType = dtUnit then
+    Result:=Result + n
+  else
+    Result:=Result + d.Parent.AliasName + '$' + n;
+end;
+
+procedure TWriter.WriteClass(d: TDef; PreInfo: boolean);
+var
+  WrittenItems: TList;
+
+  procedure _WriteConstructors(c: TClassDef; Written: TStringList);
+  var
+    i, j: integer;
+    p: TProcDef;
+    OldRet: TDef;
+    s: string;
+  begin
+    if c = nil then
+      exit;
+    for i:=0 to c.Count - 1 do
+      with c[i] do begin
+        if (DefType = dtProc) and not c.IsPrivate and (TProcDef(c[i]).ProcType = ptConstructor) then begin
+          p:=TProcDef(c[i]);
+          j:=Written.IndexOf(p.Name);
+          if (j < 0) or (Written.Objects[j] = c) then begin
+            s:=p.Name + ':';
+            for j:=0 to p.Count - 1 do
+              s:=s + DefToJniSig(p[j]);
+            if Written.IndexOf(s) < 0 then begin
+              OldRet:=p.ReturnType;
+              p.ReturnType:=d;
+              p.Parent:=d;
+              try
+                WriteProc(p);
+              finally
+                p.ReturnType:=OldRet;
+                p.Parent:=c;
+              end;
+              Written.Add(s);
+              if not (poOverload in p.ProcOpt) then
+                Written.AddObject(p.Name, c);
+            end;
+          end;
+        end;
+      end;
+
+    _WriteConstructors(c.AncestorClass, Written);
+  end;
+
+  procedure WriteConstructors;
+  var
+    cc: TStringList;
+  begin
+    if not TClassDef(d).HasAbstractMethods then begin
+      // Writing all constructors including parent's
+      cc:=TStringList.Create;
+      try
+        cc.Sorted:=True;
+        _WriteConstructors(TClassDef(d), cc);
+      finally
+        cc.Free;
+      end;
+    end;
+  end;
+
+  procedure _WriteReplacedItems(c: TClassDef);
+  var
+    i: integer;
+    p: TReplDef;
+  begin
+    c:=c.AncestorClass;
+    if c = nil then
+      exit;
+    if c.HasReplacedItems then begin
+      for i:=0 to c.Count - 1 do
+        with c[i] do begin
+          p:=TReplDef(c[i]);
+          if (DefType in ReplDefs) and ((p.IsReplaced) or p.IsReplImpl) then begin
+            if p.ReplacedItem <> nil then
+              WrittenItems.Add(p.ReplacedItem);
+            if WrittenItems.IndexOf(p) >= 0 then
+              continue;
+            case p.DefType of
+              dtProc:
+                WriteProc(TProcDef(p), nil, d);
+              dtProp, dtField:
+                WriteVar(TVarDef(p), d);
+            end;
+          end;
+        end;
+    end;
+    _WriteReplacedItems(c);
+  end;
+
+  procedure WriteReplacedItems;
+  begin
+    _WriteReplacedItems(TClassDef(d));
+  end;
+
+  procedure WriteItems(Regular, Replaced, ReplImpl: boolean);
+  var
+    i: integer;
+    it: TReplDef;
+  begin
+    for i:=0 to d.Count - 1 do begin
+      it:=TReplDef(d[i]);
+      if not (it.DefType in ReplDefs) then
+        continue;
+      if not (it.IsReplImpl or it.IsReplaced) then begin
+        if not Regular then
+          continue;
+      end
+      else
+        if (not Replaced and it.IsReplaced) or (not ReplImpl and it.IsReplImpl) then
+          continue;
+      if it.ReplacedItem <> nil then
+        WrittenItems.Add(it.ReplacedItem);
+      case it.DefType of
+        dtProc:
+          if TProcDef(it).ProcType <> ptConstructor  then
+            WriteProc(TProcDef(it));
+        dtProp, dtField:
+          WriteVar(TVarDef(it));
+      end;
+    end;
+  end;
+
+var
+  s, ss: string;
+  RegularClass: boolean;
+begin
+  if PreInfo then begin
+    WriteClassInfoVar(d);
+
+    if d.DefType = dtRecord then begin
+      s:=d.Parent.Name + '.' + d.Name;
+      Fps.WriteLn;
+      Fps.WriteLn(Format('function _%s_CreateObj(env: PJNIEnv; const r: %s): jobject;', [GetClassPrefix(d), s]));
+      Fps.WriteLn(Format('var pr: ^%s;', [s]));
+      Fps.WriteLn('begin');
+      Fps.IncI;
+      Fps.WriteLn('New(pr); pr^:=r;');
+      Fps.WriteLn(Format('Result:=_CreateJavaObj(env, pr, %s);', [GetTypeInfoVar(d)]));
+      Fps.DecI;
+      Fps.WriteLn('end;');
+
+      Fps.WriteLn;
+      ss:=Format('_%s_Free', [GetClassPrefix(d)]);
+      Fps.WriteLn(Format('procedure %s(env: PJNIEnv; _self: JObject; r: jlong);', [ss]) + JniCaliing);
+      Fps.WriteLn(Format('var pr: ^%s;', [s]));
+      Fps.WriteLn('begin');
+      Fps.WriteLn('pr:=pointer(ptruint(r));', 1);
+      Fps.WriteLn('Dispose(pr);', 1);
+      Fps.WriteLn('end;');
+
+      AddNativeMethod(d, ss, 'Release', '(J)V');
+    end;
+    exit;
+  end;
+
+  // Java
+  case d.DefType of
+    dtClass:
+      s:='class';
+    dtRecord:
+      s:='record';
+    else
+      s:='';
+  end;
+  WriteComment(d, s);
+  s:='public static class ' + GetJavaClassName(d, nil) + ' extends ';
+  if d.DefType = dtClass then
+    with TClassDef(d) do begin
+      if AncestorClass <> nil then begin
+        ss:=AncestorClass.Name;
+        if ImplementsReplacedItems then
+          ss:='__' + ss;
+        s:=s + ss;
+      end
+      else
+        s:=s + 'PascalObject';
+    end
+    else
+      s:=s + Format('%s.system.Record', [JavaPackage]);
+  Fjs.WriteLn(s + ' {');
+  Fjs.IncI;
+  if d.DefType = dtRecord then begin
+    Fjs.WriteLn('private native void Release(long pasobj);');
+    Fjs.WriteLn(Format('public %s() { }', [d.Name]));
+    Fjs.WriteLn(Format('public void Free() { Release(_pasobj); super.Free(); }', [d.Name]));
+    Fjs.WriteLn(Format('public int Size() { return %d; }', [TRecordDef(d).Size]));
+  end;
+
+  WrittenItems:=TList.Create;
+  try
+    RegularClass:=(d.DefType = dtClass) and not TClassDef(d).HasReplacedItems;
+    if RegularClass then
+      WriteConstructors;
+    // Write regular items
+    WriteItems(True, False, RegularClass);
+    if RegularClass and TClassDef(d).ImplementsReplacedItems then
+      // Write implementation wrappers for replaced mehods
+      WriteReplacedItems;
+
+    Fjs.DecI;
+    Fjs.WriteLn('}');
+    Fjs.WriteLn;
+
+    if (d.DefType = dtClass) and (TClassDef(d).HasReplacedItems) then begin
+      // Write replaced items
+      Fjs.WriteLn(Format('public static class %s extends __%0:s {', [d.AliasName]));
+      Fjs.IncI;
+
+      WriteConstructors;
+      WriteItems(False, True, True);
+
+      if TClassDef(d).ImplementsReplacedItems then
+        // Write implementation wrappers for replaced mehods
+        WriteReplacedItems;
+
+      Fjs.DecI;
+      Fjs.WriteLn('}');
+      Fjs.WriteLn;
+    end;
+  finally
+    WrittenItems.Free;
+  end;
+end;
+
+procedure TWriter.WriteProc(d: TProcDef; Variable: TVarDef; AParent: TDef);
+var
+  i, j, ClassIdx: integer;
+  s, ss: string;
+  err, tf: boolean;
+  pi: TProcInfo;
+  ci: TClassInfo;
+  IsTObject: boolean;
+  tempvars: TStringList;
+  vd: TVarDef;
+  UseTempObjVar: boolean;
+  ItemDef: TDef;
+begin
+  ASSERT(d.DefType = dtProc);
+  if d.IsPrivate or not d.IsUsed then
+    exit;
+  IsTObject:=(d.Parent.DefType = dtClass) and (TClassDef(d.Parent).AncestorClass = nil);
+  if (d.ProcType = ptDestructor) and not IsTObject then
+    exit;
+  if Variable <> nil then
+    ItemDef:=Variable
+  else
+    ItemDef:=d;
+  tempvars:=nil;
+  pi:=TProcInfo.Create;
+  with d do
+  try
+    pi.Name:=Name;
+    s:=GetClassPrefix(d.Parent) + pi.Name;
+    pi.JniName:=s;
+    pi.JniSignature:=GetProcSignature(d);
+    if AParent = nil then begin
+      // Checking duplicate name
+      ClassIdx:=FClasses.IndexOf(GetJavaClassName(d.Parent, ItemDef));
+      if ClassIdx >= 0 then begin
+        ci:=TClassInfo(FClasses.Objects[ClassIdx]);
+        j:=1;
+        repeat
+          err:=False;
+          for i:=0 to ci.Funcs.Count - 1 do
+            with TProcInfo(ci.Funcs[i]) do
+              if CompareText(JniName, pi.JniName) = 0 then begin
+                Inc(j);
+                pi.JniName:=Format('%s_%d', [s, j]);
+                err:=True;
+                break;
+              end;
+        until not err;
+      end;
+
+      err:=False;
+      if ProcType in [ptFunction, ptConstructor] then
+        s:='function'
+      else
+        s:='procedure';
+      s:=s + ' ' + pi.JniName + '(_env: PJNIEnv; _jobj: jobject';
+
+      UseTempObjVar:=(ProcType = ptProcedure) and (Variable <> nil) and (Variable.VarType <> nil) and (Variable.VarType.DefType = dtProcType) and (Variable.Parent.DefType <> dtUnit);
+
+      for j:=0 to Count - 1 do
+        with TVarDef(Items[j]) do begin
+          s:=s + '; ' + Name + ': ';
+          if VarOpt * [voVar, voOut] = [] then
+            s:=s + DefToJniType(VarType, err)
+          else begin
+            s:=s + 'jarray';
+            if tempvars = nil then
+              tempvars:=TStringList.Create;
+            if VarType = nil then
+              err:=True
+            else
+              Tag:=tempvars.AddObject('__tmp_' + Name, d.Items[j]) + 1;
+          end;
+        end;
+      s:=s + ')';
+
+      if ProcType in [ptFunction, ptConstructor] then
+        s:=s + ': ' + DefToJniType(ReturnType, err);
+      s:=s + '; ' + JniCaliing;
+      if err then begin
+        d.SetNotUsed;
+        s:='// ' + s;
+      end;
+      Fps.WriteLn;
+      Fps.WriteLn(s);
+      if err then
+        exit;
+      if (tempvars <> nil) or UseTempObjVar then begin
+        s:='';
+        Fps.WriteLn('var');
+        Fps.IncI;
+        if tempvars <> nil then begin
+          for i:=0 to tempvars.Count - 1 do begin
+            vd:=TVarDef(tempvars.Objects[i]);
+            Fps.WriteLn(Format('%s: %s;', [tempvars[i], vd.VarType.Name]));
+            if IsJavaSimpleType(vd.VarType) then begin
+              Fps.WriteLn(Format('%s_arr: P%s;', [tempvars[i], DefToJniType(vd.VarType, err)]));
+              if s = '' then
+                s:='__iscopy: JBoolean;';
+            end;
+          end;
+          if s <> '' then
+            Fps.WriteLn(s);
+        end;
+        if UseTempObjVar then
+          Fps.WriteLn('__objvar: ' + d.Parent.Name + ';');
+        Fps.DecI;
+      end;
+      Fps.WriteLn('begin');
+      Fps.IncI;
+      EHandlerStart;
+
+      tf:=False;
+      // Assign var parameter values to local vars
+      if tempvars <> nil then begin
+        for i:=0 to tempvars.Count - 1 do begin
+          vd:=TVarDef(tempvars.Objects[i]);
+          Fps.WriteLn(Format('if _env^^.GetArrayLength(_env, %s) <> 1 then _RaiseVarParamException(''%s'');', [vd.Name, vd.Name]));
+          if IsJavaSimpleType(vd.VarType) then begin
+            Fps.WriteLn(Format('%s_arr:=_env^^.Get%sArrayElements(_env, %s, __iscopy);', [tempvars[i], GetJniFuncType(vd.VarType), vd.Name]));
+            Fps.WriteLn(Format('if %s_arr = nil then _RaiseVarParamException(''%s'');', [tempvars[i], vd.Name]));
+            s:=tempvars[i] + '_arr^';
+            tf:=True;
+          end
+          else
+            s:=Format('_env^^.GetObjectArrayElement(_env, %s, 0)', [vd.Name]);
+          if voVar in vd.VarOpt then
+            Fps.WriteLn(tempvars[i] + ':=' + JniToPasType(vd.VarType, s, False) + ';');
+        end;
+      end;
+
+      if tf then begin
+        Fps.WriteLn('try');
+        Fps.IncI;
+      end;
+
+      s:='';
+      if Parent.DefType = dtUnit then
+        s:=Parent.Name + '.'
+      else
+        if ProcType = ptConstructor then
+          s:=Parent.Parent.Name + '.' + Parent.Name + '.'
+        else
+          s:=JniToPasType(d.Parent, '_jobj', True) + '.';
+
+      if Variable = nil then begin
+        // Regular proc
+        s:=s + pi.Name;
+        if Count > 0 then begin
+          s:=s + '(';
+          for j:=0 to Count - 1 do begin
+            vd:=TVarDef(Items[j]);
+            if vd.Tag <> 0 then
+              ss:=tempvars[vd.Tag - 1]
+            else begin
+              ss:=Items[j].Name;
+              ss:=JniToPasType(vd.VarType, ss, False);
+            end;
+            if j <> 0 then
+              s:=s + ', ';
+            s:=s + ss;
+          end;
+          s:=s + ')';
+        end;
+      end
+      else begin
+        // Var access
+        if UseTempObjVar then begin
+          System.Delete(s, Length(s), 1);
+          Fps.WriteLn('__objvar:=' + s + ';');
+          s:='__objvar.';
+        end;
+        s:=s + Variable.Name;
+        if Variable.IndexType <> nil then begin
+          ASSERT(Count >= 1);
+          i:=1;
+          s:=Format('%s[%s]', [s, JniToPasType(TVarDef(Items[0]).VarType, Items[0].Name, False)]);
+        end
+        else
+          i:=0;
+        if ProcType = ptProcedure then begin
+          ASSERT(Count = i + 1);
+          if Variable.VarType.DefType = dtProcType then begin
+            Fps.WriteLn(Format('_RefMethodPtr(_env, TMethod(%s), False);', [s]));
+            ss:=Format('_RefMethodPtr(_env, TMethod(%s), True);', [s]);
+          end;
+          s:=s + ':=' + JniToPasType(TVarDef(Items[i]).VarType, Items[i].Name, False);
+        end;
+      end;
+
+      if ProcType in [ptFunction, ptConstructor] then
+        s:='Result:=' + PasToJniType(ReturnType, s);
+      s:=s + ';';
+      Fps.WriteLn(s);
+
+      if (Variable <> nil) and UseTempObjVar then
+        Fps.WriteLn(ss);
+
+      // Return var/out parameters
+      if tempvars <> nil then begin
+        for i:=0 to tempvars.Count - 1 do begin
+          vd:=TVarDef(tempvars.Objects[i]);
+          if IsJavaSimpleType(vd.VarType) then
+            Fps.WriteLn(Format('%s_arr^:=%s;', [tempvars[i], PasToJniType(vd.VarType, tempvars[i])]))
+          else
+            Fps.WriteLn(Format('_env^^.SetObjectArrayElement(_env, %s, 0, %s);', [vd.Name, PasToJniType(vd.VarType, tempvars[i])]));
+        end;
+      end;
+
+      if IsTObject and ( (ProcType = ptDestructor) or (CompareText(Name, 'Free') = 0) ) then
+        Fps.WriteLn(Format('_env^^.SetLongField(_env, _jobj, %s.ObjFieldId, 0);', [GetTypeInfoVar(d.Parent)]));
+
+      if tf then begin
+        Fps.WriteLn('finally', -1);
+
+        if tempvars <> nil then begin
+          for i:=0 to tempvars.Count - 1 do begin
+            vd:=TVarDef(tempvars.Objects[i]);
+            if IsJavaSimpleType(vd.VarType) then
+              Fps.WriteLn(Format('_env^^.Release%sArrayElements(_env, %s, %s_arr, 0);', [JavaType[TTypeDef(vd.VarType).BasicType], vd.Name, tempvars[i]]));
+          end;
+        end;
+
+        Fps.DecI;
+        Fps.WriteLn('end;');
+      end;
+
+      s:='';
+      if ProcType in [ptFunction, ptConstructor] then begin
+        s:='0';
+        if (ReturnType.DefType = dtType) and (TTypeDef(ReturnType).BasicType <= btDouble) then
+          s:='0'
+        else
+          s:=Format('%s(0)', [DefToJniType(ReturnType, err)]);
+        s:='Result:=' + s + ';';
+      end;
+      EHandlerEnd('_env', s);
+
+      Fps.DecI;
+      Fps.WriteLn('end;');
+      AParent:=d.Parent;
+    end
+    else
+      ClassIdx:=FClasses.IndexOf(GetJavaClassName(AParent, ItemDef));
+
+    if ClassIdx < 0 then begin
+      ci:=TClassInfo.Create;
+      ci.Def:=AParent;
+      s:=GetJavaClassName(AParent, ItemDef);
+      ci.IsCommonClass:=s <> AParent.Name;
+      ClassIdx:=FClasses.AddObject(s, ci);
+    end;
+    TClassInfo(FClasses.Objects[ClassIdx]).Funcs.Add(pi);
+    pi:=nil;
+
+    // Java part
+    s:=GetJavaProcDeclaration(d) + ';';
+    if (Parent.DefType = dtUnit) or (ProcType = ptConstructor) then
+      s:='static ' + s;
+
+    if Variable = nil then
+      Fjs.WriteLn('// ' + GetProcDeclaration(d));
+    if poPrivate in ProcOpt then
+      ss:='private'
+    else
+      if poProtected in ProcOpt then
+        ss:='protected'
+      else
+        ss:='public';
+    Fjs.WriteLn(ss + ' native ' + s);
+  finally
+    pi.Free;
+    tempvars.Free;
+  end;
+end;
+
+procedure TWriter.WriteVar(d: TVarDef; AParent: TDef);
+var
+  pd: TProcDef;
+  t: TTypeDef;
+  s: string;
+begin
+  if not d.IsUsed then
+    exit;
+  if d.VarType <> nil then begin
+    case d.DefType of
+      dtVar:
+        s:='var';
+      dtProp:
+        s:='property';
+      else
+        s:='';
+    end;
+    s:=Trim(s + ' ' + d.Name);
+    if d.IndexType <> nil then
+      s:=s + '[]';
+    Fjs.WriteLn(Format('// %s: %s', [s, d.VarType.Name]));
+  end;
+
+  if voRead in d.VarOpt then begin
+    pd:=TProcDef.Create(nil, dtProc);
+    try
+      pd.IsUsed:=True;
+      pd.Parent:=d.Parent;
+      pd.ProcType:=ptFunction;
+      pd.Name:='get' + d.Name;
+      pd.ReturnType:=d.VarType;
+      if d.IndexType <> nil then
+        with TVarDef.Create(pd, dtParam) do begin
+          Name:='_Index';
+          AliasName:='Index';
+          VarType:=d.IndexType;
+          VarOpt:=[voRead];
+        end;
+      WriteProc(pd, d, AParent);
+    finally
+      pd.Free;
+    end;
+  end;
+
+  if voWrite in d.VarOpt then begin
+    pd:=TProcDef.Create(nil, dtProc);
+    try
+      pd.IsUsed:=True;
+      pd.Parent:=d.Parent;
+      pd.ProcType:=ptProcedure;
+      pd.Name:='set' + d.Name;
+      if d.IndexType <> nil then
+        with TVarDef.Create(pd, dtParam) do begin
+          Name:='_Index';
+          AliasName:='Index';
+          VarType:=d.IndexType;
+          VarOpt:=[voRead];
+        end;
+      with TVarDef.Create(pd, dtParam) do begin
+        Name:='_Value';
+        AliasName:='Value';
+        VarType:=d.VarType;
+        VarOpt:=[voRead];
+      end;
+      t:=TTypeDef.Create(nil, dtType);
+      try
+        t.BasicType:=btVoid;
+        pd.ReturnType:=t;
+        WriteProc(pd, d, AParent);
+      finally
+        t.Free;
+      end;
+    finally
+      pd.Free;
+    end;
+  end;
+end;
+
+procedure TWriter.WriteConst(d: TConstDef);
+var
+  s: string;
+begin
+  if not d.IsUsed then
+    exit;
+  if d.VarType = nil then begin
+    if Copy(d.Value, 1, 1) = '"' then
+      s:='String'
+    else
+      s:='double';
+  end
+  else
+    s:=DefToJavaType(d.VarType);
+  Fjs.WriteLn(Format('public static final %s %s = %s;', [s, d.Name, d.Value]));
+end;
+
+procedure TWriter.WriteEnum(d: TDef);
+var
+  i: integer;
+  s: string;
+begin
+  if not d.IsUsed then
+    exit;
+
+  RegisterPseudoClass(d);
+
+  WriteComment(d, 'enum');
+  Fjs.WriteLn(Format('public enum %s {', [d.Name]));
+  Fjs.IncI;
+  for i:=0 to d.Count - 1 do begin
+    s:=Format('%s (%s)', [d[i].Name, TConstDef(d[i]).Value]);
+    if i <> d.Count - 1 then
+      s:=s + ','
+    else
+      s:=s + ';';
+    Fjs.WriteLn(s);
+  end;
+  Fjs.WriteLn;
+  Fjs.WriteLn('private final int Value;');
+  Fjs.WriteLn(Format('%s(int v) { Value=v; }', [d.Name]));
+  Fjs.WriteLn('public int Ord() { return Value; }');
+  Fjs.DecI;
+  Fjs.WriteLn('}');
+  Fjs.WriteLn;
+end;
+
+procedure TWriter.WriteProcType(d: TProcDef; PreInfo: boolean);
+
+  procedure _AccessSimpleArray(vd: TVarDef; VarIndex: integer; DoSet: boolean);
+  begin
+    with vd do begin
+      Fps.WriteLn(Format('_tmp_%s:=_env^^.Get%sArrayElements(_env, _args[%d].L, PJBoolean(nil)^);', [Name, GetJniFuncType(VarType), VarIndex]));
+      Fps.WriteLn(Format('if _tmp_%s <> nil then', [Name]));
+      if DoSet then
+        Fps.WriteLn(Format('_tmp_%s^:=%s;', [Name, PasToJniType(VarType, Name)]), 1)
+      else
+        Fps.WriteLn(Format('%s:=%s;', [Name, JniToPasType(VarType, '_tmp_' + Name + '^', False)]), 1);
+      Fps.WriteLn(Format('_env^^.Release%sArrayElements(_env, _args[%d].L, _tmp_%s, 0);', [GetJniFuncType(VarType), VarIndex, Name]));
+    end;
+  end;
+
+var
+  vd: TVarDef;
+  i: integer;
+  s, ss: string;
+  err: boolean;
+begin
+  if not d.IsUsed or not (poMethodPtr in d.ProcOpt) then
+    exit;
+
+  if PreInfo then begin
+    WriteClassInfoVar(d);
+
+    // Handler proc
+    Fps.WriteLn;
+    vd:=TVarDef.Create(nil, dtParam);
+    try
+      vd.Name:='_data';
+      vd.VarType:=TTypeDef.Create(nil, dtType);
+      with TTypeDef(vd.VarType) do begin
+        Name:='pointer';
+        BasicType:=btPointer;
+      end;
+      d.Insert(0, vd);
+      Fps.WriteLn(GetProcDeclaration(d, Format('%sHandler', [GetClassPrefix(d)])) + ';');
+    finally
+      vd.VarType.Free;
+      vd.Free;
+    end;
+    Fps.WriteLn('var');
+    Fps.IncI;
+    Fps.WriteLn('_env: PJNIEnv;');
+    Fps.WriteLn('_mpi: _TMethodPtrInfo;');
+    if d.Count > 0 then begin
+      Fps.WriteLn(Format('_args: array[0..%d] of jvalue;', [d.Count - 1]));
+      for i:=0 to d.Count - 1 do
+        with TVarDef(d[i]) do
+          if (VarOpt * [voOut, voVar] <> []) and IsJavaSimpleType(VarType) then
+            Fps.WriteLn(Format('_tmp_%s: P%s;', [Name, DefToJniType(VarType, err)]));
+    end;
+    Fps.DecI;
+    Fps.WriteLn('begin');
+    Fps.IncI;
+    Fps.WriteLn('CurJavaVM^^.GetEnv(CurJavaVM, @_env, JNI_VERSION_1_6);');
+    Fps.WriteLn('_MethodPointersCS.Enter;');
+    Fps.WriteLn('try');
+    Fps.WriteLn('_mpi:=_TMethodPtrInfo(_MethodPointers[-integer(ptruint(_data)) - 1]);', 1);
+    Fps.WriteLn('finally');
+    Fps.WriteLn('_MethodPointersCS.Leave;', 1);
+    Fps.WriteLn('end;');
+
+    for i:=0 to d.Count - 1 do
+      with TVarDef(d[i]) do begin
+        if VarOpt * [voOut, voVar] = [] then begin
+          s:='L';
+          if VarType.DefType = dtType then
+            s:=Copy(JNITypeSig[TTypeDef(VarType).BasicType], 1, 1);
+          ss:=PasToJniType(VarType, Name);
+        end
+        else begin
+          s:='L';
+          if IsJavaSimpleType(VarType) then
+            ss:=Format('_env^^.New%sArray(_env, 1)', [GetJniFuncType(VarType)])
+          else begin
+            if voVar in VarOpt then
+              ss:=PasToJniType(VarType, Name)
+            else
+              ss:='nil';
+            ss:=Format('_env^^.NewObjectArray(_env, 1, %s.ClassRef, %s)', [GetTypeInfoVar(VarType), ss]);
+          end;
+        end;
+        Fps.WriteLn(Format('_args[%d].%s:=%s;', [i, s, ss]));
+        if (voVar in VarOpt) and IsJavaSimpleType(VarType) then
+          _AccessSimpleArray(TVarDef(d[i]), i, True);
+      end;
+
+    if d.Count > 0 then
+      s:='@_args'
+    else
+      s:='nil';
+    // Calling Java handler
+    s:=Format('_env^^.Call%sMethodA(_env, _mpi.Obj, _mpi.MethodId, %s)', [GetJniFuncType(d.ReturnType), s]);
+    if d.ProcType = ptFunction then
+      s:=Format('Result:=%s', [JniToPasType(d.ReturnType, s, False)]);
+    Fps.WriteLn(s + ';');
+    // Processing var/out parameters
+    for i:=0 to d.Count - 1 do
+      with TVarDef(d[i]) do
+        if VarOpt * [voOut, voVar] <> [] then
+          if IsJavaSimpleType(VarType) then
+            _AccessSimpleArray(TVarDef(d[i]), i, False)
+          else begin
+            s:=Format('_env^^.GetObjectArrayElement(_env, _args[%d].L, 0)', [i]);
+            Fps.WriteLn(Format('%s:=%s;', [Name, JniToPasType(VarType, s, False)]));
+          end;
+
+    Fps.DecI;
+    Fps.WriteLn('end;');
+
+    // Get handler proc
+    Fps.WriteLn;
+    Fps.WriteLn(Format('function %sGetHandler(env: PJNIEnv; jobj: jobject; const ci: _TJavaClassInfo): %s.%s;',
+                       [GetClassPrefix(d), d.Parent.Name, d.Name]));
+    Fps.WriteLn('var mpi: _TMethodPtrInfo;');
+    Fps.WriteLn('begin');
+    Fps.IncI;
+    Fps.WriteLn('Result:=nil;');
+    Fps.WriteLn('mpi:=_TMethodPtrInfo(_GetPasObj(env, jobj, ci, False));');
+    Fps.WriteLn('if mpi = nil then exit;');
+    Fps.WriteLn('if mpi.Index = 0 then');
+    Fps.WriteLn('TMethod(Result):=mpi.RealMethod', 1);
+    Fps.WriteLn('else');
+    Fps.WriteLn('with TMethod(Result) do begin', 1);
+    Fps.WriteLn('Data:=pointer(ptruint(-integer(mpi.Index)));', 2);
+    Fps.WriteLn(Format('Code:=@%sHandler;', [GetClassPrefix(d)]), 2);
+    Fps.WriteLn('end;', 1);
+    Fps.DecI;
+    Fps.WriteLn('end;');
+
+    exit;
+  end;
+
+  err:=False;
+  WriteComment(d, 'procedural type');
+
+  RegisterPseudoClass(d);
+
+  Fjs.WriteLn(Format('/* Pascal prototype: %s */', [GetProcDeclaration(d, 'Execute')]));
+  Fjs.WriteLn(Format('/* Java prototype: %s */', [GetJavaProcDeclaration(d, 'Execute')]));
+
+  Fjs.WriteLn(Format('public static class %s extends %s.system.MethodPtr {', [d.Name, JavaPackage]));
+  Fjs.IncI;
+  Fjs.WriteLn(Format('private String HandlerSig = "%s";', [GetProcSignature(d)]));
+  Fjs.WriteLn(Format('public %s(Object Obj, String MethodName) { Init(Obj, MethodName, HandlerSig); }', [d.Name]));
+  Fjs.WriteLn(Format('public %s() { Init(this, "Execute", HandlerSig); }', [d.Name]));
+  Fjs.WriteLn(Format('protected %s throws NoSuchMethodException { throw new NoSuchMethodException(); }', [GetJavaProcDeclaration(d, 'Execute')]));
+  Fjs.DecI;
+  Fjs.WriteLn('}');
+  Fjs.WriteLn;
+end;
+
+procedure TWriter.WriteSet(d: TSetDef);
+begin
+  if not d.IsUsed then
+    exit;
+  if d.ElType = nil then
+    raise Exception.Create('No element type.');
+
+  WriteComment(d, '');
+  Fjs.WriteLn(Format('/* set of %s */', [d.ElType.Name]));
+  if d.Size > 4 then begin
+    Fjs.WriteLn('/* Set size more than 32 bits is not supported */');
+    exit;
+  end;
+
+  RegisterPseudoClass(d);
+
+  Fjs.WriteLn(Format('public static class %s extends %s.system.Set<%s,%s> {', [d.Name, JavaPackage, d.Name, d.ElType.Name]));
+  Fjs.IncI;
+  Fjs.WriteLn(Format('protected byte Size() { return %d; }', [d.Size]));
+  Fjs.WriteLn(Format('protected int Base() { return %d; }', [d.Base]));
+  Fjs.WriteLn(Format('protected int ElMax() { return %d; }', [d.ElMax]));
+  Fjs.WriteLn(Format('protected int Ord(%s Element) { return Element.Ord(); }', [d.ElType.Name]));
+  Fjs.WriteLn(Format('public %s() { }', [d.Name]));
+  Fjs.WriteLn(Format('public %s(%s... Elements) { super(Elements); }', [d.Name, d.ElType.Name]));
+  Fjs.WriteLn(Format('public %0:s(%0:s... Elements) { super(Elements); }', [d.Name]));
+  Fjs.WriteLn(Format('public static %0:s Exclude(%0:s s1, %0:s s2) { %0:s r = new %0:s(s1); r.Exclude(s2); return r; }', [d.Name]));
+  Fjs.WriteLn(Format('public static %0:s Intersect(%0:s s1, %0:s s2) { %0:s r = new %0:s(s1); r.Intersect(s2); return r; }', [d.Name]));
+  Fjs.DecI;
+  Fjs.WriteLn('}');
+  Fjs.WriteLn;
+end;
+
+procedure TWriter.WriteUnit(u: TUnitDef);
+var
+  d: TDef;
+  i: integer;
+begin
+  if u.Processed then
+    exit;
+  u.Processed:=True;
+
+  if not u.IsUsed then
+    exit;
+
+  for i:=0 to High(u.UsedUnits) do
+    WriteUnit(u.UsedUnits[i]);
+
+  Fps.WriteLn;
+  Fps.WriteLn(Format('{ Unit %s }', [u.Name]));
+
+  u.Name:=LowerCase(u.Name);
+  Fjs:=TTextOutStream.Create(IncludeTrailingPathDelimiter(FPkgDir) + u.Name + '.java', fmCreate);
+  try
+    Fjs.WriteLn(Format('package %s;', [JavaPackage]));
+    if Length(u.UsedUnits) > 0 then begin
+      Fjs.WriteLn;
+      for i:=0 to High(u.UsedUnits) do
+        if u.UsedUnits[i].IsUsed then
+          Fjs.WriteLn(Format('import %s.%s.*;', [JavaPackage, LowerCase(u.UsedUnits[i].Name)]));
+    end;
+    Fjs.WriteLn;
+    Fjs.WriteLn('public class ' + u.Name + ' {');
+    Fjs.IncI;
+    if u.Name = 'system' then begin
+      Fjs.WriteLn('static private boolean _JniLibLoaded = false;');
+      Fjs.WriteLn('public static void InitJni() {');
+      Fjs.WriteLn('if (!_JniLibLoaded) {', 1);
+      Fjs.WriteLn('_JniLibLoaded=true;', 2);
+      Fjs.WriteLn(Format('System.loadLibrary("%s");', [LibName]), 2);
+      Fjs.WriteLn('}', 1);
+      Fjs.WriteLn('}');
+
+      // Support functions
+      Fjs.WriteLn('public native static long AllocMemory(int Size);');
+      AddNativeMethod(u, '_AllocMemory', 'AllocMemory', '(I)J');
+
+      // Base object
+      Fjs.WriteLn;
+      Fjs.WriteLn('public static class PascalObject {');
+      Fjs.IncI;
+      Fjs.WriteLn(Format('static { %s.system.InitJni(); }', [JavaPackage]));
+      Fjs.WriteLn('protected long _pasobj = 0;');
+      Fjs.DecI;
+      Fjs.WriteLn('}');
+      Fjs.WriteLn;
+      Fjs.WriteLn('public static long Pointer(PascalObject obj) { return obj._pasobj; }');
+
+      // Record
+      Fjs.WriteLn;
+      Fjs.WriteLn('public static class Record extends PascalObject {');
+      Fjs.IncI;
+      Fjs.WriteLn('protected void finalize() { Free(); }');
+      Fjs.WriteLn('public Record() { _pasobj = AllocMemory(Size()); }');
+      Fjs.WriteLn('public void Free() { _pasobj = 0; }');
+      Fjs.WriteLn('public int Size() { return 0; }');
+      Fjs.DecI;
+      Fjs.WriteLn('}');
+
+      // Method pointer base class
+      d:=TClassDef.Create(FThisUnit, dtClass);
+      d.Name:='_TMethodPtrInfo';
+      d.AliasName:='MethodPtr';
+      WriteClassInfoVar(d);
+
+      Fps.WriteLn;
+      Fps.WriteLn('procedure _TMethodPtrInfo_Init(env: PJNIEnv; _self, JavaObj: JObject; AMethodName, AMethodSig: jstring);' + JniCaliing);
+      Fps.WriteLn('var mpi: _TMethodPtrInfo;');
+      Fps.WriteLn('begin');
+      Fps.IncI;
+      EHandlerStart;
+      Fps.WriteLn('mpi:=_TMethodPtrInfo.Create(env, JavaObj, ansistring(_StringFromJString(env, AMethodName)), ansistring(_StringFromJString(env, AMethodSig)));');
+      Fps.WriteLn(Format('env^^.SetLongField(env, _self, %s.ObjFieldId, Int64(ptruint(mpi)));', [GetTypeInfoVar(d)]));
+      EHandlerEnd('env');
+      Fps.DecI;
+      Fps.WriteLn('end;');
+
+      AddNativeMethod(d, '_TMethodPtrInfo_Init', 'Init', Format('(Ljava/lang/Object;%s%s)V', [JNITypeSig[btString], JNITypeSig[btString]]));
+
+      Fps.WriteLn;
+      Fps.WriteLn('procedure _TMethodPtrInfo_Release(env: PJNIEnv; _self: JObject);' + JniCaliing);
+      Fps.WriteLn('begin');
+      Fps.IncI;
+      EHandlerStart;
+      Fps.WriteLn(Format('_TMethodPtrInfo(_GetPasObj(env, _self, %s, True)).Release(env);', [GetTypeInfoVar(d)]));
+      EHandlerEnd('env');
+      Fps.DecI;
+      Fps.WriteLn('end;');
+
+      AddNativeMethod(d, '_TMethodPtrInfo_Release', 'Release', '()V');
+
+      Fjs.WriteLn;
+      Fjs.WriteLn('public static class MethodPtr extends PascalObject {');
+      Fjs.IncI;
+
+      Fjs.WriteLn('private native void Release();');
+      Fjs.WriteLn('protected void finalize() { if (_pasobj != 0) Release(); }');
+      Fjs.WriteLn('protected native void Init(Object Obj, String MethodName, String MethodSignature);');
+      Fjs.DecI;
+      Fjs.WriteLn('}');
+      Fjs.WriteLn;
+
+      // Set base class
+      Fjs.WriteLn('public static class Set<TS extends Set<?,?>,TE> {');
+      Fjs.IncI;
+      Fjs.WriteLn('protected int Value = 0;');
+      Fjs.WriteLn('protected byte Size() { return 0; }');
+      Fjs.WriteLn('protected int Base() { return 0; }');
+      Fjs.WriteLn('protected int ElMax() { return 0; }');
+      Fjs.WriteLn('protected int Ord(TE Element) { return 0; }');
+      Fjs.WriteLn('protected int GetMask(TE Element) {');
+      Fjs.IncI;
+      Fjs.WriteLn('return 1 << (Ord(Element) - Base());');
+      Fjs.DecI;
+      Fjs.WriteLn('}');
+      Fjs.WriteLn('public Set() { }');
+      Fjs.WriteLn('public Set(TE... Elements) { Include(Elements); }');
+      Fjs.WriteLn('public Set(TS... Elements) { for (TS e : Elements) Include(e); }');
+      Fjs.WriteLn('public void Include(TE... Elements) { for (TE e: Elements) Value = Value | GetMask(e); }');
+      Fjs.WriteLn('public void Include(TS s) { Value=Value | s.Value; }');
+      Fjs.WriteLn('public void Exclude(TE... Elements) { for (TE e: Elements) Value = Value & ~GetMask(e); }');
+      Fjs.WriteLn('public void Exclude(TS s) { Value=Value & ~s.Value; }');
+      Fjs.WriteLn('public void Assign(TS s) { Value=s.Value; }');
+      Fjs.WriteLn('public void Intersect(TS s) { Value=Value & s.Value; }');
+      Fjs.WriteLn('public boolean Compare(TS s) { return Value == s.Value; }');
+      Fjs.WriteLn('public boolean Has(TE Element) { return (Value & GetMask(Element)) != 0; }');
+      Fjs.DecI;
+      Fjs.WriteLn('}');
+      Fjs.WriteLn;
+    end;
+    Fjs.WriteLn(Format('static { %s.system.InitJni(); }', [JavaPackage]));
+    Fjs.WriteLn;
+
+    // First pass
+    for i:=0 to u.Count - 1 do begin
+      d:=u[i];
+      if not d.IsUsed then
+        continue;
+      case d.DefType of
+        dtSet, dtEnum:
+          WriteClassInfoVar(d);
+        dtClass, dtRecord:
+          WriteClass(d, True);
+        dtProcType:
+          WriteProcType(TProcDef(d), True);
+      end;
+    end;
+
+    // Second pass
+    for i:=0 to u.Count - 1 do begin
+      d:=u[i];
+      if not d.IsUsed then
+        continue;
+      case d.DefType of
+        dtClass, dtRecord:
+          WriteClass(d, False);
+        dtProc:
+          WriteProc(TProcDef(d));
+        dtVar, dtProp:
+          WriteVar(TVarDef(d));
+        dtEnum:
+          WriteEnum(d);
+        dtProcType:
+          WriteProcType(TProcDef(d), False);
+        dtSet:
+          WriteSet(TSetDef(d));
+        dtConst:
+          WriteConst(TConstDef(d));
+      end;
+    end;
+
+    Fjs.DecI;
+    Fjs.WriteLn('}');
+  finally
+    Fjs.Free;
+  end;
+end;
+
+procedure TWriter.WriteOnLoad;
+var
+  i, j: integer;
+  ci: TClassInfo;
+  s, ss, fn: string;
+  d: TTypeDef;
+begin
+  if FClasses.Count = 0 then
+    exit;
+  Fps.WriteLn;
+  Fps.WriteLn('function JNI_OnLoad(vm: PJavaVM; reserved: pointer): jint;' + JniCaliing);
+
+  Fps.WriteLn('const');
+  for i:=0 to FClasses.Count - 1 do begin
+    ci:=TClassInfo(FClasses.Objects[i]);
+    if ci.Funcs.Count = 0 then
+      continue;
+    Fps.WriteLn(Format('  _%sNativeMethods: array[0..%d] of JNINativeMethod = (', [GetClassPrefix(ci.Def, FClasses[i]), ci.Funcs.Count - 1]));
+    for j:=0 to ci.Funcs.Count - 1 do begin
+      with TProcInfo(ci.Funcs[j]) do
+        Fps.Write(Format('    (name: ''%s''; signature: ''%s''; fnPtr: @%s)', [Name, JniSignature, JniName]));
+      if j < ci.Funcs.Count - 1 then
+        Fps.Write(',');
+      Fps.WriteLn;
+    end;
+    Fps.WriteLn('  );');
+  end;
+
+  Fps.WriteLn;
+  Fps.WriteLn('var');
+  Fps.IncI;
+  Fps.WriteLn('env: PJNIEnv;');
+  Fps.WriteLn;
+  Fps.WriteLn('function _Reg(ClassName: PAnsiChar; Methods: PJNINativeMethod; Count: integer; ci: _PJavaClassInfo; const FieldName: ansistring = ''_pasobj''; const FieldSig: ansistring = ''J''): boolean;');
+  Fps.WriteLn('var');
+  Fps.WriteLn('c: jclass;', 1);
+  Fps.WriteLn('begin');
+  Fps.IncI;
+  Fps.WriteLn('Result:=False;');
+  Fps.WriteLn('c:=env^^.FindClass(env, ClassName);');
+  Fps.WriteLn('if c = nil then exit;');
+  Fps.WriteLn('Result:=(Count = 0) or (env^^.RegisterNatives(env, c, Methods, Count) = 0);');
+  Fps.WriteLn('if Result and (ci <> nil) then begin');
+  Fps.IncI;
+  Fps.WriteLn('ci^.ClassRef:=env^^.NewGlobalRef(env, c);');
+  Fps.WriteLn('Result:=ci^.ClassRef <> nil;');
+  Fps.WriteLn('if Result and (FieldName <> '''') then begin');
+  Fps.WriteLn('ci^.ObjFieldId:=env^^.GetFieldID(env, ci^.ClassRef, PAnsiChar(FieldName), PAnsiChar(FieldSig));', 1);
+  Fps.WriteLn('Result:=ci^.ObjFieldId <> nil;', 1);
+  Fps.WriteLn('end;');
+  Fps.DecI;
+  Fps.WriteLn('end;');
+  Fps.DecI;
+  Fps.WriteLn('end;');
+  Fps.WriteLn;
+  Fps.WriteLn('begin', -1);
+  Fps.WriteLn('Result:=JNI_ERR;');
+  Fps.WriteLn('if vm^^.GetEnv(vm, @env, JNI_VERSION_1_6) <> JNI_OK then exit;');
+  Fps.WriteLn('CurJavaVM:=vm;');
+
+  d:=TTypeDef.Create(nil, dtType);
+  try
+    d.BasicType:=btString;
+    s:=JNITypeSig[d.BasicType];
+    s:=Copy(s, 2, Length(s) - 2);
+    Fps.WriteLn(Format('if not _Reg(''%s'', nil, 0, @%s, '''', '''') then exit;',
+                       [s, GetTypeInfoVar(d)]));
+  finally
+    d.Free;
+  end;
+
+  for i:=0 to FClasses.Count - 1 do begin
+    ci:=TClassInfo(FClasses.Objects[i]);
+    s:=GetTypeInfoVar(ci.Def);
+    if (s = '') or (ci.IsCommonClass) then
+      s:='nil'
+    else
+      s:='@' + s;
+    if ci.Funcs.Count = 0 then
+      ss:='nil'
+    else
+      ss:=Format('@_%sNativeMethods', [GetClassPrefix(ci.Def, FClasses[i])]);
+    fn:='';
+    if ci.Def <> nil then
+      if ci.Def.DefType in [dtSet, dtEnum] then
+        fn:=', ''Value'', ''I''';
+    Fps.WriteLn(Format('if not _Reg(''%s'', %s, %d, %s%s) then exit;',
+                       [GetJavaClassPath(ci.Def, FClasses[i]), ss, ci.Funcs.Count, s, fn]));
+  end;
+
+  Fps.WriteLn('Result:=JNI_VERSION_1_6;');
+  Fps.DecI;
+  Fps.WriteLn('end;');
+  Fps.WriteLn;
+  Fps.WriteLn('exports JNI_OnLoad;');
+end;
+
+function TWriter.JniToPasType(d: TDef; const v: string; CheckNil: boolean): string;
+var
+  n: string;
+begin
+  Result:=v;
+  if d = nil then
+    exit;
+  case d.DefType of
+    dtType:
+      with TTypeDef(d) do
+        case BasicType of
+          btString, btWideString:
+            begin
+              Result:=Format('_StringFromJString(_env, %s)', [Result]);
+              if BasicType <> btWideString then
+                Result:=Format('%s(%s)', [d.Name, Result]);
+            end;
+          btBoolean:
+            Result:=Format('LongBool(%s)', [Result]);
+          btChar:
+            Result:=Format('char(widechar(%s))', [Result]);
+          btWideChar:
+            Result:=Format('widechar(%s)', [Result]);
+          btEnum:
+            Result:=Format('%s(%s)', [d.Name, Result]);
+          btPointer:
+            Result:=Format('pointer(ptruint(%s))', [Result]);
+          btGuid:
+            Result:=Format('StringToGUID(ansistring(_StringFromJString(_env, %s)))', [Result]);
+        end;
+    dtClass:
+      begin
+        if CheckNil then
+          n:='True'
+        else
+          n:='False';
+        Result:=Format('%s.%s(_GetPasObj(_env, %s, %s, %s))', [d.Parent.Name, d.Name, Result, GetTypeInfoVar(d), n]);
+      end;
+    dtRecord:
+      Result:=Format('%s.%s(_GetPasObj(_env, %s, %s, True)^)', [d.Parent.Name, d.Name, Result, GetTypeInfoVar(d)]);
+    dtProcType:
+      Result:=Format('%sGetHandler(_env, %s, %s)', [GetClassPrefix(d), Result, GetTypeInfoVar(d)]);
+    dtEnum:
+      Result:=Format('%s.%s(_GetIntObjValue(_env, %s, %s))', [d.Parent.Name, d.Name, Result, GetTypeInfoVar(d)]);
+    dtSet:
+      Result:=Format('%s.%s(%s(_GetIntObjValue(_env, %s, %s)))', [d.Parent.Name, d.Name, GetPasIntType(TSetDef(d).Size), Result, GetTypeInfoVar(d)]);
+  end;
+end;
+
+function TWriter.PasToJniType(d: TDef; const v: string): string;
+begin
+  Result:=v;
+  if d = nil then
+    exit;
+  case d.DefType of
+    dtType:
+      with TTypeDef(d) do
+        case BasicType of
+          btString, btWideString:
+            Result:=Format('_StringToJString(_env, _JNIString(%s))', [Result]);
+          btBoolean:
+            Result:=Format('jboolean(LongBool(%s))', [Result]);
+          btChar:
+            Result:=Format('jchar(widechar(%s))', [Result]);
+          btWideChar:
+            Result:=Format('jchar(%s)', [Result]);
+          btEnum:
+            Result:=Format('jint(%s)', [Result]);
+          btPointer:
+            Result:=Format('ptruint(pointer(%s))', [Result]);
+          btGuid:
+            Result:=Format('_StringToJString(_env, _JNIString(GUIDToString(%s)))', [Result]);
+        end;
+    dtClass:
+      Result:=Format('_CreateJavaObj(_env, %s, %s)', [Result, GetTypeInfoVar(d)]);
+    dtRecord:
+      Result:=Format('_%s_CreateObj(_env, %s)', [GetClassPrefix(d), Result]);
+    dtProcType:
+      Result:=Format('_CreateMethodPtrObject(_env, TMethod(%s), %s)', [Result, GetTypeInfoVar(d)]);
+    dtEnum:
+      Result:=Format('_CreateIntObj(_env, longint(%s), %s)', [Result, GetTypeInfoVar(d)]);
+    dtSet:
+      Result:=Format('_CreateIntObj(_env, %s(%s), %s)', [GetPasIntType(TSetDef(d).Size), Result, GetTypeInfoVar(d)]);
+  end;
+end;
+
+function TWriter.GetTypeInfoVar(ClassDef: TDef): string;
+begin
+  if ClassDef.DefType = dtUnit then
+    Result:=''
+  else
+    if ClassDef.DefType = dtType then
+      Result:='_Java_' + JavaType[TTypeDef(ClassDef).BasicType] + '_Info'
+    else
+      Result:='_JNI_' + ClassDef.Parent.Name + '_' + ClassDef.Name + '_Info';
+end;
+
+function TWriter.GetClassPrefix(ClassDef: TDef; const AClassName: string): string;
+begin
+  if AClassName = '' then
+    Result:=ClassDef.Name
+  else
+    Result:=AClassName;
+  Result:=Result + '_';
+  if ClassDef.DefType <> dtUnit then
+    Result:=ClassDef.Parent.Name + '_' + Result;
+  Result:='JNI_' + Result;
+end;
+
+function TWriter.IsJavaSimpleType(d: TDef): boolean;
+begin
+  Result:=(d <> nil) and (d.DefType = dtType) and (Length(JNITypeSig[TTypeDef(d).BasicType]) = 1);
+end;
+
+function TWriter.GetProcDeclaration(d: TProcDef; const ProcName: string): string;
+var
+  s, ss: string;
+  j: integer;
+begin
+  with d do begin
+    if Count > 0 then
+      s:='('
+    else
+      s:='';
+    for j:=0 to Count - 1 do
+      with TVarDef(Items[j]) do begin
+        if j > 0 then
+          s:=s + '; ';
+        if voVar in VarOpt then
+          s:=s + 'var '
+        else
+        if voOut in VarOpt then
+          s:=s + 'out '
+        else
+        if voConst in VarOpt then
+          s:=s + 'const ';
+        s:=s + Name + ': ' + VarType.Name;
+      end;
+
+    if Count > 0 then
+      s:=s + ')';
+    case ProcType of
+      ptConstructor:
+        ss:='constructor';
+      ptDestructor:
+        ss:='destructor';
+      ptProcedure:
+        ss:='procedure';
+      ptFunction:
+        ss:='function';
+      else
+        ss:='';
+    end;
+    if ProcType in [ptConstructor, ptFunction] then
+      s:=s + ': ' + ReturnType.Name;
+    ss:=ss + ' ';
+    if ProcName <> '' then
+      ss:=ss + ProcName
+    else
+      ss:=ss + Name;
+    Result:=ss + s;
+  end;
+end;
+
+function TWriter.GetJavaProcDeclaration(d: TProcDef; const ProcName: string): string;
+var
+  s: string;
+  j: integer;
+begin
+  with d do begin
+    if ProcName <> '' then
+      s:=ProcName
+    else
+      s:=AliasName;
+    s:=DefToJavaType(ReturnType) + ' ' + s + '(';
+    for j:=0 to Count - 1 do
+      with TVarDef(Items[j]) do begin
+        if j > 0 then
+          s:=s + ', ';
+        s:=s + DefToJavaType(VarType);
+        if VarOpt * [voVar, voOut] <> [] then
+          s:=s + '[]';
+        s:=s + ' ' + AliasName;
+      end;
+    s:=s + ')';
+  end;
+  Result:=s;
+end;
+
+function TWriter.GetJniFuncType(d: TDef): string;
+begin
+  if IsJavaSimpleType(d) then begin
+    Result:=JavaType[TTypeDef(d).BasicType];
+    Result[1]:=UpCase(Result[1]);
+  end
+  else
+    Result:='Object';
+end;
+
+function TWriter.GetJavaClassName(cls: TDef; it: TDef): string;
+begin
+  Result:=cls.AliasName;
+  if (cls.DefType <> dtClass) or ((it <> nil) and not (it.DefType in ReplDefs)) then
+    exit;
+  with TClassDef(cls) do begin
+    if not (HasReplacedItems or ImplementsReplacedItems) then
+      exit;
+    if ImplementsReplacedItems and not HasReplacedItems then
+      exit;
+    if it <> nil then
+      with TReplDef(it) do begin
+        if (it.DefType = dtProc) and (TProcDef(it).ProcType = ptConstructor) then
+          exit;
+        if IsReplaced or IsReplImpl then
+          exit;
+      end;
+  end;
+  Result:='__' + Result;
+end;
+
+procedure TWriter.RegisterPseudoClass(d: TDef);
+var
+  ci: TClassInfo;
+begin
+  if FClasses.IndexOf(d.Name) < 0 then begin
+    ci:=TClassInfo.Create;
+    ci.Def:=d;
+    FClasses.AddObject(d.Name, ci);
+  end;
+end;
+
+function TWriter.GetPasIntType(Size: integer): string;
+begin
+  case Size of
+    1: Result:='byte';
+    2: Result:='word';
+    else
+       Result:='cardinal';
+  end;
+end;
+
+function TWriter.AddCustomProc(ParentDef: TDef; const JniName, Name: string; RetType: TBasicType; const Params: array of TBasicType): TProcDef;
+var
+  i: integer;
+  vd: TVarDef;
+begin
+  Result:=TProcDef.Create(ParentDef, dtProc);
+  Result.Name:=JniName;
+  Result.AliasName:=Name;
+  if RetType = btVoid then
+    Result.ProcType:=ptProcedure
+  else
+    Result.ProcType:=ptFunction;
+  for i:=0 to High(Params) do begin
+    vd:=TVarDef.Create(Result, dtParam);
+    vd.Name:=Format('p%d', [i + 1]);
+    vd.VarType:=TTypeDef.Create(vd, dtType);
+    TTypeDef(vd.VarType).BasicType:=Params[i];
+  end;
+  Result.ReturnType:=TTypeDef.Create(ParentDef, dtType);
+  TTypeDef(Result.ReturnType).BasicType:=RetType;
+end;
+
+procedure TWriter.AddNativeMethod(ParentDef: TDef; const JniName, Name, Signature: string);
+var
+  i: integer;
+  ci: TClassInfo;
+  pi: TProcInfo;
+begin
+  pi:=TProcInfo.Create;
+  pi.Name:=Name;
+  pi.JniName:=JniName;
+  pi.JniSignature:=Signature;
+  i:=FClasses.IndexOf(ParentDef.AliasName);
+  if i < 0 then begin
+    ci:=TClassInfo.Create;
+    ci.Def:=ParentDef;
+    i:=FClasses.AddObject(ParentDef.AliasName, ci);
+  end;
+  TClassInfo(FClasses.Objects[i]).Funcs.Add(pi);
+end;
+
+function TWriter.GetProcSignature(d: TProcDef): string;
+var
+  j: integer;
+begin
+  Result:='(';
+  for j:=0 to d.Count - 1 do
+    with TVarDef(d[j]) do begin
+      if VarOpt * [voVar, voOut] <> [] then
+        Result:=Result + '[';
+      Result:=Result + DefToJniSig(VarType);
+    end;
+  Result:=Result + ')' + DefToJniSig(d.ReturnType);
+end;
+
+procedure TWriter.EHandlerStart;
+begin
+  Fps.WriteLn('try');
+  Fps.IncI;
+end;
+
+procedure TWriter.EHandlerEnd(const EnvVarName: string; const ExtraCode: string);
+begin
+  Fps.WriteLn('except', -1);
+  Fps.WriteLn(Format('_HandleJNIException(%s);', [EnvVarName]));
+  if ExtraCode <> '' then
+    Fps.WriteLn(ExtraCode);
+  Fps.DecI;
+  Fps.WriteLn('end;');
+end;
+
+procedure TWriter.WriteClassInfoVar(d: TDef);
+begin
+  Fps.WriteLn;
+  Fps.WriteLn(Format('var %s: _TJavaClassInfo;', [GetTypeInfoVar(d)]));
+end;
+
+procedure TWriter.WriteComment(d: TDef; const AType: string);
+begin
+  Fps.WriteLn;
+  Fps.WriteLn(Format('{ %s }', [d.Name]));
+
+  Fjs.WriteLn(Format('/* %s %s */', [AType, d.Name]));
+{$ifdef DEBUG}
+  Fjs.WriteLn(Format('/* Ref count: %d */', [d.RefCnt]));
+{$endif}
+end;
+
+{
+procedure TWriter.AddCustomProc(ParentDef: TDef; const JniName, Name: string; RetType: TBasicType; const Params: array of TBasicType);
+var
+  i: integer;
+  ci: TClassInfo;
+  pi: TProcInfo;
+begin
+  pi:=TProcInfo.Create;
+  pi.Name:=Name;
+  pi.JniName:=JniName;
+  pi.JniSignature:='(';
+  for i:=0 to High(Params) do
+    pi.JniSignature:=pi.JniSignature + JNITypeSig[Params[i]];
+  pi.JniSignature:=pi.JniSignature + ')';
+  pi.JniSignature:=pi.JniSignature + JNITypeSig[RetType];
+
+  i:=FClasses.IndexOf(ParentDef.Name);
+  if i < 0 then begin
+    ci:=TClassInfo.Create;
+    ci.Def:=ParentDef;
+    i:=FClasses.AddObject(ParentDef.Name, ci);
+  end;
+  TClassInfo(FClasses.Objects[i]).Funcs.Add(pi);
+end;
+}
+constructor TWriter.Create;
+var
+  i: integer;
+begin
+  Units:=TStringList.Create;
+  FClasses:=TStringList.Create;
+  FClasses.Sorted:=True;
+  JavaPackage:='pas';
+  IncludeList:=TStringList.Create;
+  IncludeList.Duplicates:=dupIgnore;
+  ExcludeList:=TStringList.Create;
+  ExcludeList.Duplicates:=dupIgnore;
+
+  for i:=Low(ExcludeStd) to High(ExcludeStd) do
+    ExcludeList.Add(ExcludeStd[i]);
+  for i:=Low(ExcludeDelphi7) to High(ExcludeDelphi7) do
+    ExcludeList.Add(ExcludeDelphi7[i]);
+
+  FThisUnit:=TUnitDef.Create(nil, dtUnit);
+end;
+
+destructor TWriter.Destroy;
+var
+  i: integer;
+begin
+  for i:=0 to FClasses.Count - 1 do
+    FClasses.Objects[i].Free;
+  FClasses.Free;
+  Units.Free;
+  IncludeList.Free;
+  ExcludeList.Free;
+  FThisUnit.Free;
+  inherited Destroy;
+end;
+
+procedure TWriter.ProcessUnits;
+var
+  p: TPPUParser;
+  i: integer;
+  s, ss: string;
+  d: TDef;
+begin
+  if Units.Count = 0 then
+    raise Exception.Create('No unit name specified.');
+  if (OutPath <> '') and not DirectoryExists(OutPath) then
+    raise Exception.CreateFmt('Output path "%s" does not exist.', [OutPath]);
+  if (JavaOutPath <> '') and not DirectoryExists(JavaOutPath) then
+    raise Exception.CreateFmt('Output path "%s" does not exist.', [JavaOutPath]);
+  if LibName = '' then
+    LibName:=AnsiLowerCase(ChangeFileExt(Units[0], '')) + 'jni';
+
+  for i:=0 to IncludeList.Count - 1 do
+    IncludeList[i]:=Trim(IncludeList[i]);
+  IncludeList.Sorted:=True;
+  for i:=0 to ExcludeList.Count - 1 do
+    ExcludeList[i]:=Trim(ExcludeList[i]);
+  ExcludeList.Sorted:=True;
+
+  FThisUnit.Name:=LibName;
+  FThisUnit.AliasName:='system';
+
+  p:=TPPUParser.Create(SearchPath);
+  try
+    p.OnCheckItem:=@DoCheckItem;
+    for i:=0 to Units.Count - 1 do
+      IncludeList.Add(ChangeFileExt(ExtractFileName(Units[i]), ''));
+    for i:=0 to Units.Count - 1 do
+      p.Parse(ChangeFileExt(ExtractFileName(Units[i]), ''));
+
+    if OutPath <> '' then
+      OutPath:=IncludeTrailingPathDelimiter(OutPath);
+    if JavaOutPath <> '' then
+      JavaOutPath:=IncludeTrailingPathDelimiter(JavaOutPath);
+
+    FPkgDir:=JavaOutPath + StringReplace(JavaPackage, '.', DirectorySeparator, [rfReplaceAll]);
+    ForceDirectories(FPkgDir);
+    Fps:=TTextOutStream.Create(OutPath + LibName + '.pas', fmCreate);
+
+    Fps.WriteLn('library '+ LibName + ';');
+    Fps.WriteLn('{$ifdef fpc} {$mode objfpc} {$H+} {$endif}');
+
+    Fps.WriteLn;
+    Fps.WriteLn('uses');
+    Fps.WriteLn('{$ifndef FPC} Windows, {$endif} {$ifdef unix} cthreads, {$endif} SysUtils, SyncObjs,', 1);
+    s:='';
+    for i:=0 to p.Units.Count - 1 do begin
+      ProcessRules(p.Units[i]);
+      ss:=LowerCase(p.Units[i].Name);
+      if (ss ='system') or (ss = 'objpas') or (ss = 'sysutils') or (ss = 'syncobjs') or (ss = 'jni') then
+        continue;
+      if s <> '' then
+        s:=s + ', ';
+      s:=s + p.Units[i].Name;
+    end;
+    Fps.WriteLn(s + ', jni;', 1);
+
+    // Types
+    Fps.WriteLn;
+    Fps.WriteLn('type');
+    Fps.IncI;
+    Fps.WriteLn('_JNIString = {$ifdef FPC} unicodestring {$else} widestring {$endif};');
+    Fps.WriteLn('{$ifndef FPC} ptruint = cardinal; {$endif}');
+    Fps.WriteLn;
+    Fps.WriteLn('_TJavaClassInfo = record');
+    Fps.WriteLn('ClassRef: JClass;', 1);
+    Fps.WriteLn('ObjFieldId: JFieldId;', 1);
+    Fps.WriteLn('end;');
+    Fps.WriteLn('_PJavaClassInfo = ^_TJavaClassInfo;');
+    Fps.DecI;
+
+    Fps.WriteLn;
+    d:=TtypeDef.Create(nil, dtType);
+    TtypeDef(d).BasicType:=btString;
+    Fps.WriteLn(Format('var %s: _TJavaClassInfo;', [GetTypeInfoVar(d)]));
+    d.Free;
+
+    // Support functions
+    Fps.WriteLn;
+    Fps.WriteLn('function _StringFromJString(env: PJNIEnv; s: jstring): _JNIString;');
+    Fps.WriteLn('var');
+    Fps.WriteLn('p: PJChar;', 1);
+    Fps.WriteLn('c: JBoolean;', 1);
+    Fps.WriteLn('begin');
+    Fps.WriteLn('if s = nil then begin', 1);
+    Fps.WriteLn('Result:='''';', 2);
+    Fps.WriteLn('exit;', 2);
+    Fps.WriteLn('end;', 1);
+    Fps.WriteLn('p:=env^^.GetStringChars(env, s, c);', 1);
+    Fps.WriteLn('SetString(Result, PWideChar(p), env^^.GetStringLength(env, s));', 1);
+    Fps.WriteLn('env^^.ReleaseStringChars(env, s, p);', 1);
+    Fps.WriteLn('end;');
+
+    Fps.WriteLn;
+    Fps.WriteLn('function _StringToJString(env: PJNIEnv; const s: _JNIString): jstring;');
+    Fps.WriteLn('begin');
+    Fps.WriteLn('Result:=env^^.NewString(env, PJChar(PWideChar(s)), Length(s));', 1);
+    Fps.WriteLn('end;');
+
+    Fps.WriteLn;
+    Fps.WriteLn('function _CreateJavaObj(env: PJNIEnv; PasObj: pointer; const ci: _TJavaClassInfo): jobject;');
+    Fps.WriteLn('begin');
+    Fps.IncI;
+    Fps.WriteLn('Result:=nil;');
+    Fps.WriteLn('Result:=env^^.AllocObject(env, ci.ClassRef);');
+    Fps.WriteLn('if Result = nil then exit;');
+    Fps.WriteLn('env^^.SetLongField(env, Result, ci.ObjFieldId, Int64(ptruint(PasObj)));');
+    Fps.DecI;
+    Fps.WriteLn('end;');
+
+    Fps.WriteLn;
+    Fps.WriteLn('function _GetPasObj(env: PJNIEnv; jobj: jobject; const ci: _TJavaClassInfo; CheckNil: boolean): pointer;');
+    Fps.WriteLn('var pasobj: jlong;');
+    Fps.WriteLn('begin');
+    Fps.IncI;
+    Fps.WriteLn('if jobj <> nil then');
+    Fps.WriteLn('pasobj:=env^^.GetLongField(env, jobj, ci.ObjFieldId)', 1);
+    Fps.WriteLn('else');
+    Fps.WriteLn('pasobj:=0;', 1);
+    Fps.WriteLn('if CheckNil and (pasobj = 0) then');
+    Fps.WriteLn('raise Exception.Create(''Attempt to access a released Pascal object.'');', 1);
+    Fps.WriteLn('Result:=pointer(ptruint(pasobj));');
+    Fps.DecI;
+    Fps.WriteLn('end;');
+
+    Fps.WriteLn;
+    Fps.WriteLn('procedure _HandleJNIException(env: PJNIEnv);');
+    Fps.WriteLn('begin');
+    Fps.WriteLn('env^^.ThrowNew(env, env^^.FindClass(env, ''java/lang/Exception''), PAnsiChar(Utf8Encode(Exception(ExceptObject).Message)));', 1);
+    Fps.WriteLn('end;');
+
+    Fps.WriteLn;
+    Fps.WriteLn('procedure _RaiseVarParamException(const VarName: string);');
+    Fps.WriteLn('begin');
+    Fps.WriteLn('raise Exception.CreateFmt(''An array with only single element must be passed as parameter "%s".'', [VarName]);', 1);
+    Fps.WriteLn('end;');
+
+    Fps.WriteLn;
+    Fps.WriteLn('function _AllocMemory(env: PJNIEnv; jobj: jobject; size: jint): jlong;');
+    Fps.WriteLn('var p: pointer;');
+    Fps.WriteLn('begin');
+    Fps.WriteLn('GetMem(p, size);', 1);
+    Fps.WriteLn('FillChar(p^, size, 0);', 1);
+    Fps.WriteLn('Result:=ptruint(p);', 1);
+    Fps.WriteLn('end;');
+
+    // Method pointer support
+    Fps.WriteLn;
+    Fps.WriteLn('type');
+    Fps.IncI;
+    Fps.WriteLn('_TMethodPtrInfo = class');
+    Fps.IncI;
+    Fps.WriteLn('Obj: JObject;');
+    Fps.WriteLn('MethodId: JMethodID;');
+    Fps.WriteLn('Index, RefCnt: integer;');
+    Fps.WriteLn('RealMethod: TMethod;');
+    Fps.WriteLn('constructor Create(env: PJNIEnv; JavaObj: JObject; const AMethodName, AMethodSig: ansistring);');
+    Fps.WriteLn('procedure Release(env: PJNIEnv);');
+    Fps.DecI;
+    Fps.WriteLn('end;');
+    Fps.DecI;
+    Fps.WriteLn;
+    Fps.WriteLn('var _MethodPointers: array of _TMethodPtrInfo;');
+    Fps.WriteLn('var _MethodPointersCS: TCriticalSection;');
+    Fps.WriteLn;
+
+    Fps.WriteLn('constructor _TMethodPtrInfo.Create(env: PJNIEnv; JavaObj: JObject; const AMethodName, AMethodSig: ansistring);');
+    Fps.WriteLn('var c: JClass;');
+    Fps.WriteLn('begin');
+    Fps.IncI;
+    Fps.WriteLn('RefCnt:=1;');
+    Fps.WriteLn('if (JavaObj = nil) or (AMethodName = '''') then exit;');
+    Fps.WriteLn('c:=env^^.GetObjectClass(env, JavaObj);');
+    Fps.WriteLn('if c = nil then exit;');
+    Fps.WriteLn('MethodId:=env^^.GetMethodID(env, c, PAnsiChar(AMethodName), PAnsiChar(AMethodSig));');
+    Fps.WriteLn('if MethodId = nil then raise Exception.CreateFmt(''Method "%s" does not exist or has wrong parameters.'', [AMethodName]);');
+    Fps.WriteLn('Obj:=env^^.NewGlobalRef(env, JavaObj);');
+    Fps.WriteLn('_MethodPointersCS.Enter;');
+    Fps.WriteLn('try');
+    Fps.IncI;
+    Fps.WriteLn('Index:=Length(_MethodPointers) + 1;');
+    Fps.WriteLn(Format('if Index > %d then raise Exception.Create(''Too many method pointers.'');', [MaxMethodPointers]));
+    Fps.WriteLn('SetLength(_MethodPointers, Index);');
+    Fps.WriteLn('_MethodPointers[Index - 1]:=Self;');
+    Fps.WriteLn('finally', -1);
+    Fps.WriteLn('_MethodPointersCS.Leave;');
+    Fps.DecI;
+    Fps.WriteLn('end;');
+    Fps.DecI;
+    Fps.WriteLn('end;');
+
+    Fps.WriteLn;
+    Fps.WriteLn('procedure _TMethodPtrInfo.Release(env: PJNIEnv);');
+    Fps.WriteLn('var i: integer;');
+    Fps.WriteLn('begin');
+    Fps.IncI;
+    Fps.WriteLn('i:=InterlockedDecrement(RefCnt);');
+    Fps.WriteLn('if i <> 0 then exit;');
+    Fps.WriteLn('if Index > 0 then begin');
+    Fps.IncI;
+    Fps.WriteLn('_MethodPointersCS.Enter;');
+    Fps.WriteLn('try');
+    Fps.IncI;
+    Fps.WriteLn('Dec(Index);');
+    Fps.WriteLn('_MethodPointers[Index]:=nil;');
+    Fps.WriteLn('Index:=Length(_MethodPointers);');
+    Fps.WriteLn('while (Index > 0) and (_MethodPointers[Index] = nil) do Dec(Index);');
+    Fps.WriteLn('SetLength(_MethodPointers, Index + 1);');
+    Fps.WriteLn('finally', -1);
+    Fps.WriteLn('_MethodPointersCS.Leave;');
+    Fps.DecI;
+    Fps.WriteLn('end;');
+    Fps.WriteLn('env^^.DeleteGlobalRef(env, Obj);');
+    Fps.DecI;
+    Fps.WriteLn('end;');
+    Fps.WriteLn('Self.Destroy;');
+    Fps.DecI;
+    Fps.WriteLn('end;');
+
+    Fps.WriteLn;
+    Fps.WriteLn('procedure _RefMethodPtr(env: PJNIEnv; const m: TMethod; AddRef: boolean);');
+    Fps.WriteLn('var i: integer;');
+    Fps.WriteLn('begin');
+    Fps.IncI;
+    Fps.WriteLn('i:=-integer(ptruint(m.Data));');
+    Fps.WriteLn(Format('if (i < 1) or (i > %d) then exit;', [MaxMethodPointers]));
+    Fps.WriteLn('_MethodPointersCS.Enter;');
+    Fps.WriteLn('try');
+    Fps.IncI;
+    Fps.WriteLn('with _MethodPointers[i - 1] do');
+    Fps.WriteLn('if AddRef then InterlockedIncrement(RefCnt) else Release(env);', 1);
+    Fps.WriteLn('finally', -1);
+    Fps.WriteLn('_MethodPointersCS.Leave;');
+    Fps.DecI;
+    Fps.WriteLn('end;');
+    Fps.DecI;
+    Fps.WriteLn('end;');
+
+    Fps.WriteLn;
+    Fps.WriteLn('function _CreateMethodPtrObject(env: PJNIEnv; const m: TMethod; const ci: _TJavaClassInfo): jobject;');
+    Fps.WriteLn('var i: integer;');
+    Fps.WriteLn('var mpi: _TMethodPtrInfo;');
+    Fps.WriteLn('begin');
+    Fps.IncI;
+    Fps.WriteLn('_MethodPointersCS.Enter;');
+    Fps.WriteLn('try');
+    Fps.IncI;
+    Fps.WriteLn('i:=-integer(ptruint(m.Data));');
+    Fps.WriteLn(Format('if (i > 0) and (i <= %d) then begin', [MaxMethodPointers]));
+    Fps.WriteLn('mpi:=_MethodPointers[i - 1];', 1);
+    Fps.WriteLn('InterlockedIncrement(mpi.RefCnt);', 1);
+    Fps.WriteLn('end');
+    Fps.WriteLn('else begin');
+    Fps.WriteLn('mpi:=_TMethodPtrInfo.Create(env, nil, '''', '''');', 1);
+    Fps.WriteLn('mpi.RealMethod:=m;', 1);
+    Fps.WriteLn('end;');
+    Fps.WriteLn('finally', -1);
+    Fps.WriteLn('_MethodPointersCS.Leave;');
+    Fps.DecI;
+    Fps.WriteLn('end;');
+    Fps.WriteLn('Result:=_CreateJavaObj(env, pointer(mpi), ci);');
+    Fps.DecI;
+    Fps.WriteLn('end;');
+
+    // Set support
+    Fps.WriteLn;
+    Fps.WriteLn('function _GetIntObjValue(env: PJNIEnv; jobj: jobject; const ci: _TJavaClassInfo): longint;');
+    Fps.WriteLn('begin');
+    Fps.IncI;
+    Fps.WriteLn('if jobj = nil then raise Exception.Create(''Attempt to access a NULL set.'');');
+    Fps.WriteLn('Result:=env^^.GetIntField(env, jobj, ci.ObjFieldId);');
+    Fps.DecI;
+    Fps.WriteLn('end;');
+    Fps.WriteLn;
+    Fps.WriteLn('function _CreateIntObj(env: PJNIEnv; Value: longint; const ci: _TJavaClassInfo): jobject;');
+    Fps.WriteLn('begin');
+    Fps.IncI;
+    Fps.WriteLn('Result:=nil;');
+    Fps.WriteLn('Result:=env^^.AllocObject(env, ci.ClassRef);');
+    Fps.WriteLn('if Result = nil then exit;');
+    Fps.WriteLn('env^^.SetIntField(env, Result, ci.ObjFieldId, Value);');
+    Fps.DecI;
+    Fps.WriteLn('end;');
+
+    // Write units
+    for i:=0 to p.Units.Count - 1 do
+      with TUnitDef(p.Units[i]) do begin
+        WriteUnit(TUnitDef(p.Units[i]));
+      end;
+
+    WriteOnLoad;
+
+    Fps.WriteLn;
+    Fps.WriteLn('begin');
+    Fps.WriteLn('IsMultiThread:=True;', 1);
+    Fps.WriteLn('_MethodPointersCS:=TCriticalSection.Create;', 1);
+    Fps.WriteLn('end.');
+  finally
+    Fps.Free;
+    p.Free;
+  end;
+end;
+
+end.
+