* Fixed safecall procedures by generating implicit try/finally and setting correct return value if exception was occurred or not. Now safecall is fully Delphi compatible.

git-svn-id: trunk@7720 -

.gitattributes

@@ -8294,6 +8294,7 @@ tests/webtbs/tw8861.pp svneol=native#text/plain
 tests/webtbs/tw8870.pp svneol=native#text/plain
 tests/webtbs/tw8883.pp svneol=native#text/plain
 tests/webtbs/tw8919.pp svneol=native#text/plain
+tests/webtbs/tw8935.pp svneol=native#text/plain
 tests/webtbs/tw8950.pp svneol=native#text/plain
 tests/webtbs/tw8975.pp svneol=native#text/plain
 tests/webtbs/tw8975a.pp svneol=native#text/plain

compiler/ncgflw.pas

@@ -1477,7 +1477,14 @@ implementation
                CGMessage(cg_e_control_flow_outside_finally);
              if codegenerror then
                exit;
-             cg.a_call_name(current_asmdata.CurrAsmList,'FPC_RERAISE');
+{$if defined(x86) or defined(arm)}
+             if current_procinfo.procdef.proccalloption=pocall_safecall then
+               { 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)
+             else
+{$endif}
+               cg.a_call_name(current_asmdata.CurrAsmList,'FPC_RERAISE');
            end
          else
            begin

compiler/psub.pas

@@ -747,6 +747,11 @@ implementation
         procdef.parast.SymList.ForEachCall(@check_finalize_paras,nil);
         procdef.localst.SymList.ForEachCall(@check_finalize_locals,nil);
 
+{$if defined(x86) or defined(arm)}
+        { set implicit_finally flag for if procedure is safecall }
+        if procdef.proccalloption=pocall_safecall then
+          include(flags, pi_needs_implicit_finally);
+{$endif}
         { firstpass everything }
         flowcontrol:=[];
         do_firstpass(code);

tests/webtbs/tw8935.pp

@@ -0,0 +1,27 @@
+{%cpu=x86_64,i386,arm}
+{%result=229}
+
+procedure DoTest1; safecall;
+var
+  i: integer;
+begin
+  i:=-1;
+  i:=i - 1;
+end;
+
+function DoTest2: longint; safecall;
+begin
+  DoTest2:=$12345678;
+end;
+
+procedure DoTest3; safecall;
+begin
+  PChar(nil)^:='A';
+end;
+
+begin
+  DoTest1;
+  if DoTest2 <> $12345678 then
+    Halt(1);
+  DoTest3;
+end.