+ try/except and try/finally support for JVM target:

o always create exceptvarsym entry for on-nodes (on all targets) to remove
     some special cases when an unnamed exception was caught
   o the JVM tryfinally node generates the finally code twice: once for the
     case where no exception occurs, and once when it does occur. The reason
     is that the JVM's static bytecode verification otherwise cannot prove
     that we will only reraise the caught exception when we caught one in
     the first place (the old "jsr" opcode to de-duplicate finally code
     is no longer used in JDK 1.6 because it suffered from the same problem,
     see Sun Java bug
     http://webcache.googleusercontent.com/search?q=cache:ZJFtvxuyhfMJ:bugs.sun.com/bugdatabase/view_bug.do%3Fbug_id%3D6491544 )

git-svn-id: branches/jvmbackend@18387 -

.gitattributes

@@ -223,6 +223,7 @@ compiler/jvm/njvmadd.pas svneol=native#text/plain
 compiler/jvm/njvmcal.pas svneol=native#text/plain
 compiler/jvm/njvmcnv.pas svneol=native#text/plain
 compiler/jvm/njvmcon.pas svneol=native#text/plain
+compiler/jvm/njvmflw.pas svneol=native#text/plain
 compiler/jvm/njvminl.pas svneol=native#text/plain
 compiler/jvm/njvmmat.pas svneol=native#text/plain
 compiler/jvm/njvmmem.pas svneol=native#text/plain

compiler/jvm/cpunode.pas

@@ -32,7 +32,7 @@ implementation
   uses
     ncgbas,ncgflw,ncgcnv,ncgld,ncgmem,ncgcon,ncgset,
     ncgadd, ncgcal,ncgmat,ncginl,
-    njvmadd,njvmcal,njvmmat,njvmcnv,njvmcon,njvminl,njvmmem
+    njvmadd,njvmcal,njvmmat,njvmcnv,njvmcon,njvminl,njvmmem,njvmflw
 {    ncpuadd,ncpucall,ncpumat,ncpuinln,ncpucnv,ncpuset, }
     { this not really a node }
 {    rgcpu},tgcpu,njvmutil;

compiler/jvm/hlcgcpu.pas

@@ -101,6 +101,7 @@ uses
       procedure a_load_ref_stack(list : TAsmList;size: tdef;const ref: treference;extra_slots: longint);
       procedure a_load_const_stack(list : TAsmList;size: tdef;a :aint; typ: TRegisterType);
 
+      procedure a_load_stack_loc(list : TAsmList;size: tdef;const loc: tlocation);
       procedure a_load_loc_stack(list : TAsmList;size: tdef;const loc: tlocation);
 
       procedure a_loadfpu_const_stack(list : TAsmList;size: tdef;a :double);
@@ -277,6 +278,19 @@ implementation
       incstack(list,1);
     end;
 
+  procedure thlcgjvm.a_load_stack_loc(list: TAsmList; size: tdef; const loc: tlocation);
+    begin
+      case loc.loc of
+        LOC_REGISTER,LOC_CREGISTER,
+        LOC_FPUREGISTER,LOC_CFPUREGISTER:
+          a_load_stack_reg(list,size,loc.register);
+        LOC_REFERENCE:
+          a_load_stack_ref(list,size,loc.reference,prepare_stack_for_ref(list,loc.reference,false));
+        else
+          internalerror(2011020501);
+      end;
+    end;
+
   procedure thlcgjvm.a_load_loc_stack(list: TAsmList;size: tdef;const loc: tlocation);
     begin
       case loc.loc of

compiler/jvm/njvmflw.pas

@@ -0,0 +1,445 @@
+{
+    Copyright (c) 1998-2011 by Florian Klaempfl and Jonas Maebe
+
+    Generate assembler for nodes that influence the flow for the JVM
+
+    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 njvmflw;
+
+{$i fpcdefs.inc}
+
+interface
+
+    uses
+      aasmbase,node,nflw;
+
+    type
+       tjvmraisenode = class(traisenode)
+          function pass_typecheck: tnode; override;
+          procedure pass_generate_code;override;
+       end;
+
+       tjvmtryexceptnode = class(ttryexceptnode)
+          procedure pass_generate_code;override;
+       end;
+
+       tjvmtryfinallynode = class(ttryfinallynode)
+          procedure pass_generate_code;override;
+       end;
+
+       tjvmonnode = class(tonnode)
+          procedure pass_generate_code;override;
+       end;
+
+implementation
+
+    uses
+      verbose,globals,systems,globtype,constexp,
+      symconst,symdef,symsym,aasmtai,aasmdata,aasmcpu,defutil,jvmdef,
+      procinfo,cgbase,pass_2,parabase,
+      cpubase,cpuinfo,
+      nld,ncon,
+      tgobj,paramgr,
+      cgutils,hlcgobj,hlcgcpu
+      ;
+
+{*****************************************************************************
+                             SecondRaise
+*****************************************************************************}
+
+    var
+      current_except_loc: tlocation;
+
+    function tjvmraisenode.pass_typecheck: tnode;
+      begin
+         Result:=inherited pass_typecheck;
+         if codegenerror then
+           exit;
+         { Java exceptions must descend from java.lang.Throwable }
+         if assigned(left) and
+            not(left.resultdef).is_related(java_jlthrowable) then
+           MessagePos2(left.fileinfo,type_e_incompatible_types,left.resultdef.typename,'class(TJLThrowable)');
+         { Java exceptions cannot be raised "at" a specific location }
+         if assigned(right) then
+           MessagePos(right.fileinfo,parser_e_illegal_expression);
+      end;
+
+
+    procedure tjvmraisenode.pass_generate_code;
+      begin
+        if assigned(left) then
+          begin
+            secondpass(left);
+            thlcgjvm(hlcg).a_load_loc_stack(current_asmdata.CurrAsmList,left.resultdef,left.location);
+          end
+        else
+          thlcgjvm(hlcg).a_load_loc_stack(current_asmdata.CurrAsmList,java_jlthrowable,current_except_loc);
+        current_asmdata.CurrAsmList.Concat(taicpu.op_none(a_athrow));
+        thlcgjvm(hlcg).decstack(current_asmdata.CurrAsmList,1);
+      end;
+
+
+{*****************************************************************************
+                             SecondTryExcept
+*****************************************************************************}
+
+    var
+       begintrylabel,
+       endtrylabel: tasmlabel;
+       endexceptlabel : tasmlabel;
+
+
+    procedure tjvmtryexceptnode.pass_generate_code;
+
+      var
+         oldendexceptlabel,
+         oldbegintrylabel,
+         oldendtrylabel,
+         defaultcatchlabel: tasmlabel;
+         oldflowcontrol,tryflowcontrol,
+         exceptflowcontrol : tflowcontrol;
+      begin
+         location_reset(location,LOC_VOID,OS_NO);
+
+         oldflowcontrol:=flowcontrol;
+         flowcontrol:=[fc_inflowcontrol];
+         { this can be called recursivly }
+         oldbegintrylabel:=begintrylabel;
+         oldendtrylabel:=endtrylabel;
+         oldendexceptlabel:=endexceptlabel;
+
+         { get new labels for the control flow statements }
+         current_asmdata.getaddrlabel(begintrylabel);
+         current_asmdata.getaddrlabel(endtrylabel);
+         current_asmdata.getjumplabel(endexceptlabel);
+
+         { try block }
+         { set control flow labels for the try block }
+
+         flowcontrol:=[fc_inflowcontrol];
+         hlcg.a_label(current_asmdata.CurrAsmList,begintrylabel);
+         secondpass(left);
+         hlcg.a_label(current_asmdata.CurrAsmList,endtrylabel);
+         tryflowcontrol:=flowcontrol;
+
+         { jump over exception handling blocks }
+         current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoStart));
+         hlcg.a_jmp_always(current_asmdata.CurrAsmList,endexceptlabel);
+         current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoEnd));
+
+         { set control flow labels for the except block }
+         { and the on statements                        }
+
+         flowcontrol:=[fc_inflowcontrol];
+         { on-statements }
+         if assigned(right) then
+           secondpass(right);
+
+         { default handling except handling }
+         if assigned(t1) then
+           begin
+             current_asmdata.getaddrlabel(defaultcatchlabel);
+             current_asmdata.CurrAsmList.concat(tai_jcatch.create(
+               'all',begintrylabel,endtrylabel,defaultcatchlabel));
+             hlcg.a_label(current_asmdata.CurrAsmList,defaultcatchlabel);
+             { here we don't have to reset flowcontrol           }
+             { the default and on flowcontrols are handled equal }
+
+             { pop the exception object from the stack }
+             current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoStart));
+             thlcgjvm(hlcg).incstack(current_asmdata.CurrAsmList,1);
+             current_asmdata.CurrAsmList.concat(taicpu.op_none(a_pop));
+             thlcgjvm(hlcg).decstack(current_asmdata.CurrAsmList,1);
+             current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoEnd));
+
+             { and generate the exception handling code }
+             secondpass(t1);
+             exceptflowcontrol:=flowcontrol;
+           end;
+         hlcg.a_label(current_asmdata.CurrAsmList,endexceptlabel);
+
+         { restore all saved labels }
+         begintrylabel:=oldbegintrylabel;
+         endtrylabel:=oldendtrylabel;
+         endexceptlabel:=oldendexceptlabel;
+
+         { return all used control flow statements }
+         flowcontrol:=oldflowcontrol+(exceptflowcontrol +
+           tryflowcontrol - [fc_inflowcontrol]);
+      end;
+
+
+    {*****************************************************************************
+                                   SecondOn
+    *****************************************************************************}
+
+    procedure tjvmonnode.pass_generate_code;
+      var
+         thisonlabel : tasmlabel;
+         oldflowcontrol : tflowcontrol;
+         exceptvarsym : tlocalvarsym;
+      begin
+         location_reset(location,LOC_VOID,OS_NO);
+
+         oldflowcontrol:=flowcontrol;
+         flowcontrol:=[fc_inflowcontrol];
+         current_asmdata.getjumplabel(thisonlabel);
+
+         hlcg.a_label(current_asmdata.CurrAsmList,thisonlabel);
+
+         if assigned(excepTSymtable) then
+           exceptvarsym:=tlocalvarsym(excepTSymtable.SymList[0])
+         else
+           internalerror(2011020402);
+
+         { add exception catching information for the JVM: exception type
+           (will have to be adjusted if/when support for catching class
+            reference types is added), begin/end of code in which the exception
+            can be raised, and start of this exception handling code }
+         current_asmdata.CurrAsmList.concat(tai_jcatch.create(
+           tobjectdef(exceptvarsym.vardef).jvm_full_typename(true),
+           begintrylabel,endtrylabel,thisonlabel));
+
+         { Retrieve exception variable }
+         { 1) prepare the location where we'll store it }
+         location_reset_ref(exceptvarsym.localloc,LOC_REFERENCE,OS_ADDR,sizeof(pint));
+         tg.GetLocal(current_asmdata.CurrAsmList,sizeof(pint),exceptvarsym.vardef,exceptvarsym.localloc.reference);
+         current_except_loc:=exceptvarsym.localloc;
+         { 2) the exception variable is at the top of the evaluation stack
+           (placed there by the JVM) -> adjust stack count, then store it }
+         thlcgjvm(hlcg).incstack(current_asmdata.CurrAsmList,1);
+         thlcgjvm(hlcg).a_load_stack_loc(current_asmdata.CurrAsmList,exceptvarsym.vardef,current_except_loc);
+
+         if assigned(right) then
+           secondpass(right);
+
+         { clear some stuff }
+         tg.UngetLocal(current_asmdata.CurrAsmList,exceptvarsym.localloc.reference);
+         exceptvarsym.localloc.loc:=LOC_INVALID;
+         current_except_loc.loc:=LOC_INVALID;
+         hlcg.a_jmp_always(current_asmdata.CurrAsmList,endexceptlabel);
+
+         flowcontrol:=oldflowcontrol+(flowcontrol-[fc_inflowcontrol]);
+
+         { next on node }
+         if assigned(left) then
+           secondpass(left);
+      end;
+
+{*****************************************************************************
+                             SecondTryFinally
+*****************************************************************************}
+
+    procedure tjvmtryfinallynode.pass_generate_code;
+      var
+         begintrylabel,
+         endtrylabel,
+         reraiselabel,
+         finallylabel,
+         finallyexceptlabel,
+         endfinallylabel,
+         exitfinallylabel,
+         continuefinallylabel,
+         breakfinallylabel,
+         oldCurrExitLabel,
+         oldContinueLabel,
+         oldBreakLabel : tasmlabel;
+         oldflowcontrol,tryflowcontrol : tflowcontrol;
+         finallycodecopy: tnode;
+         reasonbuf,
+         exceptreg: tregister;
+      begin
+         location_reset(location,LOC_VOID,OS_NO);
+
+         { check if child nodes do a break/continue/exit }
+         oldflowcontrol:=flowcontrol;
+         flowcontrol:=[fc_inflowcontrol];
+         current_asmdata.getjumplabel(finallylabel);
+         current_asmdata.getjumplabel(endfinallylabel);
+         current_asmdata.getjumplabel(reraiselabel);
+
+         { the finally block must catch break, continue and exit }
+         { statements                                            }
+         oldCurrExitLabel:=current_procinfo.CurrExitLabel;
+         if implicitframe then
+           exitfinallylabel:=finallylabel
+         else
+           current_asmdata.getjumplabel(exitfinallylabel);
+         current_procinfo.CurrExitLabel:=exitfinallylabel;
+         if assigned(current_procinfo.CurrBreakLabel) then
+          begin
+            oldContinueLabel:=current_procinfo.CurrContinueLabel;
+            oldBreakLabel:=current_procinfo.CurrBreakLabel;
+            if implicitframe then
+              begin
+                breakfinallylabel:=finallylabel;
+                continuefinallylabel:=finallylabel;
+              end
+            else
+              begin
+                current_asmdata.getjumplabel(breakfinallylabel);
+                current_asmdata.getjumplabel(continuefinallylabel);
+              end;
+            current_procinfo.CurrContinueLabel:=continuefinallylabel;
+            current_procinfo.CurrBreakLabel:=breakfinallylabel;
+          end;
+
+         { allocate reg to store the reason why the finally block was entered
+           (no exception, break, continue, exit), so we can continue to the
+           right label afterwards. In case of an exception, we use a separate
+           (duplicate) finally block because otherwise the JVM's bytecode
+           verification cannot statically prove that the exception reraise code
+           will only execute in case an exception actually happened }
+         reasonbuf:=hlcg.getaddressregister(current_asmdata.CurrAsmList,s32inttype);
+
+         { try code }
+         begintrylabel:=nil;
+         endtrylabel:=nil;
+         if assigned(left) then
+           begin
+              current_asmdata.getaddrlabel(begintrylabel);
+              current_asmdata.getaddrlabel(endtrylabel);
+              hlcg.a_label(current_asmdata.CurrAsmList,begintrylabel);
+              secondpass(left);
+              hlcg.a_label(current_asmdata.CurrAsmList,endtrylabel);
+              tryflowcontrol:=flowcontrol;
+              if codegenerror then
+                exit;
+              { reason: no exception occurred }
+              hlcg.a_load_const_reg(current_asmdata.CurrAsmList,s32inttype,0,reasonbuf);
+           end;
+
+         { begin of the finally code }
+         hlcg.a_label(current_asmdata.CurrAsmList,finallylabel);
+         { finally code }
+         flowcontrol:=[fc_inflowcontrol];
+         { duplicate finally code for case when exception happened }
+         if assigned(begintrylabel) then
+           finallycodecopy:=right.getcopy;
+         secondpass(right);
+         { goto is allowed if it stays inside the finally block,
+           this is checked using the exception block number }
+         if (flowcontrol-[fc_gotolabel])<>[fc_inflowcontrol] then
+           CGMessage(cg_e_control_flow_outside_finally);
+         if codegenerror then
+           begin
+             if assigned(begintrylabel) then
+               finallycodecopy.free;
+             exit;
+           end;
+
+         { don't generate line info for internal cleanup }
+         current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoStart));
+
+         { the reasonbuf holds the reason why this (non-exception) finally code
+           was executed:
+             0 = try code simply finished
+             1 = (unused) exception raised
+             2 = exit called
+             3 = break called
+             4 = continue called }
+         if not(implicitframe) then
+           begin
+             hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,s32inttype,OC_EQ,0,reasonbuf,endfinallylabel);
+             if fc_exit in tryflowcontrol then
+               if ([fc_break,fc_continue]*tryflowcontrol)<>[] then
+                 hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,s32inttype,OC_EQ,2,reasonbuf,oldCurrExitLabel)
+               else
+                 hlcg.a_jmp_always(current_asmdata.CurrAsmList,oldCurrExitLabel);
+             if fc_break in tryflowcontrol then
+               if fc_continue in tryflowcontrol then
+                 hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,s32inttype,OC_EQ,3,reasonbuf,oldBreakLabel)
+               else
+                 hlcg.a_jmp_always(current_asmdata.CurrAsmList,oldBreakLabel);
+             if fc_continue in tryflowcontrol then
+               hlcg.a_jmp_always(current_asmdata.CurrAsmList,oldContinueLabel);
+             { now generate the trampolines for exit/break/continue to load the reasonbuf }
+             if fc_exit in tryflowcontrol then
+               begin
+                  hlcg.a_label(current_asmdata.CurrAsmList,exitfinallylabel);
+                  hlcg.a_load_const_reg(current_asmdata.CurrAsmList,s32inttype,2,reasonbuf);
+                  hlcg.a_jmp_always(current_asmdata.CurrAsmList,finallylabel);
+               end;
+             if fc_break in tryflowcontrol then
+              begin
+                  hlcg.a_label(current_asmdata.CurrAsmList,breakfinallylabel);
+                  hlcg.a_load_const_reg(current_asmdata.CurrAsmList,s32inttype,3,reasonbuf);
+                  hlcg.a_jmp_always(current_asmdata.CurrAsmList,finallylabel);
+               end;
+             if fc_continue in tryflowcontrol then
+               begin
+                  hlcg.a_label(current_asmdata.CurrAsmList,continuefinallylabel);
+                  hlcg.a_load_const_reg(current_asmdata.CurrAsmList,s32inttype,4,reasonbuf);
+                  hlcg.a_jmp_always(current_asmdata.CurrAsmList,finallylabel);
+               end;
+             { jump over finally-code-in-case-an-exception-happened }
+             hlcg.a_jmp_always(current_asmdata.CurrAsmList,endfinallylabel);
+           end;
+
+         { generate finally code in case an exception occurred }
+         if assigned(begintrylabel) then
+           begin
+             current_asmdata.getaddrlabel(finallyexceptlabel);
+             hlcg.a_label(current_asmdata.CurrAsmList,finallyexceptlabel);
+             { catch the exceptions }
+             current_asmdata.CurrAsmList.concat(tai_jcatch.create(
+               'all',begintrylabel,endtrylabel,finallyexceptlabel));
+             { store the generated exception object to a temp }
+             exceptreg:=hlcg.getaddressregister(current_asmdata.CurrAsmList,java_jlthrowable);
+             thlcgjvm(hlcg).incstack(current_asmdata.CurrAsmList,1);
+             thlcgjvm(hlcg).a_load_stack_reg(current_asmdata.CurrAsmList,java_jlthrowable,exceptreg);
+             { generate the finally code again }
+             secondpass(finallycodecopy);
+             finallycodecopy.free;
+             { in case of an implicit frame, also execute the exception handling
+               code }
+             if implicitframe then
+               begin
+                 flowcontrol:=[fc_inflowcontrol];
+                 secondpass(t1);
+                 if flowcontrol<>[fc_inflowcontrol] then
+                   CGMessage(cg_e_control_flow_outside_finally);
+                 if codegenerror then
+                   exit;
+               end;
+             { reraise the exception }
+             thlcgjvm(hlcg).a_load_reg_stack(current_asmdata.CurrAsmList,java_jlthrowable,exceptreg);
+             current_asmdata.CurrAsmList.Concat(taicpu.op_none(a_athrow));
+             thlcgjvm(hlcg).decstack(current_asmdata.CurrAsmList,1);
+           end;
+         hlcg.a_label(current_asmdata.CurrAsmList,endfinallylabel);
+
+         { end cleanup }
+         current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoEnd));
+
+         current_procinfo.CurrExitLabel:=oldCurrExitLabel;
+         if assigned(current_procinfo.CurrBreakLabel) then
+          begin
+            current_procinfo.CurrContinueLabel:=oldContinueLabel;
+            current_procinfo.CurrBreakLabel:=oldBreakLabel;
+          end;
+         flowcontrol:=oldflowcontrol+(tryflowcontrol-[fc_inflowcontrol]);
+      end;
+
+begin
+   craisenode:=tjvmraisenode;
+   ctryexceptnode:=tjvmtryexceptnode;
+   ctryfinallynode:=tjvmtryfinallynode;
+   connode:=tjvmonnode;
+end.
+

