paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2026-01-07 04:50:53 +01:00
Code Issues Packages Projects Releases Wiki Activity

* moved ifdef'd jvm code from tprocvardef to jvm-specific descendant

Browse Source 
git-svn-id: trunk@27386 -
This commit is contained in:
Jonas Maebe 2014-03-30 17:15:57 +00:00
parent a05b078fa0
commit 11c7d5223c
9 changed files with 83 additions and 67 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
compiler/jvm/hlcgcpu.pas
View File

@ -248,7 +248,7 @@ implementation
verbose,cutils,globals,fmodule,constexp,
defutil,
aasmtai,aasmcpu,
symtable,jvmdef,
symtable,symcpu,jvmdef,
procinfo,cpuinfo,cgcpu,tgobj;
const
@ -1514,7 +1514,7 @@ implementation
begin
if not tprocvardef(size).is_addressonly then
begin
concatcopy_record(list,tprocvardef(size).classdef,source,dest);
concatcopy_record(list,tcpuprocvardef(size).classdef,source,dest);
handled:=true;
end;
end;
@ -2438,7 +2438,7 @@ implementation
checkdef:=java_jubitset;
end
else if checkdef.typ=procvardef then
checkdef:=tprocvardef(checkdef).classdef
checkdef:=tcpuprocvardef(checkdef).classdef
else if is_wide_or_unicode_string(checkdef) then
checkdef:=java_jlstring
else if is_ansistring(checkdef) then

6
compiler/jvm/jvmdef.pas
View File

