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

* synchronised with trunk till r42105

Browse Source 
git-svn-id: branches/debug_eh@42106 -
This commit is contained in:
Jonas Maebe 2019-05-19 19:24:25 +00:00
commit 0cd0e1614b
12 changed files with 78 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
compiler/llvm/llvmdef.pas
View File

@ -68,7 +68,7 @@ interface
record consisting of 4 longints must be returned as a record consisting of
two int64's on x86-64. This function is used to create (and reuse)
temporary recorddefs for such purposes.}
function llvmgettemprecorddef(fieldtypes: array of tdef; packrecords, recordalignmin, maxcrecordalign: shortint): trecorddef;
function llvmgettemprecorddef(const fieldtypes: array of tdef; packrecords, recordalignmin, maxcrecordalign: shortint): trecorddef;
{ get the llvm type corresponding to a parameter, e.g. a record containing
two integer int64 for an arbitrary record split over two individual int64
@ -862,7 +862,7 @@ implementation
end;
function llvmgettemprecorddef(fieldtypes: array of tdef; packrecords, recordalignmin, maxcrecordalign: shortint): trecorddef;
function llvmgettemprecorddef(const fieldtypes: array of tdef; packrecords, recordalignmin, maxcrecordalign: shortint): trecorddef;
var
i: longint;
res: PHashSetItem;

6
compiler/ncgld.pas
View File

@ -557,7 +557,8 @@ implementation
hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,false);
{ vd will contain the type of the self pointer (self in
case of a class/classref, address of self in case of
an object }
an object, frame pointer or pointer to parentfpstruct
in case of nested procsym load }
vd:=nil;
case left.location.loc of
LOC_CREGISTER,
@ -573,7 +574,8 @@ implementation
LOC_REFERENCE:
begin
if is_implicit_pointer_object_type(left.resultdef) or
(left.resultdef.typ=classrefdef) then
(left.resultdef.typ=classrefdef) or
is_nested_pd(procdef) then
begin
vd:=left.resultdef;
location.registerhi:=hlcg.getaddressregister(current_asmdata.CurrAsmList,left.resultdef);

22
compiler/ngenutil.pas
View File

@ -143,6 +143,9 @@ interface
also for the linker }
class procedure RegisterUsedAsmSym(sym: TAsmSymbol; def: tdef; compileronly: boolean); virtual;
class procedure RegisterModuleInitFunction(pd: tprocdef); virtual;
class procedure RegisterModuleFiniFunction(pd: tprocdef); virtual;
class procedure GenerateObjCImageInfo; virtual;
strict protected
@ -163,7 +166,8 @@ implementation
symbase,symtable,defutil,
nadd,ncal,ncnv,ncon,nflw,ninl,nld,nmem,nutils,
ppu,
pass_1;
pass_1,
export;
class function tnodeutils.call_fail_node:tnode;
var
@ -949,7 +953,7 @@ implementation
{ the mainstub is generated via a synthetic proc -> parsed via
psub.read_proc_body() -> that one will insert the mangled name in the
alias names already }
if potype<>potype_mainstub then
if not(potype in [potype_mainstub,potype_libmainstub]) then
pd.aliasnames.insert(pd.mangledname);
result:=pd;
end;
@ -1564,6 +1568,20 @@ implementation
end;
class procedure tnodeutils.RegisterModuleInitFunction(pd: tprocdef);
begin
{ setinitname may generate a new section -> don't add to the
current list, because we assume this remains a text section }
exportlib.setinitname(current_asmdata.AsmLists[al_pure_assembler],pd.mangledname);
end;
class procedure tnodeutils.RegisterModuleFiniFunction(pd: tprocdef);
begin
exportlib.setfininame(current_asmdata.AsmLists[al_pure_assembler],pd.mangledname);
end;
class procedure tnodeutils.GenerateObjCImageInfo;
var
tcb: ttai_typedconstbuilder;

2
compiler/pexpr.pas
View File

@ -1150,7 +1150,7 @@ implementation
hp2:=cloadnode.create_procvar(tprocsym(tcallnode(hp).symtableprocentry),currprocdef,tcallnode(hp).symtableproc);
if (po_methodpointer in pv.procoptions) then
tloadnode(hp2).set_mp(tcallnode(hp).methodpointer.getcopy);
hp.destroy;
hp.free;
{ replace the old callnode with the new loadnode }
hpp^:=hp2;
end;

32
compiler/pmodules.pas
View File

