+ limited thlcg.gen_load_cgpara_loc() implementation (only loc_reference

    support), passed through to original ncgutils version in thlcg2ll
  + thlcgobj.location_force_mem() implementation
  * order parameters for jvm similar to those for i386 without fixed_stack,
    so we don't need temporary paralocations
  * converted most of ncgcal to thlcg
  * disabled special handling for virtual methods for jvm in ncgcal, as all
    invocations are name-based there
  + njvmcal with special jvm callnode support:
   o always move the function result into a memory temp
   o when freeing an unused function result, use a_pop(2) and adjust
     the internal evaluation stack height counter
   o after the call instruction, adjust the evaluation stack height counter
     by subtracting the number of the pushed parameter slots, adjusted for
     the slots taken up by the function result

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

.gitattributes

@@ -218,6 +218,7 @@ compiler/jvm/cputarg.pas svneol=native#text/plain
 compiler/jvm/hlcgcpu.pas svneol=native#text/plain
 compiler/jvm/itcpujas.pas svneol=native#text/plain
 compiler/jvm/jvmreg.dat svneol=native#text/plain
+compiler/jvm/njvmcal.pas svneol=native#text/plain
 compiler/jvm/rgcpu.pas svneol=native#text/plain
 compiler/jvm/rjvmcon.inc svneol=native#text/plain
 compiler/jvm/rjvmnor.inc svneol=native#text/plain

compiler/hlcg2ll.pas

@@ -395,6 +395,7 @@ unit hlcg2ll;
           procedure maketojumpbool(list:TAsmList; p : tnode);override;
 
           procedure gen_load_loc_cgpara(list: TAsmList; vardef: tdef; const l: tlocation; const cgpara: tcgpara); override;
+          procedure gen_load_cgpara_loc(list: TAsmList; vardef: tdef; const para: TCGPara; var destloc: tlocation; reusepara: boolean); override;
        end;
 
 
