paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-07 13:46:02 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ "weakexternal" support for imported procedures and variables.

Browse Source 
the syntax is exactly the same as for "external", except for
    the keyword. It is currently only active for Darwin targets.
    It should also work at least for Linux targets, but only with
    the GNU assembler (which is why it is not activated there)
  + test for this functionality

git-svn-id: trunk@12009 -
This commit is contained in:
Jonas Maebe 2008-11-01 18:38:32 +00:00
parent eb130d7501
commit a23630260b
41 changed files with 736 additions and 447 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
.gitattributes vendored
View File

@ -7889,6 +7889,10 @@ tests/test/tunroll1.pp svneol=native#text/plain
tests/test/tutf81.pp svneol=native#text/plain%3Bcharset%3Dutf-8 tests/test/tutf81.pp svneol=native#text/plain%3Bcharset%3Dutf-8
tests/test/tutf82.pp svneol=native#text/plain%3Bcharset%3Dutf-8 tests/test/tutf82.pp svneol=native#text/plain%3Bcharset%3Dutf-8
tests/test/tvarset1.pp svneol=native#text/plain tests/test/tvarset1.pp svneol=native#text/plain
tests/test/tweaklib1.pp svneol=native#text/plain
tests/test/tweaklib2.pp svneol=native#text/plain
tests/test/tweaklib3.pp svneol=native#text/plain
tests/test/tweaklib4.pp svneol=native#text/plain
tests/test/twide1.pp svneol=native#text/plain tests/test/twide1.pp svneol=native#text/plain
tests/test/twide2.pp svneol=native#text/plain tests/test/twide2.pp svneol=native#text/plain
tests/test/twide3.pp svneol=native#text/plain tests/test/twide3.pp svneol=native#text/plain

2
compiler/aasmbase.pas
View File

@ -37,7 +37,7 @@ interface
; ;
type type
TAsmsymbind=(AB_NONE,AB_EXTERNAL,AB_COMMON,AB_LOCAL,AB_GLOBAL); TAsmsymbind=(AB_NONE,AB_EXTERNAL,AB_COMMON,AB_LOCAL,AB_GLOBAL,AB_WEAK_EXTERNAL);
TAsmsymtype=( TAsmsymtype=(
AT_NONE,AT_FUNCTION,AT_DATA,AT_SECTION,AT_LABEL, AT_NONE,AT_FUNCTION,AT_DATA,AT_SECTION,AT_LABEL,

14
compiler/aasmdata.pas
View File

@ -145,6 +145,7 @@ interface
destructor destroy;override; destructor destroy;override;
{ asmsymbol } { asmsymbol }
function DefineAsmSymbol(const s : string;_bind:TAsmSymBind;_typ:Tasmsymtype) : TAsmSymbol; function DefineAsmSymbol(const s : string;_bind:TAsmSymBind;_typ:Tasmsymtype) : TAsmSymbol;
function WeakRefAsmSymbol(const s : string) : TAsmSymbol;
function RefAsmSymbol(const s : string) : TAsmSymbol; function RefAsmSymbol(const s : string) : TAsmSymbol;
function GetAsmSymbol(const s : string) : TAsmSymbol; function GetAsmSymbol(const s : string) : TAsmSymbol;
{ create new assembler label } { create new assembler label }
@ -373,7 +374,18 @@ implementation
begin begin
result:=TAsmSymbol(FAsmSymbolDict.Find(s)); result:=TAsmSymbol(FAsmSymbolDict.Find(s));
if not assigned(result) then if not assigned(result) then
result:=TAsmSymbol.create(AsmSymbolDict,s,AB_EXTERNAL,AT_NONE); result:=TAsmSymbol.create(AsmSymbolDict,s,AB_EXTERNAL,AT_NONE)
{ one normal reference removes the "weak" character of a symbol }
else if (result.bind=AB_WEAK_EXTERNAL) then
result.bind:=AB_EXTERNAL;
end;
function TAsmData.WeakRefAsmSymbol(const s : string) : TAsmSymbol;
begin
result:=TAsmSymbol(FAsmSymbolDict.Find(s));
if not assigned(result) then
result:=TAsmSymbol.create(AsmSymbolDict,s,AB_WEAK_EXTERNAL,AT_NONE);
end; end;

4
compiler/aasmtai.pas
View File

@ -254,7 +254,7 @@ interface
TAsmDirective=( TAsmDirective=(
asd_non_lazy_symbol_pointer,asd_indirect_symbol,asd_lazy_symbol_pointer, asd_non_lazy_symbol_pointer,asd_indirect_symbol,asd_lazy_symbol_pointer,
asd_extern,asd_nasm_import, asd_toc_entry, asd_mod_init_func, asd_mod_term_func, asd_extern,asd_nasm_import, asd_toc_entry, asd_mod_init_func, asd_mod_term_func,
asd_reference,asd_no_dead_strip asd_reference,asd_no_dead_strip,asd_weak_reference
); );
const const
@ -264,7 +264,7 @@ interface
directivestr : array[TAsmDirective] of string[23]=( directivestr : array[TAsmDirective] of string[23]=(
'non_lazy_symbol_pointer','indirect_symbol','lazy_symbol_pointer', 'non_lazy_symbol_pointer','indirect_symbol','lazy_symbol_pointer',
'extern','nasm_import', 'tc', 'mod_init_func', 'mod_term_func', 'reference', 'extern','nasm_import', 'tc', 'mod_init_func', 'mod_term_func', 'reference',
'no_dead_strip' 'no_dead_strip','weak_reference'
); );
type type

26
compiler/aggas.pas
View File

@ -40,12 +40,16 @@ interface
{# This is a derived class which is used to write {# This is a derived class which is used to write
GAS styled assembler. GAS styled assembler.
} }
{ TGNUAssembler }
TGNUAssembler=class(texternalassembler) TGNUAssembler=class(texternalassembler)
protected protected
function sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string;virtual; function sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string;virtual;
procedure WriteSection(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder); procedure WriteSection(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder);
procedure WriteExtraHeader;virtual; procedure WriteExtraHeader;virtual;
procedure WriteInstruction(hp: tai); procedure WriteInstruction(hp: tai);
procedure WriteWeakSymbolDef(s: tasmsymbol); virtual;
public public
function MakeCmdLine: TCmdStr; override; function MakeCmdLine: TCmdStr; override;
procedure WriteTree(p:TAsmList);override; procedure WriteTree(p:TAsmList);override;
@ -75,8 +79,12 @@ interface
end; end;
{ TAppleGNUAssembler }
TAppleGNUAssembler=class(TGNUAssembler) TAppleGNUAssembler=class(TGNUAssembler)
protected
function sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string;override; function sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string;override;
procedure WriteWeakSymbolDef(s: tasmsymbol); override;
private private
debugframecount: aint; debugframecount: aint;
end; end;
@ -1082,10 +1090,17 @@ implementation
end; end;
procedure TGNUAssembler.WriteWeakSymbolDef(s: tasmsymbol);
begin
AsmWriteLn(#9'.weak '+s.name);
end;
procedure TGNUAssembler.WriteAsmList; procedure TGNUAssembler.WriteAsmList;
var var
n : string; n : string;
hal : tasmlisttype; hal : tasmlisttype;
i: longint;
begin begin
{$ifdef EXTDEBUG} {$ifdef EXTDEBUG}
if assigned(current_module.mainsource) then if assigned(current_module.mainsource) then
@ -1108,6 +1123,11 @@ implementation
AsmWriteLn(target_asm.comment+'End asmlist '+AsmlistTypeStr[hal]); AsmWriteLn(target_asm.comment+'End asmlist '+AsmlistTypeStr[hal]);
end; end;
{ add weak symbol markers }
for i:=0 to current_asmdata.asmsymboldict.count-1 do
if (tasmsymbol(current_asmdata.asmsymboldict[i]).bind=AB_WEAK_EXTERNAL) then
writeweaksymboldef(tasmsymbol(current_asmdata.asmsymboldict[i]));
if create_smartlink_sections and if create_smartlink_sections and
(target_info.system in systems_darwin) then (target_info.system in systems_darwin) then
AsmWriteLn(#9'.subsections_via_symbols'); AsmWriteLn(#9'.subsections_via_symbols');
@ -1184,6 +1204,12 @@ implementation
end; end;
procedure TAppleGNUAssembler.WriteWeakSymbolDef(s: tasmsymbol);
begin
AsmWriteLn(#9'.weak_reference '+s.name);
end;
{****************************************************************************} {****************************************************************************}
{ a.out/GNU Assembler writer } { a.out/GNU Assembler writer }
{****************************************************************************} {****************************************************************************}

22
compiler/arm/cgcpu.pas
View File

@ -46,7 +46,7 @@ unit cgcpu;
procedure a_param_ref(list : TAsmList;size : tcgsize;const r : treference;const paraloc : TCGPara);override; procedure a_param_ref(list : TAsmList;size : tcgsize;const r : treference;const paraloc : TCGPara);override;
procedure a_paramaddr_ref(list : TAsmList;const r : treference;const paraloc : TCGPara);override; procedure a_paramaddr_ref(list : TAsmList;const r : treference;const paraloc : TCGPara);override;
procedure a_call_name(list : TAsmList;const s : string);override; procedure a_call_name(list : TAsmList;const s : string; weak: boolean);override;
procedure a_call_reg(list : TAsmList;reg: tregister);override; procedure a_call_reg(list : TAsmList;reg: tregister);override;
procedure a_call_ref(list : TAsmList;ref: treference);override; procedure a_call_ref(list : TAsmList;ref: treference);override;
@ -112,7 +112,7 @@ unit cgcpu;
{ clear out potential overflow bits from 8 or 16 bit operations } { clear out potential overflow bits from 8 or 16 bit operations }
{ the upper 24/16 bits of a register after an operation } { the upper 24/16 bits of a register after an operation }
procedure maybeadjustresult(list: TAsmList; op: TOpCg; size: tcgsize; dst: tregister); procedure maybeadjustresult(list: TAsmList; op: TOpCg; size: tcgsize; dst: tregister);
function get_darwin_call_stub(const s: string): tasmsymbol; function get_darwin_call_stub(const s: string; weak: boolean): tasmsymbol;
end; end;
tcg64farm = class(tcg64f32) tcg64farm = class(tcg64f32)
@ -286,12 +286,15 @@ unit cgcpu;
end; end;
procedure tcgarm.a_call_name(list : TAsmList;const s : string); procedure tcgarm.a_call_name(list : TAsmList;const s : string; weak: boolean);
begin begin
if target_info.system<>system_arm_darwin then if target_info.system<>system_arm_darwin then
list.concat(taicpu.op_sym(A_BL,current_asmdata.RefAsmSymbol(s))) if not weak then
list.concat(taicpu.op_sym(A_BL,current_asmdata.RefAsmSymbol(s)))
else
list.concat(taicpu.op_sym(A_BL,current_asmdata.WeakRefAsmSymbol(s)))
else else
list.concat(taicpu.op_sym(A_BL,get_darwin_call_stub(s))); list.concat(taicpu.op_sym(A_BL,get_darwin_call_stub(s,weak)));
{ {
the compiler does not properly set this flag anymore in pass 1, and the compiler does not properly set this flag anymore in pass 1, and
for now we only need it after pass 2 (I hope) (JM) for now we only need it after pass 2 (I hope) (JM)
@ -1669,7 +1672,7 @@ unit cgcpu;
paramanager.freeparaloc(list,paraloc1); paramanager.freeparaloc(list,paraloc1);
alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
alloccpuregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default)); alloccpuregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default));
a_call_name(list,'FPC_MOVE'); a_call_name(list,'FPC_MOVE',false);
dealloccpuregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default)); dealloccpuregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default));
dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
paraloc3.done; paraloc3.done;
@ -1943,7 +1946,7 @@ unit cgcpu;
internalerror(200409281); internalerror(200409281);
end; end;
a_call_name(list,'FPC_OVERFLOW'); a_call_name(list,'FPC_OVERFLOW',false);
a_label(list,hl); a_label(list,hl);
end; end;
@ -2110,7 +2113,7 @@ unit cgcpu;
end; end;
function tcgarm.get_darwin_call_stub(const s: string): tasmsymbol; function tcgarm.get_darwin_call_stub(const s: string; weak: boolean): tasmsymbol;
var var
stubname: string; stubname: string;
l1: tasmsymbol; l1: tasmsymbol;
@ -2128,6 +2131,9 @@ unit cgcpu;
current_asmdata.asmlists[al_imports].concat(Tai_align.Create(4)); current_asmdata.asmlists[al_imports].concat(Tai_align.Create(4));
result := current_asmdata.RefAsmSymbol(stubname); result := current_asmdata.RefAsmSymbol(stubname);
current_asmdata.asmlists[al_imports].concat(Tai_symbol.Create(result,0)); current_asmdata.asmlists[al_imports].concat(Tai_symbol.Create(result,0));
{ register as a weak symbol if necessary }
if weak then
current_asmdata.weakrefasmsymbol(s);
current_asmdata.asmlists[al_imports].concat(tai_directive.create(asd_indirect_symbol,s)); current_asmdata.asmlists[al_imports].concat(tai_directive.create(asd_indirect_symbol,s));
if not(cs_create_pic in current_settings.moduleswitches) then if not(cs_create_pic in current_settings.moduleswitches) then

6
compiler/cg64f32.pas
View File

@ -742,7 +742,7 @@ unit cg64f32;
cg.a_cmp_const_reg_label(list,OS_32,OC_EQ,-1,hreg,neglabel); cg.a_cmp_const_reg_label(list,OS_32,OC_EQ,-1,hreg,neglabel);
end; end;
{ For all other values we have a range check error } { For all other values we have a range check error }
cg.a_call_name(list,'FPC_RANGEERROR'); cg.a_call_name(list,'FPC_RANGEERROR',false);
{ if the high dword = 0, the low dword can be considered a } { if the high dword = 0, the low dword can be considered a }
{ simple cardinal } { simple cardinal }
@ -779,7 +779,7 @@ unit cg64f32;
current_asmdata.getjumplabel(neglabel); current_asmdata.getjumplabel(neglabel);
cg.a_cmp_const_reg_label(list,OS_32,OC_LT,0,hreg,neglabel); cg.a_cmp_const_reg_label(list,OS_32,OC_LT,0,hreg,neglabel);
cg.a_call_name(list,'FPC_RANGEERROR'); cg.a_call_name(list,'FPC_RANGEERROR',false);
{ if we get here, the 64bit value lies between } { if we get here, the 64bit value lies between }
{ longint($80000000) and -1 (JM) } { longint($80000000) and -1 (JM) }
@ -830,7 +830,7 @@ unit cg64f32;
current_asmdata.getjumplabel(poslabel); current_asmdata.getjumplabel(poslabel);
cg.a_cmp_const_reg_label(list,opsize,OC_GTE,0,hreg,poslabel); cg.a_cmp_const_reg_label(list,opsize,OC_GTE,0,hreg,poslabel);
cg.a_call_name(list,'FPC_RANGEERROR'); cg.a_call_name(list,'FPC_RANGEERROR',false);
cg.a_label(list,poslabel); cg.a_label(list,poslabel);
end; end;
end; end;