@ -670,7 +670,7 @@ implementation
st.insert(ps);
pd:=tprocdef(cnodeutils.create_main_procdef(target_info.cprefix+name,potype,ps));
{ We don't need a local symtable, change it into the static symtable }
if not (potype in [potype_mainstub,potype_pkgstub]) then
if not (potype in [potype_mainstub,potype_pkgstub,potype_libmainstub]) then
begin
pd.localst.free;
pd.localst:=st;
@ -1903,13 +1903,13 @@ type
var
main_file : tinputfile;
hp,hp2 : tmodule;
initpd : tprocdef;
finalize_procinfo,
init_procinfo,
main_procinfo : tcgprocinfo;
force_init_final : boolean;
resources_used : boolean;
program_uses_checkpointer : boolean;
initname,
program_name : ansistring;
consume_semicolon_after_uses : boolean;
ps : tprogramparasym;
@ -2129,6 +2129,17 @@ type
from the bootstrap code.}
if islibrary then
begin
initpd:=nil;
{ ToDo: other systems that use indirect entry info, but check back with Windows! }
{ we need to call FPC_LIBMAIN in sysinit which in turn will call PascalMain -> create dummy stub }
if target_info.system in systems_darwin then
begin
main_procinfo:=create_main_proc(make_mangledname('sysinitcallthrough',current_module.localsymtable,'stub'),potype_libmainstub,current_module.localsymtable);
call_through_new_name(main_procinfo.procdef,target_info.cprefix+'FPC_LIBMAIN');
initpd:=main_procinfo.procdef;
main_procinfo.free;
end;
main_procinfo:=create_main_proc(make_mangledname('',current_module.localsymtable,mainaliasname),potype_proginit,current_module.localsymtable);
{ Win32 startup code needs a single name }
if not(target_info.system in (systems_darwin+systems_aix)) then
@ -2136,17 +2147,10 @@ type
else
main_procinfo.procdef.aliasnames.concat(target_info.Cprefix+'PASCALMAIN');
{ ToDo: systems that use indirect entry info, but check back with Windows! }
if target_info.system in systems_darwin then
{ we need to call FPC_LIBMAIN in sysinit which in turn will call PascalMain }
initname:=target_info.cprefix+'FPC_LIBMAIN'
else
initname:=main_procinfo.procdef.mangledname;
{ setinitname may generate a new section -> don't add to the
current list, because we assume this remains a text section
-- add to pure assembler section, so in case of special directives
they are directly added to the assembler output by llvm }
exportlib.setinitname(current_asmdata.AsmLists[al_pure_assembler],initname);
if not(target_info.system in systems_darwin) then
initpd:=main_procinfo.procdef;
cnodeutils.RegisterModuleInitFunction(initpd);
end
else if (target_info.system in ([system_i386_netware,system_i386_netwlibc,system_powerpc_macos]+systems_darwin+systems_aix)) then
begin
@ -2225,7 +2229,7 @@ type
{ Place in "pure assembler" list so that the llvm assembler writer
directly emits the generated directives }
if (islibrary) then
exportlib.setfininame(current_asmdata.asmlists[al_pure_assembler],'FPC_LIB_EXIT');
cnodeutils.RegisterModuleFiniFunction(search_system_proc('fpc_lib_exit'));
{ all labels must be defined before generating code }
if Errorcount=0 then

6
compiler/symconst.pas
View File

@ -308,7 +308,8 @@ type
potype_propsetter,
potype_exceptfilter, { SEH exception filter or termination handler }
potype_mainstub, { "main" function that calls through to FPC_SYSTEMMAIN }
potype_pkgstub { stub for a package file, that tells OS that all is OK }
potype_pkgstub, { stub for a package file, that tells OS that all is OK }
potype_libmainstub { "main" function for a library that calls through to FPC_LIBMAIN }
);
tproctypeoptions=set of tproctypeoption;
@ -968,7 +969,8 @@ inherited_objectoptions : tobjectoptions = [oo_has_virtual,oo_has_private,oo_has
'property setters', {potype_propsetter}
'exception filters', {potype_exceptfilter}
'"main" stub', {potype_mainstub}
'package stub' {potype_pkgstub}
'package stub', {potype_pkgstub}
'lib "main" stub' {potype_libmainstub}
);
{ TProcOption string identifiers for error messages }

3
compiler/utils/ppuutils/ppudump.pp
View File

@ -1950,7 +1950,8 @@ const
(mask:potype_propsetter; str:'Property Setter'),
(mask:potype_exceptfilter; str:'SEH filter'),
(mask:potype_mainstub; str:'main stub'),
(mask:potype_pkgstub; str:'package stub')
(mask:potype_pkgstub; str:'package stub'),
(mask:potype_libmainstub; str:'library main stub')
);
procopt : array[1..ord(high(tprocoption))] of tprocopt=(
(mask:po_classmethod; str:'ClassMethod'),

2
rtl/inc/compproc.inc
View File

@ -787,9 +787,9 @@ procedure fpc_do_exit;compilerproc;
{
Procedure fpc_do_exit; compilerproc;
Procedure fpc_lib_exit; compilerproc;
Procedure fpc_HandleErrorAddrFrame (Errno : longint;addr,frame : pointer); compilerproc;
}
Procedure fpc_lib_exit; compilerproc;
Procedure fpc_HandleError (Errno : longint); compilerproc;
procedure fpc_AbstractErrorIntern;compilerproc;

2
rtl/inc/system.inc
View File

@ -1135,7 +1135,7 @@ end;
procedure internal_do_exit; external name 'FPC_DO_EXIT';
Procedure lib_exit;[Public,Alias:'FPC_LIB_EXIT'];
Procedure fpc_lib_exit;[Public,Alias:'FPC_LIB_EXIT'];
begin
InternalExit;
end;

7
tests/tbs/tb0508.pp
View File

@ -1,5 +1,7 @@
{ inlining is not compatible with get_caller_frame/get_frame }
{$inline off}
{$ifndef cpullvm}
type
PointerLocal = procedure(_EBP: Pointer);
@ -44,3 +46,8 @@ var
begin
t1;
end.
{$else ndef cpullvm}
begin
{ this kind of hacks can never work on llvm }
end.
{$endif cpullvm}

2
tests/test/opt/tdfa19.pp
View File

@ -1,5 +1,5 @@
{ %OPT=-Oodfa -vw -Sew }
{ %norun }
{ %norun }
{$mode objfpc}

22
tests/webtbs/tw17379.pp
View File

@ -1,22 +1,34 @@
{ %norun }
{$mode macpas}
{$warnings off}
program recursivefunctionparam;
function first( function test( theint: integer): boolean): integer;
begin {not implemented} end;
begin
test(2);
end;
function find: integer;
var
l: longint;
function test( theint: integer): boolean;
begin
first( test)
if (theint = 1) then
first( test)
else
begin
writeln('nested procvar call, l = ', l);
if l<>1234567890 then
halt(1);
end;
find:=0;
end;
begin
{not implemented}
l:=1234567890;
test(1)
end;
begin
find;
end.