paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-20 11:29:26 +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/hlcgcpu.pas svneol=native#text/plain
compiler/jvm/itcpujas.pas svneol=native#text/plain compiler/jvm/itcpujas.pas svneol=native#text/plain
compiler/jvm/jvmreg.dat 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/rgcpu.pas svneol=native#text/plain
compiler/jvm/rjvmcon.inc svneol=native#text/plain compiler/jvm/rjvmcon.inc svneol=native#text/plain
compiler/jvm/rjvmnor.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 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_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; 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); ncgutil.gen_load_loc_cgpara(list,vardef,l,cgpara);
end; 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. 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_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_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_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; // 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 } { load a tlocation into a cgpara }
procedure gen_load_loc_cgpara(list: TAsmList; vardef: tdef; const l: tlocation; const cgpara: tcgpara);virtual; 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 } { load the function return value into the ABI-defined function return location }
procedure gen_load_return_value(list:TAsmList);virtual; procedure gen_load_return_value(list:TAsmList);virtual;
@ -1640,6 +1643,57 @@ implementation
location_freetemp(list,oldloc); location_freetemp(list,oldloc);
end; 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); procedure thlcgobj.gen_proc_symbol(list: TAsmList);
var var
item, item,
@ -1825,6 +1879,31 @@ implementation
end; end;
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); procedure thlcgobj.gen_load_return_value(list: TAsmList);
var var
ressym : tabstractnormalvarsym; ressym : tabstractnormalvarsym;

3
compiler/jvm/cpunode.pas
View File

@ -31,7 +31,8 @@ implementation
uses uses
ncgbas,ncgflw,ncgcnv,ncgld,ncgmem,ncgcon,ncgset, ncgbas,ncgflw,ncgcnv,ncgld,ncgmem,ncgcon,ncgset,
ncgadd, ncgcal,ncgmat,ncginl ncgadd, ncgcal,ncgmat,ncginl,
njvmcal
{ ncpuadd,ncpucall,ncpumat,ncpuinln,ncpucnv,ncpuset, } { ncpuadd,ncpucall,ncpumat,ncpuinln,ncpucnv,ncpuset, }
{ this not really a node } { this not really a node }
{ rgcpu},tgcpu; { 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 That means the for pushes the para with the
highest offset (see para3) needs to be pushed first highest offset (see para3) needs to be pushed first
} }
{$ifdef i386} {$if defined(i386)}
{ the i386 code generator expects all reference } { the i386 and jvm code generators expect all reference }
{ parameter to be in this order so it can use } { parameters to be in this order so they can use }
{ pushes in case of no fixed stack } { pushes in case of no fixed stack }
if (not paramanager.use_fixed_stack and if (not paramanager.use_fixed_stack and
(hpcurr.parasym.paraloc[callerside].location^.reference.offset> (hpcurr.parasym.paraloc[callerside].location^.reference.offset>
hp.parasym.paraloc[callerside].location^.reference.offset)) or hp.parasym.paraloc[callerside].location^.reference.offset)) or
(paramanager.use_fixed_stack and (paramanager.use_fixed_stack and
(node_complexity(hpcurr)<node_complexity(hp))) then (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 if (node_complexity(hpcurr)<node_complexity(hp)) then
{$endif i386} {$endif jvm}
break; break;
end; end;
LOC_MMREGISTER, LOC_MMREGISTER,

28
compiler/ncgcal.pas
View File

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