Преглед на файлове

symdef.pas New make_dllmangledname function
used both in pdecvar and pdecsub units to generate a mangled name
for externals imported from a dynamic library.

git-svn-id: trunk@17850 -

pierre преди 14 години
родител
ревизия
47ff755068
променени са 3 файла, в които са добавени 75 реда и са изтрити 74 реда
  1. 10 73
      compiler/pdecsub.pas
  2. 1 1
      compiler/pdecvar.pas
  3. 64 0
      compiler/symdef.pas

+ 10 - 73
compiler/pdecsub.pas

@@ -2718,20 +2718,9 @@ const
 
 
     function proc_get_importname(pd:tprocdef):string;
+      var
+        dllname, importname : string;
 
-       function maybe_cprefix(const s:string):string;
-         begin
-           if not(pd.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
-             result:=s
-           else
-             result:=target_info.Cprefix+s;
-         end;
-
-       var
-         crc : cardinal;
-         i : longint;
-         use_crc : boolean;
-         dllname : string;
       begin
         result:='';
         if not(po_external in pd.procoptions) then
@@ -2740,56 +2729,15 @@ const
         if assigned(pd.import_name) or (pd.import_nr<>0) then
           begin
             if assigned(pd.import_dll) then
-              begin
-                { If we are not using direct dll linking under win32 then imports
-                  need to use the normal name since two functions can refer to the
-                  same DLL function. This is also needed for compatability
-                  with Delphi and TP7 }
-(*
-                case target_info.system of
-                  system_i386_emx,
-                  system_i386_os2 :
-                    begin
-                      { keep normal mangledname }
-                      if not (Assigned (PD.Import_Name)) then
-                       Result := PD.MangledName;
-                    end;
-                  else
-*)
-                if assigned(pd.import_name) then
-                  begin
-                    if target_info.system in (systems_all_windows + systems_nativent +
-                                       [system_i386_emx, system_i386_os2]) then
-                      begin
-                        dllname:=lower(ExtractFileName(pd.import_dll^));
-                        { Remove .dll suffix if present }
-                        if copy(dllname,length(dllname)-3,length(dllname))='.dll' then
-                          dllname:=copy(dllname,1,length(dllname)-4);
-                        use_crc:=false;
-                        for i:=1 to length(dllname) do
-                          if not (dllname[i] in ['a'..'z','A'..'Z','_','0'..'9']) then
-                            begin
-                              use_crc:=true;
-                              break;
-                            end;
-
-                        if use_crc and (length(dllname) > 0) then
-                          begin
-                            crc:=0;
-                            crc:=UpdateCrc32(crc,dllname[1],length(dllname));
-                            result:='_$dll$crc$'+hexstr(crc,8)+'$'+pd.import_name^;
-                          end
-                        else
-                          result:='_$dll$'+dllname+'$'+pd.import_name^;
-                      end
-                    else
-                      result:=maybe_cprefix(pd.import_name^);
-                  end
-                else
-                  result:=ExtractFileName(pd.import_dll^)+'_index_'+tostr(pd.import_nr);
-              end
+              dllname:=pd.import_dll^
             else
-              result:=maybe_cprefix(pd.import_name^);
+              dllname:='';
+            if assigned(pd.import_name) then
+              importname:=pd.import_name^
+            else
+              importname:='';
+            proc_get_importname:=make_dllmangledname(dllname,
+              importname,pd.import_nr,pd.proccalloption);
           end
         else
           begin
@@ -2836,17 +2784,6 @@ const
                     s:=proc_get_importname(pd);
                     if s<>'' then
                       begin
-                        { Replace ? and @ in import name, since GNU AS does not allow these characters in symbol names. }
-                        { This allows to import VC++ mangled names from DLLs. }
-                        { Do not perform replacement, if external symbol is not imported from DLL. }
-                        if (target_info.system in systems_all_windows) and (pd.import_dll<>nil) then
-                          begin
-                            Replace(s,'?','__q$$');
-{$ifdef arm}
-                            { @ symbol is not allowed in ARM assembler only }
-                            Replace(s,'@','__a$$');
-{$endif arm}
-                          end;
                         pd.setmangledname(s);
                       end;
                   end;

+ 1 - 1
compiler/pdecvar.pas

@@ -1035,7 +1035,7 @@ implementation
             begin
               if target_info.system in (systems_all_windows + systems_nativent +
                                        [system_i386_emx, system_i386_os2]) then
-                mangledname:='_$dll$'+ExtractFileName(dll_name)+'$'+C_name;
+                mangledname:=make_dllmangledname(dll_name,C_name,0,pocall_none);
 
               current_module.AddExternalImport(dll_name,C_Name,mangledname,0,true,false);
             end

+ 64 - 0
compiler/symdef.pas

@@ -789,6 +789,8 @@ interface
 {$endif AVR}
 
     function make_mangledname(const typeprefix:string;st:TSymtable;const suffix:string):string;
+    function make_dllmangledname(const dllname,importname:string;
+                                 import_nr : word; pco : tproccalloption):string;
 
     { should be in the types unit, but the types unit uses the node stuff :( }
     function is_interfacecom(def: tdef): boolean;
@@ -938,6 +940,68 @@ implementation
           result := '_' + result;
       end;
 
+    function make_dllmangledname(const dllname,importname:string;import_nr : word; pco : tproccalloption):string;
+       var
+         crc : cardinal;
+         i : longint;
+         use_crc : boolean;
+         dllprefix : string;
+      begin
+        if (target_info.system in (systems_all_windows + systems_nativent +
+                           [system_i386_emx, system_i386_os2]))
+            and (dllname <> '') then
+          begin
+            dllprefix:=lower(ExtractFileName(dllname));
+            { Remove .dll suffix if present }
+            if copy(dllprefix,length(dllprefix)-3,length(dllprefix))='.dll' then
+              dllprefix:=copy(dllprefix,1,length(dllprefix)-4);
+            use_crc:=false;
+            for i:=1 to length(dllprefix) do
+              if not (dllprefix[i] in ['a'..'z','A'..'Z','_','0'..'9']) then
+                begin
+                  use_crc:=true;
+                  break;
+                end;
+            if use_crc then
+              begin
+                crc:=0;
+                crc:=UpdateCrc32(crc,dllprefix[1],length(dllprefix));
+                dllprefix:='_$dll$crc$'+hexstr(crc,8)+'$';
+              end
+            else
+              dllprefix:='_$dll$'+dllprefix+'$';
+
+            if importname<>'' then
+              result:=dllname+importname
+            else
+              result:=dllname+'_index_'+tostr(import_nr);
+            { Replace ? and @ in import name, since GNU AS does not allow these characters in symbol names. }
+            { This allows to import VC++ mangled names from DLLs. }
+            { Do not perform replacement, if external symbol is not imported from DLL. }
+            if (dllname<>'') then
+              begin
+                Replace(result,'?','__q$$');
+    {$ifdef arm}
+                { @ symbol is not allowed in ARM assembler only }
+                Replace(result,'@','__a$$');
+    {$endif arm}
+             end;
+          end
+        else
+          begin
+            if importname<>'' then
+             begin
+               if not(pco in [pocall_cdecl,pocall_cppdecl]) then
+                 result:=importname
+               else
+                 result:=target_info.Cprefix+importname;
+             end
+            else
+              result:='_index_'+tostr(import_nr);
+          end;
+
+      end;
+
 {****************************************************************************
            TDEFAWARESYMTABLESTACK
            (symtablestack descendant that does some special actions on