* mangledname rewrite, tprocdef.mangledname is now created dynamicly

    in most cases and not written to the ppu
  * add mangeledname_prefix() routine to generate the prefix of
    manglednames depending on the current procedure, object and module
  * removed static procprefix since the mangledname is now build only
    on demand from tprocdef.mangledname

compiler/cginfo.pas

@@ -83,12 +83,27 @@ interface
        OS_VECTOR = OS_NO; { the normal registers can also be used as vectors }
 {$endif ia64}
 
+    const
+      TCGSize2Size : Array[tcgsize] of integer =
+        (0,1,2,4,8,1,2,4,8,
+         4,8,10,8,
+         1,2,4,8,16,1,2,4,8,16);
+
+
 implementation
 
 end.
 {
   $Log$
-  Revision 1.1  2002-04-02 18:09:47  jonas
+  Revision 1.2  2002-04-19 15:46:01  peter
+    * mangledname rewrite, tprocdef.mangledname is now created dynamicly
+      in most cases and not written to the ppu
+    * add mangeledname_prefix() routine to generate the prefix of
+      manglednames depending on the current procedure, object and module
+    * removed static procprefix since the mangledname is now build only
+      on demand from tprocdef.mangledname
+
+  Revision 1.1  2002/04/02 18:09:47  jonas
     + initial implementation (Peter forgot to commit it)
 
 }

compiler/nobj.pas

@@ -762,7 +762,7 @@ implementation
          if not(is_interface(_class)) and
             has_virtual_method and
             not(has_constructor) then
-           Message1(parser_w_virtual_without_constructor,_class.objname^);
+           Message1(parser_w_virtual_without_constructor,_class.objrealname^);
       end;
 
 
@@ -772,8 +772,8 @@ implementation
 
     function  tclassheader.gintfgetvtbllabelname(intfindex: integer): string;
       begin
-        gintfgetvtbllabelname:='VTBL_'+current_module.modulename^+'$_'+upper(_class.objname^)+
-                               '_$$_'+upper(_class.implementedinterfaces.interfaces(intfindex).objname^);
+        gintfgetvtbllabelname:=mangledname_prefix('VTBL',_class.owner)+_class.objname^+
+                               '_$_'+_class.implementedinterfaces.interfaces(intfindex).objname^;
       end;
 
 
@@ -794,7 +794,7 @@ implementation
         proccount:=implintf.implproccount(intfindex);
         for i:=1 to proccount do
           begin
-            tmps:=implintf.implprocs(intfindex,i).mangledname+'_$$_'+upper(curintf.objname^);
+            tmps:=implintf.implprocs(intfindex,i).mangledname+'_$_'+curintf.objname^;
             { create wrapper code }
             cgintfwrapper(rawcode,implintf.implprocs(intfindex,i),tmps,implintf.ioffsets(intfindex)^);
             { create reference }
@@ -1072,22 +1072,12 @@ implementation
   procedure tclassheader.writeinterfaceids;
     var
       i: longint;
-      s1,s2 : string;
     begin
-       if _class.owner.name=nil then
-         s1:=''
-       else
-         s1:=upper(_class.owner.name^);
-       if _class.objname=nil then
-         s2:=''
-       else
-         s2:=upper(_class.objname^);
-      s1:=s1+'$_'+s2;
       if _class.isiidguidvalid then
         begin
           if (cs_create_smart in aktmoduleswitches) then
             dataSegment.concat(Tai_cut.Create);
-          dataSegment.concat(Tai_symbol.Createname_global('IID$_'+s1,0));
+          dataSegment.concat(Tai_symbol.Createname_global(mangledname_prefix('IID',_class.owner)+_class.objname^,0));
           dataSegment.concat(Tai_const.Create_32bit(longint(_class.iidguid.D1)));
           dataSegment.concat(Tai_const.Create_16bit(_class.iidguid.D2));
           dataSegment.concat(Tai_const.Create_16bit(_class.iidguid.D3));
@@ -1096,7 +1086,7 @@ implementation
         end;
       if (cs_create_smart in aktmoduleswitches) then
         dataSegment.concat(Tai_cut.Create);
-      dataSegment.concat(Tai_symbol.Createname_global('IIDSTR$_'+s1,0));
+      dataSegment.concat(Tai_symbol.Createname_global(mangledname_prefix('IIDSTR',_class.owner)+_class.objname^,0));
       dataSegment.concat(Tai_const.Create_8bit(length(_class.iidstr^)));
       dataSegment.concat(Tai_string.Create(_class.iidstr^));
     end;
@@ -1185,8 +1175,8 @@ implementation
             { write class name }
             getdatalabel(classnamelabel);
             dataSegment.concat(Tai_label.Create(classnamelabel));
-            dataSegment.concat(Tai_const.Create_8bit(length(_class.objname^)));
-            dataSegment.concat(Tai_string.Create(_class.objname^));
+            dataSegment.concat(Tai_const.Create_8bit(length(_class.objrealname^)));
+            dataSegment.concat(Tai_string.Create(_class.objrealname^));
             { generate message and dynamic tables }
             if (oo_has_msgstr in _class.objectoptions) then
               strmessagetable:=genstrmsgtab;
