+ support for nested Java classes

o tobjectdef.jvm_full_typename() now gets an extra parameter to determine
     whether or not the package name should be prepended, so it can be easily
     used to generate the name of the .j file and of the class name inside it

git-svn-id: branches/jvmbackend@18384 -
This commit is contained in:
Jonas Maebe 2011-08-20 07:55:03 +00:00
parent fde622e050
commit be4a27657b
5 changed files with 65 additions and 23 deletions

View File

@ -54,6 +54,7 @@ interface
function VisibilityToStr(vis: tvisibility): string;
function MethodDefinition(pd: tprocdef): string;
function FieldDefinition(sym: tabstractvarsym): string;
function InnerObjDef(obj: tobjectdef): string;
procedure WriteProcDef(pd: tprocdef);
procedure WriteFieldSym(sym: tabstractvarsym);
@ -433,7 +434,7 @@ implementation
case obj.objecttype of
odt_javaclass:
begin
AsmWriteLn('.class '+obj.objextname^);
AsmWriteLn('.class '+obj.jvm_full_typename(false));
superclass:=obj.childof;
end;
odt_interfacejava:
@ -466,6 +467,13 @@ implementation
AsmWriteln(intf.objextname^);
end;
end;
{ in case of nested class: relation to parent class }
if obj.owner.symtabletype=objectsymtable then
AsmWriteln(InnerObjDef(obj));
{ all all nested classes }
for i:=0 to obj.symtable.deflist.count-1 do
if is_java_class_or_interface(tdef(obj.symtable.deflist[i])) then
AsmWriteln(InnerObjDef(tobjectdef(obj.symtable.deflist[i])));
end;
AsmLn;
end;
@ -525,16 +533,7 @@ implementation
else
AsmClear;
AsmFileName:=obj.objextname^;
st:=obj.owner;
while assigned(st) and
(st.symtabletype=objectsymtable) do
begin
{ nested classes are named as "OuterClass$InnerClass" }
enclosingobj:=tobjectdef(st.defowner);
AsmFileName:=enclosingobj.objextname^+'$'+AsmFileName;
st:=enclosingobj.owner;
end;
AsmFileName:=obj.jvm_full_typename(false);
AsmFileName:=Path+FixFileName(AsmFileName)+target_info.asmext;
AsmCreate(cut_normal);
end;
@ -611,6 +610,36 @@ implementation
end;
function TJasminAssembler.InnerObjDef(obj: tobjectdef): string;
var
kindname: string;
begin
if obj.owner.defowner.typ<>objectdef then
internalerror(2011021701);
case obj.objecttype of
odt_javaclass:
kindname:='class ';
odt_interfacejava:
kindname:='interface ';
else
internalerror(2011021702);
end;
result:=
'.inner '+
kindname+
VisibilityToStr(obj.typesym.visibility)+
{ Nested classes in the Pascal sense are equivalent to "static"
inner classes in Java -- will be changed when support for
Java-style non-static classes is added }
' static '+
obj.objextname^+
' inner '+
obj.jvm_full_typename(true)+
' outer '+
tobjectdef(obj.owner.defowner).jvm_full_typename(true);
end;
procedure TJasminAssembler.WriteProcDef(pd: tprocdef);
begin
if not assigned(pd.exprasmlist) and

View File

@ -68,7 +68,7 @@ implementation
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)));
current_asmdata.CurrAsmList.concat(taicpu.op_sym(a_new,current_asmdata.RefAsmSymbol(tobjectdef(tprocdef(procdefinition).owner.defowner).jvm_full_typename(true))));
{ 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 }

View File

@ -195,7 +195,7 @@ implementation
case tobjectdef(def).objecttype of
odt_javaclass,
odt_interfacejava:
encodedstr:=encodedstr+'L'+tobjectdef(def).jvm_full_typename+';'
encodedstr:=encodedstr+'L'+tobjectdef(def).jvm_full_typename(true)+';'
else
result:=false;
end;
@ -241,7 +241,7 @@ implementation
odt_javaclass,
odt_interfacejava:
begin
tmpresult:=tobjectdef(owner.defowner).jvm_full_typename+'/'
tmpresult:=tobjectdef(owner.defowner).jvm_full_typename(true)+'/'
end
else
internalerror(2010122606);

View File

@ -764,14 +764,14 @@ implementation
case token of
_TYPE :
begin
if not(current_objectdef.objecttype in [odt_class,odt_object,odt_helper]) then
if not(current_objectdef.objecttype in [odt_class,odt_object,odt_helper,odt_javaclass]) then
Message(parser_e_type_var_const_only_in_records_and_classes);
consume(_TYPE);
object_member_blocktype:=bt_type;
end;
_VAR :
begin
if not(current_objectdef.objecttype in [odt_class,odt_object,odt_helper]) then
if not(current_objectdef.objecttype in [odt_class,odt_object,odt_helper,odt_javaclass]) then
Message(parser_e_type_var_const_only_in_records_and_classes);
consume(_VAR);
fields_allowed:=true;
@ -781,7 +781,7 @@ implementation
end;
_CONST:
begin
if not(current_objectdef.objecttype in [odt_class,odt_object,odt_helper]) then
if not(current_objectdef.objecttype in [odt_class,odt_object,odt_helper,odt_javaclass]) then
Message(parser_e_type_var_const_only_in_records_and_classes);
consume(_CONST);
object_member_blocktype:=bt_const;

View File

@ -337,7 +337,7 @@ interface
{ C++ }
procedure finish_cpp_data;
{ JVM }
function jvm_full_typename: string;
function jvm_full_typename(with_package_name: boolean): string;
end;
tclassrefdef = class(tabstractpointerdef)
@ -5510,12 +5510,25 @@ implementation
end;
function tobjectdef.jvm_full_typename: string;
function tobjectdef.jvm_full_typename(with_package_name: boolean): string;
var
st: tsymtable;
enclosingobj: tobjectdef;
begin
result:='';
if assigned(import_lib) then
result:=import_lib^+'/';
result:=result+objextname^;
result:=objextname^;
st:=owner;
while assigned(st) and
(st.symtabletype=objectsymtable) do
begin
{ nested classes are named as "OuterClass$InnerClass" }
enclosingobj:=tobjectdef(st.defowner);
result:=enclosingobj.objextname^+'$'+result;
st:=enclosingobj.owner;
end;
if with_package_name and
assigned(import_lib) then
result:=import_lib^+'/'+result;
end;
{****************************************************************************