47
compiler/cgobj.pas
View File

@ -196,7 +196,7 @@ unit cgobj;
a temp register on most cpu's resulting in conflicts with the a temp register on most cpu's resulting in conflicts with the
registers used for the parameters (PFV) registers used for the parameters (PFV)
} }
procedure a_call_name(list : TAsmList;const s : string);virtual; abstract; procedure a_call_name(list : TAsmList;const s : string; weak: boolean);virtual; abstract;
procedure a_call_reg(list : TAsmList;reg : tregister);virtual; abstract; procedure a_call_reg(list : TAsmList;reg : tregister);virtual; abstract;
procedure a_call_ref(list : TAsmList;ref : treference);virtual; abstract; procedure a_call_ref(list : TAsmList;ref : treference);virtual; abstract;
{ same as a_call_name, might be overriden on certain architectures to emit { same as a_call_name, might be overriden on certain architectures to emit
@ -476,7 +476,7 @@ unit cgobj;
procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);virtual;abstract; procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);virtual;abstract;
procedure g_adjust_self_value(list:TAsmList;procdef: tprocdef;ioffset: aint);virtual; procedure g_adjust_self_value(list:TAsmList;procdef: tprocdef;ioffset: aint);virtual;
function g_indirect_sym_load(list:TAsmList;const symname: string): tregister;virtual; function g_indirect_sym_load(list:TAsmList;const symname: string; weak: boolean): tregister;virtual;
{ generate a stub which only purpose is to pass control the given external method, { generate a stub which only purpose is to pass control the given external method,
setting up any additional environment before doing so (if required). setting up any additional environment before doing so (if required).
@ -3072,7 +3072,7 @@ implementation
paramanager.freeparaloc(list,cgpara2); paramanager.freeparaloc(list,cgpara2);
paramanager.freeparaloc(list,cgpara1); paramanager.freeparaloc(list,cgpara1);
allocallcpuregisters(list); allocallcpuregisters(list);
a_call_name(list,'FPC_SHORTSTR_ASSIGN'); a_call_name(list,'FPC_SHORTSTR_ASSIGN',false);
deallocallcpuregisters(list); deallocallcpuregisters(list);
cgpara3.done; cgpara3.done;
cgpara2.done; cgpara2.done;
@ -3094,7 +3094,7 @@ implementation
paramanager.freeparaloc(list,cgpara2); paramanager.freeparaloc(list,cgpara2);
paramanager.freeparaloc(list,cgpara1); paramanager.freeparaloc(list,cgpara1);
allocallcpuregisters(list); allocallcpuregisters(list);
a_call_name(list,'FPC_VARIANT_COPY_OVERWRITE'); a_call_name(list,'FPC_VARIANT_COPY_OVERWRITE',false);
deallocallcpuregisters(list); deallocallcpuregisters(list);
cgpara2.done; cgpara2.done;
cgpara1.done; cgpara1.done;
@ -3136,7 +3136,7 @@ implementation
a_param_ref(list,OS_ADDR,ref,cgpara1); a_param_ref(list,OS_ADDR,ref,cgpara1);
paramanager.freeparaloc(list,cgpara1); paramanager.freeparaloc(list,cgpara1);
allocallcpuregisters(list); allocallcpuregisters(list);
a_call_name(list,incrfunc); a_call_name(list,incrfunc,false);
deallocallcpuregisters(list); deallocallcpuregisters(list);
end end
else else
@ -3149,7 +3149,7 @@ implementation
paramanager.freeparaloc(list,cgpara1); paramanager.freeparaloc(list,cgpara1);
paramanager.freeparaloc(list,cgpara2); paramanager.freeparaloc(list,cgpara2);
allocallcpuregisters(list); allocallcpuregisters(list);
a_call_name(list,'FPC_ADDREF'); a_call_name(list,'FPC_ADDREF',false);
deallocallcpuregisters(list); deallocallcpuregisters(list);
end; end;
cgpara2.done; cgpara2.done;
@ -3206,7 +3206,7 @@ implementation
a_param_reg(list,OS_ADDR,tempreg1,cgpara1); a_param_reg(list,OS_ADDR,tempreg1,cgpara1);
paramanager.freeparaloc(list,cgpara1); paramanager.freeparaloc(list,cgpara1);
allocallcpuregisters(list); allocallcpuregisters(list);
a_call_name(list,decrfunc); a_call_name(list,decrfunc,false);
deallocallcpuregisters(list); deallocallcpuregisters(list);
end end
else else
@ -3219,7 +3219,7 @@ implementation
paramanager.freeparaloc(list,cgpara1); paramanager.freeparaloc(list,cgpara1);
paramanager.freeparaloc(list,cgpara2); paramanager.freeparaloc(list,cgpara2);
allocallcpuregisters(list); allocallcpuregisters(list);
a_call_name(list,'FPC_DECREF'); a_call_name(list,'FPC_DECREF',false);
deallocallcpuregisters(list); deallocallcpuregisters(list);
end; end;
cgpara2.done; cgpara2.done;
@ -3252,7 +3252,7 @@ implementation
paramanager.freeparaloc(list,cgpara1); paramanager.freeparaloc(list,cgpara1);
paramanager.freeparaloc(list,cgpara2); paramanager.freeparaloc(list,cgpara2);
allocallcpuregisters(list); allocallcpuregisters(list);
a_call_name(list,'FPC_INITIALIZE'); a_call_name(list,'FPC_INITIALIZE',false);
deallocallcpuregisters(list); deallocallcpuregisters(list);
end; end;
cgpara1.done; cgpara1.done;
@ -3287,7 +3287,7 @@ implementation
paramanager.freeparaloc(list,cgpara1); paramanager.freeparaloc(list,cgpara1);
paramanager.freeparaloc(list,cgpara2); paramanager.freeparaloc(list,cgpara2);
allocallcpuregisters(list); allocallcpuregisters(list);
a_call_name(list,'FPC_FINALIZE'); a_call_name(list,'FPC_FINALIZE',false);
deallocallcpuregisters(list); deallocallcpuregisters(list);
end; end;
cgpara1.done; cgpara1.done;
@ -3432,7 +3432,7 @@ implementation
{ if low(to) > maxlongint also range error } { if low(to) > maxlongint also range error }
(lto > aintmax) then (lto > aintmax) then
begin begin
a_call_name(list,'FPC_RANGEERROR'); a_call_name(list,'FPC_RANGEERROR',false);
exit exit
end; end;
{ from is signed and to is unsigned -> when looking at to } { from is signed and to is unsigned -> when looking at to }
@ -3447,7 +3447,7 @@ implementation
if (lfrom > aintmax) or if (lfrom > aintmax) or
(hto < 0) then (hto < 0) then
begin begin
a_call_name(list,'FPC_RANGEERROR'); a_call_name(list,'FPC_RANGEERROR',false);
exit exit
end; end;
{ from is unsigned and to is signed -> when looking at to } { from is unsigned and to is signed -> when looking at to }
@ -3472,7 +3472,7 @@ implementation
else else
{$endif cpu64bitalu} {$endif cpu64bitalu}
a_cmp_const_reg_label(list,OS_INT,OC_BE,aint(int64(hto-lto)),hreg,neglabel); a_cmp_const_reg_label(list,OS_INT,OC_BE,aint(int64(hto-lto)),hreg,neglabel);
a_call_name(list,'FPC_RANGEERROR'); a_call_name(list,'FPC_RANGEERROR',false);
a_label(list,neglabel); a_label(list,neglabel);
end; end;
@ -3509,7 +3509,7 @@ implementation
paramanager.allocparaloc(list,cgpara1); paramanager.allocparaloc(list,cgpara1);
a_param_const(list,OS_INT,210,cgpara1); a_param_const(list,OS_INT,210,cgpara1);
paramanager.freeparaloc(list,cgpara1); paramanager.freeparaloc(list,cgpara1);
a_call_name(list,'FPC_HANDLEERROR'); a_call_name(list,'FPC_HANDLEERROR',false);
a_label(list,oklabel); a_label(list,oklabel);
cgpara1.done; cgpara1.done;
end; end;
@ -3535,7 +3535,7 @@ implementation
paramanager.freeparaloc(list,cgpara1); paramanager.freeparaloc(list,cgpara1);
paramanager.freeparaloc(list,cgpara2); paramanager.freeparaloc(list,cgpara2);
allocallcpuregisters(list); allocallcpuregisters(list);
a_call_name(list,'FPC_CHECK_OBJECT_EXT'); a_call_name(list,'FPC_CHECK_OBJECT_EXT',false);
deallocallcpuregisters(list); deallocallcpuregisters(list);
end end
else else
@ -3545,7 +3545,7 @@ implementation
a_param_reg(list,OS_ADDR,reg,cgpara1); a_param_reg(list,OS_ADDR,reg,cgpara1);
paramanager.freeparaloc(list,cgpara1); paramanager.freeparaloc(list,cgpara1);
allocallcpuregisters(list); allocallcpuregisters(list);
a_call_name(list,'FPC_CHECK_OBJECT'); a_call_name(list,'FPC_CHECK_OBJECT',false);
deallocallcpuregisters(list); deallocallcpuregisters(list);
end; end;
cgpara1.done; cgpara1.done;
@ -3591,7 +3591,7 @@ implementation
a_param_reg(list,OS_INT,sizereg,cgpara1); a_param_reg(list,OS_INT,sizereg,cgpara1);
paramanager.freeparaloc(list,cgpara1); paramanager.freeparaloc(list,cgpara1);
allocallcpuregisters(list); allocallcpuregisters(list);
a_call_name(list,'FPC_GETMEM'); a_call_name(list,'FPC_GETMEM',false);
deallocallcpuregisters(list); deallocallcpuregisters(list);
cgpara1.done; cgpara1.done;
{ return the new address } { return the new address }
@ -3617,7 +3617,7 @@ implementation
paramanager.freeparaloc(list,cgpara2); paramanager.freeparaloc(list,cgpara2);
paramanager.freeparaloc(list,cgpara1); paramanager.freeparaloc(list,cgpara1);
allocallcpuregisters(list); allocallcpuregisters(list);
a_call_name(list,'FPC_MOVE'); a_call_name(list,'FPC_MOVE',false);
deallocallcpuregisters(list); deallocallcpuregisters(list);
cgpara3.done; cgpara3.done;
cgpara2.done; cgpara2.done;
@ -3637,7 +3637,7 @@ implementation
a_param_loc(list,l,cgpara1); a_param_loc(list,l,cgpara1);
paramanager.freeparaloc(list,cgpara1); paramanager.freeparaloc(list,cgpara1);
allocallcpuregisters(list); allocallcpuregisters(list);
a_call_name(list,'FPC_FREEMEM'); a_call_name(list,'FPC_FREEMEM',false);
deallocallcpuregisters(list); deallocallcpuregisters(list);
cgpara1.done; cgpara1.done;
end; end;
@ -3813,11 +3813,11 @@ implementation
procedure tcg.a_call_name_static(list : TAsmList;const s : string); procedure tcg.a_call_name_static(list : TAsmList;const s : string);
begin begin
a_call_name(list,s); a_call_name(list,s,false);
end; end;
function tcg.g_indirect_sym_load(list:TAsmList;const symname: string): tregister; function tcg.g_indirect_sym_load(list:TAsmList;const symname: string; weak: boolean): tregister;
var var
l: tasmsymbol; l: tasmsymbol;
ref: treference; ref: treference;
@ -3834,7 +3834,10 @@ implementation
begin begin
l:=current_asmdata.DefineAsmSymbol('L'+symname+'$non_lazy_ptr',AB_LOCAL,AT_DATA); l:=current_asmdata.DefineAsmSymbol('L'+symname+'$non_lazy_ptr',AB_LOCAL,AT_DATA);
current_asmdata.asmlists[al_picdata].concat(tai_symbol.create(l,0)); current_asmdata.asmlists[al_picdata].concat(tai_symbol.create(l,0));
current_asmdata.asmlists[al_picdata].concat(tai_const.create_indirect_sym(current_asmdata.RefAsmSymbol(symname))); if not(weak) then
current_asmdata.asmlists[al_picdata].concat(tai_const.create_indirect_sym(current_asmdata.RefAsmSymbol(symname)))
else
current_asmdata.asmlists[al_picdata].concat(tai_const.create_indirect_sym(current_asmdata.WeakRefAsmSymbol(symname)));
{$ifdef cpu64bitaddr} {$ifdef cpu64bitaddr}
current_asmdata.asmlists[al_picdata].concat(tai_const.create_64bit(0)); current_asmdata.asmlists[al_picdata].concat(tai_const.create_64bit(0));
{$else cpu64bitaddr} {$else cpu64bitaddr}

4
compiler/i386/cgcpu.pas
View File

@ -653,7 +653,7 @@ unit cgcpu;
else else
begin begin
{ case 1 } { case 1 }
cg.a_call_name(list,procdef.mangledname); cg.a_call_name(list,procdef.mangledname,false);
end; end;
{ restore param1 value self to interface } { restore param1 value self to interface }
g_adjust_self_value(list,procdef,-ioffset); g_adjust_self_value(list,procdef,-ioffset);
@ -693,7 +693,7 @@ unit cgcpu;
list.concat(taicpu.op_sym(A_JMP,S_NO,lab)) list.concat(taicpu.op_sym(A_JMP,S_NO,lab))
end end
else else
list.concat(taicpu.op_sym(A_JMP,S_NO,get_darwin_call_stub(procdef.mangledname))) list.concat(taicpu.op_sym(A_JMP,S_NO,get_darwin_call_stub(procdef.mangledname,false)))
end; end;
List.concat(Tai_symbol_end.Createname(labelname)); List.concat(Tai_symbol_end.Createname(labelname));

4
compiler/i386/n386add.pas
View File

@ -173,7 +173,7 @@ interface
cg.a_jmp_flags(current_asmdata.CurrAsmList,F_AE,hl4) cg.a_jmp_flags(current_asmdata.CurrAsmList,F_AE,hl4)
else else
cg.a_jmp_flags(current_asmdata.CurrAsmList,F_NO,hl4); cg.a_jmp_flags(current_asmdata.CurrAsmList,F_NO,hl4);
cg.a_call_name(current_asmdata.CurrAsmList,'FPC_OVERFLOW'); cg.a_call_name(current_asmdata.CurrAsmList,'FPC_OVERFLOW',false);
cg.a_label(current_asmdata.CurrAsmList,hl4); cg.a_label(current_asmdata.CurrAsmList,hl4);
end; end;
end; end;
@ -386,7 +386,7 @@ interface
begin begin
current_asmdata.getjumplabel(hl4); current_asmdata.getjumplabel(hl4);
cg.a_jmp_flags(current_asmdata.CurrAsmList,F_AE,hl4); cg.a_jmp_flags(current_asmdata.CurrAsmList,F_AE,hl4);
cg.a_call_name(current_asmdata.CurrAsmList,'FPC_OVERFLOW'); cg.a_call_name(current_asmdata.CurrAsmList,'FPC_OVERFLOW',false);
cg.a_label(current_asmdata.CurrAsmList,hl4); cg.a_label(current_asmdata.CurrAsmList,hl4);
end; end;
{Free EAX,EDX} {Free EAX,EDX}

7
compiler/msg/errore.msg
View File

@ -366,7 +366,7 @@ scan_w_multiple_main_name_overrides=02086_W_Overriding name of "main" procedure
# #
# Parser # Parser
# #
# 03247 is the last used one # 03248 is the last used one
# #
% \section{Parser messages} % \section{Parser messages}
% This section lists all parser messages. The parser takes care of the % This section lists all parser messages. The parser takes care of the
@ -1165,6 +1165,11 @@ parser_e_cant_export_var_different_name=03247_E_Variables cannot be exported wit
% is exported inside the \var{exports} statement of a library. % 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 % 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. % variable is declared, using the \var{export} and \var{alias} directives.
parser_e_weak_external_not_supported=03248_E_Weak external symbols are not supported for the current target
% A "weak external" symbol is a symbol which may or may not exist at (either static
% or dynamic) link time. This concept may not be available (or implemented yet)
% on the current cpu/OS target.
% \end{description} % \end{description}
# #

5
compiler/msgidx.inc
View File

@ -335,6 +335,7 @@ const
parser_e_class_doesnt_implement_interface=03245; parser_e_class_doesnt_implement_interface=03245;
parser_e_class_implements_must_be_interface=03246; parser_e_class_implements_must_be_interface=03246;
parser_e_cant_export_var_different_name=03247; parser_e_cant_export_var_different_name=03247;
parser_e_weak_external_not_supported=03248;
type_e_mismatch=04000; type_e_mismatch=04000;
type_e_incompatible_types=04001; type_e_incompatible_types=04001;
type_e_not_equal_types=04002; type_e_not_equal_types=04002;
@ -755,9 +756,9 @@ const
option_info=11024; option_info=11024;
option_help_pages=11025; option_help_pages=11025;
MsgTxtSize = 47509; MsgTxtSize = 47580;
MsgIdxMax : array[1..20] of longint=( MsgIdxMax : array[1..20] of longint=(
24,87,248,84,65,50,108,22,201,61, 24,87,249,84,65,50,108,22,201,61,
44,1,1,1,1,1,1,1,1,1 44,1,1,1,1,1,1,1,1,1
); );

570
compiler/msgtxt.inc
View File

File diff suppressed because it is too large Load Diff

6
compiler/ncgcal.pas
View File

@ -1018,7 +1018,7 @@ implementation
if (po_interrupt in procdefinition.procoptions) then if (po_interrupt in procdefinition.procoptions) then
extra_interrupt_code; extra_interrupt_code;
extra_call_code; extra_call_code;
cg.a_call_name(current_asmdata.CurrAsmList,tprocdef(procdefinition).mangledname); cg.a_call_name(current_asmdata.CurrAsmList,tprocdef(procdefinition).mangledname,po_weakexternal in procdefinition.procoptions);
extra_post_call_code; extra_post_call_code;
end; end;
end; end;
@ -1114,7 +1114,7 @@ implementation
cgpara.done; cgpara.done;
{$endif x86_64} {$endif x86_64}
cg.allocallcpuregisters(current_asmdata.CurrAsmList); cg.allocallcpuregisters(current_asmdata.CurrAsmList);
cg.a_call_name(current_asmdata.CurrAsmList,'FPC_SAFECALLCHECK'); cg.a_call_name(current_asmdata.CurrAsmList,'FPC_SAFECALLCHECK',false);
cg.deallocallcpuregisters(current_asmdata.CurrAsmList); cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
end; end;
{$endif} {$endif}
@ -1152,7 +1152,7 @@ implementation
not(po_virtualmethod in procdefinition.procoptions) then not(po_virtualmethod in procdefinition.procoptions) then
begin begin
cg.allocallcpuregisters(current_asmdata.CurrAsmList); cg.allocallcpuregisters(current_asmdata.CurrAsmList);
cg.a_call_name(current_asmdata.CurrAsmList,'FPC_IOCHECK'); cg.a_call_name(current_asmdata.CurrAsmList,'FPC_IOCHECK',false);
cg.deallocallcpuregisters(current_asmdata.CurrAsmList); cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
end; end;
end; end;

48
compiler/ncgflw.pas
View File

@ -977,14 +977,14 @@ implementation
paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc2); paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc2);
paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc3); paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc3);
cg.allocallcpuregisters(current_asmdata.CurrAsmList); cg.allocallcpuregisters(current_asmdata.CurrAsmList);
cg.a_call_name(current_asmdata.CurrAsmList,'FPC_RAISEEXCEPTION'); cg.a_call_name(current_asmdata.CurrAsmList,'FPC_RAISEEXCEPTION',false);
cg.deallocallcpuregisters(current_asmdata.CurrAsmList); cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
end end
else else
begin begin
cg.allocallcpuregisters(current_asmdata.CurrAsmList); cg.allocallcpuregisters(current_asmdata.CurrAsmList);
cg.a_call_name(current_asmdata.CurrAsmList,'FPC_POPADDRSTACK'); cg.a_call_name(current_asmdata.CurrAsmList,'FPC_POPADDRSTACK',false);
cg.a_call_name(current_asmdata.CurrAsmList,'FPC_RERAISE'); cg.a_call_name(current_asmdata.CurrAsmList,'FPC_RERAISE',false);
cg.deallocallcpuregisters(current_asmdata.CurrAsmList); cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
end; end;
paraloc1.done; paraloc1.done;
@ -1008,7 +1008,7 @@ implementation
paraloc1 : tcgpara; paraloc1 : tcgpara;
begin begin
cg.allocallcpuregisters(current_asmdata.CurrAsmList); cg.allocallcpuregisters(current_asmdata.CurrAsmList);
cg.a_call_name(current_asmdata.CurrAsmList,'FPC_POPOBJECTSTACK'); cg.a_call_name(current_asmdata.CurrAsmList,'FPC_POPOBJECTSTACK',false);
cg.deallocallcpuregisters(current_asmdata.CurrAsmList); cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
paraloc1.init; paraloc1.init;
paramanager.getintparaloc(pocall_default,1,paraloc1); paramanager.getintparaloc(pocall_default,1,paraloc1);
@ -1016,7 +1016,7 @@ implementation
cg.a_param_reg(current_asmdata.CurrAsmList,OS_ADDR,NR_FUNCTION_RESULT_REG,paraloc1); cg.a_param_reg(current_asmdata.CurrAsmList,OS_ADDR,NR_FUNCTION_RESULT_REG,paraloc1);
paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc1); paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc1);
cg.allocallcpuregisters(current_asmdata.CurrAsmList); cg.allocallcpuregisters(current_asmdata.CurrAsmList);
cg.a_call_name(current_asmdata.CurrAsmList,'FPC_DESTROYEXCEPTION'); cg.a_call_name(current_asmdata.CurrAsmList,'FPC_DESTROYEXCEPTION',false);
cg.deallocallcpuregisters(current_asmdata.CurrAsmList); cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
paraloc1.done; paraloc1.done;
end; end;
@ -1130,7 +1130,7 @@ implementation
cg.a_param_const(current_asmdata.CurrAsmList,OS_ADDR,-1,paraloc1); cg.a_param_const(current_asmdata.CurrAsmList,OS_ADDR,-1,paraloc1);
paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc1); paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc1);
cg.allocallcpuregisters(current_asmdata.CurrAsmList); cg.allocallcpuregisters(current_asmdata.CurrAsmList);
cg.a_call_name(current_asmdata.CurrAsmList,'FPC_CATCHES'); cg.a_call_name(current_asmdata.CurrAsmList,'FPC_CATCHES',false);
cg.deallocallcpuregisters(current_asmdata.CurrAsmList); cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
paraloc1.done; paraloc1.done;
@ -1152,7 +1152,7 @@ implementation
free_exception(current_asmdata.CurrAsmList,destroytemps,0,doobjectdestroy,false); free_exception(current_asmdata.CurrAsmList,destroytemps,0,doobjectdestroy,false);
cg.allocallcpuregisters(current_asmdata.CurrAsmList); cg.allocallcpuregisters(current_asmdata.CurrAsmList);
cg.a_call_name(current_asmdata.CurrAsmList,'FPC_POPSECONDOBJECTSTACK'); cg.a_call_name(current_asmdata.CurrAsmList,'FPC_POPSECONDOBJECTSTACK',false);
cg.deallocallcpuregisters(current_asmdata.CurrAsmList); cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
paraloc1.init; paraloc1.init;
@ -1161,12 +1161,12 @@ implementation
cg.a_param_reg(current_asmdata.CurrAsmList, OS_ADDR, NR_FUNCTION_RESULT_REG, paraloc1); cg.a_param_reg(current_asmdata.CurrAsmList, OS_ADDR, NR_FUNCTION_RESULT_REG, paraloc1);
paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc1); paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc1);
cg.allocallcpuregisters(current_asmdata.CurrAsmList); cg.allocallcpuregisters(current_asmdata.CurrAsmList);
cg.a_call_name(current_asmdata.CurrAsmList,'FPC_DESTROYEXCEPTION'); cg.a_call_name(current_asmdata.CurrAsmList,'FPC_DESTROYEXCEPTION',false);
cg.deallocallcpuregisters(current_asmdata.CurrAsmList); cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
paraloc1.done; paraloc1.done;
{ we don't need to restore esi here because reraise never } { we don't need to restore esi here because reraise never }
{ returns } { returns }
cg.a_call_name(current_asmdata.CurrAsmList,'FPC_RERAISE'); cg.a_call_name(current_asmdata.CurrAsmList,'FPC_RERAISE',false);
cg.a_label(current_asmdata.CurrAsmList,doobjectdestroy); cg.a_label(current_asmdata.CurrAsmList,doobjectdestroy);
cleanupobjectstack; cleanupobjectstack;
@ -1175,7 +1175,7 @@ implementation
end end
else else
begin begin
cg.a_call_name(current_asmdata.CurrAsmList,'FPC_RERAISE'); cg.a_call_name(current_asmdata.CurrAsmList,'FPC_RERAISE',false);
exceptflowcontrol:=flowcontrol; exceptflowcontrol:=flowcontrol;
end; end;
@ -1186,7 +1186,7 @@ implementation
{ we must also destroy the address frame which guards } { we must also destroy the address frame which guards }
{ exception object } { exception object }
cg.allocallcpuregisters(current_asmdata.CurrAsmList); cg.allocallcpuregisters(current_asmdata.CurrAsmList);
cg.a_call_name(current_asmdata.CurrAsmList,'FPC_POPADDRSTACK'); cg.a_call_name(current_asmdata.CurrAsmList,'FPC_POPADDRSTACK',false);
cg.deallocallcpuregisters(current_asmdata.CurrAsmList); cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
cg.g_exception_reason_load(current_asmdata.CurrAsmList,excepttemps.reasonbuf); cg.g_exception_reason_load(current_asmdata.CurrAsmList,excepttemps.reasonbuf);
cleanupobjectstack; cleanupobjectstack;
@ -1199,7 +1199,7 @@ implementation
{ we must also destroy the address frame which guards } { we must also destroy the address frame which guards }
{ exception object } { exception object }
cg.allocallcpuregisters(current_asmdata.CurrAsmList); cg.allocallcpuregisters(current_asmdata.CurrAsmList);
cg.a_call_name(current_asmdata.CurrAsmList,'FPC_POPADDRSTACK'); cg.a_call_name(current_asmdata.CurrAsmList,'FPC_POPADDRSTACK',false);
cg.deallocallcpuregisters(current_asmdata.CurrAsmList); cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
cg.g_exception_reason_load(current_asmdata.CurrAsmList,excepttemps.reasonbuf); cg.g_exception_reason_load(current_asmdata.CurrAsmList,excepttemps.reasonbuf);
cleanupobjectstack; cleanupobjectstack;
@ -1212,7 +1212,7 @@ implementation
{ we must also destroy the address frame which guards } { we must also destroy the address frame which guards }
{ exception object } { exception object }
cg.allocallcpuregisters(current_asmdata.CurrAsmList); cg.allocallcpuregisters(current_asmdata.CurrAsmList);
cg.a_call_name(current_asmdata.CurrAsmList,'FPC_POPADDRSTACK'); cg.a_call_name(current_asmdata.CurrAsmList,'FPC_POPADDRSTACK',false);
cg.deallocallcpuregisters(current_asmdata.CurrAsmList); cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
cg.g_exception_reason_load(current_asmdata.CurrAsmList,excepttemps.reasonbuf); cg.g_exception_reason_load(current_asmdata.CurrAsmList,excepttemps.reasonbuf);
cleanupobjectstack; cleanupobjectstack;
@ -1224,7 +1224,7 @@ implementation
{ do some magic for exit in the try block } { do some magic for exit in the try block }
cg.a_label(current_asmdata.CurrAsmList,exittrylabel); cg.a_label(current_asmdata.CurrAsmList,exittrylabel);
cg.allocallcpuregisters(current_asmdata.CurrAsmList); cg.allocallcpuregisters(current_asmdata.CurrAsmList);
cg.a_call_name(current_asmdata.CurrAsmList,'FPC_POPADDRSTACK'); cg.a_call_name(current_asmdata.CurrAsmList,'FPC_POPADDRSTACK',false);
cg.deallocallcpuregisters(current_asmdata.CurrAsmList); cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
cg.g_exception_reason_load(current_asmdata.CurrAsmList,excepttemps.reasonbuf); cg.g_exception_reason_load(current_asmdata.CurrAsmList,excepttemps.reasonbuf);
cg.a_jmp_always(current_asmdata.CurrAsmList,oldCurrExitLabel); cg.a_jmp_always(current_asmdata.CurrAsmList,oldCurrExitLabel);
@ -1234,7 +1234,7 @@ implementation
begin begin
cg.a_label(current_asmdata.CurrAsmList,breaktrylabel); cg.a_label(current_asmdata.CurrAsmList,breaktrylabel);
cg.allocallcpuregisters(current_asmdata.CurrAsmList); cg.allocallcpuregisters(current_asmdata.CurrAsmList);
cg.a_call_name(current_asmdata.CurrAsmList,'FPC_POPADDRSTACK'); cg.a_call_name(current_asmdata.CurrAsmList,'FPC_POPADDRSTACK',false);
cg.deallocallcpuregisters(current_asmdata.CurrAsmList); cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
cg.g_exception_reason_load(current_asmdata.CurrAsmList,excepttemps.reasonbuf); cg.g_exception_reason_load(current_asmdata.CurrAsmList,excepttemps.reasonbuf);
cg.a_jmp_always(current_asmdata.CurrAsmList,oldBreakLabel); cg.a_jmp_always(current_asmdata.CurrAsmList,oldBreakLabel);
@ -1244,7 +1244,7 @@ implementation
begin begin
cg.a_label(current_asmdata.CurrAsmList,continuetrylabel); cg.a_label(current_asmdata.CurrAsmList,continuetrylabel);
cg.allocallcpuregisters(current_asmdata.CurrAsmList); cg.allocallcpuregisters(current_asmdata.CurrAsmList);
cg.a_call_name(current_asmdata.CurrAsmList,'FPC_POPADDRSTACK'); cg.a_call_name(current_asmdata.CurrAsmList,'FPC_POPADDRSTACK',false);
cg.deallocallcpuregisters(current_asmdata.CurrAsmList); cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
cg.g_exception_reason_load(current_asmdata.CurrAsmList,excepttemps.reasonbuf); cg.g_exception_reason_load(current_asmdata.CurrAsmList,excepttemps.reasonbuf);
cg.a_jmp_always(current_asmdata.CurrAsmList,oldContinueLabel); cg.a_jmp_always(current_asmdata.CurrAsmList,oldContinueLabel);
@ -1302,7 +1302,7 @@ implementation
cg.a_paramaddr_ref(current_asmdata.CurrAsmList,href2,paraloc1); cg.a_paramaddr_ref(current_asmdata.CurrAsmList,href2,paraloc1);
paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc1); paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc1);
cg.allocallcpuregisters(current_asmdata.CurrAsmList); cg.allocallcpuregisters(current_asmdata.CurrAsmList);
cg.a_call_name(current_asmdata.CurrAsmList,'FPC_CATCHES'); cg.a_call_name(current_asmdata.CurrAsmList,'FPC_CATCHES',false);
cg.deallocallcpuregisters(current_asmdata.CurrAsmList); cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
{ is it this catch? No. go to next onlabel } { is it this catch? No. go to next onlabel }
@ -1360,18 +1360,18 @@ implementation
free_exception(current_asmdata.CurrAsmList,excepttemps,0,doobjectdestroy,false); free_exception(current_asmdata.CurrAsmList,excepttemps,0,doobjectdestroy,false);
cg.allocallcpuregisters(current_asmdata.CurrAsmList); cg.allocallcpuregisters(current_asmdata.CurrAsmList);
cg.a_call_name(current_asmdata.CurrAsmList,'FPC_POPSECONDOBJECTSTACK'); cg.a_call_name(current_asmdata.CurrAsmList,'FPC_POPSECONDOBJECTSTACK',false);
cg.deallocallcpuregisters(current_asmdata.CurrAsmList); cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
paramanager.getintparaloc(pocall_default,1,paraloc1); paramanager.getintparaloc(pocall_default,1,paraloc1);
paramanager.allocparaloc(current_asmdata.CurrAsmList,paraloc1); paramanager.allocparaloc(current_asmdata.CurrAsmList,paraloc1);
cg.a_param_reg(current_asmdata.CurrAsmList, OS_ADDR, NR_FUNCTION_RESULT_REG, paraloc1); cg.a_param_reg(current_asmdata.CurrAsmList, OS_ADDR, NR_FUNCTION_RESULT_REG, paraloc1);
paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc1); paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc1);
cg.allocallcpuregisters(current_asmdata.CurrAsmList); cg.allocallcpuregisters(current_asmdata.CurrAsmList);
cg.a_call_name(current_asmdata.CurrAsmList,'FPC_DESTROYEXCEPTION'); cg.a_call_name(current_asmdata.CurrAsmList,'FPC_DESTROYEXCEPTION',false);
cg.deallocallcpuregisters(current_asmdata.CurrAsmList); cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
{ we don't need to store/restore registers here because reraise never { we don't need to store/restore registers here because reraise never
returns } returns }
cg.a_call_name(current_asmdata.CurrAsmList,'FPC_RERAISE'); cg.a_call_name(current_asmdata.CurrAsmList,'FPC_RERAISE',false);
cg.a_label(current_asmdata.CurrAsmList,doobjectdestroy); cg.a_label(current_asmdata.CurrAsmList,doobjectdestroy);
cleanupobjectstack; cleanupobjectstack;
@ -1525,15 +1525,15 @@ implementation
(current_procinfo.procdef.proccalloption=pocall_safecall) then (current_procinfo.procdef.proccalloption=pocall_safecall) then
begin begin
{ Remove and destroy the last exception object } { Remove and destroy the last exception object }
cg.a_call_name(current_asmdata.CurrAsmList,'FPC_POPOBJECTSTACK'); cg.a_call_name(current_asmdata.CurrAsmList,'FPC_POPOBJECTSTACK',false);
cg.a_call_name(current_asmdata.CurrAsmList,'FPC_DESTROYEXCEPTION'); cg.a_call_name(current_asmdata.CurrAsmList,'FPC_DESTROYEXCEPTION',false);
{ Set return value of safecall procedure to indicate exception. } { Set return value of safecall procedure to indicate exception. }
{ Exception will be raised after procedure exit based on return value } { Exception will be raised after procedure exit based on return value }
cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_ADDR,aint($8000FFFF),NR_FUNCTION_RETURN_REG); cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_ADDR,aint($8000FFFF),NR_FUNCTION_RETURN_REG);
end end
else else
{$endif} {$endif}
cg.a_call_name(current_asmdata.CurrAsmList,'FPC_RERAISE'); cg.a_call_name(current_asmdata.CurrAsmList,'FPC_RERAISE',false);
end end
else else
begin begin
@ -1562,7 +1562,7 @@ implementation
cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_INT,OC_EQ,0,NR_FUNCTION_RESULT_REG,oldContinueLabel); cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_INT,OC_EQ,0,NR_FUNCTION_RESULT_REG,oldContinueLabel);
end; end;
cg.a_label(current_asmdata.CurrAsmList,reraiselabel); cg.a_label(current_asmdata.CurrAsmList,reraiselabel);
cg.a_call_name(current_asmdata.CurrAsmList,'FPC_RERAISE'); cg.a_call_name(current_asmdata.CurrAsmList,'FPC_RERAISE',false);
{ do some magic for exit,break,continue in the try block } { do some magic for exit,break,continue in the try block }
if fc_exit in tryflowcontrol then if fc_exit in tryflowcontrol then
begin begin