@ -97,7 +97,7 @@ implementation
cutils,cclasses,constexp,
verbose,systems,
fmodule,
symtable,symconst,symsym,symdef,symcreat,
symtable,symconst,symsym,symdef,symcpu,symcreat,
defutil,paramgr;
{******************************************************************
@ -352,7 +352,7 @@ implementation
end;
procvardef :
begin
result:=jvmaddencodedtype(tprocvardef(def).classdef,false,encodedstr,forcesignature,founderror);
result:=jvmaddencodedtype(tcpuprocvardef(def).classdef,false,encodedstr,forcesignature,founderror);
end;
objectdef :
case tobjectdef(def).objecttype of
@ -724,7 +724,7 @@ implementation
end;
procvardef :
begin
result:=tprocvardef(def).classdef;
result:=tcpuprocvardef(def).classdef;
end;
objectdef :
case tobjectdef(def).objecttype of

4
compiler/jvm/njvmcal.pas
View File

@ -60,7 +60,7 @@ implementation
uses
verbose,globals,globtype,constexp,cutils,
symconst,symtable,symsym,defutil,
symconst,symtable,symsym,symcpu,defutil,
cgutils,tgobj,procinfo,htypechk,
cpubase,aasmdata,aasmcpu,
hlcgobj,hlcgcpu,
@ -527,7 +527,7 @@ implementation
var
pdclass: tobjectdef;
begin
pdclass:=tprocvardef(right.resultdef).classdef;
pdclass:=tcpuprocvardef(right.resultdef).classdef;
{ convert procvar type into corresponding class }
if not tprocvardef(right.resultdef).is_addressonly then
begin

32
compiler/jvm/njvmcnv.pas
View File

@ -96,7 +96,7 @@ implementation
uses
verbose,globals,globtype,constexp,cutils,
symbase,symconst,symdef,symsym,symtable,aasmbase,aasmdata,
symbase,symconst,symdef,symsym,symcpu,symtable,aasmbase,aasmdata,
defutil,defcmp,jvmdef,
cgbase,cgutils,pass_1,pass_2,
nbas,ncon,ncal,ninl,nld,nmem,procinfo,
@ -222,7 +222,7 @@ implementation
if not assigned(totypedef) or
(totypedef.typ<>procvardef) then
begin
if assigned(tprocvardef(resultdef).classdef) then
if assigned(tcpuprocvardef(resultdef).classdef) then
internalerror(2011072405);
{ associate generic classdef; this is the result of an @proc
expression, and such expressions can never result in a direct call
@ -232,7 +232,7 @@ implementation
{ todo }
internalerror(2011072406)
else
tprocvardef(resultdef).classdef:=java_procvarbase;
tcpuprocvardef(resultdef).classdef:=java_procvarbase;
end;
end;
@ -376,10 +376,10 @@ implementation
result:=inherited first_nil_to_methodprocvar;
if assigned(result) then
exit;
if not assigned(tprocvardef(resultdef).classdef) then
tprocvardef(resultdef).classdef:=java_procvarbase;
if not assigned(tcpuprocvardef(resultdef).classdef) then
tcpuprocvardef(resultdef).classdef:=java_procvarbase;
result:=ccallnode.createinternmethod(
cloadvmtaddrnode.create(ctypenode.create(tprocvardef(resultdef).classdef)),'CREATE',nil);
cloadvmtaddrnode.create(ctypenode.create(tcpuprocvardef(resultdef).classdef)),'CREATE',nil);
{ method pointer is an implicit pointer type }
result:=ctypeconvnode.create_explicit(result,getpointerdef(resultdef));
result:=cderefnode.create(result);
@ -482,7 +482,7 @@ implementation
if not assigned(procdefparas) then
procdefparas:=carrayconstructornode.create(nil,nil);
constrparas:=ccallparanode.create(procdefparas,constrparas);
result:=ccallnode.createinternmethod(cloadvmtaddrnode.create(ctypenode.create(tprocvardef(resultdef).classdef)),'CREATE',constrparas);
result:=ccallnode.createinternmethod(cloadvmtaddrnode.create(ctypenode.create(tcpuprocvardef(resultdef).classdef)),'CREATE',constrparas);
{ typecast to the procvar type }
if tprocvardef(resultdef).is_addressonly then
result:=ctypeconvnode.create_explicit(result,resultdef)
@ -985,21 +985,21 @@ implementation
result:=nil;
if fromdef=todef then
exit;
fsym:=tfieldvarsym(search_struct_member(tprocvardef(fromdef).classdef,'METHOD'));
fsym:=tfieldvarsym(search_struct_member(tcpuprocvardef(fromdef).classdef,'METHOD'));
if not assigned(fsym) or
(fsym.typ<>fieldvarsym) then
internalerror(2011072414);
{ can either be a procvar or a procvarclass }
if fromdef.typ=procvardef then
begin
left:=ctypeconvnode.create_explicit(left,tprocvardef(fromdef).classdef);
left:=ctypeconvnode.create_explicit(left,tcpuprocvardef(fromdef).classdef);
include(left.flags,nf_load_procvar);
typecheckpass(left);
end;
result:=csubscriptnode.create(fsym,left);
{ create destination procvartype with info from source }
result:=ccallnode.createinternmethod(
cloadvmtaddrnode.create(ctypenode.create(tprocvardef(todef).classdef)),
cloadvmtaddrnode.create(ctypenode.create(tcpuprocvardef(todef).classdef)),
'CREATE',ccallparanode.create(result,nil));
left:=nil;
end;
@ -1011,8 +1011,8 @@ implementation
{ must be procedure-of-object -> implicit pointer type -> get address
before typecasting to corresponding classdef }
left:=caddrnode.create_internal(left);
inserttypeconv_explicit(left,tprocvardef(fromdef).classdef);
fsym:=tfieldvarsym(search_struct_member(tprocvardef(fromdef).classdef,'METHOD'));
inserttypeconv_explicit(left,tcpuprocvardef(fromdef).classdef);
fsym:=tfieldvarsym(search_struct_member(tcpuprocvardef(fromdef).classdef,'METHOD'));
if not assigned(fsym) or
(fsym.typ<>fieldvarsym) then
internalerror(2011072414);
@ -1024,11 +1024,11 @@ implementation
var
fsym: tsym;
begin
fsym:=tfieldvarsym(search_struct_member(tprocvardef(todef).classdef,'METHOD'));
fsym:=tfieldvarsym(search_struct_member(tcpuprocvardef(todef).classdef,'METHOD'));
if not assigned(fsym) or
(fsym.typ<>fieldvarsym) then
internalerror(2011072415);
result:=ccallnode.createinternmethod(cloadvmtaddrnode.create(ctypenode.create(tprocvardef(todef).classdef)),
result:=ccallnode.createinternmethod(cloadvmtaddrnode.create(ctypenode.create(tcpuprocvardef(todef).classdef)),
'CREATE',ccallparanode.create(left,nil));
left:=nil;
end;
@ -1083,9 +1083,9 @@ implementation
result:=true;
{ check procvar conversion compatibility via their classes }
if fromdef.typ=procvardef then
fromdef:=tprocvardef(fromdef).classdef;
fromdef:=tcpuprocvardef(fromdef).classdef;
if todef.typ=procvardef then
todef:=tprocvardef(todef).classdef;
todef:=tcpuprocvardef(todef).classdef;
if (todef=java_jlobject) or
(todef=voidpointertype) then
exit;

8
compiler/jvm/njvmmem.pas
View File

@ -61,7 +61,7 @@ implementation
systems,globals,procinfo,
cutils,verbose,constexp,
aasmbase,
symconst,symtype,symtable,symsym,symdef,defutil,jvmdef,
symconst,symtype,symtable,symsym,symdef,symcpu,defutil,jvmdef,
htypechk,paramgr,
nadd,ncal,ncnv,ncon,nld,nutils,
pass_1,njvmcon,
@ -199,7 +199,7 @@ implementation
{ an internal address node will observe "normal" address
operator semantics (= take the actual address!) }
result:=caddrnode.create_internal(taddrnode(left).left);
result:=ctypeconvnode.create_explicit(result,tprocvardef(taddrnode(left).left.resultdef).classdef);
result:=ctypeconvnode.create_explicit(result,tcpuprocvardef(taddrnode(left).left.resultdef).classdef);
taddrnode(left).left:=nil;
end;
end
@ -209,9 +209,9 @@ implementation
begin
{ the "code" field from the procvar }
result:=caddrnode.create_internal(left);
result:=ctypeconvnode.create_explicit(result,tprocvardef(left.resultdef).classdef);
result:=ctypeconvnode.create_explicit(result,tcpuprocvardef(left.resultdef).classdef);
{ procvarclass.method }
fsym:=search_struct_member(tprocvardef(left.resultdef).classdef,'METHOD');
fsym:=search_struct_member(tcpuprocvardef(left.resultdef).classdef,'METHOD');
if not assigned(fsym) or
(fsym.typ<>fieldvarsym) then
internalerror(2011072501);

8
compiler/jvm/pjvm.pas
View File

@ -64,7 +64,7 @@ implementation
fmodule,
parabase,aasmdata,
pdecsub,ngenutil,pparautl,
symtable,symcreat,defcmp,jvmdef,nobj,
symtable,symcreat,defcmp,jvmdef,symcpu,nobj,
defutil,paramgr;
@ -490,7 +490,7 @@ implementation
clash; at unit level because we don't want its methods to be nested
inside a function in case its a local type) }
pvclass:=cobjectdef.create(odt_javaclass,'$'+current_module.realmodulename^+'$'+name+'$InternProcvar$'+tostr(def.defid),java_procvarbase);
tprocvardef(def).classdef:=pvclass;
tcpuprocvardef(def).classdef:=pvclass;
include(pvclass.objectoptions,oo_is_sealed);
if df_generic in def.defoptions then
include(pvclass.defoptions,df_generic);
@ -583,7 +583,7 @@ implementation
procedure jvm_wrap_virtual_class_method(pd: tprocdef);
var
wrapperpd: tprocdef;
wrapperpv: tprocvardef;
wrapperpv: tcpuprocvardef;
typ: ttypesym;
wrappername: shortstring;
begin
@ -641,7 +641,7 @@ implementation
wrapperpd.synthetickind:=tsk_jvm_virtual_clmethod;
wrapperpd.skpara:=pd;
{ also create procvar type that we can use in the implementation }
wrapperpv:=tprocvardef(pd.getcopyas(procvardef,pc_normal));
wrapperpv:=tcpuprocvardef(pd.getcopyas(procvardef,pc_normal));
wrapperpv.calcparas;
{ no use in creating a callback wrapper here, this procvar type isn't
for public consumption }

