* split off the texceptaddr declaration into rtl/inc/excepth.inc, so it can

be included at the start of the implementation of the system unit (before
    the rest of except.inc)
  * catch declarations in/loading from the system unit of the TExceptAddr type
  * use this type instead of hardcoded size constants in the compiler
  * in generic code that is active for all targets, puts its use in a virtual
    method since it's only valid for targets using setjmp/longjmp-style
    exception handling (and the record is not defined at all in the JVM RTL)

git-svn-id: branches/hlcgllvm@28376 -
This commit is contained in:
Jonas Maebe 2014-08-10 19:40:29 +00:00
parent 4acd43c643
commit 6e1d370417
9 changed files with 112 additions and 51 deletions

1
.gitattributes vendored
View File

@ -8228,6 +8228,7 @@ rtl/inc/dynarr.inc svneol=native#text/plain
rtl/inc/dynarrh.inc svneol=native#text/plain
rtl/inc/dynlibs.pas svneol=native#text/plain
rtl/inc/except.inc svneol=native#text/plain
rtl/inc/excepth.inc svneol=native#text/plain
rtl/inc/exeinfo.pp svneol=native#text/plain
rtl/inc/extres.inc svneol=native#text/plain
rtl/inc/fexpand.inc svneol=native#text/plain

View File

@ -41,10 +41,14 @@ interface
tjvmtryexceptnode = class(ttryexceptnode)
procedure pass_generate_code;override;
protected
procedure adjust_estimated_stack_size; override;
end;
tjvmtryfinallynode = class(ttryfinallynode)
procedure pass_generate_code;override;
protected
procedure adjust_estimated_stack_size; override;
end;
tjvmonnode = class(tonnode)
@ -258,6 +262,12 @@ implementation
end;
procedure tjvmtryexceptnode.adjust_estimated_stack_size;
begin
{ do nothing }
end;
{*****************************************************************************
SecondOn
*****************************************************************************}
@ -492,6 +502,12 @@ implementation
flowcontrol:=oldflowcontrol+(tryflowcontrol-[fc_inflowcontrol]);
end;
procedure tjvmtryfinallynode.adjust_estimated_stack_size;
begin
{ do nothing }
end;
begin
cfornode:=tjvmfornode;
craisenode:=tjvmraisenode;

View File

@ -386,16 +386,10 @@ implementation
*****************************************************************************}
procedure get_exception_temps(list:TAsmList;var t:texceptiontemps);
var
except_buf_size: longint;
begin
{ todo: is there a way to retrieve the except_buf_size from the size of
the TExceptAddr record from the system unit (like we do for jmp_buf_size),
without moving TExceptAddr to the interface part? }
except_buf_size:=voidpointertype.size*2+sizeof(pint);
tg.GetTemp(list,except_buf_size,sizeof(pint),tt_persistent,t.envbuf);
tg.gethltemp(list,rec_exceptaddr,rec_exceptaddr.size,tt_persistent,t.envbuf);
tg.gethltemp(list,rec_jmp_buf,rec_jmp_buf.size,tt_persistent,t.jmpbuf);
tg.GetTemp(list,sizeof(pint),sizeof(pint),tt_persistent,t.reasonbuf);
tg.gethltemp(list,ossinttype,ossinttype.size,tt_persistent,t.reasonbuf);
end;

View File