@@ -1280,7 +1270,15 @@ initialization
 end.
 {
   $Log$
-  Revision 1.14  2002-04-15 18:59:07  carl
+  Revision 1.15  2002-04-19 15:46:01  peter
+    * mangledname rewrite, tprocdef.mangledname is now created dynamicly
+      in most cases and not written to the ppu
+    * add mangeledname_prefix() routine to generate the prefix of
+      manglednames depending on the current procedure, object and module
+    * removed static procprefix since the mangledname is now build only
+      on demand from tprocdef.mangledname
+
+  Revision 1.14  2002/04/15 18:59:07  carl
   + target_info.size_of_pointer -> pointer_Size
 
   Revision 1.13  2002/02/11 18:51:35  peter

compiler/parser.pas

@@ -241,7 +241,6 @@ implementation
          oldrefsymtable,
          olddefaultsymtablestack,
          oldsymtablestack : tsymtable;
-         oldprocprefix    : string;
          oldaktprocsym    : tprocsym;
          oldaktprocdef    : tprocdef;
          oldoverloaded_operators : toverloaded_operators;
@@ -305,7 +304,6 @@ implementation
          oldsymtablestack:=symtablestack;
          olddefaultsymtablestack:=defaultsymtablestack;
          oldrefsymtable:=refsymtable;
-         oldprocprefix:=procprefix;
          oldaktprocsym:=aktprocsym;
          oldaktprocdef:=aktprocdef;
          oldaktdefproccall:=aktdefproccall;
@@ -375,7 +373,6 @@ implementation
          refsymtable:=nil;
          aktprocsym:=nil;
          aktdefproccall:=initdefproccall;
-         procprefix:='';
          registerdef:=true;
          statement_level:=0;
          aktexceptblock:=0;
@@ -544,7 +541,6 @@ implementation
               aktdefproccall:=oldaktdefproccall;
               aktprocsym:=oldaktprocsym;
               aktprocdef:=oldaktprocdef;
-              procprefix:=oldprocprefix;
               move(oldoverloaded_operators,overloaded_operators,sizeof(toverloaded_operators));
               aktlocalswitches:=oldaktlocalswitches;
               aktmoduleswitches:=oldaktmoduleswitches;
@@ -631,7 +627,15 @@ implementation
 end.
 {
   $Log$
-  Revision 1.27  2002-01-29 19:43:11  peter
+  Revision 1.28  2002-04-19 15:46:02  peter
+    * mangledname rewrite, tprocdef.mangledname is now created dynamicly
+      in most cases and not written to the ppu
+    * add mangeledname_prefix() routine to generate the prefix of
+      manglednames depending on the current procedure, object and module
+    * removed static procprefix since the mangledname is now build only
+      on demand from tprocdef.mangledname
+
+  Revision 1.27  2002/01/29 19:43:11  peter
     * update target_asm according to outputformat
 
   Revision 1.26  2001/11/02 22:58:02  peter

compiler/pdecl.pas

@@ -133,7 +133,7 @@ implementation
                      hp:=tconstsym.create_ptr(orgname,constguid,pg);
                    end
                   else
-                   Message1(parser_e_interface_has_no_guid,tobjectdef(p.resulttype.def).objname^);
+                   Message1(parser_e_interface_has_no_guid,tobjectdef(p.resulttype.def).objrealname^);
                 end
                else
                 Message(cg_e_illegal_expression);
@@ -608,7 +608,15 @@ implementation
 end.
 {
   $Log$
-  Revision 1.41  2002-03-04 17:54:59  peter
+  Revision 1.42  2002-04-19 15:46:02  peter
+    * mangledname rewrite, tprocdef.mangledname is now created dynamicly
+      in most cases and not written to the ppu
+    * add mangeledname_prefix() routine to generate the prefix of
+      manglednames depending on the current procedure, object and module
+    * removed static procprefix since the mangledname is now build only
+      on demand from tprocdef.mangledname
+
+  Revision 1.41  2002/03/04 17:54:59  peter
     * allow oridinal labels again
 
   Revision 1.40  2001/12/06 17:57:35  florian

compiler/pdecobj.pas

@@ -543,7 +543,7 @@ implementation
                      p2:=search_default_property(aktclass);
                      if assigned(p2) then
                        message1(parser_e_only_one_default_property,
-                         tobjectdef(p2.owner.defowner)^.objname^)
+                         tobjectdef(p2.owner.defowner)^.objrealname^)
                      else
                      }
                        begin
@@ -634,7 +634,7 @@ implementation
                     childof:=interface_iunknown;
                 end;
                 if (oo_is_forward in childof.objectoptions) then
-                  Message1(parser_e_forward_declaration_must_be_resolved,childof.objname^);
+                  Message1(parser_e_forward_declaration_must_be_resolved,childof.objrealname^);
                 aktclass.set_parent(childof);
              end;
          end;
@@ -849,7 +849,7 @@ implementation
                    if assigned(fd) then
                     begin
                       if (oo_is_forward in childof.objectoptions) then
-                       Message1(parser_e_forward_declaration_must_be_resolved,childof.objname^);
+                       Message1(parser_e_forward_declaration_must_be_resolved,childof.objrealname^);
                       aktclass:=fd;
                       { we must inherit several options !!
                         this was missing !!
@@ -1110,7 +1110,15 @@ implementation
 end.
 {
   $Log$
-  Revision 1.39  2002-04-04 19:06:00  peter
+  Revision 1.40  2002-04-19 15:46:02  peter
+    * mangledname rewrite, tprocdef.mangledname is now created dynamicly
+      in most cases and not written to the ppu
+    * add mangeledname_prefix() routine to generate the prefix of
+      manglednames depending on the current procedure, object and module
+    * removed static procprefix since the mangledname is now build only
+      on demand from tprocdef.mangledname
+
+  Revision 1.39  2002/04/04 19:06:00  peter
     * removed unused units
     * use tlocation.size in cg.a_*loc*() routines
 

compiler/pdecsub.pas

@@ -110,7 +110,7 @@ implementation
         hvs,
         vs      : tvarsym;
         srsym   : tsym;
-        hs1,hs2 : string;
+        hs1 : string;
         varspez : Tvarspez;
         inserthigh : boolean;
         tdefaultvalue : tconstsym;
@@ -121,8 +121,6 @@ implementation
         defaultrequired:=false;
         { parsing a proc or procvar ? }
         is_procvar:=(aktprocdef.deftype=procvardef);
-        if not is_procvar then
-          hs2:=tprocdef(aktprocdef).mangledname;
         consume(_LKLAMMER);
         { Delphi/Kylix supports nonsense like }
         { procedure p();                      }
@@ -159,11 +157,6 @@ implementation
                  CGMessage(parser_e_self_call_by_value);
               if not is_procvar then
                begin
-{$ifndef UseNiceNames}
-                 hs2:=hs2+'$'+'self';
-{$else UseNiceNames}
-                 hs2:=hs2+tostr(length('self'))+'self';
-{$endif UseNiceNames}
                  htype.setdef(procinfo^._class);
                  vs:=tvarsym.create('@',htype);
                  vs.varspez:=vs_var;
@@ -213,13 +206,11 @@ implementation
                          InternalError(1234124);
                         tarraydef(tt.def).elementtype:=ttypesym(srsym).restype;
                         tarraydef(tt.def).IsArrayOfConst:=true;
-                        hs1:='array_of_const';
                       end
                      else
                       begin
                         { define field type }
                         single_type(tarraydef(tt.def).elementtype,hs1,false);
-                        hs1:='array_of_'+hs1;
                       end;
                      inserthigh:=true;
                    end
@@ -284,11 +275,6 @@ implementation
                   { For proc vars we only need the definitions }
                   if not is_procvar then
                    begin
-{$ifndef UseNiceNames}
-                     hs2:=hs2+'$'+hs1;
-{$else UseNiceNames}
-                     hs2:=hs2+tostr(length(hs1))+hs1;
-{$endif UseNiceNames}
                      vs:=tvarsym.create(s,tt);
                      vs.varspez:=varspez;
                    { we have to add this to avoid var param to be in registers !!!}
@@ -332,8 +318,6 @@ implementation
             end;
           { set the new mangled name }
         until not try_to_consume(_SEMICOLON);
-        if not is_procvar then
-          tprocdef(aktprocdef).setmangledname(hs2);
         dec(testcurobject);
         current_object_option:=old_object_option;
         consume(_RKLAMMER);
@@ -345,15 +329,12 @@ implementation
         orgsp,sp:stringid;
         paramoffset:longint;
         sym:tsym;
-        hs:string;
         doinsert : boolean;
         st : tsymtable;
         srsymtable : tsymtable;
         pdl     : pprocdeflist;
-        overloaded_level:word;
         storepos,procstartfilepos : tfileposinfo;
         i: longint;
-        procdefs : pprocdeflist;
       begin
         { Save the position where this procedure really starts }
         procstartfilepos:=akttokenpos;
@@ -497,39 +478,6 @@ implementation
              end;
          end;
 
-      { Create the mangledname }
-      {$ifndef UseNiceNames}
-        if assigned(procinfo^._class) then
-         begin
-           if (pos('_$$_',procprefix)=0) then
-            hs:=procprefix+'_$$_'+upper(procinfo^._class.objname^)+'_$$_'+sp
-           else
-            hs:=procprefix+'_$'+sp;
-         end
-        else
-         begin
-           if lexlevel=normal_function_level then
-            hs:=procprefix+'_'+sp
-           else
-            hs:=procprefix+'_$'+sp;
-         end;
-      {$else UseNiceNames}
-        if assigned(procinfo^._class) then
-         begin
-           if (pos('_5Class_',procprefix)=0) then
-            hs:=procprefix+'_5Class_'+procinfo^._class.name^+'_'+tostr(length(sp))+sp
-           else
-            hs:=procprefix+'_'+tostr(length(sp))+sp;
-         end
-        else
-         begin
-           if lexlevel=normal_function_level then
-            hs:=procprefix+'_'+tostr(length(sp))+sp
-           else
-            hs:=lowercase(procprefix)+'_'+tostr(length(sp))+sp;
-         end;
-      {$endif UseNiceNames}
-
         doinsert:=true;
         if assigned(aktprocsym) then
          begin
@@ -647,29 +595,6 @@ implementation
         { save file position }
         aktprocdef.fileinfo:=procstartfilepos;
 
-        { store mangledname }
-        aktprocdef.setmangledname(hs);
-
-        if not parse_only then
-          begin
-             overloaded_level:=1;
-             { we need another procprefix !!! }
-             { count, but only those in the same unit !!}
-             procdefs:=aktprocsym.defs;
-             while assigned(procdefs) and
-                   (procdefs^.def.owner.symtabletype in [globalsymtable,staticsymtable]) do
-               begin
-                  { only count already implemented functions }
-                  if not(procdefs^.def.forwarddef) then
-                    inc(overloaded_level);
-                  procdefs:=procdefs^.next;
-               end;
-             if overloaded_level>0 then
-               procprefix:=hs+'$'+tostr(overloaded_level)+'$'
-             else
-               procprefix:=hs+'$';
-          end;
-
         { this must also be inserted in the right symtable !! PM }
         { otherwise we get subbtle problems with
           definitions of args defs in staticsymtable for
@@ -794,10 +719,6 @@ implementation
                               Message(parser_e_comparative_operator_return_boolean);
                              if assigned(otsym) then
                                otsym.vartype.def:=aktprocdef.rettype.def;
-                             { We need to add the return type in the mangledname
-                               to allow overloading with just different results !! (PM) }
-                             aktprocdef.setmangledname(
-                               aktprocdef.mangledname+'$$'+hs);
                              if (optoken=_ASSIGNMENT) and
                                 is_equal(aktprocdef.rettype.def,
                                    tvarsym(aktprocdef.parast.symindex.first).vartype.def) then
@@ -1851,62 +1772,46 @@ const
                     begin
                       { For delphi check if the current implementation has no proccalloption, then
                         take the options from the interface }
-                      if (m_delphi in aktmodeswitches) then
-                       begin
-                         if (aprocdef.proccalloption=pocall_none) then
-                          aprocdef.proccalloption:=hd.proccalloption
-                         else
-                          MessagePos(aprocdef.fileinfo,parser_e_call_convention_dont_match_forward);
-                       end
-                      else
-                       MessagePos(aprocdef.fileinfo,parser_e_call_convention_dont_match_forward);
-                      { restore interface settings for error recovery }
+                      if not(m_delphi in aktmodeswitches) or
+                         (aprocdef.proccalloption<>pocall_none) then
+                        MessagePos(aprocdef.fileinfo,parser_e_call_convention_dont_match_forward);
+                      { restore interface settings }
                       aprocdef.proccalloption:=hd.proccalloption;
-                      aprocdef.setmangledname(hd.mangledname);
+                      aprocdef.has_mangledname:=hd.has_mangledname;
+                      if hd.has_mangledname then
+                        aprocdef.setmangledname(hd.mangledname);
                     end;
 
                    { Check manglednames }
-                   hd.count:=false;
                    if (m_repeat_forward in aktmodeswitches) or
                       aprocdef.haspara then
                     begin
-                      if (hd.mangledname<>aprocdef.mangledname) then
-                       begin
-                         if not(po_external in aprocdef.procoptions) then
-                           MessagePos2(aprocdef.fileinfo,parser_n_interface_name_diff_implementation_name,
-                                       hd.mangledname,aprocdef.mangledname);
-                         { if the mangledname is already used, then rename it to the
-                           new mangledname of the implementation }
-                         if hd.is_used then
-                           renameasmsymbol(hd.mangledname,aprocdef.mangledname);
-                         { reset the mangledname of the interface }
-                         hd.setmangledname(aprocdef.mangledname);
-                       end
-                      else
-                       begin
-                         { If mangled names are equal then they have the same amount of arguments }
-                         { We can check the names of the arguments }
-                         { both symtables are in the same order from left to right }
-                         ad:=tsym(hd.parast.symindex.first);
-                         fd:=tsym(aprocdef.parast.symindex.first);
-                         while assigned(ad) and assigned(fd) do
-                          begin
-                            if ad.name<>fd.name then
-                             begin
-                               { don't give an error if the default parameter is not
-                                 specified in the implementation }
-                               if ((copy(fd.name,1,3)='def') and
-                                   (copy(ad.name,1,3)<>'def')) then
-                                 MessagePos3(aprocdef.fileinfo,parser_e_header_different_var_names,
-                                             aprocsym.name,ad.name,fd.name);
-                               break;
-                             end;
-                            ad:=tsym(ad.indexnext);
-                            fd:=tsym(fd.indexnext);
-                          end;
-                       end;
+                      { If mangled names are equal then they have the same amount of arguments }
+                      { We can check the names of the arguments }
+                      { both symtables are in the same order from left to right }
+                      ad:=tsym(hd.parast.symindex.first);
+                      fd:=tsym(aprocdef.parast.symindex.first);
+                      repeat
+                        { skip default parameter constsyms }
+                        while assigned(ad) and (ad.typ<>varsym) do
+                         ad:=tsym(ad.indexnext);
+                        while assigned(fd) and (fd.typ<>varsym) do
+                         fd:=tsym(fd.indexnext);
+                        { stop when one of the two lists is at the end }
+                        if not assigned(ad) or not assigned(fd) then
+                         break;
+                        if (ad.name<>fd.name) then
+                         begin
+                           MessagePos3(aprocdef.fileinfo,parser_e_header_different_var_names,
+                                       aprocsym.name,ad.name,fd.name);
+                           break;
+                         end;
+                        ad:=tsym(ad.indexnext);
+                        fd:=tsym(fd.indexnext);
+                      until false;
+                      if assigned(ad) or assigned(fd) then
+                        internalerror(200204178);
                     end;
-                   hd.count:=true;
 
                    { Everything is checked, now we can update the forward declaration
                      with the new data from the implementation }
@@ -1914,11 +1819,19 @@ const
                    hd.hasforward:=true;
                    hd.parast.address_fixup:=aprocdef.parast.address_fixup;
                    hd.procoptions:=hd.procoptions+aprocdef.procoptions;
-                   if hd.extnumber=-1 then
+                   if hd.extnumber=65535 then
                      hd.extnumber:=aprocdef.extnumber;
                    while not aprocdef.aliasnames.empty do
                     hd.aliasnames.insert(aprocdef.aliasnames.getfirst);
-
+                   { update mangledname if the implementation has a fixed mangledname set }
+                   if aprocdef.has_mangledname then
+                    begin
+                      { rename also asmsymbol first, because the name can already be used }
+                      renameasmsymbol(hd.mangledname,aprocdef.mangledname);
+                      { update the mangledname }
+                      hd.has_mangledname:=true;
+                      hd.setmangledname(aprocdef.mangledname);
+                    end;
                    { for compilerproc defines we need to rename and update the
                      symbolname to lowercase }
                    if (aprocdef.proccalloption=pocall_compilerproc) then
@@ -1989,7 +1902,13 @@ const
         { if we didn't reuse a forwarddef then we add the procdef to the overloaded
           list }
         if not forwardfound then
-         aprocsym.addprocdef(aprocdef);
+         begin
+           aprocsym.addprocdef(aprocdef);
+           { add overloadnumber for unique naming, the overloadcount is
+             counted per module and 0 for the first procedure }
+           aprocdef.overloadnumber:=aprocsym.overloadcount;
+           inc(aprocsym.overloadcount);
+         end;
 
         { insert otsym only in the right symtable }
         if ((procinfo^.flags and pi_operator)<>0) and
@@ -2017,7 +1936,15 @@ const
 end.
 {
   $Log$
-  Revision 1.49  2002-04-15 19:00:33  carl
+  Revision 1.50  2002-04-19 15:46:02  peter
+    * mangledname rewrite, tprocdef.mangledname is now created dynamicly
+      in most cases and not written to the ppu
+    * add mangeledname_prefix() routine to generate the prefix of
+      manglednames depending on the current procedure, object and module
+    * removed static procprefix since the mangledname is now build only
+      on demand from tprocdef.mangledname
+
+  Revision 1.49  2002/04/15 19:00:33  carl
   + target_info.size_of_pointer -> pointer_Size
 
   Revision 1.48  2002/03/29 13:29:32  peter

compiler/pmodules.pas

@@ -146,13 +146,13 @@ implementation
 {$endif}
            then
          begin
-           { align the first data } 
+           { align the first data }
            dataSegment.insert(Tai_align.Create(used_align(32,
                aktalignment.constalignmin,aktalignment.constalignmax)));
            dataSegment.insert(Tai_string.Create('FPC '+full_version_string+
              ' ['+date_string+'] for '+target_cpu_string+' - '+target_info.shortname));
          end;
-        { align code segment }         
+        { align code segment }
         codeSegment.concat(Tai_align.Create(aktalignment.procalign));
        { Insert start and end of sections }
         fixseg(codesegment,sec_code);
@@ -781,13 +781,6 @@ implementation
          if (current_module.modulename^='OBJPAS') then
            exclude(aktmodeswitches,m_objpas);
 
-         { this should be placed after uses !!}
-{$ifndef UseNiceNames}
-         procprefix:='_'+current_module.modulename^+'$$';
-{$else UseNiceNames}
-         procprefix:='_'+tostr(length(current_module.modulename^))+lowercase(current_module.modulename^)+'_';
-{$endif UseNiceNames}
-
          parse_only:=true;
 
          { generate now the global symboltable }
@@ -1247,9 +1240,6 @@ implementation
 
          Message1(parser_u_parsing_implementation,current_module.mainsource^);
 
-         { reset }
-         procprefix:='';
-
          {The program intialization needs an alias, so it can be called
           from the bootstrap code.}
          codegen_newprocedure;
@@ -1398,7 +1388,15 @@ implementation
 end.
 {
   $Log$
-  Revision 1.60  2002-04-14 16:53:10  carl
+  Revision 1.61  2002-04-19 15:46:02  peter
+    * mangledname rewrite, tprocdef.mangledname is now created dynamicly
+      in most cases and not written to the ppu
+    * add mangeledname_prefix() routine to generate the prefix of
+      manglednames depending on the current procedure, object and module
+    * removed static procprefix since the mangledname is now build only
+      on demand from tprocdef.mangledname
+
+  Revision 1.60  2002/04/14 16:53:10  carl
   + align code section and data section according to alignment rules
 
   Revision 1.59  2002/04/07 17:58:38  carl

compiler/psub.pas

@@ -500,7 +500,6 @@ implementation
         generates the code for it
       }
       var
-        oldprefix        : string;
         oldprocsym       : tprocsym;
         oldprocdef       : tprocdef;
         oldprocinfo      : pprocinfo;
@@ -511,7 +510,6 @@ implementation
       { save old state }
          oldprocdef:=aktprocdef;
          oldprocsym:=aktprocsym;
-         oldprefix:=procprefix;
          oldconstsymtable:=constsymtable;
          oldprocinfo:=procinfo;
       { create a new procedure }
@@ -680,9 +678,6 @@ implementation
          codegen_doneprocedure;
          { Restore old state }
          constsymtable:=oldconstsymtable;
-         { from now on all refernece to mangledname means
-           that the function is already used }
-         aktprocdef.count:=true;
 {$ifdef notused}
          { restore the interface order to maintain CRC values PM }
          if assigned(prevdef) and assigned(aktprocdef.nextoverloaded) then
@@ -695,7 +690,6 @@ implementation
 {$endif notused}
          aktprocsym:=oldprocsym;
          aktprocdef:=oldprocdef;
-         procprefix:=oldprefix;
          procinfo:=oldprocinfo;
          otsym:=nil;
       end;
@@ -817,7 +811,15 @@ implementation
 end.
 {
   $Log$
-  Revision 1.47  2002-04-15 19:01:28  carl
+  Revision 1.48  2002-04-19 15:46:02  peter
+    * mangledname rewrite, tprocdef.mangledname is now created dynamicly
+      in most cases and not written to the ppu
+    * add mangeledname_prefix() routine to generate the prefix of
+      manglednames depending on the current procedure, object and module
+    * removed static procprefix since the mangledname is now build only
+      on demand from tprocdef.mangledname
+
+  Revision 1.47  2002/04/15 19:01:28  carl
   + target_info.size_of_pointer -> pointer_Size
 
   Revision 1.46  2002/04/04 18:45:19  carl

compiler/ptype.pas

@@ -151,8 +151,9 @@ implementation
            loaded at that time. A symbol reference to an other unit
            is still possible, because it's already loaded (PFV)
            can't use in [] here, becuase unitid can be > 255 }
-         if (ttypesym(srsym).owner.unitid=0) or
-            (ttypesym(srsym).owner.unitid=1) then
+{         if (ttypesym(srsym).owner.unitid=0) or
+            (ttypesym(srsym).owner.unitid=1) then }
+         if (ttypesym(srsym).owner.unitid=0) then
           tt.setdef(ttypesym(srsym).restype.def)
          else
           tt.setsym(srsym);
@@ -630,7 +631,15 @@ implementation
 end.
 {
   $Log$
-  Revision 1.36  2002-04-16 16:12:47  peter
+  Revision 1.37  2002-04-19 15:46:03  peter
+    * mangledname rewrite, tprocdef.mangledname is now created dynamicly
+      in most cases and not written to the ppu
+    * add mangeledname_prefix() routine to generate the prefix of
+      manglednames depending on the current procedure, object and module
+    * removed static procprefix since the mangledname is now build only
+      on demand from tprocdef.mangledname
+
+  Revision 1.36  2002/04/16 16:12:47  peter
     * give error when using enums with jumps as array index
     * allow char as enum value
 

compiler/regvars.pas

@@ -232,7 +232,7 @@ implementation
                    if (procinfo^.flags and pi_do_call)<>0 then
                      begin
                       for i:=maxfpuvarregs downto 2 do
-                      regvarinfo^.fpuregvars[i]:=nil;
+                        regvarinfo^.fpuregvars[i]:=nil;
                      end
                    else
                      begin
@@ -287,7 +287,8 @@ implementation
                     reference_reset(hr);
                     if vsym.owner.symtabletype in [inlinelocalsymtable,localsymtable] then
                       hr.offset:=-vsym.address+vsym.owner.address_fixup
-                    else hr.offset:=vsym.address+vsym.owner.address_fixup;
+                    else
+                      hr.offset:=vsym.address+vsym.owner.address_fixup;
                     hr.base:=procinfo^.framepointer;
                     cg.a_load_reg_ref(asml,def_cgsize(vsym.vartype.def),vsym.reg,hr);
                   end;
@@ -311,7 +312,8 @@ implementation
           reference_reset(hr);
           if vsym.owner.symtabletype in [inlinelocalsymtable,localsymtable] then
             hr.offset:=-vsym.address+vsym.owner.address_fixup
-          else hr.offset:=vsym.address+vsym.owner.address_fixup;
+          else
+            hr.offset:=vsym.address+vsym.owner.address_fixup;
           hr.base:=procinfo^.framepointer;
           if (vsym.varspez in [vs_var,vs_out]) or
              ((vsym.varspez=vs_const) and
@@ -454,10 +456,12 @@ implementation
 {$endif i386}
             for i := 1 to maxvarregs do
              begin
-               reg32:=changeregsize(regvars[i].reg,S_L);
-               if assigned(regvars[i]) and
-                  (rg.regvar_loaded[reg32]) then
-                asml.concat(Tairegalloc.dealloc(reg32));
+               if assigned(regvars[i]) then
+                begin
+                  reg32:=changeregsize(regvars[i].reg,S_L);
+                  if (rg.regvar_loaded[reg32]) then
+                   asml.concat(Tairegalloc.dealloc(reg32));
+                end;
              end;
           end;
     end;
@@ -466,7 +470,15 @@ end.
 
 {
   $Log$
-  Revision 1.27  2002-04-15 19:44:19  peter
+  Revision 1.28  2002-04-19 15:46:03  peter
+    * mangledname rewrite, tprocdef.mangledname is now created dynamicly
+      in most cases and not written to the ppu
+    * add mangeledname_prefix() routine to generate the prefix of
+      manglednames depending on the current procedure, object and module
+    * removed static procprefix since the mangledname is now build only
+      on demand from tprocdef.mangledname
+
+  Revision 1.27  2002/04/15 19:44:19  peter
     * fixed stackcheck that would be called recursively when a stack
       error was found
     * generic changeregsize(reg,size) for i386 register resizing

compiler/symdef.pas

@@ -124,6 +124,7 @@ interface
           procedure write(ppufile:tcompilerppufile);override;
           procedure deref;override;
           function  gettypename:string;override;
+          function  getmangledparaname:string;override;
           procedure setsize;
           { debug }
 {$ifdef GDB}
@@ -247,7 +248,8 @@ interface
           procedure writefields(sym:tnamedindexitem);
        public
           childof  : tobjectdef;
-          objname  : pstring;
+          objname,
+          objrealname   : pstring;
           objectoptions : tobjectoptions;
           { to be able to have a variable vmt position }
           { and no vmt field for objects without virtuals }
@@ -345,11 +347,12 @@ interface
           IsVariant,
           IsConstructor,
           IsArrayOfConst : boolean;
-          function gettypename:string;override;
           function elesize : longint;
           constructor create(l,h : longint;const t : ttype);
           constructor load(ppufile:tcompilerppufile);
           procedure write(ppufile:tcompilerppufile);override;
+          function  gettypename:string;override;
+          function  getmangledparaname : string;override;
 {$ifdef GDB}
           function stabstring : pchar;override;
           procedure concatstabto(asmlist : taasmoutput);override;
@@ -424,7 +427,7 @@ interface
           procedure deref;override;
           procedure concatpara(const tt:ttype;sym : tsym;vsp : tvarspez;defval:tsym);
           function  para_size(alignsize:longint) : longint;
-          function  demangled_paras : string;
+          function  typename_paras : string;
           procedure test_if_fpu_result;
           { debug }
 {$ifdef GDB}
@@ -462,7 +465,8 @@ interface
           isstabwritten : boolean;
 {$endif GDB}
        public
-          extnumber  : longint;
+          extnumber      : word;
+          overloadnumber : word;
           messageinf : tmessageinf;
 {$ifndef EXTDEBUG}
           { where is this function defined, needed here because there
@@ -501,8 +505,6 @@ interface
           { true if the procedure has a forward declaration }
           hasforward : boolean;
           { check the problems of manglednames }
-          count      : boolean;
-          is_used    : boolean;
           has_mangledname : boolean;
           { small set which contains the modified registers }
           usedregisters : tregisterset;
@@ -550,6 +552,7 @@ interface
           function  size : longint;override;
           procedure write(ppufile:tcompilerppufile);override;
           function  gettypename:string;override;
+          function  getmangledparaname:string;override;
           function  is_publishable : boolean;override;
           { debug }
 {$ifdef GDB}
@@ -688,6 +691,7 @@ interface
        pbestrealtype : ^ttype = @s64floattype;
 {$endif SPARC}
 
+    function mangledname_prefix(typeprefix:string;st:tsymtable):string;
 
 {$ifdef GDB}
     { GDB Helpers }
@@ -735,6 +739,38 @@ implementation
                                   Helpers
 ****************************************************************************}
 
+    function mangledname_prefix(typeprefix:string;st:tsymtable):string;
+      var
+        s,
+        prefix : string;
+      begin
+        prefix:='';
+        { sub procedures }
+        while (st.symtabletype=localsymtable) do
+         begin
+           if st.defowner.deftype<>procdef then
+            internalerror(200204173);
+           s:=tprocdef(st.defowner).procsym.name;
+           if tprocdef(st.defowner).overloadnumber>0 then
+            s:=s+'$'+tostr(tprocdef(st.defowner).overloadnumber);
+           prefix:=s+'$'+prefix;
+           st:=st.defowner.owner;
+         end;
+        { object/classes symtable }
+        if (st.symtabletype=objectsymtable) then
+         begin
+           if st.defowner.deftype<>objectdef then
+            internalerror(200204174);
+           prefix:=tobjectdef(st.defowner).objname^+'_$_'+prefix;
+           st:=st.defowner.owner;
+         end;
+        { symtable must now be static or global }
+        if not(st.symtabletype in [staticsymtable,globalsymtable]) then
+         internalerror(200204175);
+        mangledname_prefix:=typeprefix+'_'+st.name^+'_'+prefix;
+      end;
+
+
 {$ifdef GDB}
     procedure forcestabto(asmlist : taasmoutput; pd : tdef);
       begin
@@ -1342,6 +1378,12 @@ implementation
       end;
 
 
+    function tstringdef.getmangledparaname : string;
+      begin
+        getmangledparaname:='STRING';
+      end;
+
+
     function tstringdef.is_publishable : boolean;
       begin
          is_publishable:=true;
@@ -2078,6 +2120,19 @@ implementation
       end;
 
 
+    function tfiledef.getmangledparaname : string;
+      begin
+         case filetyp of
+           ft_untyped:
+             getmangledparaname:='FILE';
+           ft_typed:
+             getmangledparaname:='FILE$OF$'+typedfiletype.def.mangledparaname;
+           ft_text:
+             getmangledparaname:='TEXT'
+         end;
+      end;
+
+
 {****************************************************************************
                                TVARIANTDEF
 ****************************************************************************}
@@ -2718,6 +2773,18 @@ implementation
       end;
 
 
+    function tarraydef.getmangledparaname : string;
+      begin
+         if isarrayofconst then
+          getmangledparaname:='array_of_const'
+         else
+          if ((highrange=-1) and (lowrange=0)) then
+           getmangledparaname:='array_of_'+elementtype.def.mangledparaname
+         else
+          internalerror(200204176);
+      end;
+
+
 {***************************************************************************
                               tabstractrecorddef
 ***************************************************************************}
@@ -3144,7 +3211,7 @@ implementation
       end;
 
 
-    function tabstractprocdef.demangled_paras : string;
+    function tabstractprocdef.typename_paras : string;
       var
         hs,s : string;
         hp : TParaItem;
@@ -3153,7 +3220,7 @@ implementation
         hp:=TParaItem(Para.last);
         if not(assigned(hp)) then
           begin
-             demangled_paras:='';
+             typename_paras:='';
              exit;
           end;
         s:='(';
@@ -3210,7 +3277,7 @@ implementation
         s:=s+')';
         if (po_varargs in procoptions) then
          s:=s+';VarArgs';
-        demangled_paras:=s;
+        typename_paras:=s;
       end;
 
 
@@ -3244,7 +3311,7 @@ implementation
          has_mangledname:=false;
          _mangledname:=nil;
          fileinfo:=aktfilepos;
-         extnumber:=-1;
+         extnumber:=$ffff;
          aliasnames:=tstringlist.create;
          localst:=tlocalsymtable.create;
          parast:=tparasymtable.create;
@@ -3272,8 +3339,7 @@ implementation
          _class := nil;
          code:=nil;
          regvarinfo := nil;
-         count:=false;
-         is_used:=false;
+         overloadnumber:=0;
 {$ifdef GDB}
          isstabwritten := false;
 {$endif GDB}
@@ -3286,10 +3352,13 @@ implementation
          deftype:=procdef;
 
          ppufile.getnormalset(usedregisters);
-         has_mangledname:=true;
-         _mangledname:=stringdup(ppufile.getstring);
-
-         extnumber:=ppufile.getlongint;
+         has_mangledname:=boolean(ppufile.getbyte);
+         if has_mangledname then
+          _mangledname:=stringdup(ppufile.getstring)
+         else
+          _mangledname:=nil;
+         overloadnumber:=ppufile.getword;
+         extnumber:=ppufile.getword;
          _class := tobjectdef(ppufile.getderef);
          procsym := tsym(ppufile.getderef);
          ppufile.getposinfo(fileinfo);
@@ -3326,8 +3395,6 @@ implementation
          lastwritten:=nil;
          defref:=nil;
          refcount:=0;
-         count:=true;
-         is_used:=false;
 {$ifdef GDB}
          isstabwritten := false;
 {$endif GDB}
@@ -3373,8 +3440,11 @@ implementation
 
          ppufile.putnormalset(usedregisters);
          ppufile.do_interface_crc:=oldintfcrc;
-         ppufile.putstring(mangledname);
-         ppufile.putlongint(extnumber);
+         ppufile.putbyte(byte(has_mangledname));
+         if has_mangledname then
+          ppufile.putstring(mangledname);
+         ppufile.putword(overloadnumber);
+         ppufile.putword(extnumber);
          ppufile.putderef(_class);
          ppufile.putderef(procsym);
          ppufile.putposinfo(fileinfo);
@@ -3422,8 +3492,8 @@ implementation
       begin
         s:='';
         if assigned(_class) then
-         s:=_class.objname^+'.';
-        s:=s+procsym.realname+demangled_paras;
+         s:=_class.objrealname^+'.';
+        s:=s+procsym.realname+typename_paras;
         fullprocname:=s;
       end;
 
@@ -3704,13 +3774,31 @@ implementation
 
 
     function tprocdef.mangledname : string;
+      var
+        s  : string;
+        hp : TParaItem;
       begin
-         if assigned(_mangledname) then
-           mangledname:=_mangledname^
-         else
-           mangledname:='';
-         if count then
-           is_used:=true;
+        if assigned(_mangledname) then
+         begin
+           mangledname:=_mangledname^;
+           exit;
+         end;
+        { we need to use the symtable where the procsym is inserted,
+          because that is visible to the world }
+        s:=mangledname_prefix('',procsym.owner)+procsym.name+'$';
+        if overloadnumber>0 then
+         s:=s+tostr(overloadnumber)+'$';
+        { add parameter types }
+        hp:=TParaItem(Para.last);
+        while assigned(hp) do
+         begin
+           s:=s+hp.paratype.def.mangledparaname;
+           hp:=TParaItem(hp.previous);
+           if assigned(hp) then
+            s:=s+'$';
+         end;
+        _mangledname:=stringdup(s);
+        mangledname:=_mangledname^;
       end;
 
 
@@ -3783,31 +3871,12 @@ implementation
          cplusplusmangledname:=s;
       end;
 
+
     procedure tprocdef.setmangledname(const s : string);
       begin
-         if assigned(_mangledname) then
-           begin
-{$ifdef MEMDEBUG}
-              dec(manglenamesize,length(_mangledname^));
-{$endif}
-              stringdispose(_mangledname);
-           end;
-         _mangledname:=stringdup(s);
-{$ifdef MEMDEBUG}
-         inc(manglenamesize,length(s));
-{$endif}
-{$ifdef EXTDEBUG}
-         if assigned(parast) then
-           begin
-              stringdispose(parast.name);
-              parast.name:=stringdup('args of '+s);
-           end;
-         if assigned(localst) then
-           begin
-              stringdispose(localst.name);
-              localst.name:=stringdup('locals of '+s);
-           end;
-{$endif}
+        stringdispose(_mangledname);
+        _mangledname:=stringdup(s);
+        has_mangledname:=true;
       end;
 
 
@@ -3971,10 +4040,10 @@ implementation
       begin
          if assigned(rettype.def) and
             (rettype.def<>voidtype.def) then
-           s:='<procedure variable type of function'+demangled_paras+
+           s:='<procedure variable type of function'+typename_paras+
              ':'+rettype.def.gettypename
          else
-           s:='<procedure variable type of procedure'+demangled_paras;
+           s:='<procedure variable type of procedure'+typename_paras;
          if po_methodpointer in procoptions then
            s := s+' of object';
          gettypename := s+';'+ProcCallOptionStr[proccalloption]+'>';
@@ -4011,7 +4080,8 @@ implementation
          symtable.dataalignment:=aktalignment.recordalignmax;
         lastvtableindex:=0;
         set_parent(c);
-        objname:=stringdup(n);
+        objname:=stringdup(upper(n));
+        objrealname:=stringdup(n);
 
         { set up guid }
         isiidguidvalid:=true; { default null guid }
@@ -4040,7 +4110,8 @@ implementation
          objecttype:=tobjectdeftype(ppufile.getbyte);
          savesize:=ppufile.getlongint;
          vmt_offset:=ppufile.getlongint;
-         objname:=stringdup(ppufile.getstring);
+         objrealname:=stringdup(ppufile.getstring);
+         objname:=stringdup(upper(objrealname^));
          childof:=tobjectdef(ppufile.getderef);
          ppufile.getsmallset(objectoptions);
 
@@ -4070,7 +4141,7 @@ implementation
 
          oldread_member:=read_member;
          read_member:=true;
-         symtable:=tobjectsymtable.create(objname^);
+         symtable:=tobjectsymtable.create(objrealname^);
          tobjectsymtable(symtable).load(ppufile);
          read_member:=oldread_member;
 
@@ -4081,11 +4152,11 @@ implementation
          { it !                                  }
          if (childof=nil) and
             (objecttype=odt_class) and
-            (upper(objname^)='TOBJECT') then
+            (objname^='TOBJECT') then
            class_tobject:=self;
          if (childof=nil) and
             (objecttype=odt_interfacecom) and
-            (upper(objname^)='IUNKNOWN') then
+            (objname^='IUNKNOWN') then
            interface_iunknown:=self;
 {$ifdef GDB}
          writing_class_record_stab:=false;
@@ -4098,6 +4169,7 @@ implementation
         if assigned(symtable) then
           symtable.free;
         stringdispose(objname);
+        stringdispose(objrealname);
         stringdispose(iidstr);
         if assigned(implementedinterfaces) then
           implementedinterfaces.free;
@@ -4115,7 +4187,7 @@ implementation
          ppufile.putbyte(byte(objecttype));
          ppufile.putlongint(size);
          ppufile.putlongint(vmt_offset);
-         ppufile.putstring(objname^);
+         ppufile.putstring(objrealname^);
          ppufile.putderef(childof);
          ppufile.putsmallset(objectoptions);
          if objecttype in [odt_interfacecom,odt_interfacecorba] then
@@ -4219,7 +4291,7 @@ implementation
         if (oo_is_forward in objectoptions) then
           begin
              { ok, in future, the forward can be resolved }
-             Message1(sym_e_class_forward_not_resolved,objname^);
+             Message1(sym_e_class_forward_not_resolved,objrealname^);
              exclude(objectoptions,oo_is_forward);
           end;
      end;
@@ -4323,39 +4395,16 @@ implementation
 
 
     function tobjectdef.vmt_mangledname : string;
-    {DM: I get a nil pointer on the owner name. I don't know if this
-     may happen, and I have therefore fixed the problem by doing nil pointer
-     checks.}
-    var
-      s1,s2:string;
     begin
-        if not(oo_has_vmt in objectoptions) then
-          Message1(parser_object_has_no_vmt,objname^);
-        if owner.name=nil then
-          s1:=''
-        else
-          s1:=upper(owner.name^);
-        if objname=nil then
-          s2:=''
-        else
-          s2:=Upper(objname^);
-        vmt_mangledname:='VMT_'+s1+'$_'+s2;
+      if not(oo_has_vmt in objectoptions) then
+        Message1(parser_object_has_no_vmt,objrealname^);
+      vmt_mangledname:=mangledname_prefix('VMT',owner)+objname^;
     end;
 
 
     function tobjectdef.rtti_name : string;
-    var
-      s1,s2:string;
     begin
-       if owner.name=nil then
-         s1:=''
-       else
-         s1:=upper(owner.name^);
-       if objname=nil then
-         s2:=''
-       else
-         s2:=Upper(objname^);
-       rtti_name:='RTTI_'+s1+'$_'+s2;
+      rtti_name:=mangledname_prefix('RTTI',owner)+objname^;
     end;
 
 
@@ -4897,8 +4946,8 @@ implementation
           end;
 
          { generate the name }
-         rttiList.concat(Tai_const.Create_8bit(length(objname^)));
-         rttiList.concat(Tai_string.Create(objname^));
+         rttiList.concat(Tai_const.Create_8bit(length(objrealname^)));
+         rttiList.concat(Tai_string.Create(objrealname^));
 
          case rt of
            initrtti :
@@ -5419,7 +5468,15 @@ implementation
 end.
 {
   $Log$
-  Revision 1.70  2002-04-15 19:06:34  carl
+  Revision 1.71  2002-04-19 15:46:03  peter
+    * mangledname rewrite, tprocdef.mangledname is now created dynamicly
+      in most cases and not written to the ppu
+    * add mangeledname_prefix() routine to generate the prefix of
+      manglednames depending on the current procedure, object and module
+    * removed static procprefix since the mangledname is now build only
+      on demand from tprocdef.mangledname
+
+  Revision 1.70  2002/04/15 19:06:34  carl
   + target_info.size_of_pointer -> pointer_Size
 
   Revision 1.69  2002/04/14 16:55:43  carl

compiler/symsym.pas

@@ -46,6 +46,9 @@ interface
 
        { this object is the base for all symbol objects }
        tstoredsym = class(tsym)
+       protected
+          _mangledname : pstring;
+       public
 {$ifdef GDB}
           isstabwritten : boolean;
 {$endif GDB}
@@ -69,6 +72,8 @@ interface
           function  write_references(ppufile:tcompilerppufile;locals:boolean):boolean;virtual;
           function  is_visible_for_proc(currprocdef:tprocdef):boolean;
           function  is_visible_for_object(currobjdef:tobjectdef):boolean;
+          function  mangledname : string;
+          procedure generate_mangledname;virtual;abstract;
        end;
 
        tlabelsym = class(tstoredsym)
@@ -79,7 +84,7 @@ interface
           constructor create(const n : string; l : tasmlabel);
           destructor destroy;override;
           constructor load(ppufile:tcompilerppufile);
-          function mangledname : string;
+          procedure generate_mangledname;override;
           procedure write(ppufile:tcompilerppufile);override;
        end;
 
@@ -104,6 +109,7 @@ interface
           defs      : pprocdeflist; { linked list of overloaded procdefs }
           is_global : boolean;
           overloadchecked : boolean;
+          overloadcount   : longint; { amount of overloaded functions in this module }
           constructor create(const n : string);
           constructor load(ppufile:tcompilerppufile);
           destructor destroy;override;
@@ -156,8 +162,8 @@ interface
           destructor  destroy;override;
           procedure write(ppufile:tcompilerppufile);override;
           procedure deref;override;
-          procedure setmangledname(const s : string);
-          function  mangledname : string;
+          procedure generate_mangledname;override;
+          procedure set_mangledname(const s:string);
           procedure insert_in_data;override;
           function  getsize : longint;
           function  getvaluesize : longint;
@@ -166,8 +172,6 @@ interface
           function  stabstring : pchar;override;
           procedure concatstabto(asmlist : taasmoutput);override;
 {$endif GDB}
-       private
-          _mangledname  : pchar;
        end;
 
        tpropertysym = class(tstoredsym)
@@ -226,14 +230,13 @@ interface
        end;
 
        ttypedconstsym = class(tstoredsym)
-          prefix          : pstring;
           typedconsttype  : ttype;
           is_writable     : boolean;
           constructor create(const n : string;p : tdef;writable : boolean);
           constructor createtype(const n : string;const tt : ttype;writable : boolean);
           constructor load(ppufile:tcompilerppufile);
           destructor destroy;override;
-          function  mangledname : string;
+          procedure generate_mangledname;override;
           procedure write(ppufile:tcompilerppufile);override;
           procedure deref;override;
           function  getsize:longint;
@@ -332,8 +335,6 @@ interface
 
        generrorsym : tsym;
 
-       procprefix : string;     { prefix generated for the current compiled proc }
-
     const
        current_object_option : tsymoptions = [sp_public];
 
@@ -394,6 +395,7 @@ implementation
             inc(refcount);
           end;
          lastref:=defref;
+         _mangledname:=nil;
       end;
 
 
@@ -414,6 +416,7 @@ implementation
          refs:=0;
          lastwritten:=nil;
          refcount:=0;
+         _mangledname:=nil;
 {$ifdef GDB}
          isstabwritten := false;
 {$endif GDB}
@@ -494,6 +497,8 @@ implementation
 
     destructor tstoredsym.destroy;
       begin
+        if assigned(_mangledname) then
+         stringdispose(_mangledname);
         if assigned(defref) then
          begin
            defref.freechain;
@@ -602,6 +607,18 @@ implementation
       end;
 
 
+    function tstoredsym.mangledname : string;
+      begin
+        if not assigned(_mangledname) then
+         begin
+           generate_mangledname;
+           if not assigned(_mangledname) then
+            internalerror(200204171);
+         end;
+        mangledname:=_mangledname^
+      end;
+
+
 {****************************************************************************
                                  TLABELSYM
 ****************************************************************************}
@@ -637,9 +654,9 @@ implementation
       end;
 
 
-    function tlabelsym.mangledname : string;
+    procedure tlabelsym.generate_mangledname;
       begin
-         mangledname:=lab.name;
+        _mangledname:=stringdup(lab.name);
       end;
 
 
@@ -745,6 +762,7 @@ implementation
          owner:=nil;
          is_global:=false;
          overloadchecked:=false;
+         overloadcount:=0;
       end;
 
 
@@ -763,6 +781,7 @@ implementation
          until false;
          is_global:=false;
          overloadchecked:=false;
+         overloadcount:=-1; { invalid, not used anymore }
       end;
 
 
@@ -1307,7 +1326,8 @@ implementation
       begin
          tvarsym(self).create(n,tt);
          include(varoptions,vo_is_C_var);
-         setmangledname(mangled);
+         stringdispose(_mangledname);
+         _mangledname:=stringdup(mangled);
       end;
 
 
@@ -1315,7 +1335,6 @@ implementation
       begin
          inherited loadsym(ppufile);
          typ:=varsym;
-         _mangledname:=nil;
          reg:=R_NO;
          refs := 0;
          varstate:=vs_used;
@@ -1328,13 +1347,12 @@ implementation
          ppufile.gettype(vartype);
          ppufile.getsmallset(varoptions);
          if (vo_is_C_var in varoptions) then
-           setmangledname(ppufile.getstring);
+           _mangledname:=stringdup(ppufile.getstring);
       end;
 
 
     destructor tvarsym.destroy;
       begin
-         strdispose(_mangledname);
          inherited destroy;
       end;
 
@@ -1364,34 +1382,16 @@ implementation
       end;
 
 
-    procedure tvarsym.setmangledname(const s : string);
+    procedure tvarsym.generate_mangledname;
       begin
-        _mangledname:=strpnew(s);
+        _mangledname:=stringdup(mangledname_prefix('U',owner)+name);
       end;
 
 
-    function tvarsym.mangledname : string;
-      var
-        prefix : string;
+    procedure tvarsym.set_mangledname(const s:string);
       begin
-         if assigned(_mangledname) then
-           begin
-              mangledname:=strpas(_mangledname);
-              exit;
-           end;
-         case owner.symtabletype of
-           staticsymtable :
-             if (cs_create_smart in aktmoduleswitches) then
-               prefix:='_'+upper(owner.name^)+'$$$_'
-             else
-               prefix:='_';
-           globalsymtable :
-             prefix:=
-              'U_'+upper(owner.name^)+'_';
-           else
-             Message(sym_e_invalid_call_tvarsymmangledname);
-         end;
-         mangledname:=prefix+name;
+        stringdispose(_mangledname);
+        _mangledname:=stringdup(s);
       end;
 
 
@@ -1708,7 +1708,6 @@ implementation
          typ:=typedconstsym;
          typedconsttype.setdef(p);
          is_writable:=writable;
-         prefix:=stringdup(procprefix);
       end;
 
 
@@ -1718,7 +1717,6 @@ implementation
          typ:=typedconstsym;
          typedconsttype:=tt;
          is_writable:=writable;
-         prefix:=stringdup(procprefix);
       end;
 
 
@@ -1727,21 +1725,19 @@ implementation
          inherited loadsym(ppufile);
          typ:=typedconstsym;
          ppufile.gettype(typedconsttype);
-         prefix:=stringdup(ppufile.getstring);
          is_writable:=boolean(ppufile.getbyte);
       end;
 
 
     destructor ttypedconstsym.destroy;
       begin
-         stringdispose(prefix);
          inherited destroy;
       end;
 
 
-    function ttypedconstsym.mangledname : string;
+    procedure ttypedconstsym.generate_mangledname;
       begin
-         mangledname:='TC_'+prefix^+'_'+name;
+        _mangledname:=stringdup(mangledname_prefix('TC',owner)+name);
       end;
 
 
@@ -1764,7 +1760,6 @@ implementation
       begin
          inherited writesym(ppufile);
          ppufile.puttype(typedconsttype);
-         ppufile.putstring(prefix^);
          ppufile.putbyte(byte(is_writable));
          ppufile.writeentry(ibtypedconstsym);
       end;
@@ -2518,7 +2513,15 @@ implementation
 end.
 {
   $Log$
-  Revision 1.34  2002-04-16 16:12:47  peter
+  Revision 1.35  2002-04-19 15:46:03  peter
+    * mangledname rewrite, tprocdef.mangledname is now created dynamicly
+      in most cases and not written to the ppu
+    * add mangeledname_prefix() routine to generate the prefix of
+      manglednames depending on the current procedure, object and module
+    * removed static procprefix since the mangledname is now build only
+      on demand from tprocdef.mangledname
+
+  Revision 1.34  2002/04/16 16:12:47  peter
     * give error when using enums with jumps as array index
     * allow char as enum value
 

compiler/symtype.pas

@@ -70,6 +70,8 @@ interface
          procedure derefimpl;virtual;abstract;
          function  typename:string;
          function  gettypename:string;virtual;
+         function  mangledparaname:string;
+         function  getmangledparaname:string;virtual;abstract;
          function  size:longint;virtual;abstract;
          function  alignment:longint;virtual;abstract;
          function  getsymtable(t:tgetsymtable):tsymtable;virtual;
@@ -177,6 +179,15 @@ implementation
       end;
 
 
+    function tdef.mangledparaname:string;
+      begin
+        if assigned(typesym) then
+         mangledparaname:=typesym.name
+        else
+         mangledparaname:=getmangledparaname;
+      end;
+
+
     function tdef.getsymtable(t:tgetsymtable):tsymtable;
       begin
         getsymtable:=nil;
@@ -517,7 +528,15 @@ implementation
 end.
 {
   $Log$
-  Revision 1.13  2001-12-31 16:59:43  peter
+  Revision 1.14  2002-04-19 15:46:04  peter
+    * mangledname rewrite, tprocdef.mangledname is now created dynamicly
+      in most cases and not written to the ppu
+    * add mangeledname_prefix() routine to generate the prefix of
+      manglednames depending on the current procedure, object and module
+    * removed static procprefix since the mangledname is now build only
+      on demand from tprocdef.mangledname
+
+  Revision 1.13  2001/12/31 16:59:43  peter
     * protected/private symbols parsing fixed
 
   Revision 1.12  2001/11/18 18:43:18  peter

compiler/targets/t_beos.pas

@@ -91,7 +91,7 @@ begin
   { insert sharedlibrary }
   current_module.linkothersharedlibs.add(SplitName(module),link_allways);
   { reset the mangledname and turn off the dll_var option }
-  aktvarsym.setmangledname(name);
+  aktvarsym.set_mangledname(name);
   exclude(aktvarsym.varoptions,vo_is_dll_var);
 end;
 
@@ -534,7 +534,15 @@ initialization
 end.
 {
   $Log$
-  Revision 1.12  2002-04-15 19:16:57  carl
+  Revision 1.13  2002-04-19 15:46:04  peter
+    * mangledname rewrite, tprocdef.mangledname is now created dynamicly
+      in most cases and not written to the ppu
+    * add mangeledname_prefix() routine to generate the prefix of
+      manglednames depending on the current procedure, object and module
+    * removed static procprefix since the mangledname is now build only
+      on demand from tprocdef.mangledname
+
+  Revision 1.12  2002/04/15 19:16:57  carl
   - remove size_of_pointer field
 
   Revision 1.11  2002/01/29 21:27:34  peter

compiler/targets/t_fbsd.pas

@@ -93,7 +93,7 @@ begin
   { insert sharedlibrary }
   current_module.linkothersharedlibs.add(SplitName(module),link_allways);
   { reset the mangledname and turn off the dll_var option }
-  aktvarsym.setmangledname(name);
+  aktvarsym.set_mangledname(name);
   exclude(aktvarsym.varoptions,vo_is_dll_var);
 end;
 
@@ -713,7 +713,15 @@ initialization
 end.
 {
   $Log$
-  Revision 1.15  2002-04-15 19:16:57  carl
+  Revision 1.16  2002-04-19 15:46:04  peter
+    * mangledname rewrite, tprocdef.mangledname is now created dynamicly
+      in most cases and not written to the ppu
+    * add mangeledname_prefix() routine to generate the prefix of
+      manglednames depending on the current procedure, object and module
+    * removed static procprefix since the mangledname is now build only
+      on demand from tprocdef.mangledname
+
+  Revision 1.15  2002/04/15 19:16:57  carl
   - remove size_of_pointer field
 
   Revision 1.14  2002/01/29 21:27:34  peter

compiler/targets/t_linux.pas

@@ -95,7 +95,7 @@ begin
   { insert sharedlibrary }
   current_module.linkothersharedlibs.add(SplitName(module),link_allways);
   { reset the mangledname and turn off the dll_var option }
-  aktvarsym.setmangledname(name);
+  aktvarsym.set_mangledname(name);
   exclude(aktvarsym.varoptions,vo_is_dll_var);
 end;
 
@@ -739,7 +739,15 @@ initialization
 end.
 {
   $Log$
-  Revision 1.18  2002-04-15 19:44:23  peter
+  Revision 1.19  2002-04-19 15:46:05  peter
+    * mangledname rewrite, tprocdef.mangledname is now created dynamicly
+      in most cases and not written to the ppu
+    * add mangeledname_prefix() routine to generate the prefix of
+      manglednames depending on the current procedure, object and module
+    * removed static procprefix since the mangledname is now build only
+      on demand from tprocdef.mangledname
+
+  Revision 1.18  2002/04/15 19:44:23  peter
     * fixed stackcheck that would be called recursively when a stack
       error was found
     * generic changeregsize(reg,size) for i386 register resizing

compiler/targets/t_nwm.pas

@@ -21,7 +21,7 @@
 
     First Implementation 10 Sept 2000 Armin Diehl
 
-    Currently generating NetWare-NLM's only work under Linux and win32. 
+    Currently generating NetWare-NLM's only work under Linux and win32.
     (see http://home.arcor.de/armin.diehl/fpcnw for binutils working
     with win32) while not included in fpc-releases.
 
@@ -55,8 +55,8 @@
        make all
 
     Debugging is currently only possible at assembler level with nwdbg, written
-    by Jan Beulich. (or with my modified RDebug) Nwdbg supports symbols but it's 
-    not a source-level debugger. You can get nwdbg from developer.novell.com. 
+    by Jan Beulich. (or with my modified RDebug) Nwdbg supports symbols but it's
+    not a source-level debugger. You can get nwdbg from developer.novell.com.
     To enter the debugger from your program, call _EnterDebugger (defined in unit system).
 
     A sample program:
@@ -141,7 +141,7 @@ begin
    begin
      aktprocdef.setmangledname(name);
      aktprocdef.has_mangledname:=true;
-   end     
+   end
   else
     message(parser_e_empty_import_name);
 end;
@@ -152,7 +152,7 @@ begin
   { insert sharedlibrary }
   current_module.linkothersharedlibs.add(SplitName(module),link_allways);
   { reset the mangledname and turn off the dll_var option }
-  aktvarsym.setmangledname(name);
+  aktvarsym.set_mangledname(name);
   exclude(aktvarsym.varoptions,vo_is_dll_var);
 end;
 
@@ -302,7 +302,7 @@ begin
   if Description <> '' then
     LinkRes.Add('DESCRIPTION "' + Description + '"');
   LinkRes.Add('VERSION '+tostr(dllmajor)+','+tostr(dllminor)+','+tostr(dllrevision));
-  
+
   p := Pos ('"', nwscreenname);
   while (p > 0) do
   begin
@@ -370,7 +370,7 @@ begin
         imported libraries}
        if (pos ('.a',s) <> 0) OR (pos ('.A', s) <> 0) then
        begin
-         LinkRes.Add ('INPUT '+FindObjectFile(s,'')); 
+         LinkRes.Add ('INPUT '+FindObjectFile(s,''));
        end else
        begin
              i:=Pos(target_info.staticlibext,S);
@@ -551,7 +551,15 @@ initialization
 end.
 {
   $Log$
-  Revision 1.18  2002-04-15 19:16:57  carl
+  Revision 1.19  2002-04-19 15:46:05  peter
+    * mangledname rewrite, tprocdef.mangledname is now created dynamicly
+      in most cases and not written to the ppu
+    * add mangeledname_prefix() routine to generate the prefix of
+      manglednames depending on the current procedure, object and module
+    * removed static procprefix since the mangledname is now build only
+      on demand from tprocdef.mangledname
+
+  Revision 1.18  2002/04/15 19:16:57  carl
   - remove size_of_pointer field
 
   Revision 1.17  2002/03/30 09:09:47  armin

compiler/targets/t_sunos.pas

@@ -101,7 +101,7 @@ begin
   { insert sharedlibrary }
   current_module.linkothersharedlibs.add(SplitName(module),link_allways);
   { reset the mangledname and turn off the dll_var option }
-  aktvarsym.setmangledname(name);
+  aktvarsym.set_mangledname(name);
   exclude(aktvarsym.varoptions,vo_is_dll_var);
 end;
 
@@ -554,7 +554,15 @@ initialization
 end.
 {
   $Log$
-  Revision 1.17  2002-04-15 19:16:57  carl
+  Revision 1.18  2002-04-19 15:46:05  peter
+    * mangledname rewrite, tprocdef.mangledname is now created dynamicly
+      in most cases and not written to the ppu
+    * add mangeledname_prefix() routine to generate the prefix of
+      manglednames depending on the current procedure, object and module
+    * removed static procprefix since the mangledname is now build only
+      on demand from tprocdef.mangledname
+
+  Revision 1.17  2002/04/15 19:16:57  carl
   - remove size_of_pointer field
 
   Revision 1.16  2002/03/04 19:10:14  peter