50
compiler/jvm/symcpu.pas
View File

@ -27,6 +27,7 @@ interface
uses
globtype,
symtype,
symdef,symsym;
type
@ -74,6 +75,16 @@ type
end;
tcpuprocvardef = class(tprocvardef)
protected
procedure ppuwrite_platform(ppufile: tcompilerppufile); override;
procedure ppuload_platform(ppufile: tcompilerppufile); override;
public
{ class representing this procvar on the Java side }
classdef : tobjectdef;
classdefderef : tderef;
procedure buildderef;override;
procedure deref;override;
function getcopy: tstoreddef; override;
end;
tcpuprocdef = class(tprocdef)
@ -140,9 +151,46 @@ implementation
uses
verbose,cutils,
symtype,symconst,
symconst,
jvmdef;
{****************************************************************************
tcpuprocvardef
****************************************************************************}
procedure tcpuprocvardef.ppuwrite_platform(ppufile: tcompilerppufile);
begin
inherited;
ppufile.putderef(classdefderef);
end;
procedure tcpuprocvardef.ppuload_platform(ppufile: tcompilerppufile);
begin
inherited;
ppufile.getderef(classdefderef);
end;
procedure tcpuprocvardef.buildderef;
begin
inherited buildderef;
classdefderef.build(classdef);
end;
procedure tcpuprocvardef.deref;
begin
inherited deref;
classdef:=tobjectdef(classdefderef.resolve);
end;
function tcpuprocvardef.getcopy: tstoreddef;
begin
result:=inherited;
tcpuprocvardef(result).classdef:=classdef;
end;
{****************************************************************************
tcpustaticvarsym
****************************************************************************}

