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

* implemented declaring and calling constructors for Java classes

Browse Source 
o handle them like for regular classes (return a class instance,
     although this is technically not true since they don't return
     anything; will be changed in the future)
   o because of the previous point, make sure that we handle the
     "function result" properly and don't pop too many values from
     the evaluation stack when calling one constructor from another
   o added "extra_pre_call_code" method used by njvmcal to insert
     the "new" opcode to create the new class instance before
     calling a constructor
   o when a constructor does not call any other constructor (inherited
     or otherwise), automatically insert a call to the inherited
     parameterless constructor as required by the jvm standard)
   TODO: check that *if* an inherited or other constructor is called
     from another constructor, that it does so as the first statement/
     call

git-svn-id: branches/jvmbackend@18328 -
This commit is contained in:
Jonas Maebe 2011-08-20 07:46:37 +00:00
parent e2e32fbbe9
commit eb5814a868
9 changed files with 111 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
compiler/jvm/hlcgcpu.pas
View File

@ -81,6 +81,7 @@ uses
procedure g_proc_entry(list : TAsmList;localsize : longint;nostackframe:boolean); override;
procedure g_proc_exit(list : TAsmList;parasize:longint;nostackframe:boolean); override;
procedure gen_load_return_value(list:TAsmList);override;
procedure record_generated_code_for_procdef(pd: tprocdef; code, data: TAsmList); override;
{ JVM-specific routines }
@ -788,11 +789,16 @@ implementation
procedure thlcgjvm.g_proc_exit(list: TAsmList; parasize: longint; nostackframe: boolean);
var
retdef: tdef;
opc: tasmop;
begin
case current_procinfo.procdef.returndef.typ of
if current_procinfo.procdef.proctypeoption=potype_constructor then
retdef:=voidtype
else
retdef:=current_procinfo.procdef.returndef;
case retdef.typ of
orddef:
case torddef(current_procinfo.procdef.returndef).ordtype of
case torddef(retdef).ordtype of
uvoid:
opc:=a_return;
s64bit,
@ -803,7 +809,7 @@ implementation
opc:=a_ireturn;
end;
floatdef:
case tfloatdef(current_procinfo.procdef.returndef).floattype of
case tfloatdef(retdef).floattype of
s32real:
opc:=a_freturn;
s64real:
@ -817,6 +823,14 @@ implementation
list.concat(taicpu.op_none(opc));
end;
procedure thlcgjvm.gen_load_return_value(list: TAsmList);
begin
{ constructors don't return anything in the jvm }
if current_procinfo.procdef.proctypeoption=potype_constructor then
exit;
inherited gen_load_return_value(list);
end;
procedure thlcgjvm.record_generated_code_for_procdef(pd: tprocdef; code, data: TAsmList);
begin
{ add something to the al_procedures list as well, because if all al_*

37
compiler/jvm/njvmcal.pas
View File

@ -35,6 +35,7 @@ interface
tjvmcallnode = class(tcgcallnode)
protected
procedure extra_pre_call_code; override;
procedure set_result_location(realresdef: tstoreddef); override;
procedure do_release_unused_return_value;override;
procedure extra_post_call_code; override;
@ -45,16 +46,37 @@ implementation
uses
verbose,globtype,
symtype,defutil,ncal,
cgbase,cgutils,tgobj,
symconst,symtype,defutil,ncal,
cgbase,cgutils,tgobj,procinfo,
cpubase,aasmdata,aasmcpu,
hlcgobj,hlcgcpu;
hlcgobj,hlcgcpu,
jvmdef;
{*****************************************************************************
TJVMCALLNODE
*****************************************************************************}
procedure tjvmcallnode.extra_pre_call_code;
begin
{ when calling a constructor, first create a new instance, except
when calling it from another constructor (because then this has
already been done before calling the current constructor) }
if procdefinition.typ<>procdef then
exit;
if tprocdef(procdefinition).proctypeoption<>potype_constructor then
exit;
if (methodpointer.resultdef.typ<>classrefdef) then
exit;
current_asmdata.CurrAsmList.concat(taicpu.op_sym(a_new,current_asmdata.RefAsmSymbol(tobjectdef(tprocdef(procdefinition).owner.defowner).jvm_full_typename)));
{ the constructor doesn't return anything, so put a duplicate of the
self pointer on the evaluation stack for use as function result
after the constructor has run }
current_asmdata.CurrAsmList.concat(taicpu.op_none(a_dup));
thlcgjvm(hlcg).incstack(2);
end;
procedure tjvmcallnode.set_result_location(realresdef: tstoreddef);
begin
location_reset_ref(location,LOC_REFERENCE,def_cgsize(realresdef),1);
@ -64,6 +86,9 @@ implementation
procedure tjvmcallnode.do_release_unused_return_value;
begin
if (tprocdef(procdefinition).proctypeoption=potype_constructor) and
(current_procinfo.procdef.proctypeoption=potype_constructor) then
exit;
case resultdef.size of
0:
;
@ -92,7 +117,11 @@ implementation
realresdef:=tstoreddef(resultdef)
else
realresdef:=tstoreddef(typedef);
totalremovesize:=pushedparasize-realresdef.size;
{ a constructor doesn't actually return a value in the jvm }
if (tprocdef(procdefinition).proctypeoption=potype_constructor) then
totalremovesize:=pushedparasize
else
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

16
compiler/ncal.pas
View File

@ -1670,7 +1670,12 @@ implementation
{ push 0 as self when allocation is needed }
if (methodpointer.resultdef.typ=classrefdef) or
(cnf_new_call in callnodeflags) then
selftree:=cpointerconstnode.create(0,voidpointertype)
if not is_javaclass(tdef(procdefinition.owner.defowner)) then
selftree:=cpointerconstnode.create(0,voidpointertype)
else
{ special handling for Java constructors, handled in
tjvmcallnode.extra_pre_call_code }
selftree:=cnothingnode.create
else
begin
if methodpointer.nodetype=typen then
@ -3340,6 +3345,15 @@ implementation
doinlinesimplify(tnode(callcleanupblock));
end;
{ If a constructor calls another constructor of the same or of an
inherited class, some targets (jvm) have to generate different
entry code for the constructor. }
if (current_procinfo.procdef.proctypeoption=potype_constructor) and
(procdefinition.typ=procdef) and
(tprocdef(procdefinition).proctypeoption=potype_constructor) and
([cnf_member_call,cnf_inherited] * callnodeflags <> []) then
current_procinfo.ConstructorCallingConstructor:=true;
{ Continue with checking a normal call or generate the inlined code }
if cnf_do_inline in callnodeflags then
result:=pass1_inline

8
compiler/ncgcal.pas
View File

@ -68,6 +68,7 @@ interface
}
procedure pop_parasize(pop_size:longint);virtual;
procedure extra_interrupt_code;virtual;
procedure extra_pre_call_code;virtual;
procedure extra_call_code;virtual;
procedure extra_post_call_code;virtual;
procedure do_syscall;virtual;abstract;
@ -285,6 +286,11 @@ implementation
end;
procedure tcgcallnode.extra_pre_call_code;
begin
end;
procedure tcgcallnode.extra_call_code;
begin
end;
@ -650,6 +656,8 @@ implementation
not(procdefinition.has_paraloc_info in [callerside,callbothsides]) then
internalerror(200305264);
extra_pre_call_code;
if assigned(callinitblock) then
secondpass(tnode(callinitblock));

4
compiler/pdecobj.pas
View File

@ -102,7 +102,9 @@ implementation
include(current_structdef.objectoptions,oo_has_constructor);
{ Set return type, class and record constructors return the
created instance, object constructors return boolean }
if is_class(pd.struct) or is_record(pd.struct) then
if is_class(pd.struct) or
is_record(pd.struct) or
is_javaclass(pd.struct) then
pd.returndef:=pd.struct
else
{$ifdef CPU64bitaddr}

8
compiler/pdecsub.pas
View File

@ -1402,7 +1402,9 @@ implementation
begin
{ Set return type, class constructors return the
created instance, object constructors return boolean }
if is_class(pd.struct) or is_record(pd.struct) then
if is_class(pd.struct) or
is_record(pd.struct) or
is_javaclass(pd.struct) then
pd.returndef:=pd.struct
else
{$ifdef CPU64bitaddr}
@ -2377,7 +2379,7 @@ const
mutexclpo : []
),(
idtok:_OVERLOAD;
pd_flags : [pd_implemen,pd_interface,pd_body];
pd_flags : [pd_implemen,pd_interface,pd_body,pd_javaclass,pd_intfjava];
handler : @pd_overload;
pocall : pocall_none;
pooption : [po_overload];
@ -2386,7 +2388,7 @@ const
mutexclpo : []
),(
idtok:_OVERRIDE;
pd_flags : [pd_interface,pd_object,pd_notobjintf,pd_objcclass,pd_javaclass,pd_notrecord];
pd_flags : [pd_interface,pd_object,pd_notobjintf,pd_objcclass,pd_javaclass,pd_intfjava,pd_notrecord];
handler : @pd_override;
pocall : pocall_none;
pooption : [po_overridingmethod,po_virtualmethod];

7
compiler/pexpr.pas
View File

@ -1257,7 +1257,9 @@ implementation
else
begin
p1:=ctypenode.create(ttypesym(sym).typedef);
if (is_class(ttypesym(sym).typedef) or is_objcclass(ttypesym(sym).typedef)) and
if (is_class(ttypesym(sym).typedef) or
is_objcclass(ttypesym(sym).typedef) or
is_javaclass(ttypesym(sym).typedef)) and
not(block_type in [bt_type,bt_const_type,bt_var_type]) then
p1:=cloadvmtaddrnode.create(p1);
end;
@ -1553,7 +1555,8 @@ implementation
(for "TClassHelper.Something") }
{ class reference ? }
if is_class(hdef) or
is_objcclass(hdef) then
is_objcclass(hdef) or
is_javaclass(hdef) then
begin
if getaddr and (token=_POINT) then
begin

5
compiler/procinfo.pas
View File

@ -114,6 +114,11 @@ unit procinfo;
{ max. of space need for parameters }
maxpushedparasize : aint;
{ is this a constructor that calls another constructor on itself
(either inherited, or another constructor of the same class)?
Requires different entry code for some targets. }
ConstructorCallingConstructor: boolean;
constructor create(aparent:tprocinfo);virtual;
destructor destroy;override;

20
compiler/psub.pas
View File

@ -292,6 +292,7 @@ implementation
var
srsym : tsym;
para : tcallparanode;
call : tcallnode;
newstatement : tstatementnode;
begin
result:=internalstatements(newstatement);
@ -350,6 +351,25 @@ implementation
voidpointertype),
ccallnode.createintern('fpc_help_constructor',para)));
end
else
if is_javaclass(current_structdef) then
begin
if (current_procinfo.procdef.proctypeoption=potype_constructor) and
not current_procinfo.ConstructorCallingConstructor then
begin
{ call inherited constructor }
srsym:=search_struct_member(tobjectdef(current_structdef).childof,'CREATE');
if assigned(srsym) and
(srsym.typ=procsym) then
begin
call:=ccallnode.create(nil,tprocsym(srsym),srsym.owner,load_self_node,[cnf_inherited]);
exclude(tcallnode(call).callnodeflags,cnf_return_value_used);
addstatement(newstatement,call);
end
else
internalerror(2011010312);
end;
end
else
if not is_record(current_structdef) then
internalerror(200305103);