compiler/ncgflw.pas

@@ -1344,7 +1344,6 @@ implementation
          oldBreakLabel : tasmlabel;
          oldflowcontrol : tflowcontrol;
          excepttemps : texceptiontemps;
-         exceptref,
          href2: treference;
          paraloc1 : tcgpara;
          exceptvarsym : tlocalvarsym;
@@ -1373,20 +1372,11 @@ implementation
          if assigned(excepTSymtable) then
            exceptvarsym:=tlocalvarsym(excepTSymtable.SymList[0])
          else
-           exceptvarsym:=nil;
+           internalerror(2011020401);
 
-         if assigned(exceptvarsym) then
-           begin
-             exceptvarsym.localloc.loc:=LOC_REFERENCE;
-             exceptvarsym.localloc.size:=OS_ADDR;
-             tg.GetLocal(current_asmdata.CurrAsmList,sizeof(pint),voidpointertype,exceptvarsym.localloc.reference);
-             cg.a_load_reg_ref(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,NR_FUNCTION_RESULT_REG,exceptvarsym.localloc.reference);
-           end
-         else
-           begin
-             tg.GetTemp(current_asmdata.CurrAsmList,sizeof(pint),sizeof(pint),tt_normal,exceptref);
-             cg.a_load_reg_ref(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,NR_FUNCTION_RESULT_REG,exceptref);
-           end;
+         location_reset_ref(exceptvarsym.localloc,LOC_REFERENCE,OS_ADDR,sizeof(pint));
+         tg.GetLocal(current_asmdata.CurrAsmList,sizeof(pint),voidpointertype,exceptvarsym.localloc.reference);
+         cg.a_load_reg_ref(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,NR_FUNCTION_RESULT_REG,exceptvarsym.localloc.reference);
          cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_FUNCTION_RESULT_REG);
 
          { in the case that another exception is risen
@@ -1443,13 +1433,8 @@ implementation
          cg.a_label(current_asmdata.CurrAsmList,doobjectdestroy);
          cleanupobjectstack;
          { clear some stuff }
-         if assigned(exceptvarsym) then
-           begin
-             tg.UngetLocal(current_asmdata.CurrAsmList,exceptvarsym.localloc.reference);
-             exceptvarsym.localloc.loc:=LOC_INVALID;
-           end
-         else
-           tg.Ungettemp(current_asmdata.CurrAsmList,exceptref);
+         tg.UngetLocal(current_asmdata.CurrAsmList,exceptvarsym.localloc.reference);
+         exceptvarsym.localloc.loc:=LOC_INVALID;
          cg.a_jmp_always(current_asmdata.CurrAsmList,endexceptlabel);
 
          if assigned(right) then

compiler/nflw.pas

@@ -1916,7 +1916,8 @@ implementation
              set_varstate(left,vs_read,[vsf_must_be_valid]);
              if codegenerror then
               exit;
-             if not(is_class(left.resultdef)) then
+             if not is_class(left.resultdef) and
+                not is_javaclass(left.resultdef) then
                CGMessage1(type_e_class_type_expected,left.resultdef.typename);
              { insert needed typeconvs for addr,frame }
              if assigned(right) then
@@ -2112,7 +2113,8 @@ implementation
       begin
          result:=nil;
          resultdef:=voidtype;
-         if not(is_class(excepttype)) then
+         if not is_class(excepttype) and
+            not is_javaclass(excepttype) then
            CGMessage1(type_e_class_type_expected,excepttype.typename);
          if assigned(left) then
            typecheckpass(left);

compiler/pdecobj.pas

@@ -1182,8 +1182,12 @@ implementation
                     if (current_structdef.objname^='TOBJECT') then
                       class_tobject:=current_objectdef;
                   odt_javaclass:
-                    if (current_objectdef.objname^='TOBJECT') then
-                      java_jlobject:=current_objectdef;
+                    begin
+                      if (current_objectdef.objname^='TOBJECT') then
+                        java_jlobject:=current_objectdef;
+                      if (current_objectdef.objname^='TJLTHROWABLE') then
+                        java_jlthrowable:=current_objectdef;
+                    end;
                 end;
               end;
             if (current_module.modulename^='OBJCBASE') then

compiler/pstatmnt.pas

@@ -865,7 +865,8 @@ implementation
                             begin
                                consume_sym(srsym,srsymtable);
                                if (srsym.typ=typesym) and
-                                  is_class(ttypesym(srsym).typedef) then
+                                  (is_class(ttypesym(srsym).typedef) or
+                                   is_javaclass(ttypesym(srsym).typedef)) then
                                  begin
                                     ot:=ttypesym(srsym).typedef;
                                     sym:=tlocalvarsym.create(objrealname,vs_value,ot,[]);
@@ -878,9 +879,6 @@ implementation
                                     else
                                       Message1(type_e_class_type_expected,ot.typename);
                                  end;
-                               excepTSymtable:=tstt_excepTSymtable.create;
-                               excepTSymtable.insert(sym);
-                               symtablestack.push(excepTSymtable);
                             end
                           else
                             begin
@@ -906,7 +904,8 @@ implementation
                                { check if type is valid, must be done here because
                                  with "e: Exception" the e is not necessary }
                                if (srsym.typ=typesym) and
-                                  is_class(ttypesym(srsym).typedef) then
+                                  (is_class(ttypesym(srsym).typedef) or
+                                   is_javaclass(ttypesym(srsym).typedef)) then
                                  ot:=ttypesym(srsym).typedef
                                else
                                  begin
@@ -916,8 +915,14 @@ implementation
                                     else
                                       Message1(type_e_class_type_expected,ot.typename);
                                  end;
-                               excepTSymtable:=nil;
+                               { create dummy symbol so we don't need a special
+                                 case in ncgflw, and so that we always know the
+                                 type }
+                               sym:=tlocalvarsym.create('$exceptsym',vs_value,ot,[]);
                             end;
+                          excepTSymtable:=tstt_excepTSymtable.create;
+                          excepTSymtable.insert(sym);
+                          symtablestack.push(excepTSymtable);
                        end
                      else
                        consume(_ID);

compiler/symdef.pas

@@ -762,6 +762,8 @@ interface
        { Java base types }
        { java.lang.Object }
        java_jlobject             : tobjectdef;
+       { java.lang.Throwable }
+       java_jlthrowable          : tobjectdef;
 
     const
 {$ifdef i386}
@@ -4558,10 +4560,13 @@ implementation
             (objecttype=odt_objcclass) and
             (objname^='PROTOCOL') then
            objc_protocoltype:=self;
-         if (childof=nil) and
-            (objecttype=odt_javaclass) and
-            (objname^='TOBJECT') then
-           java_jlobject:=self;
+         if (objecttype=odt_javaclass) then
+           begin
+             if (objname^='TOBJECT') then
+               java_jlobject:=self;
+             if (objname^='TJLTHROWABLE') then
+               java_jlthrowable:=self;
+           end;
          writing_class_record_dbginfo:=false;
        end;
 

rtl/java/system.pp

@@ -68,6 +68,14 @@ type
     function equals(obj: TObject): boolean;
     function hashcode: longint;
   end;
+  TJLObject = TObject;
+
+  TJISerializable = interface external 'java.lang' name 'Serializable'
+  end;
+
+  TJLThrowable = class external 'java.lang' name 'Throwable' (TObject,TJISerializable)
+    constructor create;
+  end;
 
   { Java Float class type }
   TJFloat = class external 'java.lang' name 'Float'