4
compiler/jvm/tgcpu.pas
View File

@ -55,7 +55,7 @@ unit tgcpu;
uses
verbose,
cgbase,
symconst,symdef,symsym,defutil,
symconst,symdef,symsym,symcpu,defutil,
cpubase,aasmcpu,
hlcgobj,hlcgcpu;
@ -182,7 +182,7 @@ unit tgcpu;
begin
if not tprocvardef(def).is_addressonly then
begin
getimplicitobjtemp(list,tprocvardef(def).classdef,temptype,ref);
getimplicitobjtemp(list,tcpuprocvardef(def).classdef,temptype,ref);
result:=true;
end;
end;

32
compiler/symdef.pas
View File

@ -589,21 +589,12 @@ interface
end;
tprocvardef = class(tabstractprocdef)
{$ifdef jvm}
{ class representing this procvar on the Java side }
classdef : tobjectdef;
classdefderef : tderef;
{$endif}
constructor create(level:byte);virtual;
constructor ppuload(ppufile:tcompilerppufile);
function getcopy : tstoreddef;override;
{ do not override this routine in platform-specific subclasses,
override ppuwrite_platform instead }
procedure ppuwrite(ppufile:tcompilerppufile);override;final;
{$ifdef jvm}
procedure buildderef;override;
procedure deref;override;
{$endif}
function GetSymtable(t:tGetSymtable):TSymtable;override;
function size : asizeint;override;
function GetTypeName:string;override;
@ -5837,9 +5828,6 @@ implementation
inherited ppuload(procvardef,ppufile);
{ load para symtable }
parast:=tparasymtable.create(self,ppufile.getbyte);
{$ifdef jvm}
ppufile.getderef(classdefderef);
{$endif}
ppuload_platform(ppufile);
tparasymtable(parast).ppuload(ppufile);
end;
@ -5875,9 +5863,6 @@ implementation
tprocvardef(result).has_paraloc_info:=has_paraloc_info;
{$ifdef m68k}
tprocvardef(result).exp_funcretloc:=exp_funcretloc;
{$endif}
{$ifdef jvm}
tprocvardef(result).classdef:=classdef;
{$endif}
end;
@ -5890,9 +5875,6 @@ implementation
procvars) }
ppufile.putbyte(parast.symtablelevel);
{$ifdef jvm}
ppufile.putderef(classdefderef);
{$endif}
{ Write this entry }
writeentry(ppufile,ibprocvardef);
@ -5900,20 +5882,6 @@ implementation
tparasymtable(parast).ppuwrite(ppufile);
end;
{$ifdef jvm}
procedure tprocvardef.buildderef;
begin
inherited buildderef;
classdefderef.build(classdef);
end;
procedure tprocvardef.deref;
begin
inherited deref;
classdef:=tobjectdef(classdefderef.resolve);
end;
{$endif}
function tprocvardef.GetSymtable(t:tGetSymtable):TSymtable;
begin