paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-15 17:39:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

* factored unix exports handling from t_bsd and t_linux into expunix unit

Browse Source 
(todo: at least solaris, maybe others)
  * changed the "exports" section handling:
    a) make everything private which is not exported (implemented for
       darwin and linux)
    b) for the exported symbols:
     - functions/procedures
      1) if no name or index is provided, and if the procedure has aliases
         defined via the public/export directives, then export the default
         mangled name and all defined aliases
      2) otherwise if no name is specified (but there is an index) then
        i) if the procedure is defined as cdecl/cppdecl/mwpascal, use the
           appropriately mangled version of the function name
       ii) otherwise export the name without any mangling(e.g. "exports
           proc1" -> proc1 is the exported name)
     - variables
      1) if no name is provided and the variable was specified as cvar,
         use the mangled name
      2) otherwise if no name is provided, export the name without any
         mangling
  -> initialization/finalization of shared libraries under Linux works
     again (mantis )
  -> sharing symbols between shared library and main program works
     under Linux (mantis )

git-svn-id: trunk@10551 -
This commit is contained in:
Jonas Maebe 2008-03-24 16:55:05 +00:00
parent f96817b5e9
commit 150eda304b
17 changed files with 906 additions and 559 deletions

8
.gitattributes vendored
View File

@ -135,6 +135,7 @@ compiler/dbgstabs.pas svneol=native#text/plain
compiler/defcmp.pas svneol=native#text/plain
compiler/defutil.pas svneol=native#text/plain
compiler/export.pas svneol=native#text/plain
compiler/expunix.pp svneol=native#text/plain
compiler/finput.pas svneol=native#text/plain
compiler/fmodule.pas svneol=native#text/plain
compiler/fpccrc.pas svneol=native#text/plain
@ -8848,6 +8849,8 @@ tests/webtbs/tw7806.pp svneol=native#text/plain
tests/webtbs/tw7808.pp svneol=native#text/plain
tests/webtbs/tw7817a.pp svneol=native#text/plain
tests/webtbs/tw7817b.pp svneol=native#text/plain
tests/webtbs/tw7838a.pp svneol=native#text/plain
tests/webtbs/tw7838b.pp svneol=native#text/plain
tests/webtbs/tw7847.pp svneol=native#text/plain
tests/webtbs/tw7851.pp svneol=native#text/plain
tests/webtbs/tw7851a.pp svneol=native#text/plain
@ -8951,6 +8954,10 @@ tests/webtbs/tw9073.pp svneol=native#text/plain
tests/webtbs/tw9076.pp svneol=native#text/plain
tests/webtbs/tw9076a.pp svneol=native#text/plain
tests/webtbs/tw9085.pp svneol=native#text/plain
tests/webtbs/tw9089a.pp svneol=native#text/plain
tests/webtbs/tw9089b.pp svneol=native#text/plain
tests/webtbs/tw9089c.pp svneol=native#text/plain
tests/webtbs/tw9089d.pp svneol=native#text/plain
tests/webtbs/tw9095.pp svneol=native#text/plain
tests/webtbs/tw9096.pp svneol=native#text/plain
tests/webtbs/tw9098.pp svneol=native#text/plain
@ -9050,6 +9057,7 @@ tests/webtbs/uw4541.pp svneol=native#text/plain
tests/webtbs/uw6203.pp svneol=native#text/plain
tests/webtbs/uw6767.pp svneol=native#text/plain
tests/webtbs/uw7381.pp svneol=native#text/plain
tests/webtbs/uw7838a.pp svneol=native#text/plain
tests/webtbs/uw8180.pp svneol=native#text/plain
tests/webtbs/uw8372.pp svneol=native#text/plain
tests/webtbs/uw8730a.pp svneol=native#text/plain

87
compiler/export.pas
View File

