--- Merging r29401 into '.':

U    rtl/unix/dl.pp
U    rtl/android/Makefile.fpc
A    rtl/android/dlandroid.inc
U    rtl/android/Makefile
--- Merging r29402 into '.':
U    utils/fpcm/revision.inc
--- Merging r29418 into '.':
U    rtl/android/dlandroid.inc
--- Merging r29419 into '.':
U    utils/pas2jni/readme.txt
U    utils/pas2jni/writer.pas
U    utils/pas2jni/ppuparser.pas
--- Merging r29420 into '.':
U    packages/fcl-db/src/sqldb/odbc/odbcconn.pas

# revisions: 29401,29402,29418,29419,29420

git-svn-id: branches/fixes_3_0@29421 -

.gitattributes

@@ -7913,6 +7913,7 @@ rtl/android/Makefile.fpc svneol=native#text/plain
 rtl/android/arm/dllprt0.as svneol=native#text/plain
 rtl/android/arm/prt0.as svneol=native#text/plain
 rtl/android/cwstring.pp svneol=native#text/plain
+rtl/android/dlandroid.inc svneol=native#text/plain
 rtl/android/i386/dllprt0.as svneol=native#text/plain
 rtl/android/i386/prt0.as svneol=native#text/plain
 rtl/android/jvm/Makefile svneol=native#text/plain

packages/fcl-db/src/sqldb/odbc/odbcconn.pas

@@ -16,9 +16,7 @@ unit odbcconn;
 interface
 
 uses
-  Classes, SysUtils, sqldb, db, odbcsqldyn
-{$IF (FPC_VERSION>=2) AND (FPC_RELEASE>=1)}, BufDataset{$ENDIF}
-  ;
+  Classes, SysUtils, sqldb, db, odbcsqldyn, BufDataset;
 
 type
 
@@ -33,9 +31,6 @@ type
     FQuery:string;        // last prepared query, with :ParamName converted to ?
     FParamIndex:TParamBinding; // maps the i-th parameter in the query to the TParams passed to PrepareStatement
     FParamBuf:array of pointer; // buffers that can be used to bind the i-th parameter in the query
-{$IF NOT((FPC_VERSION>=2) AND (FPC_RELEASE>=1))}
-    FBlobStreams:TList;   // list of Blob TMemoryStreams stored in field buffers (we need this currently as we can't hook into the freeing of TBufDataset buffers)
-{$ENDIF}
   public
     constructor Create(Connection:TODBCConnection);
     destructor Destroy; override;
@@ -95,13 +90,8 @@ type
     // - Result retrieving
     procedure AddFieldDefs(cursor:TSQLCursor; FieldDefs:TFieldDefs); override;
     function Fetch(cursor:TSQLCursor):boolean; override;
-{$IF (FPC_VERSION>=2) AND (FPC_RELEASE>=1)}
     function LoadField(cursor:TSQLCursor; FieldDef:TFieldDef; buffer:pointer; out CreateBlob : boolean):boolean; override;
     procedure LoadBlobIntoBuffer(FieldDef: TFieldDef;ABlobBuf: PBufBlobField; cursor: TSQLCursor; ATransaction : TSQLTransaction); override;
-{$ELSE}
-    function LoadField(cursor:TSQLCursor; FieldDef:TFieldDef; buffer:pointer):boolean; override;
-    function CreateBlobStream(Field:TField; Mode:TBlobStreamMode):TStream; override;
-{$ENDIF}
     procedure FreeFldBuffers(cursor:TSQLCursor); override;
     // - UpdateIndexDefs
     procedure UpdateIndexDefs(IndexDefs:TIndexDefs; TableName:string); override;
@@ -135,7 +125,6 @@ type
 
   EODBCException = class(ESQLDatabaseError);
 
-{$IF (FPC_VERSION>=2) AND (FPC_RELEASE>=1)}
   { TODBCConnectionDef }
 
   TODBCConnectionDef = Class(TConnectionDef)
