paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-06-01 16:44:55 +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/tutf82.pp svneol=native#text/plain%3Bcharset%3Dutf-8
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/twide2.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
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=(
AT_NONE,AT_FUNCTION,AT_DATA,AT_SECTION,AT_LABEL,

14
compiler/aasmdata.pas
View File

@ -145,6 +145,7 @@ interface
destructor destroy;override;
{ asmsymbol }
function DefineAsmSymbol(const s : string;_bind:TAsmSymBind;_typ:Tasmsymtype) : TAsmSymbol;
function WeakRefAsmSymbol(const s : string) : TAsmSymbol;
function RefAsmSymbol(const s : string) : TAsmSymbol;
function GetAsmSymbol(const s : string) : TAsmSymbol;
{ create new assembler label }
@ -373,7 +374,18 @@ implementation
begin
result:=TAsmSymbol(FAsmSymbolDict.Find(s));
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;

4
compiler/aasmtai.pas
View File

@ -254,7 +254,7 @@ interface
TAsmDirective=(
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_reference,asd_no_dead_strip
asd_reference,asd_no_dead_strip,asd_weak_reference
);
const
@ -264,7 +264,7 @@ interface
directivestr : array[TAsmDirective] of string[23]=(
'non_lazy_symbol_pointer','indirect_symbol','lazy_symbol_pointer',
'extern','nasm_import', 'tc', 'mod_init_func', 'mod_term_func', 'reference',
'no_dead_strip'
'no_dead_strip','weak_reference'
);
type

26
compiler/aggas.pas
View File

@ -40,12 +40,16 @@ interface
{# This is a derived class which is used to write
GAS styled assembler.
}
{ TGNUAssembler }
TGNUAssembler=class(texternalassembler)
protected
function sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string;virtual;
procedure WriteSection(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder);
procedure WriteExtraHeader;virtual;
procedure WriteInstruction(hp: tai);
procedure WriteWeakSymbolDef(s: tasmsymbol); virtual;
public
function MakeCmdLine: TCmdStr; override;
procedure WriteTree(p:TAsmList);override;
@ -75,8 +79,12 @@ interface
end;
{ TAppleGNUAssembler }
TAppleGNUAssembler=class(TGNUAssembler)
protected
function sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string;override;
procedure WriteWeakSymbolDef(s: tasmsymbol); override;
private
debugframecount: aint;
end;
@ -1082,10 +1090,17 @@ implementation
end;
procedure TGNUAssembler.WriteWeakSymbolDef(s: tasmsymbol);
begin
AsmWriteLn(#9'.weak '+s.name);
end;
procedure TGNUAssembler.WriteAsmList;
var
n : string;
hal : tasmlisttype;
i: longint;
begin
{$ifdef EXTDEBUG}
if assigned(current_module.mainsource) then
@ -1108,6 +1123,11 @@ implementation
AsmWriteLn(target_asm.comment+'End asmlist '+AsmlistTypeStr[hal]);
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
(target_info.system in systems_darwin) then
AsmWriteLn(#9'.subsections_via_symbols');
@ -1184,6 +1204,12 @@ implementation
end;
procedure TAppleGNUAssembler.WriteWeakSymbolDef(s: tasmsymbol);
begin
AsmWriteLn(#9'.weak_reference '+s.name);
end;
{****************************************************************************}
{ 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_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_ref(list : TAsmList;ref: treference);override;
@ -112,7 +112,7 @@ unit cgcpu;
{ clear out potential overflow bits from 8 or 16 bit operations }
{ the upper 24/16 bits of a register after an operation }
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;
tcg64farm = class(tcg64f32)
@ -286,12 +286,15 @@ unit cgcpu;
end;
procedure tcgarm.a_call_name(list : TAsmList;const s : string);
procedure tcgarm.a_call_name(list : TAsmList;const s : string; weak: boolean);
begin
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
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
for now we only need it after pass 2 (I hope) (JM)
@ -1669,7 +1672,7 @@ unit cgcpu;
paramanager.freeparaloc(list,paraloc1);
alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(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_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
paraloc3.done;
@ -1943,7 +1946,7 @@ unit cgcpu;
internalerror(200409281);
end;
a_call_name(list,'FPC_OVERFLOW');
a_call_name(list,'FPC_OVERFLOW',false);
a_label(list,hl);
end;
@ -2110,7 +2113,7 @@ unit cgcpu;
end;
function tcgarm.get_darwin_call_stub(const s: string): tasmsymbol;
function tcgarm.get_darwin_call_stub(const s: string; weak: boolean): tasmsymbol;
var
stubname: string;
l1: tasmsymbol;
@ -2128,6 +2131,9 @@ unit cgcpu;
current_asmdata.asmlists[al_imports].concat(Tai_align.Create(4));
result := current_asmdata.RefAsmSymbol(stubname);
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));
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);
end;
{ 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 }
{ simple cardinal }
@ -779,7 +779,7 @@ unit cg64f32;
current_asmdata.getjumplabel(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 }
{ longint($80000000) and -1 (JM) }
@ -830,7 +830,7 @@ unit cg64f32;
current_asmdata.getjumplabel(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);
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
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_ref(list : TAsmList;ref : treference);virtual; abstract;
{ 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_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,
setting up any additional environment before doing so (if required).
@ -3072,7 +3072,7 @@ implementation
paramanager.freeparaloc(list,cgpara2);
paramanager.freeparaloc(list,cgpara1);
allocallcpuregisters(list);
a_call_name(list,'FPC_SHORTSTR_ASSIGN');
a_call_name(list,'FPC_SHORTSTR_ASSIGN',false);
deallocallcpuregisters(list);
cgpara3.done;
cgpara2.done;
@ -3094,7 +3094,7 @@ implementation
paramanager.freeparaloc(list,cgpara2);
paramanager.freeparaloc(list,cgpara1);
allocallcpuregisters(list);
a_call_name(list,'FPC_VARIANT_COPY_OVERWRITE');
a_call_name(list,'FPC_VARIANT_COPY_OVERWRITE',false);
deallocallcpuregisters(list);
cgpara2.done;
cgpara1.done;
@ -3136,7 +3136,7 @@ implementation
a_param_ref(list,OS_ADDR,ref,cgpara1);
paramanager.freeparaloc(list,cgpara1);
allocallcpuregisters(list);
a_call_name(list,incrfunc);
a_call_name(list,incrfunc,false);
deallocallcpuregisters(list);
end
else
@ -3149,7 +3149,7 @@ implementation
paramanager.freeparaloc(list,cgpara1);
paramanager.freeparaloc(list,cgpara2);
allocallcpuregisters(list);
a_call_name(list,'FPC_ADDREF');
a_call_name(list,'FPC_ADDREF',false);
deallocallcpuregisters(list);
end;
cgpara2.done;
@ -3206,7 +3206,7 @@ implementation
a_param_reg(list,OS_ADDR,tempreg1,cgpara1);
paramanager.freeparaloc(list,cgpara1);
allocallcpuregisters(list);
a_call_name(list,decrfunc);
a_call_name(list,decrfunc,false);
deallocallcpuregisters(list);
end
else
@ -3219,7 +3219,7 @@ implementation
paramanager.freeparaloc(list,cgpara1);
paramanager.freeparaloc(list,cgpara2);
allocallcpuregisters(list);
a_call_name(list,'FPC_DECREF');
a_call_name(list,'FPC_DECREF',false);
deallocallcpuregisters(list);
end;
cgpara2.done;
@ -3252,7 +3252,7 @@ implementation
paramanager.freeparaloc(list,cgpara1);
paramanager.freeparaloc(list,cgpara2);
allocallcpuregisters(list);
a_call_name(list,'FPC_INITIALIZE');
a_call_name(list,'FPC_INITIALIZE',false);
deallocallcpuregisters(list);
end;
cgpara1.done;
@ -3287,7 +3287,7 @@ implementation
paramanager.freeparaloc(list,cgpara1);
paramanager.freeparaloc(list,cgpara2);
allocallcpuregisters(list);
a_call_name(list,'FPC_FINALIZE');
a_call_name(list,'FPC_FINALIZE',false);
deallocallcpuregisters(list);
end;
cgpara1.done;
@ -3432,7 +3432,7 @@ implementation
{ if low(to) > maxlongint also range error }
(lto > aintmax) then
begin
a_call_name(list,'FPC_RANGEERROR');
a_call_name(list,'FPC_RANGEERROR',false);
exit
end;
{ from is signed and to is unsigned -> when looking at to }
@ -3447,7 +3447,7 @@ implementation
if (lfrom > aintmax) or
(hto < 0) then
begin
a_call_name(list,'FPC_RANGEERROR');
a_call_name(list,'FPC_RANGEERROR',false);
exit
end;
{ from is unsigned and to is signed -> when looking at to }
@ -3472,7 +3472,7 @@ implementation
else
{$endif cpu64bitalu}
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);
end;
@ -3509,7 +3509,7 @@ implementation
paramanager.allocparaloc(list,cgpara1);
a_param_const(list,OS_INT,210,cgpara1);
paramanager.freeparaloc(list,cgpara1);
a_call_name(list,'FPC_HANDLEERROR');
a_call_name(list,'FPC_HANDLEERROR',false);
a_label(list,oklabel);
cgpara1.done;
end;
@ -3535,7 +3535,7 @@ implementation
paramanager.freeparaloc(list,cgpara1);
paramanager.freeparaloc(list,cgpara2);
allocallcpuregisters(list);
a_call_name(list,'FPC_CHECK_OBJECT_EXT');
a_call_name(list,'FPC_CHECK_OBJECT_EXT',false);
deallocallcpuregisters(list);
end
else
@ -3545,7 +3545,7 @@ implementation
a_param_reg(list,OS_ADDR,reg,cgpara1);
paramanager.freeparaloc(list,cgpara1);
allocallcpuregisters(list);
a_call_name(list,'FPC_CHECK_OBJECT');
a_call_name(list,'FPC_CHECK_OBJECT',false);
deallocallcpuregisters(list);
end;
cgpara1.done;
@ -3591,7 +3591,7 @@ implementation
a_param_reg(list,OS_INT,sizereg,cgpara1);
paramanager.freeparaloc(list,cgpara1);
allocallcpuregisters(list);
a_call_name(list,'FPC_GETMEM');
a_call_name(list,'FPC_GETMEM',false);
deallocallcpuregisters(list);
cgpara1.done;
{ return the new address }
@ -3617,7 +3617,7 @@ implementation
paramanager.freeparaloc(list,cgpara2);
paramanager.freeparaloc(list,cgpara1);
allocallcpuregisters(list);
a_call_name(list,'FPC_MOVE');
a_call_name(list,'FPC_MOVE',false);
deallocallcpuregisters(list);
cgpara3.done;
cgpara2.done;
@ -3637,7 +3637,7 @@ implementation
a_param_loc(list,l,cgpara1);
paramanager.freeparaloc(list,cgpara1);
allocallcpuregisters(list);
a_call_name(list,'FPC_FREEMEM');
a_call_name(list,'FPC_FREEMEM',false);
deallocallcpuregisters(list);
cgpara1.done;
end;
@ -3813,11 +3813,11 @@ implementation
procedure tcg.a_call_name_static(list : TAsmList;const s : string);
begin
a_call_name(list,s);
a_call_name(list,s,false);
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
l: tasmsymbol;
ref: treference;
@ -3834,7 +3834,10 @@ implementation
begin
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_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}
current_asmdata.asmlists[al_picdata].concat(tai_const.create_64bit(0));
{$else cpu64bitaddr}

4
compiler/i386/cgcpu.pas
View File

@ -653,7 +653,7 @@ unit cgcpu;
else
begin
{ case 1 }
cg.a_call_name(list,procdef.mangledname);
cg.a_call_name(list,procdef.mangledname,false);
end;
{ restore param1 value self to interface }
g_adjust_self_value(list,procdef,-ioffset);
@ -693,7 +693,7 @@ unit cgcpu;
list.concat(taicpu.op_sym(A_JMP,S_NO,lab))
end
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;
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)
else
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);
end;
end;
@ -386,7 +386,7 @@ interface
begin
current_asmdata.getjumplabel(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);
end;
{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
#
# 03247 is the last used one
# 03248 is the last used one
#
% \section{Parser messages}
% 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.
% 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.
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}
#