@ -28,8 +28,8 @@ interface
uses
cutils,cclasses,
systems,
symtype,
aasmbase;
symtype,symdef,symsym,
aasmbase,aasmdata;
const
{ export options }
@ -51,6 +51,8 @@ type
texportlib=class
private
notsupmsg : boolean;
finitname,
ffininame : string;
procedure NotSupported;
public
constructor Create;virtual;
@ -59,10 +61,23 @@ type
procedure exportprocedure(hp : texported_item);virtual;
procedure exportvar(hp : texported_item);virtual;
procedure generatelib;virtual;
procedure setinitname(list: TAsmList; const s: string); virtual;
procedure setfininame(list: TAsmList; const s: string); virtual;
property initname: string read finitname;
property fininame: string read ffininame;
end;
TExportLibClass=class of TExportLib;
procedure exportprocsym(sym: tsym; const s : string; index: longint; options: word);
procedure exportvarsym(sym: tsym; const s : string; index: longint; options: word);
procedure exportallprocdefnames(sym: tprocsym; pd: tprocdef; options: word);
procedure exportallprocsymnames(ps: tprocsym; options: word);
var
CExportLib : array[tsystem] of TExportLibClass;
ExportLib : TExportLib;
@ -80,6 +95,63 @@ uses
TExported_procedure
****************************************************************************}
procedure exportprocsym(sym: tsym; const s : string; index: longint; options: word);
var
hp : texported_item;
begin
hp:=texported_item.create;
hp.name:=stringdup(s);
hp.sym:=sym;
hp.options:=options or eo_name;
hp.index:=index;
exportlib.exportprocedure(hp);
end;
procedure exportvarsym(sym: tsym; const s : string; index: longint; options: word);
var
hp : texported_item;
begin
hp:=texported_item.create;
hp.name:=stringdup(s);
hp.sym:=sym;
hp.is_var:=true;
hp.options:=options or eo_name;
hp.index:=index;
exportlib.exportvar(hp);
end;
procedure exportallprocdefnames(sym: tprocsym; pd: tprocdef; options: word);
var
item: TCmdStrListItem;
begin
exportprocsym(sym,pd.mangledname,0,options);
{ walk through all aliases }
item:=TCmdStrListItem(pd.aliasnames.first);
while assigned(item) do
begin
{ avoid duplicate entries, sometimes aliasnames contains the mangledname }
if item.str<>pd.mangledname then
exportprocsym(sym,item.str,0,options);
item:=TCmdStrListItem(item.next);
end;
end;
procedure exportallprocsymnames(ps: tprocsym; options: word);
var
i: longint;
begin
for i:= 0 to ps.ProcdefList.Count-1 do
exportallprocdefnames(ps,tprocdef(ps.ProcdefList[i]),options);
end;
{****************************************************************************
TExported_procedure
****************************************************************************}
constructor texported_item.Create;
begin
inherited Create;
@ -148,6 +220,17 @@ begin
end;
procedure texportlib.setinitname(list: TAsmList; const s: string);
begin
finitname:=s;
end;
procedure texportlib.setfininame(list: TAsmList; const s: string);
begin
ffininame:=s;
end;
{*****************************************************************************
Init/Done
*****************************************************************************}

185
compiler/expunix.pp Normal file
View File

@ -0,0 +1,185 @@
{
Copyright (c) 2008 by the Free Pascal Compiler team
This unit implements common support for import,export,link routines
for unix target
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
****************************************************************************
}
unit expunix;
{$i fpcdefs.inc}
interface
uses
cutils,cclasses,
systems,
export,
symtype,symdef,symsym,
aasmbase;
type
texportlibunix=class(texportlib)
private
fexportedsymnames: TCmdStrList;
public
constructor Create; override;
destructor destroy; override;
procedure preparelib(const s : string);override;
procedure exportprocedure(hp : texported_item);override;
procedure exportvar(hp : texported_item);override;
procedure generatelib;override;
property exportedsymnames: TCmdStrList read fexportedsymnames;
end;
implementation
{****************************************************************************
TExportLibUnix
****************************************************************************}
uses
symconst,
globtype,globals,
aasmdata,aasmtai,aasmcpu,
fmodule,
cgbase,cgutils,cpubase,cgobj,
ncgutil,
verbose;
constructor texportlibunix.create;
begin
inherited create;
fexportedsymnames:=tcmdstrlist.create_no_double;
end;
destructor texportlibunix.destroy;
begin
fexportedsymnames.free;
inherited destroy;
end;
procedure texportlibunix.preparelib(const s:string);
begin
end;
procedure texportlibunix.exportprocedure(hp : texported_item);
var
hp2 : texported_item;
begin
{ first test the index value }
if (hp.options and eo_index)<>0 then
begin
Message1(parser_e_no_export_with_index_for_target,target_info.shortname);
exit;
end;
{ now place in correct order }
hp2:=texported_item(current_module._exports.first);
while assigned(hp2) and
(hp.name^>hp2.name^) do
hp2:=texported_item(hp2.next);
{ insert hp there !! }
if assigned(hp2) and (hp2.name^=hp.name^) then
begin
{ this is not allowed !! }
Message1(parser_e_export_name_double,hp.name^);
exit;
end;
if hp2=texported_item(current_module._exports.first) then
current_module._exports.concat(hp)
else if assigned(hp2) then
begin
hp.next:=hp2;
hp.previous:=hp2.previous;
if assigned(hp2.previous) then
hp2.previous.next:=hp;
hp2.previous:=hp;
end
else
current_module._exports.concat(hp);
end;
procedure texportlibunix.exportvar(hp : texported_item);
begin
hp.is_var:=true;
exportprocedure(hp);
end;
procedure texportlibunix.generatelib; // straight t_linux copy for now.
var
hp2 : texported_item;
pd : tprocdef;
{$ifdef x86}
sym : tasmsymbol;
r : treference;
{$endif x86}
begin
new_section(current_asmdata.asmlists[al_procedures],sec_code,'',0);
hp2:=texported_item(current_module._exports.first);
while assigned(hp2) do
begin
if (not hp2.is_var) and
(hp2.sym.typ=procsym) then
begin
{ the manglednames can already be the same when the procedure
is declared with cdecl }
pd:=tprocdef(tprocsym(hp2.sym).ProcdefList[0]);
if not has_alias_name(pd,hp2.name^) then
begin
{ place jump in al_procedures }
current_asmdata.asmlists[al_procedures].concat(tai_align.create(target_info.alignment.procalign));
current_asmdata.asmlists[al_procedures].concat(Tai_symbol.Createname_global(hp2.name^,AT_FUNCTION,0));
if (cs_create_pic in current_settings.moduleswitches) and
{ other targets need to be checked how it works }
(target_info.system in [system_i386_freebsd,system_x86_64_linux,system_i386_linux]) then
begin
{$ifdef x86}
sym:=current_asmdata.RefAsmSymbol(pd.mangledname);
reference_reset_symbol(r,sym,0);
if cs_create_pic in current_settings.moduleswitches then
r.refaddr:=addr_pic
else
r.refaddr:=addr_full;
current_asmdata.asmlists[al_procedures].concat(taicpu.op_ref(A_JMP,S_NO,r));
{$endif x86}
end
else
cg.a_jmp_name(current_asmdata.asmlists[al_procedures],pd.mangledname);
current_asmdata.asmlists[al_procedures].concat(Tai_symbol_end.Createname(hp2.name^));
end;
exportedsymnames.insert(hp2.name^);
end
else
begin
if (hp2.name^<>hp2.sym.mangledname) then
Message2(parser_e_cant_export_var_different_name,hp2.sym.realname,hp2.sym.mangledname)
else
exportedsymnames.insert(hp2.name^);
end;
hp2:=texported_item(hp2.next);
end;
end;
end.