@@ -1167,4 +1168,9 @@ procedure thlcg2ll.a_loadaddr_ref_reg(list: TAsmList; fromsize, tosize: tdef; co
       ncgutil.gen_load_loc_cgpara(list,vardef,l,cgpara);
     end;
 
+  procedure thlcg2ll.gen_load_cgpara_loc(list: TAsmList; vardef: tdef; const para: TCGPara; var destloc: tlocation; reusepara: boolean);
+    begin
+      ncgutil.gen_load_cgpara_loc(list, vardef, para, destloc, reusepara);
+    end;
+
 end.

compiler/hlcgobj.pas

@@ -417,7 +417,7 @@ unit hlcgobj;
 
           procedure location_force_reg(list:TAsmList;var l:tlocation;src_size,dst_size:tdef;maybeconst:boolean);virtual;
           procedure location_force_fpureg(list:TAsmList;var l: tlocation;size: tdef;maybeconst:boolean);virtual;abstract;
-          procedure location_force_mem(list:TAsmList;var l:tlocation;size:tdef);virtual;abstract;
+          procedure location_force_mem(list:TAsmList;var l:tlocation;size:tdef);virtual;
 //          procedure location_force_mmregscalar(list:TAsmList;var l: tlocation;size:tdef;maybeconst:boolean);virtual;abstract;
 //          procedure location_force_mmreg(list:TAsmList;var l: tlocation;size:tdef;maybeconst:boolean);virtual;abstract;
 
@@ -437,6 +437,9 @@ unit hlcgobj;
           { load a tlocation into a cgpara }
           procedure gen_load_loc_cgpara(list: TAsmList; vardef: tdef; const l: tlocation; const cgpara: tcgpara);virtual;
 
+          { load a cgpara into a tlocation }
+          procedure gen_load_cgpara_loc(list: TAsmList; vardef: tdef; const para: TCGPara; var destloc: tlocation; reusepara: boolean);virtual;
+
           { load the function return value into the ABI-defined function return location }
           procedure gen_load_return_value(list:TAsmList);virtual;
 
@@ -1640,6 +1643,57 @@ implementation
         location_freetemp(list,oldloc);
     end;
 
+  procedure thlcgobj.location_force_mem(list: TAsmList; var l: tlocation; size: tdef);
+    var
+      r : treference;
+    begin
+      case l.loc of
+        LOC_FPUREGISTER,
+        LOC_CFPUREGISTER :
+          begin
+            tg.GetTemp(list,TCGSize2Size[l.size],TCGSize2Size[l.size],tt_normal,r);
+            hlcg.a_loadfpu_reg_ref(list,size,size,l.register,r);
+            location_reset_ref(l,LOC_REFERENCE,l.size,0);
+            l.reference:=r;
+          end;
+(*
+        LOC_MMREGISTER,
+        LOC_CMMREGISTER:
+          begin
+            tg.GetTemp(list,TCGSize2Size[l.size],TCGSize2Size[l.size],tt_normal,r);
+            cg.a_loadmm_reg_ref(list,l.size,l.size,l.register,r,mms_movescalar);
+            location_reset_ref(l,LOC_REFERENCE,l.size,0);
+            l.reference:=r;
+          end;
+*)
+        LOC_CONSTANT,
+        LOC_REGISTER,
+        LOC_CREGISTER :
+          begin
+            tg.GetTemp(list,TCGSize2Size[l.size],TCGSize2Size[l.size],tt_normal,r);
+            hlcg.a_load_loc_ref(list,size,size,l,r);
+            location_reset_ref(l,LOC_REFERENCE,l.size,0);
+            l.reference:=r;
+          end;
+(*
+        LOC_SUBSETREG,
+        LOC_CSUBSETREG,
+        LOC_SUBSETREF,
+        LOC_CSUBSETREF:
+          begin
+            tg.GetTemp(list,TCGSize2Size[l.size],TCGSize2Size[l.size],tt_normal,r);
+            cg.a_load_loc_ref(list,l.size,l,r);
+            location_reset_ref(l,LOC_REFERENCE,l.size,0);
+            l.reference:=r;
+          end;
+*)
+        LOC_CREFERENCE,
+        LOC_REFERENCE : ;
+        else
+          internalerror(2011010304);
+      end;
+    end;
+
   procedure thlcgobj.gen_proc_symbol(list: TAsmList);
     var
       item,
@@ -1825,6 +1879,31 @@ implementation
       end;
     end;
 
+  procedure thlcgobj.gen_load_cgpara_loc(list: TAsmList; vardef: tdef; const para: TCGPara; var destloc: tlocation; reusepara: boolean);
+    var
+      href     : treference;
+    begin
+      para.check_simple_location;
+      { skip e.g. empty records }
+      if (para.location^.loc = LOC_VOID) then
+        exit;
+      case destloc.loc of
+        LOC_REFERENCE :
+          begin
+            { If the parameter location is reused we don't need to copy
+              anything }
+            if not reusepara then
+              begin
+                reference_reset_base(href,para.location^.reference.index,para.location^.reference.offset,para.alignment);
+                a_load_ref_ref(list,para.def,para.def,href,destloc.reference);
+              end;
+          end;
+        { TODO other possible locations }
+        else
+          internalerror(2011010308);
+      end;
+    end;
+
   procedure thlcgobj.gen_load_return_value(list: TAsmList);
     var
       ressym : tabstractnormalvarsym;

compiler/jvm/cpunode.pas

@@ -31,7 +31,8 @@ implementation
 
   uses
     ncgbas,ncgflw,ncgcnv,ncgld,ncgmem,ncgcon,ncgset,
-    ncgadd, ncgcal,ncgmat,ncginl
+    ncgadd, ncgcal,ncgmat,ncginl,
+    njvmcal
 {    ncpuadd,ncpucall,ncpumat,ncpuinln,ncpucnv,ncpuset, }
     { this not really a node }
 {    rgcpu},tgcpu;

compiler/jvm/njvmcal.pas

@@ -0,0 +1,107 @@
+{
+    Copyright (c) 2011 by Jonas Maebe
+
+    JVM-specific code for call 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 njvmcal;
+
+{$i fpcdefs.inc}
+
+interface
+
+    uses
+      symdef,
+      ncgcal;
+
+    type
+
+       { tjvmcallnode }
+
+       tjvmcallnode = class(tcgcallnode)
+        protected
+         procedure set_result_location(realresdef: tstoreddef); override;
+         procedure release_unused_return_value_cpu;override;
+         procedure extra_post_call_code; override;
+       end;
+
+
+implementation
+
+    uses
+      verbose,globtype,
+      symtype,defutil,ncal,
+      cgbase,cgutils,tgobj,
+      cpubase,aasmdata,aasmcpu,
+      hlcgobj,hlcgcpu;
+
+
+{*****************************************************************************
+                             TJVMCALLNODE
+*****************************************************************************}
+
+    procedure tjvmcallnode.set_result_location(realresdef: tstoreddef);
+      begin
+        location_reset_ref(location,LOC_REFERENCE,def_cgsize(realresdef),1);
+        tg.gettemp(current_asmdata.CurrAsmList,realresdef.size,1,tt_normal,location.reference);
+      end;
+
+
+    procedure tjvmcallnode.release_unused_return_value_cpu;
+      begin
+        case resultdef.size of
+          0:
+            ;
+          1..4:
+            begin
+              current_asmdata.CurrAsmList.concat(taicpu.op_none(a_pop));
+              thlcgjvm(hlcg).decstack(1);
+            end;
+          8:
+            begin
+              current_asmdata.CurrAsmList.concat(taicpu.op_none(a_pop2));
+              thlcgjvm(hlcg).decstack(2);
+            end
+          else
+            internalerror(2011010305);
+        end;
+      end;
+
+
+    procedure tjvmcallnode.extra_post_call_code;
+      var
+        totalremovesize: longint;
+        realresdef: tdef;
+      begin
+        if not assigned(typedef) then
+          realresdef:=tstoreddef(resultdef)
+        else
+          realresdef:=tstoreddef(typedef);
+        totalremovesize:=pushedparasize-realresdef.size;
+        { remove parameters from internal evaluation stack counter (in case of
+          e.g. no parameters and a result, it can also increase) }
+        if totalremovesize>0 then
+          thlcgjvm(hlcg).decstack(totalremovesize shr 2)
+        else if totalremovesize<0 then
+          thlcgjvm(hlcg).incstack((-totalremovesize) shr 2);
+      end;
+
+
+begin
+  ccallnode:=tjvmcallnode;
+end.

compiler/ncal.pas

@@ -3155,18 +3155,20 @@ implementation
                               That means the for pushes the para with the
                               highest offset (see para3) needs to be pushed first
                             }
-{$ifdef i386}
-                            { the i386 code generator expects all reference }
-                            { parameter to be in this order so it can use   }
-                            { pushes in case of no fixed stack              }
+{$if defined(i386)}
+                            { the i386 and jvm code generators expect all reference }
+                            { parameters to be in this order so they can use   }
+                            { pushes in case of no fixed stack                 }
                             if (not paramanager.use_fixed_stack and
                                 (hpcurr.parasym.paraloc[callerside].location^.reference.offset>
                                  hp.parasym.paraloc[callerside].location^.reference.offset)) or
                                (paramanager.use_fixed_stack and
                                 (node_complexity(hpcurr)<node_complexity(hp))) then
-{$else i386}
+{$elseif defined(jvm)}
+                            if (hpcurr.parasym.paraloc[callerside].location^.reference.offset<hp.parasym.paraloc[callerside].location^.reference.offset) then
+{$else jvm}
                             if (node_complexity(hpcurr)<node_complexity(hp)) then
-{$endif i386}
+{$endif jvm}
                               break;
                           end;
                         LOC_MMREGISTER,

compiler/ncgcal.pas

@@ -43,6 +43,8 @@ interface
           procedure secondcallparan;override;
        end;
 
+       { tcgcallnode }
+
        tcgcallnode = class(tcallnode)
        private
 
@@ -181,7 +183,7 @@ implementation
                        href,third.location,'FPC_DECREF_ARRAY');
                    end
                  else
