+ added interface to ncgutil.gen_load_loc_cgpara() to hlcgobj + generic

    implementation (without loc_©mmregister support)
  * moved ncgutil.gen_load_return_value() to hlcgobj, and factored out
    architecture-specific behaviour to load an uninitialised function result
    into a virtual method (+ JVM-specific implementation of that method),
    gen_load_uninitialized_function_result()
  + added hlcgx86 unit and thlcgx86 type to override the
    thlcgobj.gen_load_uninitialized_function_result() method for x87
    function results; the i386 and x86_64 units now instantiate thlcgx86
    instead of thlcg2ll
  * moved calling of ncgutil.gen_load_loc_cgpara() from ncgcal also to hlcgobj
  -> returning function results works for JVM

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

.gitattributes

@@ -652,6 +652,7 @@ compiler/x86/agx86nsm.pas svneol=native#text/plain
 compiler/x86/cga.pas svneol=native#text/plain
 compiler/x86/cgx86.pas svneol=native#text/plain
 compiler/x86/cpubase.pas svneol=native#text/plain
+compiler/x86/hlcgx86.pas svneol=native#text/plain
 compiler/x86/itcpugas.pas svneol=native#text/plain
 compiler/x86/itx86int.pas svneol=native#text/plain
 compiler/x86/nx86add.pas svneol=native#text/plain

compiler/hlcg2ll.pas

@@ -393,6 +393,8 @@ unit hlcg2ll;
 //          procedure location_force_mmreg(list:TAsmList;var l: tlocation;size:tdef;maybeconst:boolean);override;
 
           procedure maketojumpbool(list:TAsmList; p : tnode);override;
+
+          procedure gen_load_loc_cgpara(list: TAsmList; vardef: tdef; const l: tlocation; const cgpara: tcgpara); override;
        end;
 
 
