mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-14 07:29:29 +02:00
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 -
This commit is contained in:
parent
2a3180c3d1
commit
47ff755068
@ -2718,20 +2718,9 @@ const
|
|||||||
|
|
||||||
|
|
||||||
function proc_get_importname(pd:tprocdef):string;
|
function proc_get_importname(pd:tprocdef):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
|
var
|
||||||
crc : cardinal;
|
dllname, importname : string;
|
||||||
i : longint;
|
|
||||||
use_crc : boolean;
|
|
||||||
dllname : string;
|
|
||||||
begin
|
begin
|
||||||
result:='';
|
result:='';
|
||||||
if not(po_external in pd.procoptions) then
|
if not(po_external in pd.procoptions) then
|
||||||
@ -2740,56 +2729,15 @@ const
|
|||||||
if assigned(pd.import_name) or (pd.import_nr<>0) then
|
if assigned(pd.import_name) or (pd.import_nr<>0) then
|
||||||
begin
|
begin
|
||||||
if assigned(pd.import_dll) then
|
if assigned(pd.import_dll) then
|
||||||
begin
|
dllname:=pd.import_dll^
|
||||||
{ 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
|
else
|
||||||
*)
|
dllname:='';
|
||||||
if assigned(pd.import_name) then
|
if assigned(pd.import_name) then
|
||||||
begin
|
importname:=pd.import_name^
|
||||||
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
|
else
|
||||||
result:='_$dll$'+dllname+'$'+pd.import_name^;
|
importname:='';
|
||||||
end
|
proc_get_importname:=make_dllmangledname(dllname,
|
||||||
else
|
importname,pd.import_nr,pd.proccalloption);
|
||||||
result:=maybe_cprefix(pd.import_name^);
|
|
||||||
end
|
|
||||||
else
|
|
||||||
result:=ExtractFileName(pd.import_dll^)+'_index_'+tostr(pd.import_nr);
|
|
||||||
end
|
|
||||||
else
|
|
||||||
result:=maybe_cprefix(pd.import_name^);
|
|
||||||
end
|
end
|
||||||
else
|
else
|
||||||
begin
|
begin
|
||||||
@ -2836,17 +2784,6 @@ const
|
|||||||
s:=proc_get_importname(pd);
|
s:=proc_get_importname(pd);
|
||||||
if s<>'' then
|
if s<>'' then
|
||||||
begin
|
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);
|
pd.setmangledname(s);
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
@ -1035,7 +1035,7 @@ implementation
|
|||||||
begin
|
begin
|
||||||
if target_info.system in (systems_all_windows + systems_nativent +
|
if target_info.system in (systems_all_windows + systems_nativent +
|
||||||
[system_i386_emx, system_i386_os2]) then
|
[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);
|
current_module.AddExternalImport(dll_name,C_Name,mangledname,0,true,false);
|
||||||
end
|
end
|
||||||
|
@ -789,6 +789,8 @@ interface
|
|||||||
{$endif AVR}
|
{$endif AVR}
|
||||||
|
|
||||||
function make_mangledname(const typeprefix:string;st:TSymtable;const suffix:string):string;
|
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 :( }
|
{ should be in the types unit, but the types unit uses the node stuff :( }
|
||||||
function is_interfacecom(def: tdef): boolean;
|
function is_interfacecom(def: tdef): boolean;
|
||||||
@ -938,6 +940,68 @@ implementation
|
|||||||
result := '_' + result;
|
result := '_' + result;
|
||||||
end;
|
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
|
TDEFAWARESYMTABLESTACK
|
||||||
(symtablestack descendant that does some special actions on
|
(symtablestack descendant that does some special actions on
|
||||||
|
Loading…
Reference in New Issue
Block a user