2
compiler/ncginl.pas
View File

@ -231,7 +231,7 @@ implementation
paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc3); paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc3);
paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc4); paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc4);
cg.allocallcpuregisters(current_asmdata.CurrAsmList); cg.allocallcpuregisters(current_asmdata.CurrAsmList);
cg.a_call_name(current_asmdata.CurrAsmList,'FPC_ASSERT'); cg.a_call_name(current_asmdata.CurrAsmList,'FPC_ASSERT',false);
cg.deallocallcpuregisters(current_asmdata.CurrAsmList); cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
location_freetemp(current_asmdata.CurrAsmList,hp3.location); location_freetemp(current_asmdata.CurrAsmList,hp3.location);
location_freetemp(current_asmdata.CurrAsmList,hp2.location); location_freetemp(current_asmdata.CurrAsmList,hp2.location);

37
compiler/ncgld.pas
View File

@ -270,7 +270,8 @@ implementation
gvs:=tstaticvarsym(symtableentry); gvs:=tstaticvarsym(symtableentry);
if ([vo_is_dll_var,vo_is_external] * gvs.varoptions <> []) then if ([vo_is_dll_var,vo_is_external] * gvs.varoptions <> []) then
begin begin
location.reference.base := cg.g_indirect_sym_load(current_asmdata.CurrAsmList,tstaticvarsym(symtableentry).mangledname); location.reference.base := cg.g_indirect_sym_load(current_asmdata.CurrAsmList,tstaticvarsym(symtableentry).mangledname,
vo_is_weak_external in gvs.varoptions);
if (location.reference.base <> NR_NO) then if (location.reference.base <> NR_NO) then
exit; exit;
end; end;
@ -279,7 +280,10 @@ implementation
{ DLL variable } { DLL variable }
begin begin
hregister:=cg.getaddressregister(current_asmdata.CurrAsmList); hregister:=cg.getaddressregister(current_asmdata.CurrAsmList);
location.reference.symbol:=current_asmdata.RefAsmSymbol(tstaticvarsym(symtableentry).mangledname); if not(vo_is_weak_external in gvs.varoptions) then
location.reference.symbol:=current_asmdata.RefAsmSymbol(tstaticvarsym(symtableentry).mangledname)
else
location.reference.symbol:=current_asmdata.WeakRefAsmSymbol(tstaticvarsym(symtableentry).mangledname);
cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,location.reference,hregister); cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,location.reference,hregister);
reference_reset_base(location.reference,hregister,0); reference_reset_base(location.reference,hregister,0);
end end
@ -290,7 +294,10 @@ implementation
if (tf_section_threadvars in target_info.flags) then if (tf_section_threadvars in target_info.flags) then
begin begin
if gvs.localloc.loc=LOC_INVALID then if gvs.localloc.loc=LOC_INVALID then
reference_reset_symbol(location.reference,current_asmdata.RefAsmSymbol(gvs.mangledname),0) if not(vo_is_weak_external in gvs.varoptions) then
reference_reset_symbol(location.reference,current_asmdata.RefAsmSymbol(gvs.mangledname),0)
else
reference_reset_symbol(location.reference,current_asmdata.WeakRefAsmSymbol(gvs.mangledname),0)
else else
location:=gvs.localloc; location:=gvs.localloc;
{$ifdef i386} {$ifdef i386}
@ -324,7 +331,10 @@ implementation
cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,href,hregister); cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,href,hregister);
cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_ADDR,OC_EQ,0,hregister,norelocatelab); cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_ADDR,OC_EQ,0,hregister,norelocatelab);
{ don't save the allocated register else the result will be destroyed later } { don't save the allocated register else the result will be destroyed later }
reference_reset_symbol(href,current_asmdata.RefAsmSymbol(tstaticvarsym(symtableentry).mangledname),0); if not(vo_is_weak_external in gvs.varoptions) then
reference_reset_symbol(href,current_asmdata.RefAsmSymbol(gvs.mangledname),0)
else
reference_reset_symbol(href,current_asmdata.WeakRefAsmSymbol(gvs.mangledname),0);
paramanager.allocparaloc(current_asmdata.CurrAsmList,paraloc1); paramanager.allocparaloc(current_asmdata.CurrAsmList,paraloc1);
cg.a_param_ref(current_asmdata.CurrAsmList,OS_32,href,paraloc1); cg.a_param_ref(current_asmdata.CurrAsmList,OS_32,href,paraloc1);
paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc1); paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc1);
@ -342,7 +352,10 @@ implementation
layout of a threadvar is (4 bytes pointer): layout of a threadvar is (4 bytes pointer):
0 - Threadvar index 0 - Threadvar index
4 - Threadvar value in single threading } 4 - Threadvar value in single threading }
reference_reset_symbol(href,current_asmdata.RefAsmSymbol(tstaticvarsym(symtableentry).mangledname),sizeof(pint)); if not(vo_is_weak_external in gvs.varoptions) then
reference_reset_symbol(href,current_asmdata.RefAsmSymbol(gvs.mangledname),sizeof(pint))
else
reference_reset_symbol(href,current_asmdata.WeakRefAsmSymbol(gvs.mangledname),sizeof(pint));
cg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,href,hregister); cg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,href,hregister);
cg.a_label(current_asmdata.CurrAsmList,endrelocatelab); cg.a_label(current_asmdata.CurrAsmList,endrelocatelab);
location.reference.base:=hregister; location.reference.base:=hregister;
@ -352,7 +365,10 @@ implementation
else else
begin begin
if gvs.localloc.loc=LOC_INVALID then if gvs.localloc.loc=LOC_INVALID then
reference_reset_symbol(location.reference,current_asmdata.RefAsmSymbol(gvs.mangledname),0) if not(vo_is_weak_external in gvs.varoptions) then
reference_reset_symbol(location.reference,current_asmdata.RefAsmSymbol(gvs.mangledname),0)
else
reference_reset_symbol(location.reference,current_asmdata.WeakRefAsmSymbol(gvs.mangledname),0)
else else
location:=gvs.localloc; location:=gvs.localloc;
end; end;
@ -482,10 +498,15 @@ implementation
begin begin
pd:=tprocdef(tprocsym(symtableentry).ProcdefList[0]); pd:=tprocdef(tprocsym(symtableentry).ProcdefList[0]);
if (po_external in pd.procoptions) then if (po_external in pd.procoptions) then
location.reference.base := cg.g_indirect_sym_load(current_asmdata.CurrAsmList,pd.mangledname); location.reference.base :=
cg.g_indirect_sym_load(current_asmdata.CurrAsmList,pd.mangledname,
po_weakexternal in pd.procoptions);
{!!!!! Be aware, work on virtual methods too } {!!!!! Be aware, work on virtual methods too }
if (location.reference.base = NR_NO) then if (location.reference.base = NR_NO) then
location.reference.symbol:=current_asmdata.RefAsmSymbol(procdef.mangledname); if not(po_weakexternal in pd.procoptions) then
location.reference.symbol:=current_asmdata.RefAsmSymbol(procdef.mangledname)
else
location.reference.symbol:=current_asmdata.WeakRefAsmSymbol(procdef.mangledname);
end; end;
end; end;
labelsym : labelsym :