-                   cg.g_decrrefcount(current_asmdata.CurrAsmList,left.resultdef,href);
+                   hlcg.g_decrrefcount(current_asmdata.CurrAsmList,left.resultdef,href);
                end;
 
              paramanager.createtempparaloc(current_asmdata.CurrAsmList,aktcallnode.procdefinition.proccalloption,parasym,not followed_by_stack_tainting_call_cached,tempcgpara);
@@ -217,7 +219,7 @@ implementation
                   { allow passing of a constant to a const formaldef }
                   if (parasym.varspez=vs_const) and
                      (left.location.loc in [LOC_CONSTANT,LOC_REGISTER]) then
-                    location_force_mem(current_asmdata.CurrAsmList,left.location);
+                    hlcg.location_force_mem(current_asmdata.CurrAsmList,left.location,left.resultdef);
                   push_addr_para;
                end
              { Normal parameter }
@@ -245,13 +247,13 @@ implementation
                           if (left.location.reference.index<>NR_NO) or
                              (left.location.reference.offset<>0) then
                             internalerror(200410107);
-                          cg.a_load_reg_cgpara(current_asmdata.CurrAsmList,OS_ADDR,left.location.reference.base,tempcgpara)
+                          hlcg.a_load_reg_cgpara(current_asmdata.CurrAsmList,voidpointertype,left.location.reference.base,tempcgpara)
                         end
                       else
                         begin
                           { Force to be in memory }
                           if not(left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) then