5
compiler/msgidx.inc
View File

@ -335,6 +335,7 @@ const
parser_e_class_doesnt_implement_interface=03245;
parser_e_class_implements_must_be_interface=03246;
parser_e_cant_export_var_different_name=03247;
parser_e_weak_external_not_supported=03248;
type_e_mismatch=04000;
type_e_incompatible_types=04001;
type_e_not_equal_types=04002;
@ -755,9 +756,9 @@ const
option_info=11024;
option_help_pages=11025;
MsgTxtSize = 47509;
MsgTxtSize = 47580;
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
);

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
extra_interrupt_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;
end;
end;
@ -1114,7 +1114,7 @@ implementation
cgpara.done;
{$endif x86_64}
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);
end;
{$endif}
@ -1152,7 +1152,7 @@ implementation
not(po_virtualmethod in procdefinition.procoptions) then
begin
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);
end;
end;

48
compiler/ncgflw.pas
View File

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

2
compiler/ncginl.pas
View File

@ -231,7 +231,7 @@ implementation
paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc3);
paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc4);
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);
location_freetemp(current_asmdata.CurrAsmList,hp3.location);
location_freetemp(current_asmdata.CurrAsmList,hp2.location);

37
compiler/ncgld.pas
View File

@ -270,7 +270,8 @@ implementation
gvs:=tstaticvarsym(symtableentry);
if ([vo_is_dll_var,vo_is_external] * gvs.varoptions <> []) then
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
exit;
end;
@ -279,7 +280,10 @@ implementation
{ DLL variable }
begin
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);
reference_reset_base(location.reference,hregister,0);
end
@ -290,7 +294,10 @@ implementation
if (tf_section_threadvars in target_info.flags) then
begin
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
location:=gvs.localloc;
{$ifdef i386}
@ -324,7 +331,10 @@ implementation
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);
{ 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);
cg.a_param_ref(current_asmdata.CurrAsmList,OS_32,href,paraloc1);
paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc1);
@ -342,7 +352,10 @@ implementation
layout of a threadvar is (4 bytes pointer):
0 - Threadvar index
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_label(current_asmdata.CurrAsmList,endrelocatelab);
location.reference.base:=hregister;
@ -352,7 +365,10 @@ implementation
else
begin
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
location:=gvs.localloc;
end;
@ -482,10 +498,15 @@ implementation
begin
pd:=tprocdef(tprocsym(symtableentry).ProcdefList[0]);
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 }
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;
labelsym :