6
compiler/ncgmat.pas
View File

@ -193,7 +193,7 @@ implementation
location.register64.reglo,tr); location.register64.reglo,tr);
current_asmdata.getjumplabel(hl); current_asmdata.getjumplabel(hl);
cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_INT,OC_NE,0,tr,hl); cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_INT,OC_NE,0,tr,hl);
cg.a_call_name(current_asmdata.CurrAsmList,'FPC_OVERFLOW'); cg.a_call_name(current_asmdata.CurrAsmList,'FPC_OVERFLOW',false);
cg.a_label(current_asmdata.CurrAsmList,hl); cg.a_label(current_asmdata.CurrAsmList,hl);
end; end;
end; end;
@ -244,7 +244,7 @@ implementation
begin begin
current_asmdata.getjumplabel(hl); current_asmdata.getjumplabel(hl);
cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_SINT,OC_NE,low(aint),location.register,hl); cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_SINT,OC_NE,low(aint),location.register,hl);
cg.a_call_name(current_asmdata.CurrAsmList,'FPC_OVERFLOW'); cg.a_call_name(current_asmdata.CurrAsmList,'FPC_OVERFLOW',false);
cg.a_label(current_asmdata.CurrAsmList,hl); cg.a_label(current_asmdata.CurrAsmList,hl);
end; end;
end; end;
@ -371,7 +371,7 @@ implementation
paramanager.allocparaloc(current_asmdata.CurrAsmList,paraloc1); paramanager.allocparaloc(current_asmdata.CurrAsmList,paraloc1);
cg.a_param_const(current_asmdata.CurrAsmList,OS_S32,200,paraloc1); cg.a_param_const(current_asmdata.CurrAsmList,OS_S32,200,paraloc1);
paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc1); paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc1);
cg.a_call_name(current_asmdata.CurrAsmList,'FPC_HANDLEERROR'); cg.a_call_name(current_asmdata.CurrAsmList,'FPC_HANDLEERROR',false);
paraloc1.done; paraloc1.done;
cg.a_label(current_asmdata.CurrAsmList,hl); cg.a_label(current_asmdata.CurrAsmList,hl);
if nodetype = modn then if nodetype = modn then

