From 43992495cb8bca095b7e73c0bf7b6b1b33b82ab8 Mon Sep 17 00:00:00 2001 From: Jonas Maebe Date: Sun, 30 Mar 2014 21:04:29 +0000 Subject: [PATCH] * moved jvm tprocdef name mangling to jvm-specific descendant class git-svn-id: trunk@27395 - --- compiler/agjasmin.pas | 4 +- compiler/jvm/symcpu.pas | 121 ++++++++++++++++++++++++++++++++++- compiler/nobj.pas | 3 +- compiler/symdef.pas | 138 ++++------------------------------------ 4 files changed, 136 insertions(+), 130 deletions(-) diff --git a/compiler/agjasmin.pas b/compiler/agjasmin.pas index 819df90f59..c33747f422 100644 --- a/compiler/agjasmin.pas +++ b/compiler/agjasmin.pas @@ -748,7 +748,7 @@ implementation not(po_classmethod in pd.procoptions) and not(pd.proctypeoption in [potype_constructor,potype_class_constructor])) then result:=result+'final '; - result:=result+pd.jvmmangledbasename(false); + result:=result+tcpuprocdef(pd).jvmmangledbasename(false); end; @@ -923,7 +923,7 @@ implementation if jvmtypeneedssignature(pd) then begin AsmWrite('.signature "'); - AsmWrite(pd.jvmmangledbasename(true)); + AsmWrite(tcpuprocdef(pd).jvmmangledbasename(true)); AsmWriteln('"'); end; WriteTree(tcpuprocdef(pd).exprasmlist); diff --git a/compiler/jvm/symcpu.pas b/compiler/jvm/symcpu.pas index a00db0dec1..ffd5896333 100644 --- a/compiler/jvm/symcpu.pas +++ b/compiler/jvm/symcpu.pas @@ -92,6 +92,8 @@ type { generated assembler code; used by JVM backend so it can afterwards easily write out all methods grouped per class } exprasmlist : TAsmList; + function jvmmangledbasename(signature: boolean): TSymStr; + function mangledname: TSymStr; override; destructor destroy; override; end; @@ -156,13 +158,128 @@ implementation uses verbose,cutils, - symconst, - jvmdef; + symconst,symbase,jvmdef, + paramgr; {**************************************************************************** tcpuprocdef ****************************************************************************} + function tcpuprocdef.jvmmangledbasename(signature: boolean): TSymStr; + var + vs: tparavarsym; + i: longint; + founderror: tdef; + tmpresult: TSymStr; + container: tsymtable; + begin + { format: + * method definition (in Jasmin): + (private|protected|public) [static] method(parametertypes)returntype + * method invocation + package/class/method(parametertypes)returntype + -> store common part: method(parametertypes)returntype and + adorn as required when using it. + } + if not signature then + begin + { method name } + { special names for constructors and class constructors } + if proctypeoption=potype_constructor then + tmpresult:='' + else if proctypeoption in [potype_class_constructor,potype_unitinit] then + tmpresult:='' + else if po_has_importname in procoptions then + begin + if assigned(import_name) then + tmpresult:=import_name^ + else + internalerror(2010122608); + end + else + begin + tmpresult:=procsym.realname; + if tmpresult[1]='$' then + tmpresult:=copy(tmpresult,2,length(tmpresult)-1); + { nested functions } + container:=owner; + while container.symtabletype=localsymtable do + begin + tmpresult:='$'+tprocdef(owner.defowner).procsym.realname+'$'+tostr(tprocdef(owner.defowner).procsym.symid)+'$'+tmpresult; + container:=container.defowner.owner; + end; + end; + end + else + tmpresult:=''; + { parameter types } + tmpresult:=tmpresult+'('; + { not the case for the main program (not required for defaultmangledname + because setmangledname() is called for the main program; in case of + the JVM, this only sets the importname, however) } + if assigned(paras) then + begin + init_paraloc_info(callerside); + for i:=0 to paras.count-1 do + begin + vs:=tparavarsym(paras[i]); + { function result is not part of the mangled name } + if vo_is_funcret in vs.varoptions then + continue; + { self pointer neither, except for class methods (the JVM only + supports static class methods natively, so the self pointer + here is a regular parameter as far as the JVM is concerned } + if not(po_classmethod in procoptions) and + (vo_is_self in vs.varoptions) then + continue; + { passing by reference is emulated by passing an array of one + element containing the value; for types that aren't pointers + in regular Pascal, simply passing the underlying pointer type + does achieve regular call-by-reference semantics though; + formaldefs always have to be passed like that because their + contents can be replaced } + if paramanager.push_copyout_param(vs.varspez,vs.vardef,proccalloption) then + tmpresult:=tmpresult+'['; + { Add the parameter type. } + if not jvmaddencodedtype(vs.vardef,false,tmpresult,signature,founderror) then + { an internalerror here is also triggered in case of errors in the source code } + tmpresult:=''; + end; + end; + tmpresult:=tmpresult+')'; + { And the type of the function result (void in case of a procedure and + constructor). } + if (proctypeoption in [potype_constructor,potype_class_constructor]) then + jvmaddencodedtype(voidtype,false,tmpresult,signature,founderror) + else if not jvmaddencodedtype(returndef,false,tmpresult,signature,founderror) then + { an internalerror here is also triggered in case of errors in the source code } + tmpresult:=''; + result:=tmpresult; + end; + + + function tcpuprocdef.mangledname: TSymStr; + begin + if _mangledname='' then + begin + result:=jvmmangledbasename(false); + if (po_has_importdll in procoptions) then + begin + { import_dll comes from "external 'import_dll_name' name 'external_name'" } + if assigned(import_dll) then + result:=import_dll^+'/'+result + else + internalerror(2010122607); + end + else + jvmaddtypeownerprefix(owner,mangledname); + _mangledname:=result; + end + else + result:=_mangledname; + end; + + destructor tcpuprocdef.destroy; begin exprasmlist.free; diff --git a/compiler/nobj.pas b/compiler/nobj.pas index 90165c361e..f95529805b 100644 --- a/compiler/nobj.pas +++ b/compiler/nobj.pas @@ -60,6 +60,7 @@ implementation globals,verbose,systems, node, symbase,symtable,symconst,symtype,defcmp, + symcpu, dbgbase, wpobase ; @@ -253,7 +254,7 @@ implementation those are looked up dynamicall by name } javanewtreeok:= is_java_class_or_interface(_class) and - (pd.jvmmangledbasename(false)<>vmtpd.jvmmangledbasename(false)) and + (tcpuprocdef(pd).jvmmangledbasename(false)<>tcpuprocdef(vmtpd).jvmmangledbasename(false)) and ((vmtpd.proctypeoption<>potype_constructor) and not(po_staticmethod in vmtpd.procoptions)); {$endif} diff --git a/compiler/symdef.pas b/compiler/symdef.pas index 5495a944d3..27b531d76d 100644 --- a/compiler/symdef.pas +++ b/compiler/symdef.pas @@ -646,7 +646,7 @@ interface { tprocdef } tprocdef = class(tabstractprocdef) - private + protected {$ifdef symansistr} _mangledname : ansistring; {$else symansistr} @@ -758,16 +758,13 @@ interface function getcopyas(newtyp:tdeftyp;copytyp:tproccopytyp): tstoreddef; override; function getcopy: tstoreddef; override; function GetTypeName : string;override; - function mangledname : TSymStr; + function mangledname : TSymStr; virtual; procedure setmangledname(const s : TSymStr); function fullprocname(showhidden:boolean):string; function customprocname(pno: tprocnameoptions):ansistring; function defaultmangledname: TSymStr; function cplusplusmangledname : TSymStr; function objcmangledname : TSymStr; -{$ifdef jvm} - function jvmmangledbasename(signature: boolean): TSymStr; -{$endif} function is_methodpointer:boolean;override; function is_addressonly:boolean;override; procedure make_external; @@ -5411,37 +5408,21 @@ implementation function tprocdef.mangledname : TSymStr; begin {$ifdef symansistr} - if _mangledname<>'' then -{$else symansistr} - if assigned(_mangledname) then -{$endif symansistr} + if _mangledname='' then begin -{$ifdef symansistr} - mangledname:=_mangledname; -{$else symansistr} - mangledname:=_mangledname^; -{$endif symansistr} - exit; - end; -{$ifndef jvm} - mangledname:=defaultmangledname; -{$else not jvm} - mangledname:=jvmmangledbasename(false); - if (po_has_importdll in procoptions) then - begin - { import_dll comes from "external 'import_dll_name' name 'external_name'" } - if assigned(import_dll) then - mangledname:=import_dll^+'/'+mangledname - else - internalerror(2010122607); + result:=defaultmangledname; + _mangledname:=result; end else - jvmaddtypeownerprefix(owner,mangledname); -{$endif not jvm} -{$ifdef symansistr} - _mangledname:=mangledname; + result:=_mangledname; {$else symansistr} - _mangledname:=stringdup(mangledname); + if not assigned(_mangledname) then + begin + result:=defaultmangledname; + _mangledname:=stringdup(mangledname); + end + else + result:=_mangledname^; {$endif symansistr} end; @@ -5668,99 +5649,6 @@ implementation result:=result+' '+messageinf.str^+']"'; end; -{$ifdef jvm} - function tprocdef.jvmmangledbasename(signature: boolean): TSymStr; - var - vs: tparavarsym; - i: longint; - founderror: tdef; - tmpresult: TSymStr; - container: tsymtable; - begin - { format: - * method definition (in Jasmin): - (private|protected|public) [static] method(parametertypes)returntype - * method invocation - package/class/method(parametertypes)returntype - -> store common part: method(parametertypes)returntype and - adorn as required when using it. - } - if not signature then - begin - { method name } - { special names for constructors and class constructors } - if proctypeoption=potype_constructor then - tmpresult:='' - else if proctypeoption in [potype_class_constructor,potype_unitinit] then - tmpresult:='' - else if po_has_importname in procoptions then - begin - if assigned(import_name) then - tmpresult:=import_name^ - else - internalerror(2010122608); - end - else - begin - tmpresult:=procsym.realname; - if tmpresult[1]='$' then - tmpresult:=copy(tmpresult,2,length(tmpresult)-1); - { nested functions } - container:=owner; - while container.symtabletype=localsymtable do - begin - tmpresult:='$'+tprocdef(owner.defowner).procsym.realname+'$'+tostr(tprocdef(owner.defowner).procsym.symid)+'$'+tmpresult; - container:=container.defowner.owner; - end; - end; - end - else - tmpresult:=''; - { parameter types } - tmpresult:=tmpresult+'('; - { not the case for the main program (not required for defaultmangledname - because setmangledname() is called for the main program; in case of - the JVM, this only sets the importname, however) } - if assigned(paras) then - begin - init_paraloc_info(callerside); - for i:=0 to paras.count-1 do - begin - vs:=tparavarsym(paras[i]); - { function result is not part of the mangled name } - if vo_is_funcret in vs.varoptions then - continue; - { self pointer neither, except for class methods (the JVM only - supports static class methods natively, so the self pointer - here is a regular parameter as far as the JVM is concerned } - if not(po_classmethod in procoptions) and - (vo_is_self in vs.varoptions) then - continue; - { passing by reference is emulated by passing an array of one - element containing the value; for types that aren't pointers - in regular Pascal, simply passing the underlying pointer type - does achieve regular call-by-reference semantics though; - formaldefs always have to be passed like that because their - contents can be replaced } - if paramanager.push_copyout_param(vs.varspez,vs.vardef,proccalloption) then - tmpresult:=tmpresult+'['; - { Add the parameter type. } - if not jvmaddencodedtype(vs.vardef,false,tmpresult,signature,founderror) then - { an internalerror here is also triggered in case of errors in the source code } - tmpresult:=''; - end; - end; - tmpresult:=tmpresult+')'; - { And the type of the function result (void in case of a procedure and - constructor). } - if (proctypeoption in [potype_constructor,potype_class_constructor]) then - jvmaddencodedtype(voidtype,false,tmpresult,signature,founderror) - else if not jvmaddencodedtype(returndef,false,tmpresult,signature,founderror) then - { an internalerror here is also triggered in case of errors in the source code } - tmpresult:=''; - result:=tmpresult; - end; -{$endif jvm} procedure tprocdef.setmangledname(const s : TSymStr); begin