6
compiler/ncgmat.pas
View File

@ -193,7 +193,7 @@ implementation
location.register64.reglo,tr);
current_asmdata.getjumplabel(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);
end;
end;
@ -244,7 +244,7 @@ implementation
begin
current_asmdata.getjumplabel(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);
end;
end;
@ -371,7 +371,7 @@ implementation
paramanager.allocparaloc(current_asmdata.CurrAsmList,paraloc1);
cg.a_param_const(current_asmdata.CurrAsmList,OS_S32,200,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;
cg.a_label(current_asmdata.CurrAsmList,hl);
if nodetype = modn then

16
compiler/ncgmem.pas
View File

@ -228,7 +228,7 @@ implementation
paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc1);
paraloc1.done;
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);
end;
end;
@ -283,7 +283,7 @@ implementation
cg.a_param_reg(current_asmdata.CurrAsmList, OS_ADDR,location.reference.base,paraloc1);
paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc1);
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);
end;
end
@ -302,7 +302,7 @@ implementation
cg.a_param_reg(current_asmdata.CurrAsmList, OS_ADDR,location.reference.base,paraloc1);
paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc1);
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);
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_loc_reg_label(current_asmdata.CurrAsmList,OS_INT,OC_BE,hightree.location,hreg,neglabel);
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);
{ release hightree }
hightree.free;
@ -603,7 +603,7 @@ implementation
paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc1);
paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc2);
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);
end
else
@ -685,7 +685,7 @@ implementation
cg.a_param_reg(current_asmdata.CurrAsmList,OS_ADDR,location.reference.base,paraloc1);
paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc1);
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);
end;
@ -795,7 +795,7 @@ implementation
paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc1);
paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc2);
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);
end;
@ -963,7 +963,7 @@ implementation
paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc1);
paramanager.freeparaloc(current_asmdata.CurrAsmList,paraloc2);
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);
end;
st_shortstring:

