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

git-svn-id: trunk@19414 -

compiler/psub.pas

@@ -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;

rtl/inc/compproc.inc

@@ -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}
 
 

rtl/inc/except.inc

@@ -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;
+