diff --git a/.gitattributes b/.gitattributes index 42fdeef70a..8aaa64e004 100644 --- a/.gitattributes +++ b/.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 diff --git a/compiler/jvm/cpunode.pas b/compiler/jvm/cpunode.pas index f5b0b5e54a..c3fe7cb509 100644 --- a/compiler/jvm/cpunode.pas +++ b/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; diff --git a/compiler/jvm/hlcgcpu.pas b/compiler/jvm/hlcgcpu.pas index 2b979bc8a6..524780bc63 100644 --- a/compiler/jvm/hlcgcpu.pas +++ b/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 diff --git a/compiler/jvm/njvmflw.pas b/compiler/jvm/njvmflw.pas new file mode 100644 index 0000000000..1a19e90098 --- /dev/null +++ b/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. + diff --git a/compiler/ncgflw.pas b/compiler/ncgflw.pas index d9ef8867d1..0ac0d3eafc 100644 --- a/compiler/ncgflw.pas +++ b/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 diff --git a/compiler/nflw.pas b/compiler/nflw.pas index cb47d59a65..687cd9e2fd 100644 --- a/compiler/nflw.pas +++ b/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); diff --git a/compiler/pdecobj.pas b/compiler/pdecobj.pas index 279b7454cd..795da07e55 100644 --- a/compiler/pdecobj.pas +++ b/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 diff --git a/compiler/pstatmnt.pas b/compiler/pstatmnt.pas index dc2a34b3c2..9e63ca6fcc 100644 --- a/compiler/pstatmnt.pas +++ b/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); diff --git a/compiler/symdef.pas b/compiler/symdef.pas index b66b58f73b..ea8edc7bbb 100644 --- a/compiler/symdef.pas +++ b/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; diff --git a/rtl/java/system.pp b/rtl/java/system.pp index 4b97e5d0dd..84d3f61295 100644 --- a/rtl/java/system.pp +++ b/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'