-                            location_force_mem(current_asmdata.CurrAsmList,left.location);
+                            hlcg.location_force_mem(current_asmdata.CurrAsmList,left.location,left.resultdef);
                           push_addr_para;
                         end;
                    end
@@ -371,7 +373,7 @@ implementation
             if (cnf_return_value_used in callnodeflags) or
                assigned(funcretnode) then
               begin
-                gen_load_cgpara_loc(current_asmdata.CurrAsmList,realresdef,retloc,location,false);
+                hlcg.gen_load_cgpara_loc(current_asmdata.CurrAsmList,realresdef,retloc,location,false);
 {$ifdef arm}
                 if (resultdef.typ=floatdef) and
                    (location.loc=LOC_REGISTER) and
@@ -412,9 +414,9 @@ implementation
                 begin
                   case funcretnode.location.loc of
                     LOC_REGISTER:
-                      cg.a_load_ref_reg(current_asmdata.CurrAsmList,location.size,location.size,location.reference,funcretnode.location.register);
+                      hlcg.a_load_ref_reg(current_asmdata.CurrAsmList,resultdef,resultdef,location.reference,funcretnode.location.register);
                     LOC_REFERENCE:
-                      cg.g_concatcopy(current_asmdata.CurrAsmList,location.reference,funcretnode.location.reference,resultdef.size);
+                      hlcg.g_concatcopy(current_asmdata.CurrAsmList,resultdef,location.reference,funcretnode.location.reference);
                     else
                       internalerror(200802121);
                   end;
@@ -439,7 +441,7 @@ implementation
               LOC_REFERENCE :
                 begin
                   if is_managed_type(resultdef) then
-                     cg.g_finalize(current_asmdata.CurrAsmList,resultdef,location.reference);
+                     hlcg.g_finalize(current_asmdata.CurrAsmList,resultdef,location.reference);
                    tg.ungetiftemp(current_asmdata.CurrAsmList,location.reference);
                 end;
               else
@@ -719,6 +721,8 @@ implementation
              name_to_call:='';
              if assigned(fobjcforcedprocname) then
                name_to_call:=fobjcforcedprocname^;
+             { in the JVM, virtual method calls are also name-based }
+{$ifndef jvm}
              { When methodpointer is typen we don't need (and can't) load
                a pointer. We can directly call the correct procdef (PFV) }
              if (name_to_call='') and
@@ -788,6 +792,7 @@ implementation
                  extra_post_call_code;
                end
              else
+{$endif jvm}
                begin
                   { Load parameters that are in temporary registers in the
                     correct parameter register }
@@ -814,9 +819,12 @@ implementation
                         extra_interrupt_code;
                       extra_call_code;
                       if (name_to_call='') then
-                        cg.a_call_name(current_asmdata.CurrAsmList,tprocdef(procdefinition).mangledname(false),po_weakexternal in procdefinition.procoptions)
+                        if cnf_inherited in callnodeflags then
+                          hlcg.a_call_name_inherited(current_asmdata.CurrAsmList,tprocdef(procdefinition),tprocdef(procdefinition).mangledname(false))
+                        else
+                          hlcg.a_call_name(current_asmdata.CurrAsmList,tprocdef(procdefinition),tprocdef(procdefinition).mangledname(false),po_weakexternal in procdefinition.procoptions)
                       else
-                        cg.a_call_name(current_asmdata.CurrAsmList,name_to_call,po_weakexternal in procdefinition.procoptions);
+                        hlcg.a_call_name(current_asmdata.CurrAsmList,tprocdef(procdefinition),name_to_call,po_weakexternal in procdefinition.procoptions);
                       extra_post_call_code;
                     end;
                end;