6
compiler/msg/errore.msg
View File

@ -358,7 +358,7 @@ scan_w_multiple_main_name_overrides=02086_W_Overriding name of "main" procedure
#
# Parser
#
# 03244 is the last used one
# 03247 is the last used one
#
% \section{Parser messages}
% This section lists all parser messages. The parser takes care of the
@ -1146,6 +1146,10 @@ parser_e_unsupported_real=03244_E_Floating point not supported for this target
parser_e_class_doesnt_implement_interface=03245_E_Class "$1" does not implement interface "$2"
% The delegated interface is not implemented by the class given in the implements clause
parser_e_class_implements_must_be_interface=03246_E_Type used by implements must be an interface
parser_e_cant_export_var_different_name=03247_E_Variables cannot be exported with a different name on this target, add the name to the declaration using the "export" directive (variable name: $1, declared export name: $2)
% On most targets it is not possible to change the name under which a variable is exported inside the \var{exports} statement of a library.
% In that case, you have to specify the export name at the point where the variable is declared, using the \var{export} and \var{alias} directives.
% \end{description}
#
# Type Checking

5
compiler/msgidx.inc
View File

@ -334,6 +334,7 @@ const
parser_e_unsupported_real=03244;
parser_e_class_doesnt_implement_interface=03245;
parser_e_class_implements_must_be_interface=03246;
parser_e_cant_export_var_different_name=03247;
type_e_mismatch=04000;
type_e_incompatible_types=04001;
type_e_not_equal_types=04002;
@ -750,9 +751,9 @@ const
option_info=11024;
option_help_pages=11025;
MsgTxtSize = 46724;
MsgTxtSize = 46906;
MsgIdxMax : array[1..20] of longint=(
24,87,247,84,64,50,108,22,135,61,
24,87,248,84,64,50,108,22,135,61,
42,1,1,1,1,1,1,1,1,1
);

552
compiler/msgtxt.inc
View File

File diff suppressed because it is too large Load Diff

22
compiler/ncgutil.pas
View File

@ -154,7 +154,7 @@ implementation
uses
version,
cutils,cclasses,
globals,systems,verbose,
globals,systems,verbose,export,
ppu,defutil,
procinfo,paramgr,fmodule,
regvars,dbgbase,
@ -2060,20 +2060,12 @@ implementation
current_procinfo.procdef.procendtai:=tai(list.last);
{ finalisation marker for Mac OS X }
if (target_info.system in systems_darwin) and
(current_module.islibrary) and
(((current_module.flags and uf_finalize)<>0) or
(current_procinfo.procdef.proctypeoption = potype_proginit)) then
begin
if (current_procinfo.procdef.proctypeoption = potype_proginit) then
list.concat(tai_directive.create(asd_mod_init_func,''))
else
list.concat(tai_directive.create(asd_mod_term_func,''));
list.concat(tai_align.create(4));
list.concat(Tai_const.Createname(current_procinfo.procdef.mangledname,0));
end;
if (current_module.islibrary) then
if (current_procinfo.procdef.proctypeoption = potype_proginit) then
exportlib.setinitname(list,current_procinfo.procdef.mangledname)
else if ((current_module.flags and uf_finalize)<>0) then
exportlib.setfininame(list,current_procinfo.procdef.mangledname);
if (current_procinfo.procdef.proctypeoption=potype_proginit) then
begin
if (target_info.system in (systems_darwin+[system_powerpc_macos])) and