16
compiler/ncgmem.pas
View File

@ -228,7 +228,7 @@ implementation
paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc1); paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc1);
paraloc1.done; paraloc1.done;
cg.allocallcpuregisters(current_asmdata.CurrAsmList); cg.allocallcpuregisters(current_asmdata.CurrAsmList);
cg.a_call_name(current_asmdata.CurrAsmList,'FPC_CHECKPOINTER'); cg.a_call_name(current_asmdata.CurrAsmList,'FPC_CHECKPOINTER',false);
cg.deallocallcpuregisters(current_asmdata.CurrAsmList); cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
end; end;
end; end;
@ -283,7 +283,7 @@ implementation
cg.a_param_reg(current_asmdata.CurrAsmList, OS_ADDR,location.reference.base,paraloc1); cg.a_param_reg(current_asmdata.CurrAsmList, OS_ADDR,location.reference.base,paraloc1);
paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc1); paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc1);
cg.allocallcpuregisters(current_asmdata.CurrAsmList); cg.allocallcpuregisters(current_asmdata.CurrAsmList);
cg.a_call_name(current_asmdata.CurrAsmList,'FPC_CHECKPOINTER'); cg.a_call_name(current_asmdata.CurrAsmList,'FPC_CHECKPOINTER',false);
cg.deallocallcpuregisters(current_asmdata.CurrAsmList); cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
end; end;
end end
@ -302,7 +302,7 @@ implementation
cg.a_param_reg(current_asmdata.CurrAsmList, OS_ADDR,location.reference.base,paraloc1); cg.a_param_reg(current_asmdata.CurrAsmList, OS_ADDR,location.reference.base,paraloc1);
paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc1); paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc1);
cg.allocallcpuregisters(current_asmdata.CurrAsmList); cg.allocallcpuregisters(current_asmdata.CurrAsmList);
cg.a_call_name(current_asmdata.CurrAsmList,'FPC_CHECKPOINTER'); cg.a_call_name(current_asmdata.CurrAsmList,'FPC_CHECKPOINTER',false);
cg.deallocallcpuregisters(current_asmdata.CurrAsmList); cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
end; end;
end end
@ -585,7 +585,7 @@ implementation
cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_INT,OC_LT,0,hreg,poslabel); cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_INT,OC_LT,0,hreg,poslabel);
cg.a_cmp_loc_reg_label(current_asmdata.CurrAsmList,OS_INT,OC_BE,hightree.location,hreg,neglabel); cg.a_cmp_loc_reg_label(current_asmdata.CurrAsmList,OS_INT,OC_BE,hightree.location,hreg,neglabel);
cg.a_label(current_asmdata.CurrAsmList,poslabel); cg.a_label(current_asmdata.CurrAsmList,poslabel);
cg.a_call_name(current_asmdata.CurrAsmList,'FPC_RANGEERROR'); cg.a_call_name(current_asmdata.CurrAsmList,'FPC_RANGEERROR',false);
cg.a_label(current_asmdata.CurrAsmList,neglabel); cg.a_label(current_asmdata.CurrAsmList,neglabel);
{ release hightree } { release hightree }
hightree.free; hightree.free;
@ -603,7 +603,7 @@ implementation
paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc1); paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc1);
paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc2); paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc2);
cg.allocallcpuregisters(current_asmdata.CurrAsmList); cg.allocallcpuregisters(current_asmdata.CurrAsmList);
cg.a_call_name(current_asmdata.CurrAsmList,'FPC_DYNARRAY_RANGECHECK'); cg.a_call_name(current_asmdata.CurrAsmList,'FPC_DYNARRAY_RANGECHECK',false);
cg.deallocallcpuregisters(current_asmdata.CurrAsmList); cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
end end
else else
@ -685,7 +685,7 @@ implementation
cg.a_param_reg(current_asmdata.CurrAsmList,OS_ADDR,location.reference.base,paraloc1); cg.a_param_reg(current_asmdata.CurrAsmList,OS_ADDR,location.reference.base,paraloc1);
paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc1); paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc1);
cg.allocallcpuregisters(current_asmdata.CurrAsmList); cg.allocallcpuregisters(current_asmdata.CurrAsmList);
cg.a_call_name(current_asmdata.CurrAsmList,'FPC_'+upper(tstringdef(left.resultdef).stringtypname)+'_CHECKZERO'); cg.a_call_name(current_asmdata.CurrAsmList,'FPC_'+upper(tstringdef(left.resultdef).stringtypname)+'_CHECKZERO',false);
cg.deallocallcpuregisters(current_asmdata.CurrAsmList); cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
end; end;
@ -795,7 +795,7 @@ implementation
paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc1); paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc1);
paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc2); paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc2);
cg.allocallcpuregisters(current_asmdata.CurrAsmList); cg.allocallcpuregisters(current_asmdata.CurrAsmList);
cg.a_call_name(current_asmdata.CurrAsmList,'FPC_'+upper(tstringdef(left.resultdef).stringtypname)+'_RANGECHECK'); cg.a_call_name(current_asmdata.CurrAsmList,'FPC_'+upper(tstringdef(left.resultdef).stringtypname)+'_RANGECHECK',false);
cg.deallocallcpuregisters(current_asmdata.CurrAsmList); cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
end; end;
@ -963,7 +963,7 @@ implementation
paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc1); paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc1);
paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc2); paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc2);
cg.allocallcpuregisters(current_asmdata.CurrAsmList); cg.allocallcpuregisters(current_asmdata.CurrAsmList);
cg.a_call_name(current_asmdata.CurrAsmList,'FPC_'+upper(tstringdef(left.resultdef).stringtypname)+'_RANGECHECK'); cg.a_call_name(current_asmdata.CurrAsmList,'FPC_'+upper(tstringdef(left.resultdef).stringtypname)+'_RANGECHECK',false);
cg.deallocallcpuregisters(current_asmdata.CurrAsmList); cg.deallocallcpuregisters(current_asmdata.CurrAsmList);
end; end;
st_shortstring: st_shortstring:

12
compiler/ncgutil.pas
View File

@ -397,7 +397,7 @@ implementation
paramanager.freeparaloc(list,paraloc2); paramanager.freeparaloc(list,paraloc2);
paramanager.freeparaloc(list,paraloc1); paramanager.freeparaloc(list,paraloc1);
cg.allocallcpuregisters(list); cg.allocallcpuregisters(list);
cg.a_call_name(list,'FPC_PUSHEXCEPTADDR'); cg.a_call_name(list,'FPC_PUSHEXCEPTADDR',false);
cg.deallocallcpuregisters(list); cg.deallocallcpuregisters(list);
paramanager.getintparaloc(pocall_default,1,paraloc1); paramanager.getintparaloc(pocall_default,1,paraloc1);
@ -405,7 +405,7 @@ implementation
cg.a_param_reg(list,OS_ADDR,NR_FUNCTION_RESULT_REG,paraloc1); cg.a_param_reg(list,OS_ADDR,NR_FUNCTION_RESULT_REG,paraloc1);
paramanager.freeparaloc(list,paraloc1); paramanager.freeparaloc(list,paraloc1);
cg.allocallcpuregisters(list); cg.allocallcpuregisters(list);
cg.a_call_name(list,'FPC_SETJMP'); cg.a_call_name(list,'FPC_SETJMP',false);
cg.deallocallcpuregisters(list); cg.deallocallcpuregisters(list);
cg.alloccpuregisters(list,R_INTREGISTER,[RS_FUNCTION_RESULT_REG]); cg.alloccpuregisters(list,R_INTREGISTER,[RS_FUNCTION_RESULT_REG]);
@ -421,7 +421,7 @@ implementation
procedure free_exception(list:TAsmList;const t:texceptiontemps;a:aint;endexceptlabel:tasmlabel;onlyfree:boolean); procedure free_exception(list:TAsmList;const t:texceptiontemps;a:aint;endexceptlabel:tasmlabel;onlyfree:boolean);
begin begin
cg.allocallcpuregisters(list); cg.allocallcpuregisters(list);
cg.a_call_name(list,'FPC_POPADDRSTACK'); cg.a_call_name(list,'FPC_POPADDRSTACK',false);
cg.deallocallcpuregisters(list); cg.deallocallcpuregisters(list);
if not onlyfree then if not onlyfree then
@ -1986,7 +1986,7 @@ implementation
begin begin
{ initialize units } { initialize units }
cg.allocallcpuregisters(list); cg.allocallcpuregisters(list);
cg.a_call_name(list,'FPC_INITIALIZEUNITS'); cg.a_call_name(list,'FPC_INITIALIZEUNITS',false);
cg.deallocallcpuregisters(list); cg.deallocallcpuregisters(list);
end; end;
@ -2006,7 +2006,7 @@ implementation
{ call __EXIT for main program } { call __EXIT for main program }
if (not DLLsource) and if (not DLLsource) and
(current_procinfo.procdef.proctypeoption=potype_proginit) then (current_procinfo.procdef.proctypeoption=potype_proginit) then
cg.a_call_name(list,'FPC_DO_EXIT'); cg.a_call_name(list,'FPC_DO_EXIT',false);
end; end;
@ -2186,7 +2186,7 @@ implementation
paramanager.freeparaloc(list,paraloc1); paramanager.freeparaloc(list,paraloc1);
{ Call the helper } { Call the helper }
cg.allocallcpuregisters(list); cg.allocallcpuregisters(list);
cg.a_call_name(list,'FPC_STACKCHECK'); cg.a_call_name(list,'FPC_STACKCHECK',false);
cg.deallocallcpuregisters(list); cg.deallocallcpuregisters(list);
paraloc1.done; paraloc1.done;
end; end;

24
compiler/pdecsub.pas
View File

@ -1609,6 +1609,15 @@ begin
end; end;
procedure pd_weakexternal(pd:tabstractprocdef);
begin
if not(target_info.system in system_weak_linking) then
message(parser_e_weak_external_not_supported)
else
pd_external(pd);
end;
type type
pd_handler=procedure(pd:tabstractprocdef); pd_handler=procedure(pd:tabstractprocdef);
proc_dir_rec=record proc_dir_rec=record
@ -1623,7 +1632,7 @@ type
end; end;
const const
{Should contain the number of procedure directives we support.} {Should contain the number of procedure directives we support.}
num_proc_directives=39; num_proc_directives=40;
proc_direcdata:array[1..num_proc_directives] of proc_dir_rec= proc_direcdata:array[1..num_proc_directives] of proc_dir_rec=
( (
( (
@ -1985,6 +1994,19 @@ const
mutexclpocall : []; mutexclpocall : [];
mutexclpotype : [potype_constructor,potype_destructor]; mutexclpotype : [potype_constructor,potype_destructor];
mutexclpo : [po_interrupt] mutexclpo : [po_interrupt]
),(
idtok:_WEAKEXTERNAL;
pd_flags : [pd_implemen,pd_interface,pd_notobject,pd_notobjintf,pd_cppobject];
handler : @pd_weakexternal;
pocall : pocall_none;
{ mark it both external and weak external, so we don't have to
adapt all code for external symbols to also check for weak external
}
pooption : [po_external,po_weakexternal];
mutexclpocall : [pocall_internproc,pocall_syscall];
{ allowed for external cpp classes }
mutexclpotype : [{potype_constructor,potype_destructor}];
mutexclpo : [po_public,po_exports,po_interrupt,po_assembler,po_inline]
) )
); );

15
compiler/pdecvar.pas
View File

