fpc/compiler/jvm/njvmcnv.pas

{
    Copyright (c) 1998-2011 by Florian Klaempfl and Jonas Maebe

    Generate JVM code for type converting nodes

    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 njvmcnv;

{$i fpcdefs.inc}

interface

    uses
      node,ncnv,ncgcnv,
      symtype;

    type
       tjvmtypeconvnode = class(tcgtypeconvnode)
          function typecheck_dynarray_to_openarray: tnode; override;
          function typecheck_string_to_chararray: tnode; override;
          function typecheck_string_to_string: tnode;override;
          function typecheck_char_to_string: tnode; override;
          function typecheck_proc_to_procvar: tnode; override;
          function pass_1: tnode; override;
          function simplify(forinline: boolean): tnode; override;
          function first_set_to_set : tnode;override;
          function first_nil_to_methodprocvar: tnode; override;
          function first_proc_to_procvar: tnode; override;
          function first_ansistring_to_pchar: tnode; override;

          procedure second_int_to_int;override;
          procedure second_cstring_to_pchar;override;
         { procedure second_string_to_chararray;override; }
         { procedure second_array_to_pointer;override; }
          function first_int_to_real: tnode; override;
          procedure second_pointer_to_array;override;
         { procedure second_chararray_to_string;override; }
         { procedure second_char_to_string;override; }
          procedure second_int_to_real;override;
         { procedure second_real_to_real;override; }
         { procedure second_cord_to_pointer;override; }
          procedure second_proc_to_procvar;override;
          procedure second_bool_to_int;override;
          procedure second_int_to_bool;override;
         { procedure second_load_smallset;override;  }
         { procedure second_ansistring_to_pchar;override; }
         { procedure second_pchar_to_string;override; }
         { procedure second_class_to_intf;override; }
         { procedure second_char_to_char;override; }
          procedure second_elem_to_openarray; override;
          function target_specific_explicit_typeconv: boolean; override;
          function target_specific_general_typeconv: boolean; override;
         protected
          function do_target_specific_explicit_typeconv(check_only: boolean; out resnode: tnode): boolean;
       end;

       tjvmasnode = class(tcgasnode)
        protected
         { to discern beween "obj as tclassref" and "tclassref(obj)" }
         classreftypecast: boolean;
         function target_specific_typecheck: boolean;override;
        public
         function pass_1 : tnode;override;
         procedure pass_generate_code; override;
         function dogetcopy: tnode; override;
         function docompare(p: tnode): boolean; override;
         constructor ppuload(t: tnodetype; ppufile: tcompilerppufile); override;
         procedure ppuwrite(ppufile: tcompilerppufile); override;
       end;

       tjvmisnode = class(tisnode)
        protected
         function target_specific_typecheck: boolean;override;
        public
         function pass_1 : tnode;override;
         procedure pass_generate_code; override;
       end;

implementation

   uses
      verbose,globals,globtype,constexp,cutils,
      symbase,symconst,symdef,symsym,symtable,aasmbase,aasmdata,
      defutil,defcmp,jvmdef,
      cgbase,cgutils,pass_1,pass_2,
      nbas,ncon,ncal,ninl,nld,nmem,procinfo,
      nutils,paramgr,
      cpubase,cpuinfo,aasmcpu,
      tgobj,hlcgobj,hlcgcpu;


{*****************************************************************************
                            TypeCheckTypeConv
*****************************************************************************}

    function isvalidprocvartypeconv(fromdef, todef: tdef): boolean;

      var
        tmethoddef: tdef;

      function docheck(def1,def2: tdef): boolean;
        begin
          result:=false;
          if def1.typ<>procvardef then
            exit;
          { is_addressonly procvars are treated like regular pointer-sized data,
            po_methodpointer procvars like implicit pointers to a struct }
          if tprocvardef(def1).is_addressonly then
            result:=
              ((def2.typ=procvardef) and
               tprocvardef(def2).is_addressonly) or
              (def2=java_jlobject) or
              (def2=voidpointertype)
          else if po_methodpointer in tprocvardef(def1).procoptions then
            begin
              if not assigned(tmethoddef) then
                tmethoddef:=search_system_type('TMETHOD').typedef;
              result:=
                (def2=methodpointertype) or
                (def2=tmethoddef) or
                ((def2.typ=procvardef) and
                 (po_methodpointer in tprocvardef(def2).procoptions));
            end;
          { can't typecast nested procvars, they need 3 data pointers }
        end;

      begin
        tmethoddef:=nil;
        result:=
          docheck(fromdef,todef) or
          docheck(todef,fromdef);
      end;


   function tjvmtypeconvnode.typecheck_dynarray_to_openarray: tnode;
     begin
       { all arrays are equal in Java }
       result:=nil;
       convtype:=tc_equal;
     end;


   function tjvmtypeconvnode.typecheck_string_to_chararray: tnode;
     var
       newblock: tblocknode;
       newstat: tstatementnode;
       restemp: ttempcreatenode;
       chartype: string;
     begin
       if (left.nodetype = stringconstn) and
          (tstringconstnode(left).cst_type=cst_conststring) then
         inserttypeconv(left,cunicodestringtype);
       { even constant strings have to be handled via a helper }
       if is_widechar(tarraydef(resultdef).elementdef) then
         chartype:='widechar'
       else
         chartype:='char';
       newblock:=internalstatements(newstat);
       restemp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,false);
       addstatement(newstat,restemp);
       addstatement(newstat,ccallnode.createintern('fpc_'+tstringdef(left.resultdef).stringtypname+
         '_to_'+chartype+'array',ccallparanode.create(left,ccallparanode.create(
         ctemprefnode.create(restemp),nil))));
       addstatement(newstat,ctempdeletenode.create_normal_temp(restemp));
       addstatement(newstat,ctemprefnode.create(restemp));
       result:=newblock;
       left:=nil;
     end;


   function tjvmtypeconvnode.typecheck_string_to_string: tnode;
     begin
       { make sure the generic code gets a stringdef }
       if (maybe_find_real_class_definition(resultdef,false)=java_jlstring) or
          (maybe_find_real_class_definition(left.resultdef,false)=java_jlstring) then
         begin
           left:=ctypeconvnode.create(left,cunicodestringtype);
           left.flags:=flags;
           result:=ctypeconvnode.create(left,resultdef);
           result.flags:=flags;
           left:=nil;
         end
       else
         result:=inherited;
     end;


   function tjvmtypeconvnode.typecheck_char_to_string: tnode;
    begin
      { make sure the generic code gets a stringdef }
      if self.totypedef=java_jlstring then
        begin
          inserttypeconv(left,cunicodestringtype);
          inserttypeconv(left,totypedef);
          result:=left;
          left:=nil;
          exit;
        end;
      result:=inherited;
    end;


   function tjvmtypeconvnode.typecheck_proc_to_procvar: tnode;
    begin
      result:=inherited typecheck_proc_to_procvar;
      if not assigned(totypedef) or
         (totypedef.typ<>procvardef) then
        begin
          if assigned(tprocvardef(resultdef).classdef) then
            internalerror(2011072405);
          { associate generic classdef; this is the result of an @proc
            expression, and such expressions can never result in a direct call
            -> no invoke() method required (which only exists in custom
            constructed descendents created for defined procvar types) }
          if is_nested_pd(tabstractprocdef(resultdef)) then
            { todo }
            internalerror(2011072406)
          else
            tprocvardef(resultdef).classdef:=java_procvarbase;
        end;
    end;


{*****************************************************************************
                             FirstTypeConv
*****************************************************************************}

    function tjvmtypeconvnode.first_int_to_real: tnode;
      begin
        if not is_64bitint(left.resultdef) and
           not is_currency(left.resultdef) then
          if is_signed(left.resultdef) or
             (left.resultdef.size<4) then
            inserttypeconv(left,s32inttype)
          else
            inserttypeconv(left,u32inttype);
        firstpass(left);
        result := nil;
        expectloc:=LOC_FPUREGISTER;
      end;


    function tjvmtypeconvnode.pass_1: tnode;
      begin
        if (nf_explicit in flags) then
          begin
            do_target_specific_explicit_typeconv(false,result);
            if assigned(result) then
              exit;
          end;
        result:=inherited pass_1;
      end;

    function tjvmtypeconvnode.simplify(forinline: boolean): tnode;
      begin
        result:=inherited simplify(forinline);
        if assigned(result) then
          exit;
        { string constants passed to java.lang.String must be converted to
          widestring }
        if ((is_conststringnode(left) and
             not(tstringconstnode(left).cst_type in [cst_unicodestring,cst_widestring])) or
            is_constcharnode(left)) and
           (maybe_find_real_class_definition(resultdef,false)=java_jlstring) then
          inserttypeconv(left,cunicodestringtype);
      end;


    function tjvmtypeconvnode.first_set_to_set: tnode;
      var
        setclassdef: tdef;
        helpername: string;
      begin
        result:=nil;
        if (left.nodetype=setconstn) then
          result:=inherited
        { on native targets, only the binary layout has to match. Here, both
          sets also have to be either of enums or ordinals, and in case of
          enums they have to be of the same base type }
        else if (tsetdef(left.resultdef).elementdef.typ=enumdef)=(tsetdef(resultdef).elementdef.typ=enumdef) and
            ((tsetdef(left.resultdef).elementdef.typ<>enumdef) or
             (tenumdef(tsetdef(left.resultdef).elementdef).getbasedef=tenumdef(tsetdef(resultdef).elementdef).getbasedef)) and
            (tsetdef(left.resultdef).setbase=tsetdef(resultdef).setbase) and
            (left.resultdef.size=resultdef.size) then
          begin
            result:=left;
            left:=nil;
          end
        else
          begin
            { 'deep' conversion }
            if tsetdef(resultdef).elementdef.typ<>enumdef then
              begin
                if tsetdef(left.resultdef).elementdef.typ<>enumdef then
                  helpername:='fpc_bitset_to_bitset'
                else
                  helpername:='fpc_enumset_to_bitset';
                result:=ccallnode.createintern(helpername,ccallparanode.create(
                  genintconstnode(tsetdef(resultdef).setbase), ccallparanode.create(
                    genintconstnode(tsetdef(left.resultdef).setbase),
                      ccallparanode.create(left,nil))));
              end
            else
              begin
                if tsetdef(left.resultdef).elementdef.typ<>enumdef then
                  begin
                    helpername:='fpcBitSetToEnumSet';
                    setclassdef:=java_jubitset;
                  end
                else
                  begin
                    helpername:='fpcEnumSetToEnumSet';
                    setclassdef:=java_juenumset;
                  end;
                left:=caddrnode.create_internal(left);
                include(left.flags,nf_typedaddr);
                inserttypeconv_explicit(left,setclassdef);
                result:=ccallnode.createinternmethod(
                  cloadvmtaddrnode.create(ctypenode.create(setclassdef)),
                  helpername,ccallparanode.create(
                    genintconstnode(tsetdef(resultdef).setbase), ccallparanode.create(
                      genintconstnode(tsetdef(left.resultdef).setbase),
                        ccallparanode.create(left,nil))));
              end;
            inserttypeconv_explicit(result,getpointerdef(resultdef));
            result:=cderefnode.create(result);
            { reused }
            left:=nil;
          end;

      end;


    function tjvmtypeconvnode.first_nil_to_methodprocvar: tnode;
      begin
        result:=inherited first_nil_to_methodprocvar;
        if assigned(result) then
          exit;
        if not assigned(tprocvardef(resultdef).classdef) then
          tprocvardef(resultdef).classdef:=java_procvarbase;
        result:=ccallnode.createinternmethod(
          cloadvmtaddrnode.create(ctypenode.create(tprocvardef(resultdef).classdef)),'CREATE',nil);
        { method pointer is an implicit pointer type }
        result:=ctypeconvnode.create_explicit(result,getpointerdef(resultdef));
        result:=cderefnode.create(result);
      end;


    function tjvmtypeconvnode.first_proc_to_procvar: tnode;
      var
        constrparas: tcallparanode;
        newpara: tnode;
        procdefparas: tarrayconstructornode;
        pvs: tparavarsym;
        fvs: tsym;
        i: longint;
        corrclass: tdef;
        jlclass: tobjectdef;
        encodedtype: tsymstr;
        procload: tnode;
        procdef: tprocdef;
        st: tsymtable;
        pushaddr: boolean;
      begin
        result:=inherited first_proc_to_procvar;
        if assigned(result) then
          exit;
        procdef:=tloadnode(left).procdef;
        procload:=tloadnode(left).left;
        if not assigned(procload) then
          begin
            { nested or regular routine -> figure out whether unit-level or
              nested, and if nested whether it's nested in a method or in a
              regular routine }
            st:=procdef.owner;
            while st.symtabletype=localsymtable do
              st:=st.defowner.owner;
            if st.symtabletype in [objectsymtable,recordsymtable] then
              { nested routine in method -> part of encloding class }
              procload:=cloadvmtaddrnode.create(ctypenode.create(tdef(st.defowner)))
            else
              begin
                { regular procedure/function -> get type representing unit
                  class }
                while not(st.symtabletype in [staticsymtable,globalsymtable]) do
                  st:=st.defowner.owner;
                corrclass:=search_named_unit_globaltype(st.realname^,'__FPC_JVM_MODULE_CLASS_ALIAS$',true).typedef;
                procload:=cloadvmtaddrnode.create(ctypenode.create(tdef(corrclass)));
              end;
          end;
        { todo: support nested procvars }
        if is_nested_pd(procdef) then
          internalerror(2011072607);
        { constructor FpcBaseProcVarType.create(inst: jlobject; const method: unicodestring; const argTypes: array of JLClass); }
        constrparas:=ccallparanode.create(ctypeconvnode.create_explicit(procload,java_jlobject),nil);
        if not assigned(procdef.import_name) then
          constrparas:=ccallparanode.create(cstringconstnode.createstr(procdef.procsym.realname),constrparas)
        else
          constrparas:=ccallparanode.create(cstringconstnode.createstr(procdef.import_name^),constrparas);
        procdefparas:=nil;
        jlclass:=tobjectdef(search_system_type('JLCLASS').typedef);
        { in reverse to make it easier to build the arrayconstructorn }
        for i:=procdef.paras.count-1 downto 0 do
          begin
            pvs:=tparavarsym(procdef.paras[i]);
            { self is is an implicit parameter for normal methods }
            if (vo_is_self in pvs.varoptions) and
               not(po_classmethod in procdef.procoptions) then
              continue;
            { in case of an arraydef, pass by jlclass.forName() to get the classdef
              (could be optimized by adding support to loadvmtaddrnode to also deal
               with arrays, although we'd have to create specific arraydefs for var/
               out/constref parameters }
             pushaddr:=paramanager.push_copyout_param(pvs.varspez,pvs.vardef,procdef.proccalloption);
             if pushaddr or
                (pvs.vardef.typ=arraydef) then
               begin
                 encodedtype:=jvmencodetype(pvs.vardef,false);
                 if pushaddr then
                   encodedtype:='['+encodedtype;
                 replace(encodedtype,'/','.');
                 newpara:=ccallnode.createinternmethod(cloadvmtaddrnode.create(ctypenode.create(jlclass)),'FORNAME',
                   ccallparanode.create(cstringconstnode.createstr(encodedtype),nil));
               end
             else
               begin
                 corrclass:=jvmgetcorrespondingclassdef(pvs.vardef);
                 if pvs.vardef.typ in [orddef,floatdef] then
                   begin
                     { get the class representing the primitive type }
                     fvs:=search_struct_member(tobjectdef(corrclass),'FTYPE');
                     newpara:=nil;
                     if not handle_staticfield_access(fvs,false,newpara) then
                       internalerror(2011072417);
                   end
                 else
                   newpara:=cloadvmtaddrnode.create(ctypenode.create(corrclass));
                 newpara:=ctypeconvnode.create_explicit(newpara,jlclass);
               end;
            procdefparas:=carrayconstructornode.create(newpara,procdefparas);
          end;
        if not assigned(procdefparas) then
          procdefparas:=carrayconstructornode.create(nil,nil);
        constrparas:=ccallparanode.create(procdefparas,constrparas);
        result:=ccallnode.createinternmethod(cloadvmtaddrnode.create(ctypenode.create(tprocvardef(resultdef).classdef)),'CREATE',constrparas);
        { typecast to the procvar type }
        if tprocvardef(resultdef).is_addressonly then
          result:=ctypeconvnode.create_explicit(result,resultdef)
        else
          begin
            result:=ctypeconvnode.create_explicit(result,getpointerdef(resultdef));
            result:=cderefnode.create(result)
          end;
        { reused }
        tloadnode(left).left:=nil;
      end;


    function tjvmtypeconvnode.first_ansistring_to_pchar: tnode;
      var
        ps: tsym;
      begin
        { also called for unicodestring->pwidechar, not supported since we can't
          directly access the characters in java.lang.String }
        if not is_ansistring(left.resultdef) or
           not is_pchar(resultdef) then
          begin
            CGMessage2(type_e_illegal_type_conversion,left.resultdef.typename,resultdef.typename);
            result:=nil;
            exit;
          end;
        ps:=search_struct_member(java_ansistring,'INTERNCHARS');
        if not assigned(ps) or
           (ps.typ<>procsym) then
          internalerror(2011081401);
        { AnsistringClass.internChars is a static class method that will either
          return the internal fdata ansichar array of the string, or an array
          with a single #0 }
        result:=ccallnode.create(ccallparanode.create(left,nil),tprocsym(ps),
          ps.owner,
          cloadvmtaddrnode.create(ctypenode.create(java_ansistring)),[]);
        include(result.flags,nf_isproperty);
        result:=ctypeconvnode.create_explicit(result,resultdef);
        { reused }
        left:=nil;
      end;


{*****************************************************************************
                             SecondTypeConv
*****************************************************************************}

    procedure tjvmtypeconvnode.second_int_to_int;
      var
        ressize,
        leftsize : longint;
      begin
        { insert range check if not explicit conversion }
        if not(nf_explicit in flags) then
          hlcg.g_rangecheck(current_asmdata.CurrAsmList,left.location,left.resultdef,resultdef);

        { is the result size smaller? when typecasting from void
          we always reuse the current location, because there is
          nothing that we can load in a register }
        ressize:=resultdef.size;
        leftsize :=left.resultdef.size;
        if ((ressize<>leftsize) or
            ((left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) and
             (left.location.reference.arrayreftype<>art_none) and
             (is_widechar(left.resultdef)<>is_widechar(resultdef))) or
            is_bitpacked_access(left)) and
           not is_void(left.resultdef) then
          begin
            location_copy(location,left.location);
            { reuse a loc_reference when the newsize is larger than
              than the original and 4 bytes, because all <= 4 byte loads will
              result in a stack slot that occupies 4 bytes.

              Except
                a) for arrays (they use different load instructions for
                   differently sized data types) or symbols (idem)
                b) when going from 4 to 8 bytes, because these are different
                   data types
            }
            if (location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) and
               not assigned(location.reference.symbol) and
               (location.reference.arrayreftype=art_none) and
               (ressize>leftsize) and
               (ressize=4) then
              begin
                location.size:=def_cgsize(resultdef);
                { no adjustment of the offset even though Java is big endian,
                  because the load instruction will remain the same }
              end
            else
              hlcg.location_force_reg(current_asmdata.CurrAsmList,location,left.resultdef,resultdef,false);
          end
        else
          begin
            if ((ressize < sizeof(aint)) and
                (def_cgsize(left.resultdef)<>def_cgsize(resultdef))) or
               (is_widechar(left.resultdef)<>is_widechar(resultdef)) then
              begin
                location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
                location.register:=hlcg.getintregister(current_asmdata.CurrAsmList,resultdef);
                hlcg.a_load_loc_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,left.location,location.register);
              end
            else
              location_copy(location,left.location);
          end;
      end;


    procedure tjvmtypeconvnode.second_cstring_to_pchar;
      var
        hr: treference;
        vs: tstaticvarsym;
      begin
        { don't use is_chararray because it doesn't support special arrays }
        if (left.resultdef.typ<>arraydef) or
           (tarraydef(left.resultdef).elementdef.typ<>orddef) or
           (torddef(tarraydef(left.resultdef).elementdef).ordtype<>uchar) then
          internalerror(2011081304);
        if (tstringconstnode(left).cst_type in [cst_widestring,cst_unicodestring,cst_ansistring]) and
           (tstringconstnode(left).len=0) then
          begin
            if tstringconstnode(left).cst_type=cst_ansistring then
              vs:=tstaticvarsym(systemunit.Find('EMPTYPANSICHAR'))
            else
              vs:=tstaticvarsym(systemunit.Find('EMPTYPWIDECHAR'));
            reference_reset(hr,4);
            hr.symbol:=current_asmdata.RefAsmSymbol(vs.mangledname);
            location_reset(location,LOC_REGISTER,OS_ADDR);
            location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,resultdef);
            hlcg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,vs.vardef,resultdef,hr,location.register);
          end
        else
          location_copy(location,left.location);
      end;


    procedure tjvmtypeconvnode.second_pointer_to_array;
      begin
        { arrays are implicit pointers in Java -> same location }
        location_copy(location,left.location);
      end;


    procedure tjvmtypeconvnode.second_int_to_real;
      var
        srcsize, ressize: longint;

      procedure convertsignedstackloc;
        begin
          case srcsize of
            4:
              case ressize of
                4:
                  current_asmdata.CurrAsmList.concat(taicpu.op_none(a_i2f));
                8:
                  begin
                    current_asmdata.CurrAsmList.concat(taicpu.op_none(a_i2d));
                    thlcgjvm(hlcg).incstack(current_asmdata.CurrAsmList,1);
                  end;
                else
                  internalerror(2011010601);
              end;
            8:
              case ressize of
                4:
                  begin
                    current_asmdata.CurrAsmList.concat(taicpu.op_none(a_l2f));
                    thlcgjvm(hlcg).decstack(current_asmdata.CurrAsmList,1);
                  end;
                8:
                  current_asmdata.CurrAsmList.concat(taicpu.op_none(a_l2d));
                else
                  internalerror(2011010602);
              end;
            else
              internalerror(2011010603);
          end;
        end;

      var
        signeddef : tdef;
        l1 : tasmlabel;

      begin
        srcsize:=left.resultdef.size;
        ressize:=resultdef.size;

        location_reset(location,LOC_FPUREGISTER,def_cgsize(resultdef));
        location.register:=hlcg.getfpuregister(current_asmdata.CurrAsmList,resultdef);

        { first always convert as if it's a signed number }
        thlcgjvm(hlcg).a_load_loc_stack(current_asmdata.CurrAsmList,left.resultdef,left.location);
        convertsignedstackloc;
        if not is_signed(left.resultdef) then
          begin
            { if it was unsigned, add high(cardinal)+1/high(qword)+1 in case
              the signed interpretation is < 0 }
            current_asmdata.getjumplabel(l1);
            if srcsize=4 then
              signeddef:=s32inttype
            else
              signeddef:=s64inttype;
            hlcg.a_cmp_const_loc_label(current_asmdata.CurrAsmList,signeddef,OC_GTE,0,left.location,l1);
            if srcsize=4 then
              thlcgjvm(hlcg).a_loadfpu_const_stack(current_asmdata.CurrAsmList,resultdef,4294967296.0)
            else
              thlcgjvm(hlcg).a_loadfpu_const_stack(current_asmdata.CurrAsmList,resultdef,18446744073709551616.0);
            if ressize=4 then
              current_asmdata.CurrAsmList.concat(taicpu.op_none(a_fadd))
            else
              current_asmdata.CurrAsmList.concat(taicpu.op_none(a_dadd));
            hlcg.a_label(current_asmdata.CurrAsmList,l1);
          end;
        thlcgjvm(hlcg).a_load_stack_reg(current_asmdata.CurrAsmList,resultdef,location.register);
      end;


    procedure tjvmtypeconvnode.second_proc_to_procvar;
      begin
        internalerror(2011072506);
      end;


    procedure tjvmtypeconvnode.second_bool_to_int;
      var
         newsize: tcgsize;
         oldTrueLabel,oldFalseLabel : tasmlabel;
      begin
         oldTrueLabel:=current_procinfo.CurrTrueLabel;
         oldFalseLabel:=current_procinfo.CurrFalseLabel;
         current_asmdata.getjumplabel(current_procinfo.CurrTrueLabel);
         current_asmdata.getjumplabel(current_procinfo.CurrFalseLabel);
         secondpass(left);
         location_copy(location,left.location);
         newsize:=def_cgsize(resultdef);
         { byte(bytebool) or word(wordbool) or longint(longbool) must be }
         { accepted for var parameters and assignments, and must not     }
         { change the ordinal value or value location.                   }
         { htypechk.valid_for_assign ensures that such locations with a  }
         { size<sizeof(register) cannot be LOC_CREGISTER (they otherwise }
         { could be in case of a plain assignment), and LOC_REGISTER can }
         { never be an assignment target. The remaining LOC_REGISTER/    }
         { LOC_CREGISTER locations do have to be sign/zero-extended.     }

         {   -- Note: this does not work for Java and 2/4 byte sized
                      values, because bytebool/wordbool are signed and
                      are stored in 4 byte locations -> will result in
                      "byte" with the value high(cardinal); see remark
                      in second_int_to_int above regarding consequences }
         if not(nf_explicit in flags) or
            (location.loc in [LOC_FLAGS,LOC_JUMP]) or
            ((newsize<>left.location.size) and
             ((left.resultdef.size<>resultdef.size) or
              not(left.resultdef.size in [4,8]))
            ) then
           hlcg.location_force_reg(current_asmdata.CurrAsmList,location,left.resultdef,resultdef,true)
         else
           { may differ in sign, e.g. bytebool -> byte   }
           location.size:=newsize;
         current_procinfo.CurrTrueLabel:=oldTrueLabel;
         current_procinfo.CurrFalseLabel:=oldFalseLabel;
      end;


    procedure tjvmtypeconvnode.second_int_to_bool;
      var
        hlabel1,hlabel2,oldTrueLabel,oldFalseLabel : tasmlabel;
        newsize  : tcgsize;
      begin
        oldTrueLabel:=current_procinfo.CurrTrueLabel;
        oldFalseLabel:=current_procinfo.CurrFalseLabel;
        current_asmdata.getjumplabel(current_procinfo.CurrTrueLabel);
        current_asmdata.getjumplabel(current_procinfo.CurrFalseLabel);
        secondpass(left);
        if codegenerror then
          exit;

        { Explicit typecasts from any ordinal type to a boolean type }
        { must not change the ordinal value                          }
        { Exception: Android verifier... }
        if (nf_explicit in flags) and
           not(left.location.loc in [LOC_FLAGS,LOC_JUMP]) and
           not(current_settings.cputype=cpu_dalvik) then
          begin
             location_copy(location,left.location);
             newsize:=def_cgsize(resultdef);
             { change of size? change sign only if location is LOC_(C)REGISTER? Then we have to sign/zero-extend }
             if (tcgsize2size[newsize]<>tcgsize2size[left.location.size]) or
                ((newsize<>left.location.size) and (location.loc in [LOC_REGISTER,LOC_CREGISTER])) then
               hlcg.location_force_reg(current_asmdata.CurrAsmList,location,left.resultdef,resultdef,true)
             else
               location.size:=newsize;
             current_procinfo.CurrTrueLabel:=oldTrueLabel;
             current_procinfo.CurrFalseLabel:=oldFalseLabel;
             exit;
          end;

       location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
       location.register:=hlcg.getintregister(current_asmdata.CurrAsmList,resultdef);
       current_asmdata.getjumplabel(hlabel2);
       case left.location.loc of
         LOC_CREFERENCE,LOC_REFERENCE,LOC_REGISTER,LOC_CREGISTER:
           begin
             current_asmdata.getjumplabel(hlabel1);
             hlcg.a_cmp_const_loc_label(current_asmdata.CurrAsmList,left.resultdef,OC_EQ,0,left.location,hlabel1);
           end;
         LOC_JUMP :
           begin
             hlabel1:=current_procinfo.CurrFalseLabel;
             hlcg.a_label(current_asmdata.CurrAsmList,current_procinfo.CurrTrueLabel);
           end;
         else
           internalerror(10062);
       end;

       if not(is_cbool(resultdef)) then
         thlcgjvm(hlcg).a_load_const_stack(current_asmdata.CurrAsmList,resultdef,1,R_INTREGISTER)
       else
         thlcgjvm(hlcg).a_load_const_stack(current_asmdata.CurrAsmList,resultdef,-1,R_INTREGISTER);
       { we jump over the next constant load -> they don't appear on the
         stack simulataneously }
       thlcgjvm(hlcg).decstack(current_asmdata.CurrAsmList,1);
       hlcg.a_jmp_always(current_asmdata.CurrAsmList,hlabel2);
       hlcg.a_label(current_asmdata.CurrAsmList,hlabel1);
       thlcgjvm(hlcg).a_load_const_stack(current_asmdata.CurrAsmList,resultdef,0,R_INTREGISTER);
       hlcg.a_label(current_asmdata.CurrAsmList,hlabel2);
       thlcgjvm(hlcg).a_load_stack_reg(current_asmdata.CurrAsmList,resultdef,location.register);

       current_procinfo.CurrTrueLabel:=oldTrueLabel;
       current_procinfo.CurrFalseLabel:=oldFalseLabel;
     end;


    procedure tjvmtypeconvnode.second_elem_to_openarray;
      var
        primitivetype: boolean;
        opc: tasmop;
        mangledname: string;
        basereg: tregister;
        arrayref: treference;
      begin
        { create an array with one element of the required type }
        thlcgjvm(hlcg).a_load_const_stack(current_asmdata.CurrAsmList,s32inttype,1,R_INTREGISTER);
        mangledname:=jvmarrtype(left.resultdef,primitivetype);
        if primitivetype then
          opc:=a_newarray
        else
          opc:=a_anewarray;
        { doesn't change stack height: one int replaced by one reference }
        current_asmdata.CurrAsmList.concat(taicpu.op_sym(opc,current_asmdata.RefAsmSymbol(mangledname)));
        { store the data in the newly created array }
        basereg:=hlcg.getaddressregister(current_asmdata.CurrAsmList,java_jlobject);
        thlcgjvm(hlcg).a_load_stack_reg(current_asmdata.CurrAsmList,java_jlobject,basereg);
        reference_reset_base(arrayref,basereg,0,4);
        arrayref.arrayreftype:=art_indexconst;
        arrayref.indexoffset:=0;
        hlcg.a_load_loc_ref(current_asmdata.CurrAsmList,left.resultdef,left.resultdef,left.location,arrayref);
        location_reset_ref(location,LOC_REFERENCE,OS_ADDR,4);
        tg.gethltemp(current_asmdata.CurrAsmList,java_jlobject,4,tt_normal,location.reference);
        hlcg.a_load_reg_ref(current_asmdata.CurrAsmList,java_jlobject,java_jlobject,basereg,location.reference);
      end;


    procedure get_most_nested_types(var fromdef, todef: tdef);
      begin
       while is_dynamic_array(fromdef) and
             is_dynamic_array(todef) do
         begin
           fromdef:=tarraydef(fromdef).elementdef;
           todef:=tarraydef(todef).elementdef;
         end;
       fromdef:=maybe_find_real_class_definition(fromdef,false);
       todef:=maybe_find_real_class_definition(todef,false);
      end;


    function tjvmtypeconvnode.do_target_specific_explicit_typeconv(check_only: boolean; out resnode: tnode): boolean;

      { handle explicit typecast from int to to real or vice versa }
      function int_real_explicit_typecast(fdef: tfloatdef; const singlemethod, doublemethod: string): tnode;
        var
          csym: ttypesym;
          psym: tsym;
        begin
         { use the float/double to raw bits methods to get the bit pattern }
          if fdef.floattype=s32real then
            begin
              csym:=search_system_type('JLFLOAT');
              psym:=search_struct_member(tobjectdef(csym.typedef),singlemethod);
            end
          else
            begin
              csym:=search_system_type('JLDOUBLE');
              psym:=search_struct_member(tobjectdef(csym.typedef),doublemethod);
            end;
          if not assigned(psym) or
             (psym.typ<>procsym) then
            internalerror(2011012901);
          { call the (static class) method to get the raw bits }
          result:=ccallnode.create(ccallparanode.create(left,nil),
            tprocsym(psym),psym.owner,
            cloadvmtaddrnode.create(ctypenode.create(csym.typedef)),[]);
          { convert the result to the result type of this type conversion node }
          inserttypeconv_explicit(result,resultdef);
          { left is reused }
          left:=nil;
        end;

      function ord_enum_explicit_typecast(fdef: torddef; todef: tenumdef): tnode;
        var
          psym: tsym;
        begin
          { we only create a class for the basedefs }
          todef:=todef.getbasedef;
          psym:=search_struct_member(todef.classdef,'FPCVALUEOF');
          if not assigned(psym) or
             (psym.typ<>procsym) then
            internalerror(2011062601);
          result:=ccallnode.create(ccallparanode.create(left,nil),
            tprocsym(psym),psym.owner,
            cloadvmtaddrnode.create(ctypenode.create(todef.classdef)),[]);
          { convert the result to the result type of this type conversion node }
          inserttypeconv_explicit(result,resultdef);
          { left is reused }
          left:=nil;
        end;

      function enum_ord_explicit_typecast(fdef: tenumdef; todef: torddef): tnode;
        var
          psym: tsym;
        begin
          { we only create a class for the basedef }
          fdef:=fdef.getbasedef;
          psym:=search_struct_member(fdef.classdef,'FPCORDINAL');
          if not assigned(psym) or
             (psym.typ<>procsym) then
            internalerror(2011062602);
          result:=ccallnode.create(nil,tprocsym(psym),psym.owner,left,[]);
          { convert the result to the result type of this type conversion node }
          inserttypeconv_explicit(result,resultdef);
          { left is reused }
          left:=nil;
        end;

      function from_set_explicit_typecast: tnode;
        var
          helpername: string;
          setconvdef: tdef;
        begin
         if tsetdef(left.resultdef).elementdef.typ=enumdef then
           begin
             setconvdef:=java_juenumset;
             helpername:='fpc_enumset_to_'
           end
         else
           begin
             setconvdef:=java_jubitset;
             helpername:='fpc_bitset_to_'
           end;
         if left.resultdef.size<=4 then
           helpername:=helpername+'int'
         else
           helpername:=helpername+'long';
          result:=ccallnode.createintern(helpername,ccallparanode.create(
            genintconstnode(left.resultdef.size),ccallparanode.create(genintconstnode(tsetdef(left.resultdef).setbase),
            ccallparanode.create(ctypeconvnode.create_explicit(left,setconvdef),nil))));
          left:=nil;
        end;

      function to_set_explicit_typecast: tnode;
        var
          enumclassdef: tobjectdef;
          mp: tnode;
          helpername: string;
        begin
          if tsetdef(resultdef).elementdef.typ=enumdef then
            begin
              inserttypeconv_explicit(left,s64inttype);
              enumclassdef:=tenumdef(tsetdef(resultdef).elementdef).getbasedef.classdef;
              mp:=cloadvmtaddrnode.create(ctypenode.create(enumclassdef));
              helpername:='fpcLongToEnumSet';
              { enumclass.fpcLongToEnumSet(left,setbase,setsize) }
              result:=ccallnode.createinternmethod(mp,helpername,
                ccallparanode.create(genintconstnode(resultdef.size),
                  ccallparanode.create(genintconstnode(tsetdef(resultdef).setbase),
                    ccallparanode.create(left,nil))));
            end
          else
            begin
              if left.resultdef.size<=4 then
                begin
                  helpername:='fpc_int_to_bitset';
                  inserttypeconv_explicit(left,s32inttype);
                end
              else
                begin
                  helpername:='fpc_long_to_bitset';
                  inserttypeconv_explicit(left,s64inttype);
                end;
              result:=ccallnode.createintern(helpername,
                ccallparanode.create(genintconstnode(resultdef.size),
                  ccallparanode.create(genintconstnode(tsetdef(resultdef).setbase),
                    ccallparanode.create(left,nil))));
            end;
        end;

      function procvar_to_procvar(fromdef, todef: tdef): tnode;
        var
          fsym: tsym;
        begin
          result:=nil;
          if fromdef=todef then
            exit;
          fsym:=tfieldvarsym(search_struct_member(tprocvardef(fromdef).classdef,'METHOD'));
          if not assigned(fsym) or
             (fsym.typ<>fieldvarsym) then
            internalerror(2011072414);
          { can either be a procvar or a procvarclass }
          if fromdef.typ=procvardef then
            begin
              left:=ctypeconvnode.create_explicit(left,tprocvardef(fromdef).classdef);
              include(left.flags,nf_load_procvar);
              typecheckpass(left);
            end;
          result:=csubscriptnode.create(fsym,left);
          { create destination procvartype with info from source }
          result:=ccallnode.createinternmethod(
            cloadvmtaddrnode.create(ctypenode.create(tprocvardef(todef).classdef)),
            'CREATE',ccallparanode.create(result,nil));
          left:=nil;
        end;

      function procvar_to_tmethod(fromdef, todef: tdef): tnode;
        var
          fsym: tsym;
        begin
          { must be procedure-of-object -> implicit pointer type -> get address
            before typecasting to corresponding classdef }
          left:=caddrnode.create_internal(left);
          inserttypeconv_explicit(left,tprocvardef(fromdef).classdef);
          fsym:=tfieldvarsym(search_struct_member(tprocvardef(fromdef).classdef,'METHOD'));
          if not assigned(fsym) or
             (fsym.typ<>fieldvarsym) then
            internalerror(2011072414);
          result:=csubscriptnode.create(fsym,left);
          left:=nil;
        end;

      function tmethod_to_procvar(fromdef, todef: tdef): tnode;
        var
          fsym: tsym;
        begin
          fsym:=tfieldvarsym(search_struct_member(tprocvardef(todef).classdef,'METHOD'));
          if not assigned(fsym) or
             (fsym.typ<>fieldvarsym) then
            internalerror(2011072415);
          result:=ccallnode.createinternmethod(cloadvmtaddrnode.create(ctypenode.create(tprocvardef(todef).classdef)),
            'CREATE',ccallparanode.create(left,nil));
          left:=nil;
        end;

      function ptr_no_typecheck_required(fromdef, todef: tdef): boolean;

        function check_type_equality(def1,def2: tdef): boolean;
          begin
            result:=true;
            if is_ansistring(def1) and
               (def2=java_ansistring) then
              exit;
            if is_wide_or_unicode_string(def1) and
               (def2=java_jlstring) then
              exit;
            if def1.typ=pointerdef then
              begin
                if is_shortstring(tpointerdef(def1).pointeddef) and
                   (def2=java_shortstring) then
                  exit;
                { pointer-to-set to JUEnumSet/JUBitSet }
                if (tpointerdef(def1).pointeddef.typ=setdef) then
                  begin
                    if not assigned(tsetdef(tpointerdef(def1).pointeddef).elementdef) then
                      begin
                        if (def2=java_jubitset) or
                           (def2=java_juenumset) then
                          exit;
                      end
                    else if tsetdef(tpointerdef(def1).pointeddef).elementdef.typ=enumdef then
                      begin
                        if def2=java_juenumset then
                          exit;
                      end
                    else if def2=java_jubitset then
                      exit;
                  end;
              end;
            result:=false;
          end;

        function check_array_type_equality(def1,def2: tdef): boolean;
          begin
            result:=true;
            if is_shortstring(def1) and
               (def2=java_shortstring) then
              exit;
            result:=false;
          end;

        begin
          result:=true;
          { check procvar conversion compatibility via their classes }
          if fromdef.typ=procvardef then
            fromdef:=tprocvardef(fromdef).classdef;
          if todef.typ=procvardef then
            todef:=tprocvardef(todef).classdef;
          if (todef=java_jlobject) or
             (todef=voidpointertype) then
            exit;
          if compare_defs(fromdef,todef,nothingn)>=te_equal then
            exit;
          { trecorddef.is_related() must work for inheritance/method checking,
            but do not allow records to be directly typecasted into class/
            pointer types (you have to use FpcBaseRecordType(@rec) instead) }
          if not is_record(fromdef) and
             fromdef.is_related(todef) then
            exit;
          if check_type_equality(fromdef,todef) then
            exit;
          if check_type_equality(todef,fromdef) then
            exit;
          if (fromdef.typ=pointerdef) and
             (tpointerdef(fromdef).pointeddef.typ=recorddef) and
             (todef=java_fpcbaserecordtype) then
            exit;
          { all classrefs are currently java.lang.Class at the bytecode level }
          if (fromdef.typ=classrefdef) and
             (todef.typ=objectdef) and
             (todef=search_system_type('JLCLASS').typedef) then
            exit;
          if (fromdef.typ=classrefdef) and
             (todef.typ=classrefdef) and
             tclassrefdef(fromdef).pointeddef.is_related(tclassrefdef(todef).pointeddef) then
            exit;
          { special case: "array of shortstring" to "array of ShortstringClass"
            and "array of <record>" to "array of FpcRecordBaseType" (normally
            you have to use ShortstringClass(@shortstrvar) etc, but that's not
            possible in case of passing arrays to e.g. setlength) }
          if is_dynamic_array(left.resultdef) and
             is_dynamic_array(resultdef) then
            begin
             if check_array_type_equality(fromdef,todef) or
                check_array_type_equality(todef,fromdef) then
               exit;
             if is_record(fromdef) and
                (todef=java_fpcbaserecordtype) then
               exit;
            end;
          result:=false;
        end;

      var
        fromclasscompatible,
        toclasscompatible: boolean;
        fromdef,
        todef: tdef;
        fromarrtype,
        toarrtype: char;
      begin
        resnode:=nil;
        if not(convtype in [tc_equal,tc_int_2_int,tc_int_2_bool,tc_bool_2_int,tc_class_2_intf]) or
           ((convtype in [tc_equal,tc_int_2_int,tc_bool_2_int,tc_int_2_bool]) and
            ((left.resultdef.typ=orddef) and
             (resultdef.typ=orddef))) then
          begin
            result:=false;
            exit
          end;
        { This routine is only called for explicit typeconversions of same-sized
          entities that aren't handled by normal type conversions -> bit pattern
          reinterpretations. In the JVM, many of these also need special
          handling because of the type safety. }

        { don't allow conversions between object-based and non-object-based
          types }
        fromclasscompatible:=
          (left.resultdef.typ=formaldef) or
          (left.resultdef.typ=pointerdef) or
          is_java_class_or_interface(left.resultdef) or
          is_dynamic_array(left.resultdef) or
          ((left.resultdef.typ in [stringdef,classrefdef]) and
           not is_shortstring(left.resultdef)) or
          (left.resultdef.typ=enumdef) or
          { procvar2procvar needs special handling }
          ((left.resultdef.typ=procvardef) and
           tprocvardef(left.resultdef).is_addressonly and
           (resultdef.typ<>procvardef));
        toclasscompatible:=
          (resultdef.typ=pointerdef) or
          is_java_class_or_interface(resultdef) or
          is_dynamic_array(resultdef) or
          ((resultdef.typ in [stringdef,classrefdef]) and
           not is_shortstring(resultdef)) or
          (resultdef.typ=enumdef) or
          ((resultdef.typ=procvardef) and
           tprocvardef(resultdef).is_addressonly);
        { typescasts from void (the result of untyped_ptr^) to an implicit
          pointertype (record, array, ...) also needs a typecheck }
        if is_void(left.resultdef) and
           jvmimplicitpointertype(resultdef) then
          begin
            fromclasscompatible:=true;
            toclasscompatible:=true;
          end;

        if fromclasscompatible and toclasscompatible then
          begin
            { we need an as-node to check the validity of the conversion (since
              it wasn't handled by another type conversion, we know it can't
              have been valid normally)

              Exceptions: (most nested) destination is
                * java.lang.Object, since everything is compatible with that type
                * related to source
                * a primitive that are represented by the same type in Java
                  (e.g., byte and shortint) }

            { in case of arrays, check the compatibility of the innermost types }
            fromdef:=left.resultdef;
            todef:=resultdef;
            get_most_nested_types(fromdef,todef);
            { in case of enums, get the equivalent class definitions }
            if (fromdef.typ=enumdef) then
              fromdef:=tenumdef(fromdef).getbasedef;
            if (todef.typ=enumdef) then
              todef:=tenumdef(todef).getbasedef;
            fromarrtype:=jvmarrtype_setlength(fromdef);
            toarrtype:=jvmarrtype_setlength(todef);
            if not ptr_no_typecheck_required(fromdef,todef) then
              begin
                if (fromarrtype in ['A','R','T','E','L','P']) or
                   (fromarrtype<>toarrtype) then
                  begin
                    if not check_only and
                       not assignment_side then
                      begin
                        resnode:=ctypenode.create(resultdef);
                        if resultdef.typ=objectdef then
                          resnode:=cloadvmtaddrnode.create(resnode);
                        resnode:=casnode.create_internal(left,resnode);
                        if resultdef.typ=classrefdef then
                          tjvmasnode(resnode).classreftypecast:=true;
                        left:=nil;
                      end
                  end
                { typecasting from a child to a parent type on the assignment side
                  will (rightly) mess up the type safety verification of the JVM }
                else if assignment_side then
                  CGMessage(type_e_no_managed_assign_generic_typecast);
              end;
            result:=true;
            exit;
          end;

        { a formaldef can be converted to anything, but not on the assignment
          side }
        if (left.resultdef.typ=formaldef) and
           not assignment_side then
          begin
            if resultdef.typ in [orddef,floatdef] then
              begin
                if not check_only then
                  begin
                    resnode:=cinlinenode.create(in_unbox_x_y,false,
                      ccallparanode.create(ctypenode.create(resultdef),
                        ccallparanode.create(left,nil)));
                    left:=nil;
                  end;
                result:=true;
                exit;
              end
            else if jvmimplicitpointertype(resultdef) then
              begin
                { typecast formaldef to pointer to the type, then deref, so that
                  a proper checkcast is inserted }
                if not check_only then
                  begin
                    resnode:=ctypeconvnode.create_explicit(left,getpointerdef(resultdef));
                    resnode:=cderefnode.create(resnode);
                    left:=nil;
                  end;
                result:=true;
                exit;
              end;
            result:=false;
            exit;
          end;

        { procvar to tmethod and vice versa, and procvar to procvar }
        if isvalidprocvartypeconv(left.resultdef,resultdef) then
          begin
            if not check_only then
              begin
                if (left.resultdef.typ=procvardef) and
                   (resultdef.typ=procvardef) then
                  resnode:=procvar_to_procvar(left.resultdef,resultdef)
                else if left.resultdef.typ=procvardef then
                  resnode:=procvar_to_tmethod(left.resultdef,resultdef)
                else
                  resnode:=tmethod_to_procvar(left.resultdef,resultdef);
              end;
            result:=true;
            exit;
          end;

        { don't allow conversions between different classes of primitive types,
          except for a few special cases }

        { float to int/enum explicit type conversion: get the bits }
        if (left.resultdef.typ=floatdef) and
           (is_integer(resultdef) or
            (resultdef.typ=enumdef)) then
          begin
            if not check_only then
              resnode:=int_real_explicit_typecast(tfloatdef(left.resultdef),'FLOATTORAWINTBITS','DOUBLETORAWLONGBITS');
            result:=true;
            exit;
          end;
        { int to float explicit type conversion: also use the bits }
        if (is_integer(left.resultdef) or
            (left.resultdef.typ=enumdef)) and
           (resultdef.typ=floatdef) then
          begin
            if not check_only then
              begin
                if (left.resultdef.typ=enumdef) then
                  inserttypeconv_explicit(left,s32inttype);
                resnode:=int_real_explicit_typecast(tfloatdef(resultdef),'INTBITSTOFLOAT','LONGBITSTODOUBLE');
              end;
            result:=true;
            exit;
          end;

        { enums }
        if (left.resultdef.typ=enumdef) or
           (resultdef.typ=enumdef) then
          begin
            { both enum? }
           if (resultdef.typ=left.resultdef.typ) then
             begin
               { same base type -> nothing special }
               fromdef:=tenumdef(left.resultdef).getbasedef;
               todef:=tenumdef(resultdef).getbasedef;
               if fromdef=todef then
                 begin
                   result:=false;
                   exit;
                 end;
               { convert via ordinal intermediate }
               if not check_only then
                 begin;
                   inserttypeconv_explicit(left,s32inttype);
                   inserttypeconv_explicit(left,resultdef);
                   resnode:=left;
                   left:=nil
                 end;
               result:=true;
               exit;
             end;
           { enum to orddef & vice versa }
           if left.resultdef.typ=orddef then
             begin
               if not check_only then
                 resnode:=ord_enum_explicit_typecast(torddef(left.resultdef),tenumdef(resultdef));
               result:=true;
               exit;
             end
           else if resultdef.typ=orddef then
             begin
               if not check_only then
                 resnode:=enum_ord_explicit_typecast(tenumdef(left.resultdef),torddef(resultdef));
               result:=true;
               exit;
             end
          end;

        { sets }
        if (left.resultdef.typ=setdef) or
           (resultdef.typ=setdef) then
          begin
            { set -> ord/enum/other-set-type }
            if (resultdef.typ in [orddef,enumdef]) then
              begin
                if not check_only then
                  begin
                    resnode:=from_set_explicit_typecast;
                    { convert to desired result }
                    inserttypeconv_explicit(resnode,resultdef);
                  end;
                result:=true;
                exit;
              end
            { ord/enum -> set }
            else if (left.resultdef.typ in [orddef,enumdef]) then
              begin
                if not check_only then
                  begin
                    resnode:=to_set_explicit_typecast;
                    { convert to desired result }
                    inserttypeconv_explicit(resnode,getpointerdef(resultdef));
                    resnode:=cderefnode.create(resnode);
                  end;
                result:=true;
                exit;
              end;
            { if someone needs it, float->set and set->float explicit typecasts
              could also be added (cannot be handled by the above, because
              float(intvalue) will convert rather than re-interpret the value) }
          end;

        { anything not explicitly handled is a problem }
        result:=true;
        CGMessage2(type_e_illegal_type_conversion,left.resultdef.typename,resultdef.typename);
      end;


    function tjvmtypeconvnode.target_specific_explicit_typeconv: boolean;
      var
        dummyres: tnode;
      begin
        result:=do_target_specific_explicit_typeconv(true,dummyres);
      end;



    function tjvmtypeconvnode.target_specific_general_typeconv: boolean;
      begin
        result:=false;
        { on the JVM platform, enums can always be converted to class instances,
          because enums /are/ class instances there. To prevent the
          typechecking/conversion code from assuming it can treat it like any
          ordinal constant, firstpass() it so that the ordinal constant gets
          replaced with a load of a staticvarsym. This is not done in
          pass_typecheck, because that would prevent many optimizations }
        if (left.nodetype=ordconstn) and
           (left.resultdef.typ=enumdef) and
           (resultdef.typ=objectdef) then
          firstpass(left);
      end;


    {*****************************************************************************
                         AsNode and IsNode common helpers
    *****************************************************************************}

  function asis_target_specific_typecheck(node: tasisnode): boolean;
    var
      realtodef: tdef;
      temp: tnode;
    begin
      { the JVM supports loadvmtaddrnodes for interface types, but the generic
        as/is code doesn't -> convert such loadvmtaddrnodes back to plain
        type nodes here (they only make sense in the context of treating them
        as entities loaded to store into e.g. a JLClass) }
      if (node.right.resultdef.typ=classrefdef) and
         is_javainterface(tclassrefdef(node.right.resultdef).pointeddef) and
         (node.right.nodetype=loadvmtaddrn) and
         (tloadvmtaddrnode(node.right).left.nodetype=typen) then
        begin
          temp:=tloadvmtaddrnode(node.right).left;
          tloadvmtaddrnode(node.right).left:=nil;
          node.right.free;
          node.right:=temp;
        end;

      if not(nf_internal in node.flags) then
        begin
          { handle using normal code }
          result:=false;
          exit;
        end;
      result:=true;
      { these are converted type conversion nodes, to insert the checkcast
        operations }
      realtodef:=node.right.resultdef;
      if (realtodef.typ=classrefdef) and
         ((node.nodetype<>asn) or
          not tjvmasnode(node).classreftypecast) then
        realtodef:=tclassrefdef(realtodef).pointeddef;
      realtodef:=maybe_find_real_class_definition(realtodef,false);
      if result then
        if node.nodetype=asn then
          node.resultdef:=realtodef
        else
          node.resultdef:=pasbool8type;
    end;


  function asis_pass_1(node: tasisnode; const methodname: string): tnode;
    var
      ps: tsym;
      call: tnode;
      jlclass: tobjectdef;
    begin
      result:=nil;
      firstpass(node.left);
      if not(node.right.nodetype in [typen,loadvmtaddrn]) then
        begin
          if (node.nodetype=isn) or
             not assigned(tasnode(node).call) then
            begin
              if not is_javaclassref(node.right.resultdef) then
                internalerror(2011041920);
              firstpass(node.right);
              jlclass:=tobjectdef(search_system_type('JLCLASS').typedef);
              ps:=search_struct_member(jlclass,methodname);
              if not assigned(ps) or
                 (ps.typ<>procsym) then
                internalerror(2011041910);
              call:=ccallnode.create(ccallparanode.create(node.left,nil),tprocsym(ps),ps.owner,ctypeconvnode.create_explicit(node.right,jlclass),[]);
              node.left:=nil;
              node.right:=nil;
              firstpass(call);
              if codegenerror then
                exit;
              if node.nodetype=isn then
                result:=call
              else
                begin
                  tasnode(node).call:=call;
                  node.expectloc:=call.expectloc;
                end;
            end;
        end
      else
        begin
          node.expectloc:=LOC_REGISTER;
          result:=nil;
        end;
    end;


  function asis_generate_code(node: tasisnode; opcode: tasmop): boolean;
    var
      checkdef: tdef;
    begin
      if (node.nodetype=asn) and
         assigned(tasnode(node).call) then
        begin
          result:=false;
          exit;
        end;
      result:=true;
      secondpass(node.left);
      thlcgjvm(hlcg).a_load_loc_stack(current_asmdata.CurrAsmList,node.left.resultdef,node.left.location);
      location_freetemp(current_asmdata.CurrAsmList,node.left.location);
      { Perform a checkcast instruction, which will raise an exception in case
        the actual type does not match/inherit from the expected type.

        Object types need the full type name (package+class name), arrays only
        the array definition }
      if node.nodetype=asn then
        checkdef:=node.resultdef
      else if node.right.resultdef.typ=classrefdef then
        checkdef:=tclassrefdef(node.right.resultdef).pointeddef
      else
        checkdef:=node.right.resultdef;
      thlcgjvm(hlcg).gen_typecheck(current_asmdata.CurrAsmList,opcode,checkdef);
      location_reset(node.location,LOC_REGISTER,OS_ADDR);
      node.location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,node.resultdef);
      thlcgjvm(hlcg).a_load_stack_reg(current_asmdata.CurrAsmList,node.resultdef,node.location.register);
    end;

    {*****************************************************************************
                                 TJVMAsNode
    *****************************************************************************}

  function tjvmasnode.target_specific_typecheck: boolean;
    begin
      result:=asis_target_specific_typecheck(self);
    end;


  function tjvmasnode.pass_1: tnode;
    begin
      result:=asis_pass_1(self,'CAST');
    end;


  procedure tjvmasnode.pass_generate_code;
    begin
      if not asis_generate_code(self,a_checkcast) then
        inherited;
    end;


  function tjvmasnode.dogetcopy: tnode;
    begin
      result:=inherited dogetcopy;
      tjvmasnode(result).classreftypecast:=classreftypecast;
    end;


  function tjvmasnode.docompare(p: tnode): boolean;
    begin
      result:=
        inherited docompare(p) and
        (tjvmasnode(p).classreftypecast=classreftypecast);
    end;


  constructor tjvmasnode.ppuload(t: tnodetype; ppufile: tcompilerppufile);
    begin
      inherited;
      classreftypecast:=boolean(ppufile.getbyte);
    end;


  procedure tjvmasnode.ppuwrite(ppufile: tcompilerppufile);
    begin
      inherited ppuwrite(ppufile);
      ppufile.putbyte(byte(classreftypecast));
    end;


  {*****************************************************************************
                               TJVMIsNode
  *****************************************************************************}


  function tjvmisnode.target_specific_typecheck: boolean;
    begin
      result:=asis_target_specific_typecheck(self);
    end;


  function tjvmisnode.pass_1: tnode;
    begin
      result:=asis_pass_1(self,'ISINSTANCE');
    end;


  procedure tjvmisnode.pass_generate_code;
    begin
      if not asis_generate_code(self,a_instanceof) then
        inherited;
    end;




begin
  ctypeconvnode:=tjvmtypeconvnode;
  casnode:=tjvmasnode;
  cisnode:=tjvmisnode;
end.