@@ -143,7 +132,6 @@ type
     Class Function ConnectionClass : TSQLConnectionClass; override;
     Class Function Description : String; override;
   end;
-{$ENDIF}
 
 implementation
 
@@ -302,9 +290,7 @@ end;
 constructor TODBCConnection.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);
-{$IF (FPC_VERSION>=2) AND (FPC_RELEASE>=1)}
   FConnOptions := FConnOptions + [sqEscapeRepeat] + [sqEscapeSlash];
-{$ENDIF}
 end;
 
 function TODBCConnection.StrToStatementType(s : string) : TStatementType;
@@ -661,11 +647,7 @@ begin
 
   // Parse the SQL and build FParamIndex
   if assigned(AParams) and (AParams.count > 0) then
-{$IF (FPC_VERSION>=2) AND (FPC_RELEASE>=1)}
     buf := AParams.ParseSQL(buf,false,sqEscapeSlash in ConnOptions, sqEscapeRepeat in ConnOptions,psInterbase,ODBCCursor.FParamIndex);
-{$ELSE}
-    buf := AParams.ParseSQL(buf,false,psInterbase,ODBCCursor.FParamIndex);
-{$ENDIF}
 
   // prepare statement
   ODBCCursor.FQuery:=Buf;
@@ -815,11 +797,7 @@ end;
 const
   DEFAULT_BLOB_BUFFER_SIZE = 1024;
 
-{$IF (FPC_VERSION>=2) AND (FPC_RELEASE>=1)}
 function TODBCConnection.LoadField(cursor: TSQLCursor; FieldDef: TFieldDef; buffer: pointer; out CreateBlob : boolean): boolean;
-{$ELSE}
-function TODBCConnection.LoadField(cursor: TSQLCursor; FieldDef: TFieldDef; buffer: pointer):boolean;
-{$ENDIF}
 var
   ODBCCursor:TODBCCursor;
   StrLenOrInd:SQLLEN;
@@ -827,16 +805,9 @@ var
   ODBCTimeStruct:SQL_TIME_STRUCT;
   ODBCTimeStampStruct:SQL_TIMESTAMP_STRUCT;
   DateTime:TDateTime;
-{$IF NOT((FPC_VERSION>=2) AND (FPC_RELEASE>=1))}
-  BlobBuffer:pointer;
-  BlobBufferSize,BytesRead:SQLINTEGER;
-  BlobMemoryStream:TMemoryStream;
-{$ENDIF}
   Res:SQLRETURN;
 begin
-{$IF (FPC_VERSION>=2) AND (FPC_RELEASE>=1)}
   CreateBlob := False;
-{$ENDIF}
   ODBCCursor:=cursor as TODBCCursor;
 
   // load the field using SQLGetData
@@ -899,9 +870,7 @@ begin
       else
         PWord(buffer)^ := StrLenOrInd;
     end;
-{$IF (FPC_VERSION>=2) AND (FPC_RELEASE>=1)}
     ftWideMemo,
-{$ENDIF}
     ftBlob, ftMemo:       // BLOBs
     begin
       //Writeln('BLOB');
@@ -911,48 +880,8 @@ begin
       // Read the data if not NULL
       if StrLenOrInd<>SQL_NULL_DATA then
       begin
-{$IF (FPC_VERSION>=2) AND (FPC_RELEASE>=1)}
         CreateBlob:=true; // defer actual loading of blob data to LoadBlobIntoBuffer method
         //WriteLn('Deferring loading of blob of length ',StrLenOrInd);