@ -770,6 +770,7 @@ implementation
is_dll, is_dll,
is_cdecl, is_cdecl,
is_external_var, is_external_var,
is_weak_external,
is_public_var : boolean; is_public_var : boolean;
dll_name, dll_name,
C_name : string; C_name : string;
@ -811,7 +812,9 @@ implementation
end; end;
{ external } { external }
if try_to_consume(_EXTERNAL) then is_weak_external:=try_to_consume(_WEAKEXTERNAL);
if is_weak_external or
try_to_consume(_EXTERNAL) then
begin begin
is_external_var:=true; is_external_var:=true;
if not is_cdecl then if not is_cdecl then
@ -870,6 +873,12 @@ implementation
if vo_is_typed_const in vs.varoptions then if vo_is_typed_const in vs.varoptions then
Message(parser_e_initialized_not_for_external); Message(parser_e_initialized_not_for_external);
include(vs.varoptions,vo_is_external); include(vs.varoptions,vo_is_external);
if (is_weak_external) then
begin
if not(target_info.system in system_weak_linking) then
message(parser_e_weak_external_not_supported);
include(vs.varoptions,vo_is_weak_external);
end;
vs.varregable := vr_none; vs.varregable := vr_none;
if is_dll then if is_dll then
current_module.AddExternalImport(dll_name,C_Name,0,true,false) current_module.AddExternalImport(dll_name,C_Name,0,true,false)
@ -1118,7 +1127,7 @@ implementation
end; end;
{ Check for EXTERNAL etc directives before a semicolon } { Check for EXTERNAL etc directives before a semicolon }
if (idtoken in [_EXPORT,_EXTERNAL,_PUBLIC,_CVAR]) then if (idtoken in [_EXPORT,_EXTERNAL,_WEAKEXTERNAL,_PUBLIC,_CVAR]) then
begin begin
read_public_and_external_sc(sc); read_public_and_external_sc(sc);
allowdefaultvalue:=false; allowdefaultvalue:=false;
@ -1175,7 +1184,7 @@ implementation
{ Check for EXTERNAL etc directives or, in macpas, if cs_external_var is set} { Check for EXTERNAL etc directives or, in macpas, if cs_external_var is set}
if ( if (
( (
(idtoken in [_EXPORT,_EXTERNAL,_PUBLIC,_CVAR]) and (idtoken in [_EXPORT,_EXTERNAL,_WEAKEXTERNAL,_PUBLIC,_CVAR]) and
(m_cvar_support in current_settings.modeswitches) (m_cvar_support in current_settings.modeswitches)
) or ) or
( (

12
compiler/powerpc/cgcpu.pas
View File

@ -45,7 +45,7 @@ unit cgcpu;
procedure a_param_ref(list : TAsmList;size : tcgsize;const r : treference;const paraloc : tcgpara);override; procedure a_param_ref(list : TAsmList;size : tcgsize;const r : treference;const paraloc : tcgpara);override;
procedure a_call_name(list : TAsmList;const s : string);override; procedure a_call_name(list : TAsmList;const s : string; weak: boolean);override;
procedure a_call_reg(list : TAsmList;reg: tregister); override; procedure a_call_reg(list : TAsmList;reg: tregister); override;
procedure a_op_const_reg(list : TAsmList; Op: TOpCG; size: TCGSize; a: aint; reg: TRegister); override; procedure a_op_const_reg(list : TAsmList; Op: TOpCG; size: TCGSize; a: aint; reg: TRegister); override;
@ -248,19 +248,23 @@ const
{ calling a procedure by name } { calling a procedure by name }
procedure tcgppc.a_call_name(list : TAsmList;const s : string); procedure tcgppc.a_call_name(list : TAsmList;const s : string; weak: boolean);
begin begin
{ MacOS: The linker on MacOS (PPCLink) inserts a call to glue code, { MacOS: The linker on MacOS (PPCLink) inserts a call to glue code,
if it is a cross-TOC call. If so, it also replaces the NOP if it is a cross-TOC call. If so, it also replaces the NOP
with some restore code.} with some restore code.}
if (target_info.system <> system_powerpc_darwin) then if (target_info.system <> system_powerpc_darwin) then
begin begin
if not(weak) then
list.concat(taicpu.op_sym(A_BL,current_asmdata.RefAsmSymbol(s)))
else
list.concat(taicpu.op_sym(A_BL,current_asmdata.WeakRefAsmSymbol(s)));
list.concat(taicpu.op_sym(A_BL,current_asmdata.RefAsmSymbol(s))); list.concat(taicpu.op_sym(A_BL,current_asmdata.RefAsmSymbol(s)));
if target_info.system=system_powerpc_macos then if target_info.system=system_powerpc_macos then
list.concat(taicpu.op_none(A_NOP)); list.concat(taicpu.op_none(A_NOP));
end end
else else
list.concat(taicpu.op_sym(A_BL,get_darwin_call_stub(s))); list.concat(taicpu.op_sym(A_BL,get_darwin_call_stub(s,weak)));
{ {
the compiler does not properly set this flag anymore in pass 1, and the compiler does not properly set this flag anymore in pass 1, and
for now we only need it after pass 2 (I hope) (JM) for now we only need it after pass 2 (I hope) (JM)
@ -782,7 +786,7 @@ const
p : taicpu; p : taicpu;
begin begin
if (target_info.system = system_powerpc_darwin) then if (target_info.system = system_powerpc_darwin) then
p := taicpu.op_sym(A_B,get_darwin_call_stub(s)) p := taicpu.op_sym(A_B,get_darwin_call_stub(s,false))
else else
p := taicpu.op_sym(A_B,current_asmdata.RefAsmSymbol(s)); p := taicpu.op_sym(A_B,current_asmdata.RefAsmSymbol(s));
p.is_jmp := true; p.is_jmp := true;

2
compiler/powerpc/nppcadd.pas
View File

@ -952,7 +952,7 @@ interface
{ g_overflowcheck generates a OC_AE instead of OC_EQ :/ } { g_overflowcheck generates a OC_AE instead of OC_EQ :/ }
current_asmdata.getjumplabel(hl); current_asmdata.getjumplabel(hl);
tcgppc(cg).a_jmp_cond(current_asmdata.CurrAsmList,OC_EQ,hl); tcgppc(cg).a_jmp_cond(current_asmdata.CurrAsmList,OC_EQ,hl);
cg.a_call_name(current_asmdata.CurrAsmList,'FPC_OVERFLOW'); cg.a_call_name(current_asmdata.CurrAsmList,'FPC_OVERFLOW',false);
cg.a_label(current_asmdata.CurrAsmList,hl); cg.a_label(current_asmdata.CurrAsmList,hl);
end; end;
end; end;

2
compiler/powerpc/nppcmat.pas
View File

@ -358,7 +358,7 @@ end;
begin begin
current_asmdata.getjumplabel(hl); current_asmdata.getjumplabel(hl);
current_asmdata.CurrAsmList.concat(taicpu.op_cond_sym(A_BC,zerocond,hl)); current_asmdata.CurrAsmList.concat(taicpu.op_cond_sym(A_BC,zerocond,hl));
cg.a_call_name(current_asmdata.CurrAsmList,'FPC_DIVBYZERO'); cg.a_call_name(current_asmdata.CurrAsmList,'FPC_DIVBYZERO',false);
cg.a_label(current_asmdata.CurrAsmList,hl); cg.a_label(current_asmdata.CurrAsmList,hl);
end; end;
{ unsigned division/module can only overflow in case of division by zero } { unsigned division/module can only overflow in case of division by zero }

33
compiler/powerpc64/cgcpu.pas
View File

@ -45,7 +45,7 @@ type
procedure a_param_ref(list: TAsmList; size: tcgsize; const r: treference; procedure a_param_ref(list: TAsmList; size: tcgsize; const r: treference;
const paraloc: tcgpara); override; const paraloc: tcgpara); override;
procedure a_call_name(list: TAsmList; const s: string); override; procedure a_call_name(list: TAsmList; const s: string; weak: boolean); override;
procedure a_call_reg(list: TAsmList; reg: tregister); override; procedure a_call_reg(list: TAsmList; reg: tregister); override;
procedure a_op_const_reg(list: TAsmList; Op: TOpCG; size: TCGSize; a: procedure a_op_const_reg(list: TAsmList; Op: TOpCG; size: TCGSize; a:
@ -128,7 +128,7 @@ type
if includeCall is true, the method is marked as having a call, not if false. This if includeCall is true, the method is marked as having a call, not if false. This
option is particularly useful to prevent generation of a larger stack frame for the option is particularly useful to prevent generation of a larger stack frame for the
register save and restore helper functions. } register save and restore helper functions. }
procedure a_call_name_direct(list: TAsmList; s: string; prependDot : boolean; procedure a_call_name_direct(list: TAsmList; s: string; weak: boolean; prependDot : boolean;
addNOP : boolean; includeCall : boolean = true); addNOP : boolean; includeCall : boolean = true);
procedure a_jmp_name_direct(list : TAsmList; s : string; prependDot : boolean); procedure a_jmp_name_direct(list : TAsmList; s : string; prependDot : boolean);
@ -505,23 +505,26 @@ end;
{ calling a procedure by name } { calling a procedure by name }
procedure tcgppc.a_call_name(list: TAsmList; const s: string); procedure tcgppc.a_call_name(list: TAsmList; const s: string; weak: boolean);
begin begin
if (target_info.system <> system_powerpc64_darwin) then if (target_info.system <> system_powerpc64_darwin) then
a_call_name_direct(list, s, false, true) a_call_name_direct(list, s, weak, false, true)
else else
begin begin
list.concat(taicpu.op_sym(A_BL,get_darwin_call_stub(s))); list.concat(taicpu.op_sym(A_BL,get_darwin_call_stub(s,weak)));
include(current_procinfo.flags,pi_do_call); include(current_procinfo.flags,pi_do_call);
end; end;
end; end;
procedure tcgppc.a_call_name_direct(list: TAsmList; s: string; prependDot : boolean; addNOP : boolean; includeCall : boolean); procedure tcgppc.a_call_name_direct(list: TAsmList; s: string; weak: boolean; prependDot : boolean; addNOP : boolean; includeCall : boolean);
begin begin
if (prependDot) then if (prependDot) then
s := '.' + s; s := '.' + s;
list.concat(taicpu.op_sym(A_BL, current_asmdata.RefAsmSymbol(s))); if not(weak) then
list.concat(taicpu.op_sym(A_BL, current_asmdata.RefAsmSymbol(s)))
else
list.concat(taicpu.op_sym(A_BL, current_asmdata.WeakRefAsmSymbol(s)));
if (addNOP) then if (addNOP) then
list.concat(taicpu.op_none(A_NOP)); list.concat(taicpu.op_none(A_NOP));
@ -569,7 +572,7 @@ begin
in R11 } in R11 }
a_reg_alloc(list, NR_R11); a_reg_alloc(list, NR_R11);
a_load_reg_reg(list, OS_ADDR, OS_ADDR, reg, NR_R11); a_load_reg_reg(list, OS_ADDR, OS_ADDR, reg, NR_R11);
a_call_name_direct(list, '.ptrgl', false, false); a_call_name_direct(list, '.ptrgl', false, false, false);
a_reg_dealloc(list, NR_R11); a_reg_dealloc(list, NR_R11);
end; end;
@ -1234,7 +1237,7 @@ var
begin begin
if (target_info.system = system_powerpc64_darwin) then if (target_info.system = system_powerpc64_darwin) then
begin begin
p := taicpu.op_sym(A_B,get_darwin_call_stub(s)); p := taicpu.op_sym(A_B,get_darwin_call_stub(s,false));
p.is_jmp := true; p.is_jmp := true;
list.concat(p) list.concat(p)
end end
@ -1378,7 +1381,7 @@ procedure tcgppc.g_profilecode(list: TAsmList);
begin begin
current_procinfo.procdef.paras.ForEachCall(TObjectListCallback(@profilecode_savepara), list); current_procinfo.procdef.paras.ForEachCall(TObjectListCallback(@profilecode_savepara), list);
a_call_name_direct(list, '_mcount', false, true); a_call_name_direct(list, '_mcount', false, false, true);
current_procinfo.procdef.paras.ForEachCall(TObjectListCallback(@profilecode_restorepara), list); current_procinfo.procdef.paras.ForEachCall(TObjectListCallback(@profilecode_restorepara), list);
end; end;
@ -1416,12 +1419,12 @@ var
mayNeedLRStore := false; mayNeedLRStore := false;
if ((fprcount > 0) and (gprcount > 0)) then begin if ((fprcount > 0) and (gprcount > 0)) then begin
a_op_const_reg_reg(list, OP_SUB, OS_INT, 8 * fprcount, NR_R1, NR_R12); a_op_const_reg_reg(list, OP_SUB, OS_INT, 8 * fprcount, NR_R1, NR_R12);
a_call_name_direct(list, '_savegpr1_' + intToStr(32-gprcount), false, false, false); a_call_name_direct(list, '_savegpr1_' + intToStr(32-gprcount), false, false, false, false);
a_call_name_direct(list, '_savefpr_' + intToStr(32-fprcount), false, false, false); a_call_name_direct(list, '_savefpr_' + intToStr(32-fprcount), false, false, false, false);
end else if (gprcount > 0) then end else if (gprcount > 0) then
a_call_name_direct(list, '_savegpr0_' + intToStr(32-gprcount), false, false, false) a_call_name_direct(list, '_savegpr0_' + intToStr(32-gprcount), false, false, false, false)
else if (fprcount > 0) then else if (fprcount > 0) then
a_call_name_direct(list, '_savefpr_' + intToStr(32-fprcount), false, false, false) a_call_name_direct(list, '_savefpr_' + intToStr(32-fprcount), false, false, false, false)
else else
mayNeedLRStore := true; mayNeedLRStore := true;
end else begin end else begin
@ -1553,7 +1556,7 @@ var
needsExitCode := false; needsExitCode := false;
if ((fprcount > 0) and (gprcount > 0)) then begin if ((fprcount > 0) and (gprcount > 0)) then begin
a_op_const_reg_reg(list, OP_SUB, OS_INT, 8 * fprcount, NR_R1, NR_R12); a_op_const_reg_reg(list, OP_SUB, OS_INT, 8 * fprcount, NR_R1, NR_R12);
a_call_name_direct(list, '_restgpr1_' + intToStr(32-gprcount), false, false, false); a_call_name_direct(list, '_restgpr1_' + intToStr(32-gprcount), false, false, false, false);
a_jmp_name_direct(list, '_restfpr_' + intToStr(32-fprcount), false); a_jmp_name_direct(list, '_restfpr_' + intToStr(32-fprcount), false);
end else if (gprcount > 0) then end else if (gprcount > 0) then
a_jmp_name_direct(list, '_restgpr0_' + intToStr(32-gprcount), false) a_jmp_name_direct(list, '_restgpr0_' + intToStr(32-gprcount), false)

2
compiler/powerpc64/nppcadd.pas
View File

@ -346,7 +346,7 @@ begin
{ g_overflowcheck generates a OC_AE instead of OC_EQ :/ } { g_overflowcheck generates a OC_AE instead of OC_EQ :/ }
current_asmdata.getjumplabel(hl); current_asmdata.getjumplabel(hl);
tcgppc(cg).a_jmp_cond(current_asmdata.CurrAsmList, OC_EQ, hl); tcgppc(cg).a_jmp_cond(current_asmdata.CurrAsmList, OC_EQ, hl);
cg.a_call_name(current_asmdata.CurrAsmList, 'FPC_OVERFLOW'); cg.a_call_name(current_asmdata.CurrAsmList, 'FPC_OVERFLOW',false);
cg.a_label(current_asmdata.CurrAsmList, hl); cg.a_label(current_asmdata.CurrAsmList, hl);
end; end;
end; end;

2
compiler/powerpc64/nppcmat.pas
View File

@ -241,7 +241,7 @@ begin
if right.nodetype <> ordconstn then begin if right.nodetype <> ordconstn then begin
current_asmdata.getjumplabel(hl); current_asmdata.getjumplabel(hl);
current_asmdata.CurrAsmList.concat(taicpu.op_cond_sym(A_BC,zerocond,hl)); current_asmdata.CurrAsmList.concat(taicpu.op_cond_sym(A_BC,zerocond,hl));
cg.a_call_name(current_asmdata.CurrAsmList,'FPC_DIVBYZERO'); cg.a_call_name(current_asmdata.CurrAsmList,'FPC_DIVBYZERO',false);
cg.a_label(current_asmdata.CurrAsmList,hl); cg.a_label(current_asmdata.CurrAsmList,hl);
end; end;
{ unsigned division/module can only overflow in case of division by zero { unsigned division/module can only overflow in case of division by zero

19
compiler/ppcgen/cgppc.pas
View File

@ -64,7 +64,7 @@ unit cgppc;
procedure g_maybe_got_init(list: TAsmList); override; procedure g_maybe_got_init(list: TAsmList); override;
protected protected
function get_darwin_call_stub(const s: string): tasmsymbol; function get_darwin_call_stub(const s: string; weak: boolean): tasmsymbol;
procedure a_load_subsetref_regs_noindex(list: TAsmList; subsetsize: tcgsize; loadbitsize: byte; const sref: tsubsetreference; valuereg, extra_value_reg: tregister); override; procedure a_load_subsetref_regs_noindex(list: TAsmList; subsetsize: tcgsize; loadbitsize: byte; const sref: tsubsetreference; valuereg, extra_value_reg: tregister); override;
{ Make sure ref is a valid reference for the PowerPC and sets the } { Make sure ref is a valid reference for the PowerPC and sets the }
{ base to the value of the index if (base = R_NO). } { base to the value of the index if (base = R_NO). }
@ -243,7 +243,7 @@ unit cgppc;
end; end;
function tcgppcgen.get_darwin_call_stub(const s: string): tasmsymbol; function tcgppcgen.get_darwin_call_stub(const s: string; weak: boolean): tasmsymbol;
var var
stubname: string; stubname: string;
instr: taicpu; instr: taicpu;
@ -273,6 +273,9 @@ unit cgppc;
current_asmdata.asmlists[al_imports].concat(Tai_align.Create(stubalign)); current_asmdata.asmlists[al_imports].concat(Tai_align.Create(stubalign));
result := current_asmdata.RefAsmSymbol(stubname); result := current_asmdata.RefAsmSymbol(stubname);
current_asmdata.asmlists[al_imports].concat(Tai_symbol.Create(result,0)); current_asmdata.asmlists[al_imports].concat(Tai_symbol.Create(result,0));
{ register as a weak symbol if necessary }
if weak then
current_asmdata.weakrefasmsymbol(s);
current_asmdata.asmlists[al_imports].concat(tai_directive.create(asd_indirect_symbol,s)); current_asmdata.asmlists[al_imports].concat(tai_directive.create(asd_indirect_symbol,s));
l1 := current_asmdata.RefAsmSymbol('L'+s+'$lazy_ptr'); l1 := current_asmdata.RefAsmSymbol('L'+s+'$lazy_ptr');
reference_reset_symbol(href,l1,0); reference_reset_symbol(href,l1,0);
@ -599,7 +602,7 @@ unit cgppc;
end end
else else
a_jmp_cond(list,OC_AE,hl); a_jmp_cond(list,OC_AE,hl);
a_call_name(list,'FPC_OVERFLOW'); a_call_name(list,'FPC_OVERFLOW',false);
a_label(list,hl); a_label(list,hl);
end; end;
@ -616,7 +619,7 @@ unit cgppc;
paramanager.freeparaloc(list,paraloc1); paramanager.freeparaloc(list,paraloc1);
paraloc1.done; paraloc1.done;
allocallcpuregisters(list); allocallcpuregisters(list);
a_call_name(list,'mcount'); a_call_name(list,'mcount',false);
deallocallcpuregisters(list); deallocallcpuregisters(list);
a_reg_dealloc(list,NR_R0); a_reg_dealloc(list,NR_R0);
end; end;
@ -724,7 +727,7 @@ unit cgppc;
case target_info.system of case target_info.system of
system_powerpc_darwin, system_powerpc_darwin,
system_powerpc64_darwin: system_powerpc64_darwin:
list.concat(taicpu.op_sym(A_B,get_darwin_call_stub(procdef.mangledname))); list.concat(taicpu.op_sym(A_B,get_darwin_call_stub(procdef.mangledname,false)));
system_powerpc64_linux: system_powerpc64_linux:
{$note ts:todo add GOT change?? - think not needed :) } {$note ts:todo add GOT change?? - think not needed :) }
list.concat(taicpu.op_sym(A_B,current_asmdata.RefAsmSymbol('.' + procdef.mangledname))); list.concat(taicpu.op_sym(A_B,current_asmdata.RefAsmSymbol('.' + procdef.mangledname)));
@ -777,14 +780,14 @@ unit cgppc;
if (target_info.system in [system_powerpc_darwin,system_powerpc64_darwin]) and if (target_info.system in [system_powerpc_darwin,system_powerpc64_darwin]) and
assigned(ref.symbol) and assigned(ref.symbol) and
not assigned(ref.relsymbol) and not assigned(ref.relsymbol) and
((ref.symbol.bind = AB_EXTERNAL) or ((ref.symbol.bind in [AB_EXTERNAL,AB_WEAK_EXTERNAL]) or
(cs_create_pic in current_settings.moduleswitches))then (cs_create_pic in current_settings.moduleswitches))then
begin begin
if (ref.symbol.bind = AB_EXTERNAL) or if (ref.symbol.bind in [AB_EXTERNAL,AB_WEAK_EXTERNAL]) or
((cs_create_pic in current_settings.moduleswitches) and ((cs_create_pic in current_settings.moduleswitches) and
(ref.symbol.bind in [AB_COMMON,AB_GLOBAL])) then (ref.symbol.bind in [AB_COMMON,AB_GLOBAL])) then
begin begin
tmpreg := g_indirect_sym_load(list,ref.symbol.name); tmpreg := g_indirect_sym_load(list,ref.symbol.name,ref.symbol.bind=AB_WEAK_EXTERNAL);
ref.symbol:=nil; ref.symbol:=nil;
end end
else else

2
compiler/ptconst.pas
View File

@ -1371,7 +1371,7 @@ implementation
if ( if (
( (
(token = _ID) and (token = _ID) and
(idtoken in [_EXPORT,_EXTERNAL,_PUBLIC,_CVAR]) and (idtoken in [_EXPORT,_EXTERNAL,_WEAKEXTERNAL,_PUBLIC,_CVAR]) and
(m_cvar_support in current_settings.modeswitches) (m_cvar_support in current_settings.modeswitches)
) or ) or
( (

13
compiler/sparc/cgcpu.pas
View File

@ -51,7 +51,7 @@ interface
procedure a_paramaddr_ref(list:TAsmList;const r:TReference;const paraloc:TCGPara);override; procedure a_paramaddr_ref(list:TAsmList;const r:TReference;const paraloc:TCGPara);override;
procedure a_paramfpu_reg(list : TAsmList;size : tcgsize;const r : tregister;const paraloc : TCGPara);override; procedure a_paramfpu_reg(list : TAsmList;size : tcgsize;const r : tregister;const paraloc : TCGPara);override;
procedure a_paramfpu_ref(list : TAsmList;size : tcgsize;const ref : treference;const paraloc : TCGPara);override; procedure a_paramfpu_ref(list : TAsmList;size : tcgsize;const ref : treference;const paraloc : TCGPara);override;
procedure a_call_name(list:TAsmList;const s:string);override; procedure a_call_name(list:TAsmList;const s:string; weak: boolean);override;
procedure a_call_reg(list:TAsmList;Reg:TRegister);override; procedure a_call_reg(list:TAsmList;Reg:TRegister);override;
{ General purpose instructions } { General purpose instructions }
procedure maybeadjustresult(list: TAsmList; op: TOpCg; size: tcgsize; dst: tregister); procedure maybeadjustresult(list: TAsmList; op: TOpCg; size: tcgsize; dst: tregister);
@ -430,9 +430,12 @@ implementation
end; end;
procedure TCgSparc.a_call_name(list:TAsmList;const s:string); procedure TCgSparc.a_call_name(list:TAsmList;const s:string; weak: boolean);
begin begin
list.concat(taicpu.op_sym(A_CALL,current_asmdata.RefAsmSymbol(s))); if not weak then
list.concat(taicpu.op_sym(A_CALL,current_asmdata.RefAsmSymbol(s)))
else
list.concat(taicpu.op_sym(A_CALL,current_asmdata.WeakRefAsmSymbol(s)));
{ Delay slot } { Delay slot }
list.concat(taicpu.op_none(A_NOP)); list.concat(taicpu.op_none(A_NOP));
end; end;
@ -1034,7 +1037,7 @@ implementation
internalerror(200409281); internalerror(200409281);
end; end;
a_call_name(list,'FPC_OVERFLOW'); a_call_name(list,'FPC_OVERFLOW',false);
a_label(list,hl); a_label(list,hl);
end; end;
@ -1146,7 +1149,7 @@ implementation
paramanager.freeparaloc(list,paraloc1); paramanager.freeparaloc(list,paraloc1);
alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
alloccpuregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default)); alloccpuregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default));
a_call_name(list,'FPC_MOVE'); a_call_name(list,'FPC_MOVE',false);
dealloccpuregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default)); dealloccpuregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default));
dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
paraloc3.done; paraloc3.done;