@ -183,6 +183,8 @@ interface
function pass_typecheck:tnode;override;
function pass_1 : tnode;override;
function simplify(forinline: boolean): tnode; override;
protected
procedure adjust_estimated_stack_size; virtual;
end;
ttryexceptnodeclass = class of ttryexceptnode;
@ -195,6 +197,7 @@ interface
function simplify(forinline:boolean): tnode;override;
protected
function create_finalizer_procdef: tprocdef;
procedure adjust_estimated_stack_size; virtual;
end;
ttryfinallynodeclass = class of ttryfinallynode;
@ -2068,7 +2071,8 @@ implementation
include(current_procinfo.flags,pi_do_call);
include(current_procinfo.flags,pi_uses_exceptions);
inc(current_procinfo.estimatedtempsize,rec_jmp_buf.size*2);
adjust_estimated_stack_size;
end;
@ -2080,6 +2084,11 @@ implementation
result:=cnothingnode.create;
end;
procedure ttryexceptnode.adjust_estimated_stack_size;
begin
inc(current_procinfo.estimatedtempsize,rec_jmp_buf.size*2);
end;
{*****************************************************************************
TTRYFINALLYNODE
@ -2141,7 +2150,7 @@ implementation
if not(implicitframe) then
include(current_procinfo.flags,pi_uses_exceptions);
inc(current_procinfo.estimatedtempsize,rec_jmp_buf.size);
adjust_estimated_stack_size;
end;
@ -2206,6 +2215,12 @@ implementation
end;
procedure ttryfinallynode.adjust_estimated_stack_size;
begin
inc(current_procinfo.estimatedtempsize,rec_jmp_buf.size);
end;
{*****************************************************************************
TONNODE
*****************************************************************************}

View File

@ -706,10 +706,21 @@ implementation
ttypesym(sym).typedef:=hdef;
newtype.typedef:=hdef;
{ KAZ: handle TGUID declaration in system unit }
if (cs_compilesystem in current_settings.moduleswitches) and not assigned(rec_tguid) and
(gentypename='TGUID') and { name: TGUID and size=16 bytes that is 128 bits }
assigned(hdef) and (hdef.typ=recorddef) and (hdef.size=16) then
rec_tguid:=trecorddef(hdef);
if (cs_compilesystem in current_settings.moduleswitches) and
assigned(hdef) and
(hdef.typ=recorddef) then
begin
if not assigned(rec_tguid) and
(gentypename='TGUID') and
(hdef.size=16) then
rec_tguid:=trecorddef(hdef)
else if not assigned(rec_jmp_buf) and
(gentypename='JMP_BUF') then
rec_jmp_buf:=trecorddef(hdef)
else if not assigned(rec_exceptaddr) and
(gentypename='TEXCEPTADDR') then
rec_exceptaddr:=trecorddef(hdef);
end;
end;
if assigned(hdef) then
begin

View File

@ -1017,9 +1017,12 @@ interface
of all interfaces }
rec_tguid : trecorddef;
{ pointer to jump buffer }
{ jump buffer type, used by setjmp }
rec_jmp_buf : trecorddef;
{ system.texceptaddr type, used by fpc_pushexceptaddr }
rec_exceptaddr: trecorddef;
{ Objective-C base types }
objc_metaclasstype,
objc_superclasstype,
@ -4060,21 +4063,23 @@ implementation
else
tstoredsymtable(symtable).deref;
{ assign TGUID? load only from system unit }
if not(assigned(rec_tguid)) and
(upper(typename)='TGUID') and
assigned(owner) and
{ internal types, only load from the system unit }
if assigned(owner) and
assigned(owner.name) and
(owner.name^='SYSTEM') then
rec_tguid:=self;
{ assign JMP_BUF? load only from system unit }
if not(assigned(rec_jmp_buf)) and
(upper(typename)='JMP_BUF') and
assigned(owner) and
assigned(owner.name) and
(owner.name^='SYSTEM') then
rec_jmp_buf:=self;
begin
{ TGUID }
if not assigned(rec_tguid) and
(upper(typename)='TGUID') then
rec_tguid:=self
{ JMP_BUF }
else if not assigned(rec_jmp_buf) and
(upper(typename)='JMP_BUF') then
rec_jmp_buf:=self
else if not assigned(rec_exceptaddr) and
(upper(typename)='TEXCEPTADDR') then
rec_exceptaddr:=self;
end;
end;

View File

@ -17,29 +17,6 @@
****************************************************************************}
Const
{ Type of exception. Currently only one. }
FPC_EXCEPTION = 1;
{ types of frames for the exception address stack }
cExceptionFrame = 1;
cFinalizeFrame = 2;
Type
PExceptAddr = ^TExceptAddr;
TExceptAddr = record
buf : pjmp_buf;
next : PExceptAddr;
{$ifdef CPU16}
frametype : Smallint;
{$else CPU16}
frametype : Longint;
{$endif CPU16}
end;
Const
CatchAllExceptions = PtrInt(-1);
{$ifdef FPC_HAS_FEATURE_THREADING}
ThreadVar
{$else FPC_HAS_FEATURE_THREADING}

37
rtl/inc/excepth.inc Normal file
View File

@ -0,0 +1,37 @@
{
This file is part of the Free Pascal run time library.
Copyright (c) 1999-2000 by Michael Van Canneyt
member of the Free Pascal development team
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
Const
{ Type of exception. Currently only one. }
FPC_EXCEPTION = 1;
{ types of frames for the exception address stack }
cExceptionFrame = 1;
cFinalizeFrame = 2;
Type
PExceptAddr = ^TExceptAddr;
TExceptAddr = record
buf : pjmp_buf;
next : PExceptAddr;
{$ifdef CPU16}
frametype : Smallint;
{$else CPU16}
frametype : Longint;
{$endif CPU16}
end;
Const
CatchAllExceptions = PtrInt(-1);

View File

@ -12,6 +12,11 @@
**********************************************************************}
{ contains the definition of the TExceptAddr type, which is required
by the compiler to generate code for any routine containing
implicit or explicit exceptions }
{$i excepth.inc}
{ ObjpasInt is the integer type, equivalent to Objpas.Integer (the Integer
type in ObjFpc and Delphi modes). It is defined here for use in the
implementation part of the System unit. }