paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-29 15:20:32 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ stubbed formal const/var/out support

Browse Source 
git-svn-id: branches/jvmbackend@18552 -
This commit is contained in:
Jonas Maebe 2011-08-20 08:09:45 +00:00
parent d7e78b9f95
commit 58d7a86252
1 changed files with 57 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

66
compiler/jvm/njvmcal.pas
View File

@ -27,7 +27,7 @@ interface
uses uses
cgbase, cgbase,
symdef, symtype,symdef,
ncgcal; ncgcal;
type type
@ -35,7 +35,10 @@ interface
tjvmcallparanode = class(tcgcallparanode) tjvmcallparanode = class(tcgcallparanode)
protected protected
outcopybasereg: tregister; outcopybasereg: tregister;
procedure push_formal_para; override;
procedure push_copyout_para; override; procedure push_copyout_para; override;
procedure load_arrayref_para(useparadef: tdef);
end; end;
{ tjvmcallnode } { tjvmcallnode }
@ -53,7 +56,7 @@ implementation
uses uses
verbose,globtype, verbose,globtype,
symconst,symtype,defutil,ncal, symconst,defutil,ncal,
cgutils,tgobj,procinfo, cgutils,tgobj,procinfo,
cpubase,aasmdata,aasmcpu, cpubase,aasmdata,aasmcpu,
hlcgobj,hlcgcpu, hlcgobj,hlcgcpu,
@ -64,23 +67,11 @@ implementation
TJVMCALLPARANODE TJVMCALLPARANODE
*****************************************************************************} *****************************************************************************}
procedure tjvmcallparanode.push_copyout_para; procedure tjvmcallparanode.load_arrayref_para(useparadef: tdef);
var var
mangledname: string;
primitivetype: boolean;
opc: tasmop;
arrayloc: tlocation; arrayloc: tlocation;
arrayref: treference; arrayref: treference;
begin begin
{ create an array with one element of the parameter 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)));
{ cannot be a regular array or record, because those are passed by { cannot be a regular array or record, because those are passed by
plain reference (since they are reference types at the Java level, plain reference (since they are reference types at the Java level,
but not at the Pascal level) -> no special initialisation necessary } but not at the Pascal level) -> no special initialisation necessary }
@ -93,7 +84,7 @@ implementation
out-parameter; if it's an out-parameter the contents must be nil out-parameter; if it's an out-parameter the contents must be nil
but that's already ok, since the anewarray opcode takes care of that } but that's already ok, since the anewarray opcode takes care of that }
if (parasym.varspez<>vs_out) then if (parasym.varspez<>vs_out) then
hlcg.a_load_loc_ref(current_asmdata.CurrAsmList,left.resultdef,left.resultdef,left.location,arrayref); hlcg.a_load_loc_ref(current_asmdata.CurrAsmList,useparadef,useparadef,left.location,arrayref);
{ store the array reference into the parameter location (don't change { store the array reference into the parameter location (don't change
left.location, we may need it for copy-back after the call) } left.location, we may need it for copy-back after the call) }
@ -103,6 +94,37 @@ implementation
end; end;
procedure tjvmcallparanode.push_formal_para;
var
primitivetype: boolean;
begin
{ create an array with one element of JLObject }
thlcgjvm(hlcg).a_load_const_stack(current_asmdata.CurrAsmList,s32inttype,1,R_INTREGISTER);
{ left is either an object-derived type, or has been boxed into one }
current_asmdata.CurrAsmList.concat(taicpu.op_sym(a_anewarray,current_asmdata.RefAsmSymbol(jvmarrtype(java_jlobject,primitivetype))));
load_arrayref_para(java_jlobject);
end;
procedure tjvmcallparanode.push_copyout_para;
var
mangledname: string;
primitivetype: boolean;
opc: tasmop;
begin
{ create an array with one element of the parameter 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)));
load_arrayref_para(left.resultdef);
end;
{***************************************************************************** {*****************************************************************************
TJVMCALLNODE TJVMCALLNODE
*****************************************************************************} *****************************************************************************}
@ -207,6 +229,8 @@ implementation
pararef.base:=ppn.outcopybasereg; pararef.base:=ppn.outcopybasereg;
pararef.indexoffset:=0; pararef.indexoffset:=0;
{ the value has to be copied back into persistent storage } { the value has to be copied back into persistent storage }
if (ppn.parasym.vardef.typ<>formaldef) then
begin
case ppn.left.location.loc of case ppn.left.location.loc of
LOC_REFERENCE: LOC_REFERENCE:
hlcg.a_load_ref_ref(current_asmdata.CurrAsmList,ppn.left.resultdef,ppn.left.resultdef,pararef,ppn.left.location.reference); hlcg.a_load_ref_ref(current_asmdata.CurrAsmList,ppn.left.resultdef,ppn.left.resultdef,pararef,ppn.left.location.reference);
@ -215,6 +239,16 @@ implementation
else else
internalerror(2011051201); internalerror(2011051201);
end; end;
end
else
begin
{$ifndef nounsupported}
{ to do: extract value from boxed parameter or load
value back }
{$else}
internalerror(2011051901);
{$endif}
end;
end; end;
end; end;
ppn:=tjvmcallparanode(ppn.right); ppn:=tjvmcallparanode(ppn.right);