7
compiler/symconst.pas
View File

@ -266,7 +266,9 @@ type
po_has_importdll, po_has_importdll,
po_has_importname, po_has_importname,
po_kylixlocal, po_kylixlocal,
po_dispid po_dispid,
{ weakly linked (i.e., may or may not exist at run time) }
po_weakexternal
); );
tprocoptions=set of tprocoption; tprocoptions=set of tprocoption;
@ -353,7 +355,8 @@ type
vo_is_typed_const, vo_is_typed_const,
vo_is_range_check, vo_is_range_check,
vo_is_overflow_check, vo_is_overflow_check,
vo_is_typinfo_para vo_is_typinfo_para,
vo_is_weak_external
); );
tvaroptions=set of tvaroption; tvaroptions=set of tvaroption;

3
compiler/systems.pas
View File

@ -408,6 +408,9 @@ interface
system_x86_64_win64, system_x86_64_win64,
system_ia64_win64]+system_linux; system_ia64_win64]+system_linux;
{ all systems for which weak linking has been tested/is supported }
system_weak_linking = systems_darwin;
system_internal_sysinit = [system_i386_linux,system_i386_win32]; system_internal_sysinit = [system_i386_linux,system_i386_win32];
system_embedded = [system_i386_embedded,system_m68k_embedded,system_alpha_embedded, system_embedded = [system_i386_embedded,system_m68k_embedded,system_alpha_embedded,

2
compiler/tokens.pas
View File

@ -243,6 +243,7 @@ type
_EXPERIMENTAL, _EXPERIMENTAL,
_FINALIZATION, _FINALIZATION,
_NOSTACKFRAME, _NOSTACKFRAME,
_WEAKEXTERNAL,
_DISPINTERFACE, _DISPINTERFACE,
_UNIMPLEMENTED, _UNIMPLEMENTED,
_IMPLEMENTATION, _IMPLEMENTATION,
@ -494,6 +495,7 @@ const
(str:'EXPERIMENTAL' ;special:false;keyword:m_all;op:NOTOKEN), (str:'EXPERIMENTAL' ;special:false;keyword:m_all;op:NOTOKEN),
(str:'FINALIZATION' ;special:false;keyword:m_initfinal;op:NOTOKEN), (str:'FINALIZATION' ;special:false;keyword:m_initfinal;op:NOTOKEN),
(str:'NOSTACKFRAME' ;special:false;keyword:m_none;op:NOTOKEN), (str:'NOSTACKFRAME' ;special:false;keyword:m_none;op:NOTOKEN),
(str:'WEAKEXTERNAL' ;special:false;keyword:m_none;op:NOTOKEN),
(str:'DISPINTERFACE' ;special:false;keyword:m_class;op:NOTOKEN), (str:'DISPINTERFACE' ;special:false;keyword:m_class;op:NOTOKEN),
(str:'UNIMPLEMENTED' ;special:false;keyword:m_all;op:NOTOKEN), (str:'UNIMPLEMENTED' ;special:false;keyword:m_all;op:NOTOKEN),
(str:'IMPLEMENTATION';special:false;keyword:m_all;op:NOTOKEN), (str:'IMPLEMENTATION';special:false;keyword:m_all;op:NOTOKEN),

44
compiler/x86/cgx86.pas
View File

@ -52,7 +52,7 @@ unit cgx86;
procedure dec_fpu_stack; procedure dec_fpu_stack;
procedure inc_fpu_stack; procedure inc_fpu_stack;
procedure a_call_name(list : TAsmList;const s : string);override; procedure a_call_name(list : TAsmList;const s : string; weak: boolean);override;
procedure a_call_reg(list : TAsmList;reg : tregister);override; procedure a_call_reg(list : TAsmList;reg : tregister);override;
procedure a_call_ref(list : TAsmList;ref : treference);override; procedure a_call_ref(list : TAsmList;ref : treference);override;
procedure a_call_name_static(list : TAsmList;const s : string);override; procedure a_call_name_static(list : TAsmList;const s : string);override;
@ -117,7 +117,7 @@ unit cgx86;
procedure opmm_loc_reg(list: TAsmList; Op: TOpCG; size : tcgsize;loc : tlocation;dst: tregister; shuffle : pmmshuffle); procedure opmm_loc_reg(list: TAsmList; Op: TOpCG; size : tcgsize;loc : tlocation;dst: tregister; shuffle : pmmshuffle);
function get_darwin_call_stub(const s: string): tasmsymbol; function get_darwin_call_stub(const s: string; weak: boolean): tasmsymbol;
private private
procedure sizes2load(s1,s2 : tcgsize;var op: tasmop; var s3: topsize); procedure sizes2load(s1,s2 : tcgsize;var op: tasmop; var s3: topsize);
@ -411,14 +411,14 @@ unit cgx86;
begin begin
if assigned(ref.symbol) and if assigned(ref.symbol) and
not(assigned(ref.relsymbol)) and not(assigned(ref.relsymbol)) and
((ref.symbol.bind = AB_EXTERNAL) or ((ref.symbol.bind in [AB_EXTERNAL,AB_WEAK_EXTERNAL]) or
(cs_create_pic in current_settings.moduleswitches)) then (cs_create_pic in current_settings.moduleswitches)) then
begin begin
if (ref.symbol.bind = AB_EXTERNAL) or if (ref.symbol.bind in [AB_EXTERNAL,AB_WEAK_EXTERNAL]) or
((cs_create_pic in current_settings.moduleswitches) and ((cs_create_pic in current_settings.moduleswitches) and
(ref.symbol.bind in [AB_COMMON,AB_GLOBAL])) then (ref.symbol.bind in [AB_COMMON,AB_GLOBAL])) then
begin begin
hreg:=g_indirect_sym_load(list,ref.symbol.name); hreg:=g_indirect_sym_load(list,ref.symbol.name,ref.symbol.bind=AB_WEAK_EXTERNAL);
ref.symbol:=nil; ref.symbol:=nil;
end end
else else
@ -576,7 +576,7 @@ unit cgx86;
list.concat(taicpu.op_sym(A_JMP,S_NO,current_asmdata.RefAsmSymbol(s))) list.concat(taicpu.op_sym(A_JMP,S_NO,current_asmdata.RefAsmSymbol(s)))
else else
begin begin
reference_reset_symbol(r,get_darwin_call_stub(s),0); reference_reset_symbol(r,get_darwin_call_stub(s,false),0);
r.refaddr:=addr_full; r.refaddr:=addr_full;
list.concat(taicpu.op_ref(A_JMP,S_NO,r)); list.concat(taicpu.op_ref(A_JMP,S_NO,r));
end; end;
@ -589,7 +589,7 @@ unit cgx86;
end; end;
function tcgx86.get_darwin_call_stub(const s: string): tasmsymbol; function tcgx86.get_darwin_call_stub(const s: string; weak: boolean): tasmsymbol;
var var
stubname: string; stubname: string;
begin begin
@ -604,6 +604,9 @@ unit cgx86;
current_asmdata.asmlists[al_imports].concat(Tai_section.create(sec_stub,'',0)); current_asmdata.asmlists[al_imports].concat(Tai_section.create(sec_stub,'',0));
result := current_asmdata.RefAsmSymbol(stubname); result := current_asmdata.RefAsmSymbol(stubname);
current_asmdata.asmlists[al_imports].concat(Tai_symbol.Create(result,0)); current_asmdata.asmlists[al_imports].concat(Tai_symbol.Create(result,0));
{ register as a weak symbol if necessary }
if weak then
current_asmdata.weakrefasmsymbol(s);
current_asmdata.asmlists[al_imports].concat(tai_directive.create(asd_indirect_symbol,s)); current_asmdata.asmlists[al_imports].concat(tai_directive.create(asd_indirect_symbol,s));
current_asmdata.asmlists[al_imports].concat(taicpu.op_none(A_HLT)); current_asmdata.asmlists[al_imports].concat(taicpu.op_none(A_HLT));
current_asmdata.asmlists[al_imports].concat(taicpu.op_none(A_HLT)); current_asmdata.asmlists[al_imports].concat(taicpu.op_none(A_HLT));
@ -613,7 +616,7 @@ unit cgx86;
end; end;
procedure tcgx86.a_call_name(list : TAsmList;const s : string); procedure tcgx86.a_call_name(list : TAsmList;const s : string; weak: boolean);
var var
sym : tasmsymbol; sym : tasmsymbol;
r : treference; r : treference;
@ -621,7 +624,10 @@ unit cgx86;
if (target_info.system <> system_i386_darwin) then if (target_info.system <> system_i386_darwin) then
begin begin
sym:=current_asmdata.RefAsmSymbol(s); if not(weak) then
sym:=current_asmdata.RefAsmSymbol(s)
else
sym:=current_asmdata.WeakRefAsmSymbol(s);
reference_reset_symbol(r,sym,0); reference_reset_symbol(r,sym,0);
if (cs_create_pic in current_settings.moduleswitches) and if (cs_create_pic in current_settings.moduleswitches) and
{ darwin/x86_64's assembler doesn't want @PLT after call symbols } { darwin/x86_64's assembler doesn't want @PLT after call symbols }
@ -637,7 +643,7 @@ unit cgx86;
end end
else else
begin begin
reference_reset_symbol(r,get_darwin_call_stub(s),0); reference_reset_symbol(r,get_darwin_call_stub(s,weak),0);
r.refaddr:=addr_full; r.refaddr:=addr_full;
end; end;
list.concat(taicpu.op_ref(A_CALL,S_NO,r)); list.concat(taicpu.op_ref(A_CALL,S_NO,r));
@ -814,15 +820,15 @@ unit cgx86;
if assigned(ref.symbol) then if assigned(ref.symbol) then
begin begin
if (target_info.system=system_i386_darwin) and if (target_info.system=system_i386_darwin) and
((ref.symbol.bind = AB_EXTERNAL) or ((ref.symbol.bind in [AB_EXTERNAL,AB_WEAK_EXTERNAL]) or
(cs_create_pic in current_settings.moduleswitches)) then (cs_create_pic in current_settings.moduleswitches)) then
begin begin
if (ref.symbol.bind = AB_EXTERNAL) or if (ref.symbol.bind in [AB_EXTERNAL,AB_WEAK_EXTERNAL]) or
((cs_create_pic in current_settings.moduleswitches) and ((cs_create_pic in current_settings.moduleswitches) and
(ref.symbol.bind in [AB_COMMON,AB_GLOBAL])) then (ref.symbol.bind in [AB_COMMON,AB_GLOBAL])) then
begin begin
reference_reset_base(tmpref, reference_reset_base(tmpref,
g_indirect_sym_load(list,ref.symbol.name), g_indirect_sym_load(list,ref.symbol.name,ref.symbol.bind=AB_WEAK_EXTERNAL),
offset); offset);
a_loadaddr_ref_reg(list,tmpref,r); a_loadaddr_ref_reg(list,tmpref,r);
end end
@ -894,7 +900,7 @@ unit cgx86;
if segment=NR_FS then if segment=NR_FS then
begin begin
allocallcpuregisters(list); allocallcpuregisters(list);
a_call_name(list,'GetTls'); a_call_name(list,'GetTls',false);
deallocallcpuregisters(list); deallocallcpuregisters(list);
list.concat(Taicpu.op_reg_reg(A_ADD,tcgsize2opsize[OS_ADDR],NR_EAX,r)); list.concat(Taicpu.op_reg_reg(A_ADD,tcgsize2opsize[OS_ADDR],NR_EAX,r));
end end
@ -1866,21 +1872,21 @@ unit cgx86;
new_section(list,sec_code,lower(current_procinfo.procdef.mangledname),0); new_section(list,sec_code,lower(current_procinfo.procdef.mangledname),0);
list.concat(Taicpu.Op_reg(A_PUSH,S_L,NR_EDX)); list.concat(Taicpu.Op_reg(A_PUSH,S_L,NR_EDX));
list.concat(Taicpu.Op_sym_ofs_reg(A_MOV,S_L,pl,0,NR_EDX)); list.concat(Taicpu.Op_sym_ofs_reg(A_MOV,S_L,pl,0,NR_EDX));
a_call_name(list,target_info.Cprefix+mcountprefix+'mcount'); a_call_name(list,target_info.Cprefix+mcountprefix+'mcount',false);
list.concat(Taicpu.Op_reg(A_POP,S_L,NR_EDX)); list.concat(Taicpu.Op_reg(A_POP,S_L,NR_EDX));
end; end;
system_i386_linux: system_i386_linux:
a_call_name(list,target_info.Cprefix+'mcount'); a_call_name(list,target_info.Cprefix+'mcount',false);
system_i386_go32v2,system_i386_watcom: system_i386_go32v2,system_i386_watcom:
begin begin
a_call_name(list,'MCOUNT'); a_call_name(list,'MCOUNT',false);
end; end;
system_x86_64_linux, system_x86_64_linux,
system_x86_64_darwin: system_x86_64_darwin:
begin begin
a_call_name(list,'mcount'); a_call_name(list,'mcount',false);
end; end;
end; end;
end; end;
@ -2062,7 +2068,7 @@ unit cgx86;
ai.is_jmp:=true; ai.is_jmp:=true;
list.concat(ai); list.concat(ai);
a_call_name(list,'FPC_OVERFLOW'); a_call_name(list,'FPC_OVERFLOW',false);
a_label(list,hl); a_label(list,hl);
end; end;

2
compiler/x86/nx86add.pas
View File

@ -181,7 +181,7 @@ unit nx86add;
cg.a_jmp_flags(current_asmdata.CurrAsmList,F_AE,hl4) cg.a_jmp_flags(current_asmdata.CurrAsmList,F_AE,hl4)
else else
cg.a_jmp_flags(current_asmdata.CurrAsmList,F_NO,hl4); cg.a_jmp_flags(current_asmdata.CurrAsmList,F_NO,hl4);
cg.a_call_name(current_asmdata.CurrAsmList,'FPC_OVERFLOW'); cg.a_call_name(current_asmdata.CurrAsmList,'FPC_OVERFLOW',false);
cg.a_label(current_asmdata.CurrAsmList,hl4); cg.a_label(current_asmdata.CurrAsmList,hl4);
end; end;
end; end;

2
compiler/x86_64/nx64add.pas
View File

@ -88,7 +88,7 @@ interface
begin begin
current_asmdata.getjumplabel(hl4); current_asmdata.getjumplabel(hl4);
cg.a_jmp_flags(current_asmdata.CurrAsmList,F_AE,hl4); cg.a_jmp_flags(current_asmdata.CurrAsmList,F_AE,hl4);
cg.a_call_name(current_asmdata.CurrAsmList,'FPC_OVERFLOW'); cg.a_call_name(current_asmdata.CurrAsmList,'FPC_OVERFLOW',false);
cg.a_label(current_asmdata.CurrAsmList,hl4); cg.a_label(current_asmdata.CurrAsmList,hl4);
end; end;
{ Free RDX,RAX } { Free RDX,RAX }

56
tests/test/tweaklib1.pp Normal file
View File

@ -0,0 +1,56 @@
{ %norun }
{$ifdef CPUX86_64}
{$ifndef WINDOWS}
{$PIC+}
{$endif WINDOWS}
{$endif CPUX86_64}
{$ifdef mswindows}
{$define supported}
{$endif win32}
{$ifdef Unix}
{$define supported}
{$endif Unix}
{$ifndef fpc}
{$define supported}
{$endif}
{$ifdef supported}
library tweaklib1;
{ On darwin, you always have to link with a (usually stub) library containing
all symbols, weak or not. Only at run time the weak symbols may be missing.
The real test is done there by tweaklib2/tweaklib3.
}
var
_myvar: cardinal; export name '_MYVAR';
{$ifdef darwin}
_myvar2: cardinal; export name '_MYVAR2';
{$endif darwin}
function _test: cardinal;
begin
writeln('this is a test');
_test:=$facef00d;
_myvar:=$12345678;
end;
{$ifdef darwin}
procedure _test2;
begin
end;
{$endif darwin}
exports
{$ifdef darwin}
_test2 name '_TEST2',
_myvar2,
{$endif darwin}
_test name '_TEST',
_myvar;
end.
{$endif supported}

59
tests/test/tweaklib2.pp Normal file
View File

@ -0,0 +1,59 @@
{ %NEEDLIBRARY }
{$ifdef mswindows}
{$define supported}
{$endif mswindows}
{$ifdef Unix}
{$define supported}
{$endif Unix}
{$ifndef fpc}
{$define supported}
{$endif}
{$ifdef supported}
const
{$ifdef windows}
libname='tweaklib1.dll';
{$else}
libname='tweaklib1';
{$linklib tweaklib1}
{$endif}
var
{$ifndef darwin}
_myvar: cardinal; weakexternal libname name '_MYVAR';
_myvar2: cardinal; weakexternal libname name '_MYVAR2';
{$else darwin}
{ needs to be fixed in the compiler }
_myvar: cardinal; weakexternal libname name 'MYVAR';
_myvar2: cardinal; weakexternal libname name 'MYVAR2';
{$endif darwin}
function _test: cardinal; weakexternal libname name '_TEST';
procedure _test2; weakexternal libname name '_TEST2';
begin
{$ifdef darwin}
if (paramcount=0) then
halt(0);
{$endif}
if not assigned(@_test) then
halt(1);
if assigned(@_test2) then
halt(2);
if _test<>$facef00d then
halt(3);
if not assigned(@_myvar) then
halt(4);
if assigned(@_myvar2) then
halt(5);
if (_myvar<>$12345678) then
halt(6);
end.
{$else supported}
begin
{ no library support }
end.
{$endif supported}

24
tests/test/tweaklib3.pp Normal file
View File

@ -0,0 +1,24 @@
{ %norun }
{ %target=darwin }
{ %opt=-olibtweaklib1.dylib }
{$PIC+}
library tweaklib;
var
_myvar: cardinal; export name '_MYVAR';
function _test: cardinal;
begin
writeln('this is a test');
_test:=$facef00d;
_myvar:=$12345678;
end;
exports
_test name '_TEST',
_myvar name '_MYVAR';
end.

16
tests/test/tweaklib4.pp Normal file
View File

@ -0,0 +1,16 @@
{ %target=darwin }
uses
sysutils;
var
res: longint;
begin
res:=executeprocess('./tweaklib2','1');
if (res<>0) then
begin
writeln('error: ',res);
halt(1);
end;
end.