paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-02 16:39:36 +01:00
Code Issues Packages Projects Releases Wiki Activity

+ Handle safecall exceptions with a dedicated compilerproc, simplifies compiler part and reduces generated code size.

Browse Source 
git-svn-id: trunk@19414 -
This commit is contained in:
sergei 2011-10-08 12:40:03 +00:00
parent e11c880b1e
commit fa4b78363c
3 changed files with 32 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
compiler/psub.pas
View File

@ -479,8 +479,8 @@ implementation
var
newstatement : tstatementnode;
{ safecall handling }
exceptobjnode,exceptaddrnode: ttempcreatenode;
sym,exceptsym: tsym;
sym: tsym;
argnode: tnode;
begin
generate_except_block:=internalstatements(newstatement);
@ -511,46 +511,13 @@ implementation
{ SafecallException virtual method }
{ In other case we return E_UNEXPECTED error value }
if is_class(current_procinfo.procdef.struct) then
begin
{ temp variable to store exception address }
exceptaddrnode:=ctempcreatenode.create(voidpointertype,voidpointertype.size,
tt_persistent,true);
addstatement(newstatement,exceptaddrnode);
addstatement(newstatement,
cassignmentnode.create(
ctemprefnode.create(exceptaddrnode),
ccallnode.createintern('fpc_getexceptionaddr',nil)));
{ temp variable to store popped up exception }
exceptobjnode:=ctempcreatenode.create(class_tobject,class_tobject.size,
tt_persistent,true);
addstatement(newstatement,exceptobjnode);
addstatement(newstatement,
cassignmentnode.create(
ctemprefnode.create(exceptobjnode),
ccallnode.createintern('fpc_popobjectstack', nil)));
exceptsym:=search_struct_member(tobjectdef(current_procinfo.procdef.struct),'SAFECALLEXCEPTION');
addstatement(newstatement,
cassignmentnode.create(
cloadnode.create(sym,sym.Owner),
ccallnode.create(
ccallparanode.create(ctemprefnode.create(exceptaddrnode),
ccallparanode.create(ctemprefnode.create(exceptobjnode),nil)),
tprocsym(exceptsym), tprocsym(exceptsym).owner,load_self_node,[])));
addstatement(newstatement,ccallnode.createintern('fpc_destroyexception',
ccallparanode.create(ctemprefnode.create(exceptobjnode),nil)));
addstatement(newstatement,ctempdeletenode.create(exceptobjnode));
addstatement(newstatement,ctempdeletenode.create(exceptaddrnode));
end
argnode:=load_self_node
else
begin
{ pop up and destroy an exception }
addstatement(newstatement,ccallnode.createintern('fpc_destroyexception',
ccallparanode.create(ccallnode.createintern('fpc_popobjectstack', nil),nil)));
addstatement(newstatement,
cassignmentnode.create(
cloadnode.create(sym,sym.Owner),
genintconstnode(HResult($8000FFFF))));
end;
argnode:=cnilnode.create;
addstatement(newstatement,cassignmentnode.create(
cloadnode.create(sym,sym.Owner),
ccallnode.createinternres('fpc_safecallhandler',
ccallparanode.create(argnode,nil),hresultdef)));
end;
{$endif}
end;

1
rtl/inc/compproc.inc
View File

@ -675,6 +675,7 @@ Procedure fpc_ReRaise; compilerproc;
Function fpc_Catches(Objtype : TClass) : TObject; compilerproc;
Procedure fpc_DestroyException(o : TObject); compilerproc;
function fpc_GetExceptionAddr : Pointer; compilerproc;
function fpc_safecallhandler(obj: TObject): HResult; compilerproc;
{$endif FPC_HAS_FEATURE_EXCEPTIONS}

23
rtl/inc/except.inc
View File

@ -259,6 +259,8 @@ begin
end;
end;
function Internal_PopObjectStack: TObject; external name 'FPC_POPOBJECTSTACK';
{ this is for popping exception objects when a second exception is risen }
{ in an except/on }
function fpc_PopSecondObjectStack : TObject;[Public, Alias : 'FPC_POPSECONDOBJECTSTACK']; compilerproc;
@ -343,6 +345,7 @@ begin
o.Free;
end;
{ TODO: no longer used, clean up }
function fpc_GetExceptionAddr : Pointer;[Public, Alias : 'FPC_GETEXCEPTIONADDR']; compilerproc;
var
_ExceptObjectStack : PExceptObject;
@ -362,3 +365,23 @@ begin
ExceptObjectstack:=Nil;
ExceptAddrStack:=Nil;
end;
function fpc_safecallhandler(obj: TObject): HResult; [public,alias:'FPC_SAFECALLHANDLER']; compilerproc;
var
raiselist: PExceptObject;
adr: Pointer;
exc: TObject;
begin
raiselist:=ExceptObjectStack;
if Assigned(raiseList) then
adr:=raiseList^.Addr
else
adr:=nil;
exc:=Internal_PopObjectStack;
if Assigned(obj) then
result:=obj.SafeCallException(exc,adr)
else
result:=E_UNEXPECTED;
exc.Free;
end;