paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-11 23:30:29 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ limited thlcg.gen_load_cgpara_loc() implementation (only loc_reference

Browse Source 
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 -
This commit is contained in:
Jonas Maebe 2011-08-20 07:46:22 +00:00
parent c17d022a87
commit 9a9ea1f257
7 changed files with 222 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -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

6
compiler/hlcg2ll.pas
View File

@ -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.

81
compiler/hlcgobj.pas
View File

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

3
compiler/jvm/cpunode.pas
View File

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

107
compiler/jvm/njvmcal.pas Normal file
View File

@ -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.

14
compiler/ncal.pas
View File

@ -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,

28
compiler/ncgcal.pas
View File

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