12
compiler/ncgutil.pas
View File

@ -397,7 +397,7 @@ implementation
paramanager.freeparaloc(list,paraloc2);
paramanager.freeparaloc(list,paraloc1);
cg.allocallcpuregisters(list);
cg.a_call_name(list,'FPC_PUSHEXCEPTADDR');
cg.a_call_name(list,'FPC_PUSHEXCEPTADDR',false);
cg.deallocallcpuregisters(list);
paramanager.getintparaloc(pocall_default,1,paraloc1);
@ -405,7 +405,7 @@ implementation
cg.a_param_reg(list,OS_ADDR,NR_FUNCTION_RESULT_REG,paraloc1);
paramanager.freeparaloc(list,paraloc1);
cg.allocallcpuregisters(list);
cg.a_call_name(list,'FPC_SETJMP');
cg.a_call_name(list,'FPC_SETJMP',false);
cg.deallocallcpuregisters(list);
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);
begin
cg.allocallcpuregisters(list);
cg.a_call_name(list,'FPC_POPADDRSTACK');
cg.a_call_name(list,'FPC_POPADDRSTACK',false);
cg.deallocallcpuregisters(list);
if not onlyfree then
@ -1986,7 +1986,7 @@ implementation
begin
{ initialize units }
cg.allocallcpuregisters(list);
cg.a_call_name(list,'FPC_INITIALIZEUNITS');
cg.a_call_name(list,'FPC_INITIALIZEUNITS',false);
cg.deallocallcpuregisters(list);
end;
@ -2006,7 +2006,7 @@ implementation
{ call __EXIT for main program }
if (not DLLsource) and
(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;
@ -2186,7 +2186,7 @@ implementation
paramanager.freeparaloc(list,paraloc1);
{ Call the helper }
cg.allocallcpuregisters(list);
cg.a_call_name(list,'FPC_STACKCHECK');
cg.a_call_name(list,'FPC_STACKCHECK',false);
cg.deallocallcpuregisters(list);
paraloc1.done;
end;

24
compiler/pdecsub.pas
View File

@ -1609,6 +1609,15 @@ begin
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
pd_handler=procedure(pd:tabstractprocdef);
proc_dir_rec=record
@ -1623,7 +1632,7 @@ type
end;
const
{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=
(
(
@ -1985,6 +1994,19 @@ const
mutexclpocall : [];
mutexclpotype : [potype_constructor,potype_destructor];
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_cdecl,
is_external_var,
is_weak_external,
is_public_var : boolean;
dll_name,
C_name : string;
@ -811,7 +812,9 @@ implementation
end;
{ 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
is_external_var:=true;
if not is_cdecl then
@ -870,6 +873,12 @@ implementation
if vo_is_typed_const in vs.varoptions then
Message(parser_e_initialized_not_for_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;
if is_dll then
current_module.AddExternalImport(dll_name,C_Name,0,true,false)
@ -1118,7 +1127,7 @@ implementation
end;
{ 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
read_public_and_external_sc(sc);
allowdefaultvalue:=false;
@ -1175,7 +1184,7 @@ implementation
{ Check for EXTERNAL etc directives or, in macpas, if cs_external_var is set}
if (
(
(idtoken in [_EXPORT,_EXTERNAL,_PUBLIC,_CVAR]) and
(idtoken in [_EXPORT,_EXTERNAL,_WEAKEXTERNAL,_PUBLIC,_CVAR]) and
(m_cvar_support in current_settings.modeswitches)
) 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_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_op_const_reg(list : TAsmList; Op: TOpCG; size: TCGSize; a: aint; reg: TRegister); override;
@ -248,19 +248,23 @@ const
{ 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
{ 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
with some restore code.}
if (target_info.system <> system_powerpc_darwin) then
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)));
if target_info.system=system_powerpc_macos then
list.concat(taicpu.op_none(A_NOP));
end
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
for now we only need it after pass 2 (I hope) (JM)
@ -782,7 +786,7 @@ const
p : taicpu;
begin
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
p := taicpu.op_sym(A_B,current_asmdata.RefAsmSymbol(s));
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 :/ }
current_asmdata.getjumplabel(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);
end;
end;

2
compiler/powerpc/nppcmat.pas
View File

@ -358,7 +358,7 @@ end;
begin
current_asmdata.getjumplabel(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);
end;
{ 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;
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_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
option is particularly useful to prevent generation of a larger stack frame for the
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);
procedure a_jmp_name_direct(list : TAsmList; s : string; prependDot : boolean);
@ -505,23 +505,26 @@ end;
{ 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
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
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);
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
if (prependDot) then
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
list.concat(taicpu.op_none(A_NOP));
@ -569,7 +572,7 @@ begin
in R11 }
a_reg_alloc(list, 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);
end;
@ -1234,7 +1237,7 @@ var
begin
if (target_info.system = system_powerpc64_darwin) then
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;
list.concat(p)
end
@ -1378,7 +1381,7 @@ procedure tcgppc.g_profilecode(list: TAsmList);
begin
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);
end;
@ -1416,12 +1419,12 @@ var
mayNeedLRStore := false;
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_call_name_direct(list, '_savegpr1_' + intToStr(32-gprcount), false, false, false);
a_call_name_direct(list, '_savefpr_' + intToStr(32-fprcount), 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, false);
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
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
mayNeedLRStore := true;
end else begin
@ -1553,7 +1556,7 @@ var
needsExitCode := false;
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_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);
end else if (gprcount > 0) then
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 :/ }
current_asmdata.getjumplabel(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);
end;
end;

2
compiler/powerpc64/nppcmat.pas
View File

@ -241,7 +241,7 @@ begin
if right.nodetype <> ordconstn then begin
current_asmdata.getjumplabel(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);
end;
{ 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;
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;
{ Make sure ref is a valid reference for the PowerPC and sets the }
{ base to the value of the index if (base = R_NO). }
@ -243,7 +243,7 @@ unit cgppc;
end;
function tcgppcgen.get_darwin_call_stub(const s: string): tasmsymbol;
function tcgppcgen.get_darwin_call_stub(const s: string; weak: boolean): tasmsymbol;
var
stubname: string;
instr: taicpu;
@ -273,6 +273,9 @@ unit cgppc;
current_asmdata.asmlists[al_imports].concat(Tai_align.Create(stubalign));
result := current_asmdata.RefAsmSymbol(stubname);
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));
l1 := current_asmdata.RefAsmSymbol('L'+s+'$lazy_ptr');
reference_reset_symbol(href,l1,0);
@ -599,7 +602,7 @@ unit cgppc;
end
else
a_jmp_cond(list,OC_AE,hl);
a_call_name(list,'FPC_OVERFLOW');
a_call_name(list,'FPC_OVERFLOW',false);
a_label(list,hl);
end;
@ -616,7 +619,7 @@ unit cgppc;
paramanager.freeparaloc(list,paraloc1);
paraloc1.done;
allocallcpuregisters(list);
a_call_name(list,'mcount');
a_call_name(list,'mcount',false);
deallocallcpuregisters(list);
a_reg_dealloc(list,NR_R0);
end;
@ -724,7 +727,7 @@ unit cgppc;
case target_info.system of
system_powerpc_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:
{$note ts:todo add GOT change?? - think not needed :) }
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
assigned(ref.symbol) 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
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
(ref.symbol.bind in [AB_COMMON,AB_GLOBAL])) then
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;
end
else