-{$ELSE}
-        // Determine size of buffer to use
-        if StrLenOrInd<>SQL_NO_TOTAL then
-          BlobBufferSize:=StrLenOrInd
-        else
-          BlobBufferSize:=DEFAULT_BLOB_BUFFER_SIZE;
-        try
-          // init BlobBuffer and BlobMemoryStream to nil pointers
-          BlobBuffer:=nil;
-          BlobMemoryStream:=nil;
-          if BlobBufferSize>0 then // Note: zero-length BLOB is represented as nil pointer in the field buffer to save memory usage
-          begin
-            // Allocate the buffer and memorystream
-            BlobBuffer:=GetMem(BlobBufferSize);
-            BlobMemoryStream:=TMemoryStream.Create;
-            // Retrieve data in parts (or effectively in one part if StrLenOrInd<>SQL_NO_TOTAL above)
-            repeat
-              Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_BINARY, BlobBuffer, BlobBufferSize, @StrLenOrInd);
-              ODBCCheckResult(Res, SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not get field data for field "%s" (index %d).',[FieldDef.Name, FieldDef.Index+1]);
-              // Append data in buffer to memorystream
-              if (StrLenOrInd=SQL_NO_TOTAL) or (StrLenOrInd>BlobBufferSize) then
-                BytesRead:=BlobBufferSize
-              else
-                BytesRead:=StrLenOrInd;
-              BlobMemoryStream.Write(BlobBuffer^, BytesRead);
-            until Res=SQL_SUCCESS;
-          end;
-          // Store memorystream pointer in Field buffer and in the cursor's FBlobStreams list
-          TObject(buffer^):=BlobMemoryStream;
-          if BlobMemoryStream<>nil then
-            ODBCCursor.FBlobStreams.Add(BlobMemoryStream);
-          // Set BlobMemoryStream to nil, so it won't get freed in the finally block below
-          BlobMemoryStream:=nil;
-        finally
-          BlobMemoryStream.Free;
-          if BlobBuffer<>nil then
-            Freemem(BlobBuffer,BlobBufferSize);
-        end;
-{$ENDIF}
       end;
     end;
     // TODO: Loading of other field types
@@ -965,7 +894,6 @@ begin
   //writeln(Format('Field.Size: %d; StrLenOrInd: %d',[FieldDef.Size, StrLenOrInd]));
 end;
 
-{$IF (FPC_VERSION>=2) AND (FPC_RELEASE>=1)}
 procedure TODBCConnection.LoadBlobIntoBuffer(FieldDef: TFieldDef; ABlobBuf: PBufBlobField; cursor: TSQLCursor; ATransaction: TSQLTransaction);
 var
   ODBCCursor: TODBCCursor;
@@ -1036,41 +964,13 @@ begin
     end;
   end;
 end;
-{$ELSE}
-function TODBCConnection.CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream;
-var
-  ODBCCursor: TODBCCursor;
-  BlobMemoryStream, BlobMemoryStreamCopy: TMemoryStream;
-begin
-  if (Mode=bmRead) and not Field.IsNull then
-  begin
-    Field.GetData(@BlobMemoryStream);
-    BlobMemoryStreamCopy:=TMemoryStream.Create;
-    if BlobMemoryStream<>nil then
-      BlobMemoryStreamCopy.LoadFromStream(BlobMemoryStream);
-    Result:=BlobMemoryStreamCopy;
-  end
-  else
-    Result:=nil;
-end;
-{$ENDIF}
 
 procedure TODBCConnection.FreeFldBuffers(cursor: TSQLCursor);
 var
   ODBCCursor:TODBCCursor;
-{$IF NOT((FPC_VERSION>=2) AND (FPC_RELEASE>=1))}
-  i: integer;
-{$ENDIF}
 begin
   ODBCCursor:=cursor as TODBCCursor;
 
-{$IF NOT((FPC_VERSION>=2) AND (FPC_RELEASE>=1))}
-  // Free TMemoryStreams in cursor.FBlobStreams and clear it
-  for i:=0 to ODBCCursor.FBlobStreams.Count-1 do
-    TObject(ODBCCursor.FBlobStreams[i]).Free;
-  ODBCCursor.FBlobStreams.Clear;
-{$ENDIF}
-
   if ODBCCursor.FSTMTHandle <> SQL_NULL_HSTMT then
     ODBCCheckResult(
       SQLFreeStmt(ODBCCursor.FSTMTHandle, SQL_CLOSE),
@@ -1082,11 +982,7 @@ procedure TODBCConnection.AddFieldDefs(cursor: TSQLCursor; FieldDefs: TFieldDefs
 const
   ColNameDefaultLength  = 40; // should be > 0, because an ansistring of length 0 is a nil pointer instead of a pointer to a #0
   TypeNameDefaultLength = 80; // idem
-{$IF (FPC_VERSION>=2) AND (FPC_RELEASE>=1)}
   BLOB_BUF_SIZE = 0;
-{$ELSE}
-  BLOB_BUF_SIZE = sizeof(pointer);
-{$ENDIF}
 var
   ODBCCursor:TODBCCursor;
   ColumnCount:SQLSMALLINT;
@@ -1149,11 +1045,9 @@ begin
       SQL_CHAR:          begin FieldType:=ftFixedChar;  FieldSize:=ColumnSize; end;
       SQL_VARCHAR:       begin FieldType:=ftString;     FieldSize:=ColumnSize; end;
       SQL_LONGVARCHAR:   begin FieldType:=ftMemo;       FieldSize:=BLOB_BUF_SIZE; end; // is a blob
-{$IF (FPC_VERSION>=2) AND (FPC_RELEASE>=1)}
       SQL_WCHAR:         begin FieldType:=ftFixedWideChar; FieldSize:=ColumnSize*sizeof(Widechar); end;
       SQL_WVARCHAR:      begin FieldType:=ftWideString; FieldSize:=ColumnSize*sizeof(Widechar); end;
       SQL_WLONGVARCHAR:  begin FieldType:=ftWideMemo;   FieldSize:=BLOB_BUF_SIZE; end; // is a blob
-{$ENDIF}
       SQL_DECIMAL:       begin FieldType:=ftFloat;      FieldSize:=0; end;
       SQL_NUMERIC:       begin FieldType:=ftFloat;      FieldSize:=0; end;
       SQL_SMALLINT:      begin FieldType:=ftSmallint;   FieldSize:=0; end;
@@ -1186,9 +1080,7 @@ begin
 {      SQL_INTERVAL_HOUR_TO_MINUTE:  FieldType:=ftUnknown;}
 {      SQL_INTERVAL_HOUR_TO_SECOND:  FieldType:=ftUnknown;}
 {      SQL_INTERVAL_MINUTE_TO_SECOND:FieldType:=ftUnknown;}
-{$IF (FPC_VERSION>=2) AND (FPC_RELEASE>=1)}
       SQL_GUID:          begin FieldType:=ftGuid;       FieldSize:=38; end; //SQL_GUID defines 36, but TGuidField requires 38
-{$ENDIF}
     else
       begin FieldType:=ftUnknown; FieldSize:=ColumnSize; end
     end;
@@ -1565,21 +1457,13 @@ end;
 
 constructor TODBCCursor.Create(Connection:TODBCConnection);
 begin
-{$IF NOT((FPC_VERSION>=2) AND (FPC_RELEASE>=1))}
-  // allocate FBlobStreams
-  FBlobStreams:=TList.Create;
-{$ENDIF}
 end;
 
 destructor TODBCCursor.Destroy;
 begin
-{$IF NOT((FPC_VERSION>=2) AND (FPC_RELEASE>=1))}
-  FBlobStreams.Free;
-{$ENDIF}
   inherited Destroy;
 end;
 
-{$IF (FPC_VERSION>=2) AND (FPC_RELEASE>=1)}
 class function TODBCConnectionDef.TypeName: String;
 begin
   Result:='ODBC';
@@ -1597,12 +1481,9 @@ end;
 
 initialization
   RegisterConnection(TODBCConnectionDef);
-{$ENDIF}
 
 finalization
-{$IF (FPC_VERSION>=2) AND (FPC_RELEASE>=1)}
   UnRegisterConnection(TODBCConnectionDef);
-{$ENDIF}
   if Assigned(DefaultEnvironment) then
     DefaultEnvironment.Free;
 end.

rtl/android/Makefile

@@ -3437,7 +3437,7 @@ baseunix$(PPUEXT) : $(UNIXINC)/baseunix.pp $(LINUXINC)/errno.inc $(LINUXINC)/pty
   $(LINUXINC)/ostypes.inc $(LINUXINC)/osmacro.inc $(UNIXINC)/gensigset.inc \
   $(UNIXINC)/genfuncs.inc $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) $(UNIXINC)/baseunix.pp
-dl$(PPUEXT) : $(UNIXINC)/dl.pp $(SYSTEMUNIT)$(PPUEXT)
+dl$(PPUEXT) : $(UNIXINC)/dl.pp $(SYSTEMUNIT)$(PPUEXT) dlandroid.inc
 	$(COMPILER) $(UNIXINC)/dl.pp
 dynlibs$(PPUEXT) : $(INC)/dynlibs.pas $(UNIXINC)/dynlibs.inc dl$(PPUEXT) objpas$(PPUEXT)
 	$(COMPILER) $(INC)/dynlibs.pas

rtl/android/Makefile.fpc

@@ -156,7 +156,7 @@ baseunix$(PPUEXT) : $(UNIXINC)/baseunix.pp $(LINUXINC)/errno.inc $(LINUXINC)/pty
   $(UNIXINC)/genfuncs.inc $(SYSTEMUNIT)$(PPUEXT)
         $(COMPILER) $(UNIXINC)/baseunix.pp
 
-dl$(PPUEXT) : $(UNIXINC)/dl.pp $(SYSTEMUNIT)$(PPUEXT)
+dl$(PPUEXT) : $(UNIXINC)/dl.pp $(SYSTEMUNIT)$(PPUEXT) dlandroid.inc
         $(COMPILER) $(UNIXINC)/dl.pp
 
 dynlibs$(PPUEXT) : $(INC)/dynlibs.pas $(UNIXINC)/dynlibs.inc dl$(PPUEXT) objpas$(PPUEXT)

rtl/android/dlandroid.inc

@@ -0,0 +1,91 @@
+
+// On Android the dladdr() function does not return full path to modules.
+// Emulate dladdr() by reading the /proc/self/maps to get full path to modules.
+
+var
+  _ModuleName: ansistring;
+
+function dladdr(Lib: pointer; info: Pdl_info): Longint; cdecl;
+var
+  F: Text;
+  s, ss, curnode: ansistring;
+  a1, a2, curbase: ptruint;
+  i: longint;
+  p, pp: PAnsiChar;
+begin
+{$PUSH}
+{$I-}
+  dladdr:=0;
+  _ModuleName:='';
+  if info = nil then
+    exit;
+  curbase:=0;
+  curnode:='';
+  Assign(F, '/proc/self/maps');
+  Reset(F);
+  if IoResult <> 0 then
+    exit;
+  while not Eof(F) do
+    begin
+      // Read the address range info
+      ReadLn(F, ss);
+      p:=PAnsiChar(ss);
+      // Starting address
+      pp:=p;
+      while not (p^ in ['-', #0]) do
+        Inc(p);
+      SetString(s, pp, p - pp);
+      Val('$' + s, a1, i);
+      if i = 0 then
+        begin
+          // Ending address
+          Inc(p);
+          pp:=p;
+          while p^ > ' ' do
+            Inc(p);
+          SetString(s, pp, p - pp);
+          Val('$' + s, a2, i);
+          if i = 0 then
+            begin
+              while p^ <= ' ' do Inc(p);  // Whitespace
+              while p^ > ' ' do Inc(p);   // Skip perms
+              while p^ <= ' ' do Inc(p);  // Whitespace
+              while p^ > ' ' do Inc(p);   // Skip offset
+              while p^ <= ' ' do Inc(p);  // Whitespace
+              while p^ > ' ' do Inc(p);   // Skip dev
+              while p^ <= ' ' do Inc(p);  // Whitespace
+              // inode
+              pp:=p;
+              while p^ > ' ' do
+                Inc(p);
+              SetString(s, pp, p - pp);
+              if s <> '0' then
+                begin
+                  if s <> curnode then
+                    begin
+                      curnode:=s;
+                      curbase:=a1;
+                    end;
+
+                  if (ptruint(Lib) >= a1) and (ptruint(Lib) < a2) then
+                    begin
+                      while p^ <= ' ' do Inc(p);  // Whitespace
+                      // File name
+                      if p^ = '/' then
+                        begin
+                          _ModuleName:=p;
+                          info^.dli_fname:=PAnsiChar(_ModuleName);
+                          info^.dli_fbase:=pointer(curbase);
+                          info^.dli_sname:=nil;
+                          info^.dli_saddr:=nil;
+                          dladdr:=1;
+                        end;
+                      break;
+                    end;
+                end;
+            end;
+        end;
+    end;
+  Close(F);
+{$POP}
+end;

rtl/unix/dl.pp

@@ -92,7 +92,7 @@ function dlerror() : Pchar; cdecl; external libdl;
 { overloaded for compatibility with hmodule }
 function dlsym(Lib : PtrInt; Name : Pchar) : Pointer; cdecl; external Libdl;
 function dlclose(Lib : PtrInt) : Longint; cdecl; external libdl;
-function dladdr(Lib: pointer; info: Pdl_info): Longint; cdecl; {$ifndef aix}external;{$endif}
+function dladdr(Lib: pointer; info: Pdl_info): Longint; cdecl; {$if not defined(aix) and not defined(android)} external; {$endif}
 
 implementation
 
@@ -133,9 +133,10 @@ uses
 {$i dlaix.inc}
 {$endif}
 
+{$ifdef android}
+{$i dlandroid.inc}
+{$endif}
 
 begin
-{$ifndef android}
   UnixGetModuleByAddrHook:=@UnixGetModuleByAddr;
-{$endif android}
 end.

utils/fpcm/revision.inc

@@ -1 +1 @@
-'2014-12-07 rev 29213'
+'2015-01-04 rev 29399'

utils/pas2jni/ppuparser.pas

@@ -42,6 +42,7 @@ type
   public
     SearchPath: TStringList;
     Units: TDef;
+    OnExceptionProc: TProcDef;
 
     constructor Create(const ASearchPath: string);
     destructor Destroy; override;
@@ -56,6 +57,9 @@ implementation
 
 uses process, pipes, fpjson, jsonparser;
 
+const
+  OnExceptionProcName = 'JNI_OnException';
+
 type
   TCharSet = set of char;
 
@@ -495,6 +499,9 @@ var
                   Name:='Int';
 
               _ReadDefs(d, it, 'Params');
+              // Check for user exception handler proc
+              if AMainUnit and (Parent = CurUnit) and (OnExceptionProc = nil) and (AnsiCompareText(Name, OnExceptionProcName) = 0) then
+                OnExceptionProc:=TProcDef(d);
             end;
           dtVar, dtField, dtParam:
             with TVarDef(d) do begin

utils/pas2jni/readme.txt

@@ -57,6 +57,60 @@ After successfull run of pas2jni you will get the following output files:
 
 Note: You need to use ppudump of the same version as the FPC compiler. Use the -D switch to specify correct ppudump if it is not in PATH.
 
+CUSTOM HANDLERS
+
+It is possible to define the following custom handlers in your Pascal code.
+
+procedure JNI_OnException;
+  - is called when an unhandled Pascal exception occurs. For example, you can log a stack back trace in this handler.
+
+Custom handlers must be public and defined in one of the main units specified when calling pas2jni.
+
+CODING TIPS
+
+* Setting handlers (method pointers) in a Java code.
+
+For example there is the following event handler in your Pascal code:
+
+TMyClass = class
+...
+  property OnChange: TNotifyEvent;
+...
+end;
+
+In a Java code you get the following TMyClass instance:
+
+TMyClass myclass = TMyClass.Create();
+
+It is possible set a Java handler in 2 ways:
+
+1) Place the handler inline.
+
+...
+  myclass.setOnChange(
+      new TNotifyEvent() {
+        protected void Execute(TObject Sender) {
+          // The handler code
+        }
+      }
+    );
+...
+
+2) Define the handler as a method in a class.
+
+public class MyJavaClass {
+  private void DoOnChange(TObject Sender) {
+    // The handler code
+  }
+
+  public void main() {
+    ...
+    // Set the handler to the method with the "DoOnChange" name in the current class (this).
+    myclass.setOnChange( new TNotifyEvent(this, "DoOnChange") );
+    ...
+  }
+}
+
 COMMAND LINE OPTIONS
 
 Usage: pas2jni [options] <unit> [<unit2> <unit3> ...]

utils/pas2jni/writer.pas

@@ -1074,7 +1074,7 @@ procedure TWriter.WriteProcType(d: TProcDef; PreInfo: boolean);
 var
   vd: TVarDef;
   i: integer;
-  s, ss: string;
+  s, ss, hclass: string;
   err: boolean;
 begin
   if not d.IsUsed or not (poMethodPtr in d.ProcOpt) then
@@ -1084,21 +1084,14 @@ begin
     WriteClassInfoVar(d);
 
     // Handler proc
+    hclass:=GetClassPrefix(d) + 'Class';
     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)]), True) + ';');