@@ -1160,4 +1162,9 @@ procedure thlcg2ll.a_loadaddr_ref_reg(list: TAsmList; fromsize, tosize: tdef; co
       ncgutil.maketojumpbool(list,p,lr_dont_load_regvars);
     end;
 
+  procedure thlcg2ll.gen_load_loc_cgpara(list: TAsmList; vardef: tdef; const l: tlocation; const cgpara: tcgpara);
+    begin
+      ncgutil.gen_load_loc_cgpara(list,vardef,l,cgpara);
+    end;
+
 end.

compiler/hlcgobj.pas

@@ -426,6 +426,20 @@ unit hlcgobj;
           procedure gen_proc_symbol(list:TAsmList);virtual;
           procedure gen_proc_symbol_end(list:TAsmList);virtual;
 
+         private
+          procedure gen_loadfpu_loc_cgpara(list: TAsmList; size: tdef; const l: tlocation;const cgpara: tcgpara;locintsize: longint);virtual;
+         protected
+          { Some targets have to put "something" in the function result
+            location if it's not initialised by the Pascal code, e.g.
+            stack-based architectures. By default it does nothing }
+          procedure gen_load_uninitialized_function_result(list: TAsmList; pd: tprocdef; resdef: tdef; const resloc: tcgpara);virtual;
+         public
+          { load a tlocation into a cgpara }
+          procedure gen_load_loc_cgpara(list: TAsmList; vardef: tdef; const l: tlocation; const cgpara: tcgpara);virtual;
+
+          { load the function return value into the ABI-defined function return location }
+          procedure gen_load_return_value(list:TAsmList);virtual;
+
           { extras refactored from other units }
 
           { queue the code/data generated for a procedure for writing out to
@@ -1688,6 +1702,161 @@ implementation
         end;
     end;
 
+  procedure thlcgobj.gen_loadfpu_loc_cgpara(list: TAsmList; size: tdef; const l: tlocation; const cgpara: tcgpara; locintsize: longint);
+    begin
+      case l.loc of
+(*
+        LOC_MMREGISTER,
+        LOC_CMMREGISTER:
+          case cgpara.location^.loc of
+            LOC_REFERENCE,
+            LOC_CREFERENCE,
+            LOC_MMREGISTER,
+            LOC_CMMREGISTER,
+            LOC_REGISTER,
+            LOC_CREGISTER :
+              cg.a_loadmm_reg_cgpara(list,locsize,l.register,cgpara,mms_movescalar);
+            LOC_FPUREGISTER,
+            LOC_CFPUREGISTER:
+              begin
+                tmploc:=l;
+                location_force_fpureg(list,tmploc,false);
+                cg.a_loadfpu_reg_cgpara(list,tmploc.size,tmploc.register,cgpara);
+              end;
+            else
+              internalerror(200204249);
+          end;
+*)
+        LOC_FPUREGISTER,
+        LOC_CFPUREGISTER:
+          case cgpara.location^.loc of
+(*
+            LOC_MMREGISTER,
+            LOC_CMMREGISTER:
+              begin
+                tmploc:=l;
+                location_force_mmregscalar(list,tmploc,false);
+                cg.a_loadmm_reg_cgpara(list,tmploc.size,tmploc.register,cgpara,mms_movescalar);
+              end;
+*)
+            { Some targets pass floats in normal registers }
+            LOC_REGISTER,
+            LOC_CREGISTER,
+            LOC_REFERENCE,
+            LOC_CREFERENCE,
+            LOC_FPUREGISTER,
+            LOC_CFPUREGISTER:
+              hlcg.a_loadfpu_reg_cgpara(list,size,l.register,cgpara);
+            else
+              internalerror(2011010210);
+          end;
+        LOC_REFERENCE,
+        LOC_CREFERENCE:
+          case cgpara.location^.loc of
+(*
+            LOC_MMREGISTER,
+            LOC_CMMREGISTER:
+              cg.a_loadmm_ref_cgpara(list,locsize,l.reference,cgpara,mms_movescalar);
+*)
+            { Some targets pass floats in normal registers }
+            LOC_REGISTER,
+            LOC_CREGISTER,
+            LOC_REFERENCE,
+            LOC_CREFERENCE,
+            LOC_FPUREGISTER,
+            LOC_CFPUREGISTER:
+              hlcg.a_loadfpu_ref_cgpara(list,size,l.reference,cgpara);
+            else
+              internalerror(2011010211);
+          end;
+        LOC_REGISTER,
+        LOC_CREGISTER :
+          hlcg.a_load_loc_cgpara(list,size,l,cgpara);
+         else
+           internalerror(2011010212);
+      end;
+    end;
+
+  procedure thlcgobj.gen_load_uninitialized_function_result(list: TAsmList; pd: tprocdef; resdef: tdef; const resloc: tcgpara);
+    begin
+      { do nothing by default }
+    end;
+
+  procedure thlcgobj.gen_load_loc_cgpara(list: TAsmList; vardef: tdef; const l: tlocation; const cgpara: tcgpara);
+    begin
+      { Handle Floating point types differently
+
+        This doesn't depend on emulator settings, emulator settings should
+        be handled by cpupara }
+      if (vardef.typ=floatdef) or
+         { some ABIs return certain records in an fpu register }
+         (l.loc in [LOC_FPUREGISTER,LOC_CFPUREGISTER]) or
+         (assigned(cgpara.location) and
+          (cgpara.Location^.loc in [LOC_FPUREGISTER,LOC_CFPUREGISTER])) then
+        begin
+          gen_loadfpu_loc_cgpara(list,vardef,l,cgpara,vardef.size);
+          exit;
+        end;
+
+      case l.loc of
+        LOC_CONSTANT,
+        LOC_REGISTER,
+        LOC_CREGISTER,
+        LOC_REFERENCE,
+        LOC_CREFERENCE :
+          begin
+            hlcg.a_load_loc_cgpara(list,vardef,l,cgpara);
+          end;
+(*
+        LOC_MMREGISTER,
+        LOC_CMMREGISTER:
+          begin
+            case l.size of
+              OS_F32,
+              OS_F64:
+                cg.a_loadmm_loc_cgpara(list,l,cgpara,mms_movescalar);
+              else
+                cg.a_loadmm_loc_cgpara(list,l,cgpara,nil);
+            end;
+          end;
+*)
+        else
+          internalerror(2011010212);
+      end;
+    end;
+
+  procedure thlcgobj.gen_load_return_value(list: TAsmList);
+    var
+      ressym : tabstractnormalvarsym;
+      funcretloc : TCGPara;
+    begin
+      { Is the loading needed? }
+      if is_void(current_procinfo.procdef.returndef) or
+         (
+          (po_assembler in current_procinfo.procdef.procoptions) and
+          (not(assigned(current_procinfo.procdef.funcretsym)) or
+           (tabstractvarsym(current_procinfo.procdef.funcretsym).refs=0))
+         ) then
+         exit;
+
+      funcretloc:=current_procinfo.procdef.funcretloc[calleeside];
+
+      { constructors return self }
+      if (current_procinfo.procdef.proctypeoption=potype_constructor) then
+        ressym:=tabstractnormalvarsym(current_procinfo.procdef.parast.Find('self'))
+      else
+        ressym:=tabstractnormalvarsym(current_procinfo.procdef.funcretsym);
+      if (ressym.refs>0) or
+         is_managed_type(ressym.vardef) then
+        begin
+          { was: don't do anything if funcretloc.loc in [LOC_INVALID,LOC_REFERENCE] }
+          if not paramanager.ret_in_param(current_procinfo.procdef.returndef,current_procinfo.procdef.proccalloption) then
+            hlcg.gen_load_loc_cgpara(list,ressym.vardef,ressym.localloc,funcretloc);
+        end
+      else
+        gen_load_uninitialized_function_result(list,current_procinfo.procdef,ressym.vardef,funcretloc)
+    end;
+
   procedure thlcgobj.record_generated_code_for_procdef(pd: tprocdef; code, data: TAsmList);
     begin
       { add the procedure to the al_procedures }

compiler/i386/hlcgcpu.pas

@@ -33,12 +33,12 @@ interface
 implementation
 
   uses
-    hlcgobj, hlcg2ll,
+    hlcgobj, hlcgx86,
     cgcpu;
 
   procedure create_hlcodegen;
     begin
-      hlcg:=thlcg2ll.create;
+      hlcg:=thlcgx86.create;
       create_codegen;
     end;
 

compiler/jvm/hlcgcpu.pas

@@ -30,7 +30,7 @@ uses
   globtype,
   aasmbase,aasmdata,
   symtype,symdef,
-  cpubase, hlcgobj, cgbase, cgutils;
+  cpubase, hlcgobj, cgbase, cgutils, parabase;
 
   type
 
@@ -120,6 +120,8 @@ uses
       property maxevalstackheight: longint read fmaxevalstackheight;
 
      protected
+      procedure gen_load_uninitialized_function_result(list: TAsmList; pd: tprocdef; resdef: tdef; const resloc: tcgpara); override;
+
       { in case of an array, the array base address and index have to be
         put on the evaluation stack before the stored value; similarly, for
         fields the self pointer has to be loaded first. Also checks whether
@@ -158,7 +160,7 @@ implementation
     defutil,
     aasmtai,aasmcpu,
     symconst,
-    cgcpu;
+    procinfo,cgcpu;
 
   const
     TOpCG2IAsmOp : array[topcg] of TAsmOp=(                       { not = xor -1 }
@@ -469,6 +471,30 @@ implementation
           resize_stack_int_val(list,OS_S32,def_cgsize(size),false);
       end;
 
+  procedure thlcgjvm.gen_load_uninitialized_function_result(list: TAsmList; pd: tprocdef; resdef: tdef; const resloc: tcgpara);
+    begin
+      { constructors don't return anything in Java }
+      if pd.proctypeoption=potype_constructor then
+        exit;
+      { must return a value of the correct type on the evaluation stack }
+      case def2regtyp(resdef) of
+        R_INTREGISTER,
+        R_ADDRESSREGISTER:
+          a_load_const_cgpara(list,resdef,0,resloc);
+        R_FPUREGISTER:
+          case tfloatdef(resdef).floattype of
+            s32real:
+             list.concat(taicpu.op_none(a_fconst_0));
+            s64real:
+             list.concat(taicpu.op_none(a_dconst_0));
+            else
+              internalerror(2011010302);
+          end
+        else
+          internalerror(2011010301);
+      end;
+    end;
+
   function thlcgjvm.prepare_stack_for_ref(list: TAsmList; const ref: treference; dup: boolean): longint;
     var
       href: treference;
@@ -761,10 +787,34 @@ implementation
     end;
 
   procedure thlcgjvm.g_proc_exit(list: TAsmList; parasize: longint; nostackframe: boolean);
+    var
+      opc: tasmop;
     begin
-      // TODO: must be made part of returning the result, because ret opcode
-      // depends on that
-      list.concat(taicpu.op_none(a_return));
+      case current_procinfo.procdef.returndef.typ of
+        orddef:
+          case torddef(current_procinfo.procdef.returndef).ordtype of
+            uvoid:
+              opc:=a_return;
+            s64bit,
+            u64bit,
+            scurrency:
+              opc:=a_lreturn;
+            else
+              opc:=a_ireturn;
+          end;
+        floatdef:
+          case tfloatdef(current_procinfo.procdef.returndef).floattype of
+            s32real:
+              opc:=a_freturn;
+            s64real:
+              opc:=a_dreturn;
+            else
+              internalerror(2011010213);
+          end;
+        else
+          opc:=a_areturn;
+      end;
+      list.concat(taicpu.op_none(opc));
     end;
 
   procedure thlcgjvm.record_generated_code_for_procdef(pd: tprocdef; code, data: TAsmList);

compiler/ncgcal.pas

@@ -95,7 +95,7 @@ implementation
       cga,cgx86,aasmcpu,
 {$endif x86}
       ncgutil,
-      cgobj,tgobj,
+      cgobj,tgobj,hlcgobj,
       procinfo,
       wpobase;
 
@@ -134,10 +134,10 @@ implementation
 
         { Move flags and jump in register to make it less complex }
         if left.location.loc in [LOC_FLAGS,LOC_JUMP,LOC_SUBSETREG,LOC_CSUBSETREG,LOC_SUBSETREF,LOC_CSUBSETREF] then
-          location_force_reg(current_asmdata.CurrAsmList,left.location,def_cgsize(left.resultdef),false);
+          hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,false);
 
         { load the parameter's tlocation into its cgpara }
-        gen_load_loc_cgpara(current_asmdata.CurrAsmList,left.resultdef,left.location,tempcgpara)
+        hlcg.gen_load_loc_cgpara(current_asmdata.CurrAsmList,left.resultdef,left.location,tempcgpara)
       end;
 
 

compiler/ncgutil.pas

@@ -98,7 +98,6 @@ interface
     procedure gen_entry_code(list:TAsmList);
     procedure gen_exit_code(list:TAsmList);
     procedure gen_load_para_value(list:TAsmList);
-    procedure gen_load_return_value(list:TAsmList);
 
     procedure gen_external_stub(list:TAsmList;pd:tprocdef;const externalname:string);
     procedure gen_intf_wrappers(list:TAsmList;st:TSymtable;nested:boolean);
@@ -1764,46 +1763,6 @@ implementation
       end;
 
 
-    procedure gen_load_return_value(list:TAsmList);
-      var
-        ressym : tabstractnormalvarsym;
-        funcretloc : TCGPara;
-      begin
-        { Is the loading needed? }
-        if is_void(current_procinfo.procdef.returndef) or
-           (
-            (po_assembler in current_procinfo.procdef.procoptions) and
-            (not(assigned(current_procinfo.procdef.funcretsym)) or
-             (tabstractvarsym(current_procinfo.procdef.funcretsym).refs=0))
-           ) then
-           exit;
-
-        funcretloc:=current_procinfo.procdef.funcretloc[calleeside];
-
-        { constructors return self }
-        if (current_procinfo.procdef.proctypeoption=potype_constructor) then
-          ressym:=tabstractnormalvarsym(current_procinfo.procdef.parast.Find('self'))
-        else
-          ressym:=tabstractnormalvarsym(current_procinfo.procdef.funcretsym);
-        if (ressym.refs>0) or
-           is_managed_type(ressym.vardef) then
-          begin
-            { was: don't do anything if funcretloc.loc in [LOC_INVALID,LOC_REFERENCE] }
-            if not paramanager.ret_in_param(current_procinfo.procdef.returndef,current_procinfo.procdef.proccalloption) then
-              gen_load_loc_cgpara(list,ressym.vardef,ressym.localloc,funcretloc);
-          end
-{$ifdef x86}
-         else
-          begin
-            { the caller will pop a value from the fpu stack }
-            if assigned(funcretloc.location) and
-               (funcretloc.location^.loc = LOC_FPUREGISTER) then
-              list.concat(taicpu.op_none(A_FLDZ));
-          end;
-{$endif x86}
-      end;
-
-
     procedure gen_alloc_regloc(list:TAsmList;var loc: tlocation);
       begin
         case loc.loc of

compiler/psub.pas

@@ -1116,7 +1116,7 @@ implementation
             { add code that will load the return value, this is not done
               for assembler routines when they didn't reference the result
               variable }
-            gen_load_return_value(templist);
+            hlcg.gen_load_return_value(templist);
             aktproccode.concatlist(templist);
 
             { Already reserve all registers for stack checking code and

compiler/x86/hlcgx86.pas

@@ -0,0 +1,62 @@
+{
+    Copyright (c) 1998-2010 by Florian Klaempfl and Jonas Maebe
+    Member of the Free Pascal development team
+
+    This unit contains routines to create a pass-through high-level code
+    generator. This is used by most regular code generators.
+
+    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 hlcgx86;
+
+interface
+
+{$i fpcdefs.inc}
+
+  uses
+    aasmdata,
+    symtype,symdef,
+    parabase,
+    hlcgobj, hlcg2ll;
+
+  type
+
+    { thlcgx86 }
+
+    thlcgx86 = class(thlcg2ll)
+     protected
+      procedure gen_load_uninitialized_function_result(list: TAsmList; pd: tprocdef; resdef: tdef; const resloc: tcgpara); override;
+    end;
+
+implementation
+
+  uses
+    cgbase,
+    cpubase,aasmcpu;
+
+{ thlcgx86 }
+
+  procedure thlcgx86.gen_load_uninitialized_function_result(list: TAsmList; pd: tprocdef; resdef: tdef; const resloc: tcgpara);
+    begin
+      { the caller will pop a value from the fpu stack }
+      if assigned(resloc.location) and
+         (resloc.location^.loc=LOC_FPUREGISTER) then
+        list.concat(taicpu.op_none(A_FLDZ));
+    end;
+
+end.

compiler/x86_64/hlcgcpu.pas

@@ -33,12 +33,12 @@ interface
 implementation
 
   uses
-    hlcgobj, hlcg2ll,
+    hlcgobj, hlcgx86,
     cgcpu;
 
   procedure create_hlcodegen;
     begin
-      hlcg:=thlcg2ll.create;
+      hlcg:=thlcgx86.create;
       create_codegen;
     end;