2
compiler/ptconst.pas
View File

@ -1371,7 +1371,7 @@ implementation
if (
(
(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)
) 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_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_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;
{ General purpose instructions }
procedure maybeadjustresult(list: TAsmList; op: TOpCg; size: tcgsize; dst: tregister);
@ -430,9 +430,12 @@ implementation
end;
procedure TCgSparc.a_call_name(list:TAsmList;const s:string);
procedure TCgSparc.a_call_name(list:TAsmList;const s:string; weak: boolean);
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 }
list.concat(taicpu.op_none(A_NOP));
end;
@ -1034,7 +1037,7 @@ implementation
internalerror(200409281);
end;
a_call_name(list,'FPC_OVERFLOW');
a_call_name(list,'FPC_OVERFLOW',false);
a_label(list,hl);
end;
@ -1146,7 +1149,7 @@ implementation
paramanager.freeparaloc(list,paraloc1);
alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(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_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
paraloc3.done;

7
compiler/symconst.pas
View File

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

3
compiler/systems.pas
View File

@ -408,6 +408,9 @@ interface
system_x86_64_win64,
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_embedded = [system_i386_embedded,system_m68k_embedded,system_alpha_embedded,

2
compiler/tokens.pas
View File

@ -243,6 +243,7 @@ type
_EXPERIMENTAL,
_FINALIZATION,
_NOSTACKFRAME,
_WEAKEXTERNAL,
_DISPINTERFACE,
_UNIMPLEMENTED,
_IMPLEMENTATION,
@ -494,6 +495,7 @@ const
(str:'EXPERIMENTAL' ;special:false;keyword:m_all;op:NOTOKEN),
(str:'FINALIZATION' ;special:false;keyword:m_initfinal;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:'UNIMPLEMENTED' ;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 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_ref(list : TAsmList;ref : treference);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);
function get_darwin_call_stub(const s: string): tasmsymbol;
function get_darwin_call_stub(const s: string; weak: boolean): tasmsymbol;
private
procedure sizes2load(s1,s2 : tcgsize;var op: tasmop; var s3: topsize);
@ -411,14 +411,14 @@ unit cgx86;
begin
if assigned(ref.symbol) 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
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
(ref.symbol.bind in [AB_COMMON,AB_GLOBAL])) then
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;
end
else
@ -576,7 +576,7 @@ unit cgx86;
list.concat(taicpu.op_sym(A_JMP,S_NO,current_asmdata.RefAsmSymbol(s)))
else
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;
list.concat(taicpu.op_ref(A_JMP,S_NO,r));
end;
@ -589,7 +589,7 @@ unit cgx86;
end;
function tcgx86.get_darwin_call_stub(const s: string): tasmsymbol;
function tcgx86.get_darwin_call_stub(const s: string; weak: boolean): tasmsymbol;
var
stubname: string;
begin
@ -604,6 +604,9 @@ unit cgx86;
current_asmdata.asmlists[al_imports].concat(Tai_section.create(sec_stub,'',0));
result := current_asmdata.RefAsmSymbol(stubname);
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(taicpu.op_none(A_HLT));
current_asmdata.asmlists[al_imports].concat(taicpu.op_none(A_HLT));
@ -613,7 +616,7 @@ unit cgx86;
end;
procedure tcgx86.a_call_name(list : TAsmList;const s : string);
procedure tcgx86.a_call_name(list : TAsmList;const s : string; weak: boolean);
var
sym : tasmsymbol;
r : treference;
@ -621,7 +624,10 @@ unit cgx86;
if (target_info.system <> system_i386_darwin) then
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);
if (cs_create_pic in current_settings.moduleswitches) and
{ darwin/x86_64's assembler doesn't want @PLT after call symbols }
@ -637,7 +643,7 @@ unit cgx86;
end
else
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;
end;
list.concat(taicpu.op_ref(A_CALL,S_NO,r));
@ -814,15 +820,15 @@ unit cgx86;
if assigned(ref.symbol) then
begin
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
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
(ref.symbol.bind in [AB_COMMON,AB_GLOBAL])) then
begin
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);
a_loadaddr_ref_reg(list,tmpref,r);
end
@ -894,7 +900,7 @@ unit cgx86;
if segment=NR_FS then
begin
allocallcpuregisters(list);
a_call_name(list,'GetTls');
a_call_name(list,'GetTls',false);
deallocallcpuregisters(list);
list.concat(Taicpu.op_reg_reg(A_ADD,tcgsize2opsize[OS_ADDR],NR_EAX,r));
end
@ -1866,21 +1872,21 @@ unit cgx86;
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_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));
end;
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:
begin
a_call_name(list,'MCOUNT');
a_call_name(list,'MCOUNT',false);
end;
system_x86_64_linux,
system_x86_64_darwin:
begin
a_call_name(list,'mcount');
a_call_name(list,'mcount',false);
end;
end;
end;
@ -2062,7 +2068,7 @@ unit cgx86;
ai.is_jmp:=true;
list.concat(ai);
a_call_name(list,'FPC_OVERFLOW');
a_call_name(list,'FPC_OVERFLOW',false);
a_label(list,hl);
end;

2
compiler/x86/nx86add.pas
View File

@ -181,7 +181,7 @@ unit nx86add;
cg.a_jmp_flags(current_asmdata.CurrAsmList,F_AE,hl4)
else
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);
end;
end;

2
compiler/x86_64/nx64add.pas
View File

@ -88,7 +88,7 @@ interface
begin
current_asmdata.getjumplabel(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);
end;
{ 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.