* moved jvm tprocdef name mangling to jvm-specific descendant class

git-svn-id: trunk@27395 -

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);

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:='<init>'
+        else if proctypeoption in [potype_class_constructor,potype_unitinit] then
+          tmpresult:='<clinit>'
+        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:='<error>';
+          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:='<error>';
+    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;

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}

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;
+            result:=defaultmangledname;
+            _mangledname:=result;
+          end
+        else
+          result:=_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
+        if not assigned(_mangledname) 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:=stringdup(mangledname);
           end
         else
-          jvmaddtypeownerprefix(owner,mangledname);
-{$endif not jvm}
-{$ifdef symansistr}
-      _mangledname:=mangledname;
-{$else symansistr}
-      _mangledname:=stringdup(mangledname);
+          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:='<init>'
-            else if proctypeoption in [potype_class_constructor,potype_unitinit] then
-              tmpresult:='<clinit>'
-            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:='<error>';
-              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:='<error>';
-        result:=tmpresult;
-      end;
-{$endif jvm}
 
     procedure tprocdef.setmangledname(const s : TSymStr);
       begin