84
compiler/pexports.pas
View File

@ -34,7 +34,7 @@ implementation
{ common }
cutils,
{ global }
globals,tokens,verbose,constexp,
globals,globtype,tokens,verbose,constexp,
systems,
ppu,fmodule,
{ symtable }
@ -52,7 +52,6 @@ implementation
procedure read_exports;
var
hp : texported_item;
orgs,
DefString,
InternalProcName : string;
@ -60,6 +59,9 @@ implementation
pt : tnode;
srsym : tsym;
srsymtable : TSymtable;
hpname : shortstring;
index : longint;
options : word;
function IsGreater(hp1,hp2:texported_item):boolean;
var
@ -83,12 +85,13 @@ implementation
InternalProcName:='';
consume(_EXPORTS);
repeat
hp:=texported_item.create;
hpname:='';
options:=0;
index:=0;
if token=_ID then
begin
consume_sym_orgid(srsym,srsymtable,orgs);
{ orgpattern is still valid here }
hp.sym:=srsym;
InternalProcName:='';
case srsym.typ of
staticvarsym :
@ -126,23 +129,23 @@ implementation
begin
pt:=comp_expr(true);
if pt.nodetype=ordconstn then
if (Tordconstnode(pt).value<int64(low(hp.index))) or
(Tordconstnode(pt).value>int64(high(hp.index))) then
if (Tordconstnode(pt).value<int64(low(index))) or
(Tordconstnode(pt).value>int64(high(index))) then
begin
hp.index:=0;
index:=0;
message(parser_e_range_check_error)
end
else
hp.index:=Tordconstnode(pt).value.svalue
index:=Tordconstnode(pt).value.svalue
else
begin
hp.index:=0;
index:=0;
consume(_INTCONST);
end;
hp.options:=hp.options or eo_index;
options:=options or eo_index;
pt.free;
if target_info.system in [system_i386_win32,system_i386_wdosx,system_arm_wince,system_i386_wince] then
DefString:=srsym.realname+'='+InternalProcName+' @ '+tostr(hp.index)
DefString:=srsym.realname+'='+InternalProcName+' @ '+tostr(index)
else
DefString:=srsym.realname+'='+InternalProcName; {Index ignored!}
end;
@ -150,33 +153,64 @@ implementation
begin
pt:=comp_expr(true);
if pt.nodetype=stringconstn then
hp.name:=stringdup(strpas(tstringconstnode(pt).value_str))
hpname:=strpas(tstringconstnode(pt).value_str)
else
begin
hp.name:=stringdup('');
consume(_CSTRING);
end;
hp.options:=hp.options or eo_name;
options:=options or eo_name;
pt.free;
DefString:=hp.name^+'='+InternalProcName;
DefString:=hpname+'='+InternalProcName;
end;
if try_to_consume(_RESIDENT) then
begin
hp.options:=hp.options or eo_resident;
options:=options or eo_resident;
DefString:=srsym.realname+'='+InternalProcName;{Resident ignored!}
end;
if (DefString<>'') and UseDeffileForExports then
DefFile.AddExport(DefString);
{ Default to generate a name entry with the provided name }
if not assigned(hp.name) then
begin
hp.name:=stringdup(orgs);
hp.options:=hp.options or eo_name;
end;
if hp.sym.typ=procsym then
exportlib.exportprocedure(hp)
if srsym.typ=procsym then
begin
{ if no specific name or index was given, then if }
{ the procedure has aliases defined export those, }
{ otherwise export the name as it appears in the }
{ export section (it doesn't make sense to export }
{ the generic mangled name, because the name of }
{ the parent unit is used in that) }
if ((options and (eo_name or eo_index))=0) and
(tprocdef(tprocsym(srsym).procdeflist[0]).aliasnames.count>1) then
exportallprocsymnames(tprocsym(srsym),options)
else
begin
{ there's a name or an index -> export only one name }
{ correct? Or can you export multiple names with the }
{ same index? And/or should we also export the aliases }
{ if a name is specified? (JM) }
if ((options and eo_name)=0) then
{ Use set mangled name in case of cdecl/cppdecl/mwpascal }
{ if no name specified }
if (tprocdef(tprocsym(srsym).procdeflist[0]).proccalloption in [pocall_cdecl,pocall_mwpascal]) then
hpname:=target_info.cprefix+tprocsym(srsym).realname
else if (tprocdef(tprocsym(srsym).procdeflist[0]).proccalloption in [pocall_cppdecl]) then
hpname:=target_info.cprefix+tprocdef(tprocsym(srsym).procdeflist[0]).cplusplusmangledname
else
hpname:=orgs;
exportprocsym(srsym,hpname,index,options);
end
end
else
exportlib.exportvar(hp);
begin
if ((options and eo_name)=0) then
{ for "cvar" }
if (vo_has_mangledname in tstaticvarsym(srsym).varoptions) then
hpname:=srsym.mangledname
else
hpname:=orgs;
exportvarsym(srsym,hpname,index,options);
end;
end
else
consume(_ID);

162
compiler/systems/t_bsd.pas
View File

@ -36,7 +36,7 @@ implementation
verbose,systems,globtype,globals,
symconst,script,
fmodule,aasmbase,aasmtai,aasmdata,aasmcpu,cpubase,symsym,symdef,
import,export,link,comprsrc,rescmn,i_bsd,
import,export,link,comprsrc,rescmn,i_bsd,expunix,
cgutils,cgbase,cgobj,cpuinfo,ogbase;
type
@ -48,11 +48,12 @@ implementation
procedure generatelib;override;
end;
texportlibbsd=class(texportlib)
procedure preparelib(const s : string);override;
procedure exportprocedure(hp : texported_item);override;
procedure exportvar(hp : texported_item);override;
procedure generatelib;override;
texportlibbsd=class(texportlibunix)
end;
texportlibdarwin=class(texportlibbsd)
procedure setinitname(list: TAsmList; const s: string); override;
procedure setfininame(list: TAsmList; const s: string); override;
end;
tlinkerbsd=class(texternallinker)
@ -79,6 +80,26 @@ implementation
end;
{*****************************************************************************
TEXPORTLIBDARWIN
*****************************************************************************}
procedure texportlibdarwin.setinitname(list: TAsmList; const s: string);
begin
list.concat(tai_directive.create(asd_mod_init_func,''));
list.concat(tai_align.create(sizeof(pint)));
list.concat(Tai_const.Createname(s,0));
end;
procedure texportlibdarwin.setfininame(list: TAsmList; const s: string);
begin
list.concat(tai_directive.create(asd_mod_term_func,''));
list.concat(tai_align.create(sizeof(pint)));
list.concat(Tai_const.Createname(s,0));
end;
{*****************************************************************************
TIMPORTLIBBSD
*****************************************************************************}
@ -96,109 +117,6 @@ implementation
end;
{*****************************************************************************
TEXPORTLIBBSD
*****************************************************************************}
procedure texportlibbsd.preparelib(const s:string);
begin
end;
procedure texportlibbsd.exportprocedure(hp : texported_item);
var
hp2 : texported_item;
begin
{ first test the index value }
if (hp.options and eo_index)<>0 then
begin
Message1(parser_e_no_export_with_index_for_target,'*bsd/darwin');
exit;
end;
{ now place in correct order }
hp2:=texported_item(current_module._exports.first);
while assigned(hp2) and
(hp.name^>hp2.name^) do
hp2:=texported_item(hp2.next);
{ insert hp there !! }
if assigned(hp2) and (hp2.name^=hp.name^) then
begin
{ this is not allowed !! }
Message1(parser_e_export_name_double,hp.name^);
exit;
end;
if hp2=texported_item(current_module._exports.first) then
current_module._exports.concat(hp)
else if assigned(hp2) then
begin
hp.next:=hp2;
hp.previous:=hp2.previous;
if assigned(hp2.previous) then
hp2.previous.next:=hp;
hp2.previous:=hp;
end
else
current_module._exports.concat(hp);
end;
procedure texportlibbsd.exportvar(hp : texported_item);
begin
hp.is_var:=true;
exportprocedure(hp);
end;
procedure texportlibbsd.generatelib; // straight t_linux copy for now.
var
hp2 : texported_item;
pd : tprocdef;
{$ifdef x86}
sym : tasmsymbol;
r : treference;
{$endif x86}
begin
new_section(current_asmdata.asmlists[al_procedures],sec_code,'',0);
hp2:=texported_item(current_module._exports.first);
while assigned(hp2) do
begin
if (not hp2.is_var) and
(hp2.sym.typ=procsym) then
begin
{ the manglednames can already be the same when the procedure
is declared with cdecl }
pd:=tprocdef(tprocsym(hp2.sym).ProcdefList[0]);
if pd.mangledname<>hp2.name^ then
begin
{ place jump in al_procedures }
current_asmdata.asmlists[al_procedures].concat(tai_align.create(target_info.alignment.procalign));
current_asmdata.asmlists[al_procedures].concat(Tai_symbol.Createname_global(hp2.name^,AT_FUNCTION,0));
if (cs_create_pic in current_settings.moduleswitches) and
{ other targets need to be checked how it works }
(target_info.system in [system_i386_freebsd]) then
begin
{$ifdef x86}
sym:=current_asmdata.RefAsmSymbol(pd.mangledname);
reference_reset_symbol(r,sym,0);
if cs_create_pic in current_settings.moduleswitches then
r.refaddr:=addr_pic
else
r.refaddr:=addr_full;
current_asmdata.asmlists[al_procedures].concat(taicpu.op_ref(A_JMP,S_NO,r));
{$endif x86}
end
else
cg.a_jmp_name(current_asmdata.asmlists[al_procedures],pd.mangledname);
current_asmdata.asmlists[al_procedures].concat(Tai_symbol_end.Createname(hp2.name^));
end;
end
else
Message1(parser_e_no_export_of_variables_for_target,'*bsd/darwin');
hp2:=texported_item(hp2.next);
end;
end;
{*****************************************************************************
TLINKERBSD
*****************************************************************************}
@ -679,6 +597,7 @@ var
cmdstr,
extdbgbinstr,
extdbgcmdstr : TCmdStr;
exportedsyms: text;
success : boolean;
begin
MakeSharedLibrary:=false;
@ -717,6 +636,21 @@ begin
extdbgcmdstr:=maybequoted(current_module.sharedlibfilename^);
end;
if (target_info.system in systems_darwin) then
begin
{ exported symbols for darwin }
if not texportlibunix(exportlib).exportedsymnames.empty then
begin
assign(exportedsyms,outputexedir+'linksyms.fpc');
rewrite(exportedsyms);
repeat
writeln(exportedsyms,texportlibunix(exportlib).exportedsymnames.getfirst);
until texportlibunix(exportlib).exportedsymnames.empty;
close(exportedsyms);
cmdstr:=cmdstr+' -exported_symbols_list '+maybequoted(outputexedir)+'linksyms.fpc';
end;
end;
if (LdSupportsNoResponseFile) and
not(cs_link_nolink in current_settings.globalswitches) then
begin
@ -755,6 +689,8 @@ begin
DeleteFile(linkscript.fn);
linkscript.free
end;
if (target_info.system in systems_darwin) then
DeleteFile(outputexedir+'linksyms.fpc');
end;
MakeSharedLibrary:=success; { otherwise a recursive call to link method }
@ -774,7 +710,7 @@ initialization
RegisterExternalLinker(system_x86_64_darwin_info,TLinkerBSD);
RegisterImport(system_x86_64_darwin,timportlibdarwin);
RegisterExport(system_x86_64_darwin,texportlibbsd);
RegisterExport(system_x86_64_darwin,texportlibdarwin);
RegisterTarget(system_x86_64_darwin_info);
{$endif}
{$ifdef i386}
@ -792,7 +728,7 @@ initialization
RegisterTarget(system_i386_openbsd_info);
RegisterExternalLinker(system_i386_darwin_info,TLinkerBSD);
RegisterImport(system_i386_darwin,timportlibdarwin);
RegisterExport(system_i386_darwin,texportlibbsd);
RegisterExport(system_i386_darwin,texportlibdarwin);
RegisterTarget(system_i386_darwin_info);
{$endif i386}
{$ifdef m68k}
@ -806,7 +742,7 @@ initialization
// RegisterExternalLinker(system_m68k_FreeBSD_info,TLinkerBSD);
RegisterExternalLinker(system_powerpc_darwin_info,TLinkerBSD);
RegisterImport(system_powerpc_darwin,timportlibdarwin);
RegisterExport(system_powerpc_darwin,texportlibbsd);
RegisterExport(system_powerpc_darwin,texportlibdarwin);
RegisterTarget(system_powerpc_darwin_info);
RegisterExternalLinker(system_powerpc_netbsd_info,TLinkerBSD);
@ -817,7 +753,7 @@ initialization
{$ifdef powerpc64}
RegisterExternalLinker(system_powerpc64_darwin_info,TLinkerBSD);
RegisterImport(system_powerpc64_darwin,timportlibdarwin);
RegisterExport(system_powerpc64_darwin,texportlibbsd);
RegisterExport(system_powerpc64_darwin,texportlibdarwin);
RegisterTarget(system_powerpc64_darwin_info);
{$endif powerpc64}

142
compiler/systems/t_linux.pas
View File

@ -28,18 +28,14 @@ interface
uses
symsym,symdef,ppu,
import,export,link;
import,export,expunix,link;
type
timportliblinux=class(timportlib)
procedure generatelib;override;
end;
texportliblinux=class(texportlib)
procedure preparelib(const s : string);override;
procedure exportprocedure(hp : texported_item);override;
procedure exportvar(hp : texported_item);override;
procedure generatelib;override;
texportliblinux=class(texportlibunix)
end;
tlinkerlinux=class(texternallinker)
@ -92,109 +88,6 @@ implementation
end;
{*****************************************************************************
TEXPORTLIBLINUX
*****************************************************************************}
procedure texportliblinux.preparelib(const s:string);
begin
end;
procedure texportliblinux.exportprocedure(hp : texported_item);
var
hp2 : texported_item;
begin
{ first test the index value }
if (hp.options and eo_index)<>0 then
begin
Message1(parser_e_no_export_with_index_for_target,'linux');
exit;
end;
{ now place in correct order }
hp2:=texported_item(current_module._exports.first);
while assigned(hp2) and
(hp.name^>hp2.name^) do
hp2:=texported_item(hp2.next);
{ insert hp there !! }
if assigned(hp2) and (hp2.name^=hp.name^) then
begin
{ this is not allowed !! }
Message1(parser_e_export_name_double,hp.name^);
exit;
end;
if hp2=texported_item(current_module._exports.first) then
current_module._exports.concat(hp)
else if assigned(hp2) then
begin
hp.next:=hp2;
hp.previous:=hp2.previous;
if assigned(hp2.previous) then
hp2.previous.next:=hp;
hp2.previous:=hp;
end
else
current_module._exports.concat(hp);
end;
procedure texportliblinux.exportvar(hp : texported_item);
begin
hp.is_var:=true;
exportprocedure(hp);
end;
procedure texportliblinux.generatelib;
var
hp2 : texported_item;
pd : tprocdef;
{$ifdef x86}
sym : tasmsymbol;
r : treference;
{$endif x86}
begin
new_section(current_asmdata.asmlists[al_procedures],sec_code,'',0);
hp2:=texported_item(current_module._exports.first);
while assigned(hp2) do
begin
if (not hp2.is_var) and
(hp2.sym.typ=procsym) then
begin
{ the manglednames can already be the same when the procedure
is declared with cdecl }
pd:=tprocdef(tprocsym(hp2.sym).ProcdefList[0]);
if not has_alias_name(pd,hp2.name^) then
begin
{ place jump in al_procedures }
current_asmdata.asmlists[al_procedures].concat(tai_align.create(target_info.alignment.procalign));
current_asmdata.asmlists[al_procedures].concat(Tai_symbol.Createname_global(hp2.name^,AT_FUNCTION,0));
if (cs_create_pic in current_settings.moduleswitches) and
{ other targets need to be checked how it works }
(target_info.system in [system_x86_64_linux,system_i386_linux]) then
begin
{$ifdef x86}
sym:=current_asmdata.RefAsmSymbol(pd.mangledname);
reference_reset_symbol(r,sym,0);
if cs_create_pic in current_settings.moduleswitches then
r.refaddr:=addr_pic
else
r.refaddr:=addr_full;
current_asmdata.asmlists[al_procedures].concat(taicpu.op_ref(A_JMP,S_NO,r));
{$endif x86}
end
else
cg.a_jmp_name(current_asmdata.asmlists[al_procedures],pd.mangledname);
current_asmdata.asmlists[al_procedures].concat(Tai_symbol_end.Createname(hp2.name^));
end;
end
else
message1(parser_e_no_export_of_variables_for_target,'linux');
hp2:=texported_item(hp2.next);
end;
end;
{*****************************************************************************
TLINKERLINUX
*****************************************************************************}
@ -426,30 +319,24 @@ begin
end;
{ force local symbol resolution (i.e., inside the shared }
{ library itself) for a number of global symbols which }
{ appear in every FPC-compiled program/library. This is }
{ actually the wrong approach (the right one is to make }
{ everything local, except for what appears in the }
{ "exports" statements), but it fixes some of the worst }
{ problems for now. }
{ library itself) for all non-exorted symbols, otherwise }
{ several RTL symbols of FPC-compiled shared libraries }
{ will be bound to those of a single shared library or }
{ to the main program }
if (isdll) then
begin
add('VERSION');
add('{');
add(' {');
if not texportlibunix(exportlib).exportedsymnames.empty then
begin
add(' global:');
repeat
add(' '+texportlibunix(exportlib).exportedsymnames.getfirst+';');
until texportlibunix(exportlib).exportedsymnames.empty;
end;
add(' local:');
add(' __fpc_valgrind;');
add(' __heapsize;');
add(' __stklen;');
add(' _FPC_SHARED_LIB_START_LOCAL;');
add(' FPC_FINALIZEUNITS;');
add(' FPC_INITIALIZEUNITS;');
add(' FPC_RESLOCATION;');
add(' FPC_RESOURCESTRINGTABLES;');
add(' FPC_THREADVARTABLES;');
add(' INITFINAL;');
add(' PASCALFINALIZE;');
add(' PASCALMAIN;');
add(' *;');
add(' };');
add('}');
end;
@ -1132,6 +1019,7 @@ begin
WriteResponseFile(true);
{ Create some replacements }
{ note: linux does not use exportlib.initname/fininame due to the custom startup code }
InitStr:='-init FPC_LIB_START';
FiniStr:='-fini FPC_LIB_EXIT';
SoNameStr:='-soname '+ExtractFileName(current_module.sharedlibfilename^);

29
tests/webtbs/tw7838a.pp Normal file
View File

@ -0,0 +1,29 @@
{ %norun }
{ %target=win32,win64,wince,linux}
library tw7838a;
{$mode objfpc} {$h+}
uses uw7838a;
{$ifdef win32}
const
progname = '.\prog.exe';
{$endif}
function dllf: longint;
begin
result:=exetest;
if (result<>aa) then
halt(1);
end;
exports dllf;
begin
end.

48
tests/webtbs/tw7838b.pp Normal file
View File

@ -0,0 +1,48 @@
{ %target=win32,win64,wince,linux}
program prog;
{$mode objfpc}
uses
dynlibs;
// this function is exported from the EXE
function exetest: longint; {public name 'exetest';}
begin
writeln('exe test');
result:=5;
end;
exports
exetest name 'exetest';
const
{$ifdef unix}
{$ifdef darwin}
libname = './libtw7838a.dylib';
{$else}
libname = './libtw7838a.so';
{$endif}
{$endif}
{$ifdef mswindows}
libname = '.\tw7838a.dll';
{$endif}
var
dllf: function: longint;
lh: tlibhandle;
begin
lh:= loadlibrary(libname); // load dyn.so (unix) or dyn.dll (ms windows)
if lh = nilhandle then begin writeln('dyn library returned nil handle'); halt; end;
pointer(dllf):= getprocaddress(lh, 'dllf'); // get function from dll
// call function in dll, which calls function in exe, and then prints
// a result number 5
if (dllf()<>5) then
halt(1);
writeln(dllf());
writeln('end of program');
freelibrary(lh);
end.

22
tests/webtbs/tw9089a.pp Normal file
View File

@ -0,0 +1,22 @@
{ %norun }
{ %target=win32,win64,wince,darwin,linux,freebsd,solaris,beos}
library tw9089a;
{$mode objfpc}{$H+}
var
myvar: longint; cvar;
exports
myvar;
initialization
Writeln('INIT');
myvar:=-1;
finalization
Writeln('FINI');
if (myvar<>1) then
halt(1);
end.

45
tests/webtbs/tw9089b.pp Normal file
View File

@ -0,0 +1,45 @@
{ %target=win32,win64,wince,darwin,linux,freebsd,solaris,beos}
{ %norun }
{ %needlibrary }
library tw9089b;
{$mode objfpc}{$H+}
const
{$ifdef windows}
libname='tw9089a.dll';
{$else}
libname='tw9089a';
{$linklib tw9089a}
{$endif}
var
myvar: longint; cvar; external;
function Test: Integer; cdecl; export;
begin
Result := 0;
Writeln('Test');
end;
exports
Test;
var
t: text;
initialization
Writeln('INIT2');
if (myvar<>-1) then
halt(3);
finalization
Writeln('FINI2');
myvar:=1;
{ so tw9089d can check whether the finalization has run at all }
assign(t,'tw9089b.txt');
rewrite(t);
close(t);
end.

23
tests/webtbs/tw9089c.pp Normal file
View File

@ -0,0 +1,23 @@
{ %target=win32,win64,wince,darwin,linux,freebsd,solaris,beos}
{ %needlibrary }
program ptest;
{$mode objfpc}{$H+}
uses
initc;
const
{$ifdef windows}
libname='tw9089b.dll';
{$else}
libname='tw9089a';
{$linklib tw9089b}
{$endif}
function Test: Integer; cdecl; external libname;
begin
Writeln(Test);
end.

17
tests/webtbs/tw9089d.pp Normal file
View File

@ -0,0 +1,17 @@
{ %target=win32,win64,wince,darwin,linux,freebsd,solaris,beos}
uses
SysUtils;
var
t: text;
begin
{ see tw9089b.pp }
assign(t,'tw9089b.txt');
{$i-}
reset(t);
{$i+}
if ioresult<>0 then
halt(1);
close(t);
erase(t);
end.

28
tests/webtbs/uw7838a.pp Normal file
View File

@ -0,0 +1,28 @@
unit uw7838a;
{$mode objfpc} {$h+}
interface
var
aa: longint;
{$ifdef mswindows}
function exetest: longint; external 'tw7838b.exe';
{$endif}
{$ifdef unix}
function exetest: longint; external name 'exetest';
{$endif}
implementation
initialization
writeln('libunit1 initialization');
aa:=5;
finalization
writeln('libunit1 finalization');
aa:=-5;
end.