-    finally
-      vd.VarType.Free;
-      vd.Free;
-    end;
+    Fps.WriteLn(Format('type %s = class', [hclass]));
+    Fps.WriteLn(Format('private %s;', [ GetProcDeclaration(d, 'Handler', True)]), 1);
+    Fps.WriteLn('end;');
+    Fps.WriteLn;
+    Fps.WriteLn(GetProcDeclaration(d, Format('%s.Handler', [hclass]), True) + ';');
+
     Fps.WriteLn('var');
     Fps.IncI;
     Fps.WriteLn('_env: PJNIEnv;');
@@ -1118,7 +1111,7 @@ begin
     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('_mpi:=_TMethodPtrInfo(_MethodPointers[-integer(ptruint(Self)) - 1]);', 1);
     Fps.WriteLn('finally');
     Fps.WriteLn('_MethodPointersCS.Leave;', 1);
     Fps.WriteLn('end;');
@@ -1190,7 +1183,7 @@ begin
     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(Format('Code:=@%s.Handler;', [hclass]), 2);
     Fps.WriteLn('end;', 1);
     Fps.DecI;
     Fps.WriteLn('end;');
@@ -2128,6 +2121,10 @@ begin
     Fps.WriteLn;
     Fps.WriteLn('procedure _HandleJNIException(env: PJNIEnv);');
     Fps.WriteLn('begin');
+    if p.OnExceptionProc <> nil then begin
+      Fps.WriteLn(Format('%s.%s;', [p.OnExceptionProc.Parent.Name, p.OnExceptionProc.Name]), 1);
+      p.OnExceptionProc.SetNotUsed;
+    end;
     Fps.WriteLn('env^^.ThrowNew(env, env^^.FindClass(env, ''java/lang/Exception''), PAnsiChar(Utf8Encode(Exception(ExceptObject).Message)));', 1);
     Fps.WriteLn('end;');