* Safecall on linux/i386 now behaves like cdecl plus hidden exception support.

 * Adapted tests because safecall on linux/i386 now does not include high() 
   support anymore

git-svn-id: trunk@15913 -

compiler/i386/cgcpu.pas

@@ -329,7 +329,11 @@ unit cgcpu;
          begin
            { complex return values are removed from stack in C code PM }
            { but not on win32 }
+           { and not for safecall with hidden exceptions, because the result }
+           { wich contains the exception is passed in EAX }
            if (target_info.system <> system_i386_win32) and
+              not ((current_procinfo.procdef.proccalloption = pocall_safecall) and
+               (tf_safecall_exceptions in target_info.flags)) and
               paramanager.ret_in_param(current_procinfo.procdef.returndef,
                                        current_procinfo.procdef.proccalloption) then
              list.concat(Taicpu.Op_const(A_RET,S_W,sizeof(aint)))

compiler/i386/cpupara.pas

@@ -97,29 +97,29 @@ unit cpupara;
       var
         size: longint;
       begin
+        if (tf_safecall_exceptions in target_info.flags) and
+           (calloption=pocall_safecall) then
+          begin
+            result:=true;
+            exit;
+          end;
         case target_info.system of
           system_i386_win32 :
             begin
-              if calloption=pocall_safecall then
-                begin
-                  result:=true;
-                  exit;
-                end
-              else
-                case def.typ of
-                  recorddef :
-                    begin
-                      { Win32 GCC returns small records in the FUNCTION_RETURN_REG.
-                        For stdcall we follow delphi instead of GCC }
-                      if (calloption in [pocall_cdecl,pocall_cppdecl]) and
-                         (def.size>0) and
-                         (def.size<=8) then
-                       begin
-                         result:=false;
-                         exit;
-                       end;
-                    end;
-                end;
+              case def.typ of
+                recorddef :
+                  begin
+                    { Win32 GCC returns small records in the FUNCTION_RETURN_REG.
+                      For stdcall we follow delphi instead of GCC }
+                    if (calloption in [pocall_cdecl,pocall_cppdecl]) and
+                       (def.size>0) and
+                       (def.size<=8) then
+                     begin
+                       result:=false;
+                       exit;
+                     end;
+                  end;
+              end;
             end;
           system_i386_darwin :
             begin
@@ -186,7 +186,7 @@ unit cpupara;
                 result:=false
               else
                 result:=
-                  (not(calloption in [pocall_cdecl,pocall_cppdecl,pocall_mwpascal]) and
+                  (not(calloption in (cdecl_pocalls+[pocall_mwpascal])) and
                    (def.size>sizeof(aint))) or
                   (((calloption = pocall_mwpascal) or (target_info.system=system_i386_wince)) and
                    (varspez=vs_const));
@@ -195,7 +195,7 @@ unit cpupara;
             begin
               { array of const values are pushed on the stack as
                 well as dyn. arrays }
-              if (calloption in [pocall_cdecl,pocall_cppdecl]) then
+              if (calloption in cdecl_pocalls) then
                 result:=not(is_array_of_const(def) or
                         is_dynamic_array(def))
               else
@@ -214,9 +214,9 @@ unit cpupara;
           stringdef :
             result:= (tstringdef(def).stringtype in [st_shortstring,st_longstring]);
           procvardef :
-            result:=not(calloption in [pocall_cdecl,pocall_cppdecl]) and not tprocvardef(def).is_addressonly;
+            result:=not(calloption in cdecl_pocalls) and not tprocvardef(def).is_addressonly;
           setdef :
-            result:=not(calloption in [pocall_cdecl,pocall_cppdecl]) and (not is_smallset(def));
+            result:=not(calloption in cdecl_pocalls) and (not is_smallset(def));
         end;
       end;
 

compiler/i386/n386cal.pas

@@ -89,7 +89,13 @@ implementation
         { sizeof(aint) in case of ret_in_param())                          }
         if (target_info.system = system_i386_win32) and
             paramanager.ret_in_param(procdefinition.returndef,procdefinition.proccalloption) then
-           inc(pop_size,sizeof(aint));
+          inc(pop_size,sizeof(aint));
+
+        { Safecall generates a hidden return value, which is always passed }
+        { in eax. So there is nothing to remove from the stack.            }
+        if (tf_safecall_exceptions in target_info.flags) and
+           (procdefinition.proccalloption=pocall_safecall) then
+          inc(pop_size,sizeof(aint));
 
         { better than an add on all processors }
         if pop_size=4 then

compiler/ncal.pas

@@ -2936,7 +2936,7 @@ implementation
          { Change loading of array of const to varargs }
          if assigned(left) and
             is_array_of_const(tparavarsym(procdefinition.paras[procdefinition.paras.count-1]).vardef) and
-            (procdefinition.proccalloption in [pocall_cppdecl,pocall_cdecl]) then
+            (procdefinition.proccalloption in cdecl_pocalls) then
            convert_carg_array_of_const;
 
          { bind parasyms to the callparanodes and insert hidden parameters }

compiler/ncgcal.pas

@@ -875,7 +875,7 @@ implementation
 
 {$if defined(x86) or defined(arm)}
          if (procdefinition.proccalloption=pocall_safecall) and
-            (target_info.system in systems_all_windows) then
+            (tf_safecall_exceptions in target_info.flags) then
            begin
 {$ifdef x86_64}
              cgpara.init;

compiler/ncgflw.pas

@@ -1592,7 +1592,7 @@ implementation
              if codegenerror then
                exit;
 {$if defined(x86) or defined(arm)}
-             if (target_info.system in systems_all_windows) and
+             if (tf_safecall_exceptions in target_info.flags) and
                 (current_procinfo.procdef.proccalloption=pocall_safecall) then
                begin
                  { find safe_result variable we created in the generate_except_block }

compiler/ncgmem.pas

@@ -652,7 +652,7 @@ implementation
           begin
             { cdecl functions don't have high() so we can not check the range }
             { (can't use current_procdef, since it may be a nested procedure) }
-            if not(tprocdef(tparasymtable(tparavarsym(tloadnode(left).symtableentry).owner).defowner).proccalloption in [pocall_cdecl,pocall_cppdecl]) then
+            if not(tprocdef(tparasymtable(tparavarsym(tloadnode(left).symtableentry).owner).defowner).proccalloption in cdecl_pocalls) then
              begin
                { Get high value }
                hightree:=load_high_value_node(tparavarsym(tloadnode(left).symtableentry));

compiler/ncgutil.pas

@@ -1246,7 +1246,7 @@ implementation
               begin
                 { cdecl functions don't have a high pointer so it is not possible to generate
                   a local copy }
-                if not(current_procinfo.procdef.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
+                if not(current_procinfo.procdef.proccalloption in cdecl_pocalls) then
                   begin
                     hsym:=tparavarsym(tsym(p).owner.Find('high'+tsym(p).name));
                     if not assigned(hsym) then
@@ -1658,7 +1658,7 @@ implementation
           begin
             { cdecl functions don't have a high pointer so it is not possible to generate
               a local copy }
-            if not(current_procinfo.procdef.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
+            if not(current_procinfo.procdef.proccalloption in cdecl_pocalls) then
               cg.g_releasevaluepara_openarray(list,tparavarsym(p).localloc);
           end;
       end;
@@ -2658,7 +2658,7 @@ implementation
             if (cs_check_range in current_settings.localswitches) and
                (is_open_array(tvecnode(n).left.resultdef) or
                 is_array_of_const(tvecnode(n).left.resultdef)) and
-               not(current_procinfo.procdef.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
+               not(current_procinfo.procdef.proccalloption in cdecl_pocalls) then
               add_regvars(rv^,tabstractnormalvarsym(get_high_value_sym(tparavarsym(tloadnode(tvecnode(n).left).symtableentry))).localloc)
 
         end;

compiler/nmem.pas

@@ -823,7 +823,7 @@ implementation
                    is_array_of_const(left.resultdef)) and
                   { cdecl functions don't have high() so we can not check the range }
                   { (can't use current_procdef, since it may be a nested procedure) }
-                  not(tprocdef(tparasymtable(tparavarsym(tloadnode(left).symtableentry).owner).defowner).proccalloption in [pocall_cdecl,pocall_cppdecl]) then
+                  not(tprocdef(tparasymtable(tparavarsym(tloadnode(left).symtableentry).owner).defowner).proccalloption in cdecl_pocalls) then
                    begin
                      { load_high_value_node already typechecks }
                      hightree:=load_high_value_node(tparavarsym(tloadnode(left).symtableentry));

compiler/options.pas

@@ -85,6 +85,7 @@ uses
   comphook,
   symtable,scanner,rabase,
   wpobase,
+  symconst,
   i_bsd;
 
 const
@@ -2825,6 +2826,14 @@ if (target_info.system=system_arm_darwin) then
       def_system_macro('FPC_HAS_FEATURE_'+featurestr[i]);
   option.free;
   Option:=nil;
+
+  clearstack_pocalls := [pocall_cdecl,pocall_cppdecl,pocall_syscall,pocall_mwpascal];
+  cdecl_pocalls := [pocall_cdecl, pocall_cppdecl];
+  if (tf_safecall_clearstack in target_info.flags) then
+    begin
+      include (cdecl_pocalls, pocall_safecall);
+      include (clearstack_pocalls, pocall_safecall)
+    end;
 end;
 
 

compiler/paramgr.pas

@@ -163,7 +163,7 @@ implementation
 
     function tparamanager.push_high_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
       begin
-         push_high_param:=not(calloption in [pocall_cdecl,pocall_cppdecl]) and
+         push_high_param:=not(calloption in cdecl_pocalls) and
                           (
                            is_open_array(def) or
                            is_open_string(def) or

compiler/pdecsub.pas

@@ -337,7 +337,7 @@ implementation
             begin
               { Give a warning that cdecl routines does not include high()
                 support }
-              if (pd.proccalloption in [pocall_cdecl,pocall_cppdecl]) and
+              if (pd.proccalloption in cdecl_pocalls) and
                  paramanager.push_high_param(varspez,vardef,pocall_default) then
                begin
                  if is_open_string(vardef) then
@@ -2616,7 +2616,7 @@ const
                      { for objcclasses this is checked later, because the entire
                        class may be external.  }
                      is_objc_class_or_protocol(tprocdef(pd)._class)) and
-                 not(pd.proccalloption in [pocall_cdecl,pocall_cppdecl,pocall_mwpascal]) then
+                 not(pd.proccalloption in (cdecl_pocalls + [pocall_mwpascal])) then
                 Message(parser_e_varargs_need_cdecl_and_external);
             end
            else
@@ -2624,7 +2624,7 @@ const
               { both must be defined now }
               if not((po_external in pd.procoptions) or
                      (pd.typ=procvardef)) or
-                 not(pd.proccalloption in [pocall_cdecl,pocall_cppdecl,pocall_mwpascal]) then
+                 not(pd.proccalloption in (cdecl_pocalls + [pocall_mwpascal])) then
                 Message(parser_e_varargs_need_cdecl_and_external);
             end;
          end;

compiler/psub.pas

@@ -484,7 +484,7 @@ implementation
               addstatement(newstatement,finalize_data_node(load_result_node));
 {$if defined(x86) or defined(arm)}
             { safecall handling }
-            if (target_info.system in systems_all_windows) and
+            if (tf_safecall_exceptions in target_info.flags) and
                (current_procinfo.procdef.proccalloption=pocall_safecall) then
               begin
                 { create a local hidden variable "safe_result"    }
@@ -884,7 +884,7 @@ implementation
 
 {$if defined(x86) or defined(arm)}
         { set implicit_finally flag for if procedure is safecall }
-        if (target_info.system in systems_all_windows) and
+        if (tf_safecall_exceptions in target_info.flags) and
            (procdef.proccalloption=pocall_safecall) then
           include(flags, pi_needs_implicit_finally);
 {$endif}
@@ -1215,7 +1215,7 @@ implementation
 {$if defined(x86) or defined(arm)}
             { Set return value of safecall procedure if implicit try/finally blocks are disabled }
             if not (cs_implicit_exceptions in current_settings.moduleswitches) and
-               (target_info.system in systems_all_windows) and
+               (tf_safecall_exceptions in target_info.flags) and
                (procdef.proccalloption=pocall_safecall) then
               cg.a_load_const_reg(aktproccode,OS_ADDR,0,NR_FUNCTION_RETURN_REG);
 {$endif}

compiler/symconst.pas

@@ -543,14 +543,14 @@ type
     dbg_state_queued
   );
 
+var
+  clearstack_pocalls : tproccalloptions;
+  cdecl_pocalls      : tproccalloptions;
 
 const
    inherited_objectoptions : tobjectoptions = [oo_has_virtual,oo_has_private,oo_has_protected,
                 oo_has_strictprotected,oo_has_strictprivate,oo_has_constructor,oo_has_destructor,
                 oo_can_have_published];
-   clearstack_pocalls = [
-     pocall_cdecl,pocall_cppdecl,pocall_syscall,pocall_mwpascal
-   ];
 
 {$ifdef i386}
    { we only take this into account on i386, on other platforms we always

compiler/systems.pas

@@ -334,7 +334,9 @@ interface
             tf_pic_default,
             { the os does some kind of stack checking and it can be converted into a rte 202 }
             tf_no_generic_stackcheck,
-            tf_has_winlike_resources
+            tf_has_winlike_resources,
+            tf_safecall_clearstack,
+            tf_safecall_exceptions
        );
 
        psysteminfo = ^tsysteminfo;

compiler/systems/i_linux.pas

@@ -39,7 +39,8 @@ unit i_linux;
                             tf_section_threadvars,
 {$endif segment_threadvars}
                             tf_needs_symbol_type,tf_files_case_sensitive,
-                            tf_smartlink_library,tf_needs_dwarf_cfi,tf_has_winlike_resources];
+                            tf_smartlink_library,tf_needs_dwarf_cfi,tf_has_winlike_resources,
+                            tf_safecall_exceptions, tf_safecall_clearstack];
             cpu          : cpu_i386;
             unit_env     : 'LINUXUNITS';
             extradefines : 'UNIX;HASUNIX';

compiler/systems/i_win.pas

@@ -38,7 +38,8 @@ unit i_win;
                             ,tf_smartlink_sections{,tf_section_threadvars}{,tf_needs_dwarf_cfi},
                             tf_winlikewidestring,tf_no_pic_supported,
                             tf_no_generic_stackcheck,tf_has_winlike_resources,
-                            tf_dwarf_only_local_labels];
+                            tf_dwarf_only_local_labels,
+                            tf_safecall_exceptions];
             cpu          : cpu_i386;
             unit_env     : 'WIN32UNITS';
             extradefines : 'MSWINDOWS;WINDOWS';

tests/test/cg/tcalcst6.pp

@@ -28,6 +28,12 @@ program tcalcst6;
   {$define tp}
 {$endif}
 
+{ On linux/i386 safecall is the same as cdecl, so it does not       }
+{ support all parameter types.                                      }
+{$if (defined(linux) and defined(cpui386))}
+  {$define safecall_is_cdecl}
+{$endif}
+
 
  { REAL should map to single or double }
  { so it is not checked, since single  }
@@ -237,7 +243,7 @@ var
      proc_const_s64bit := 0;
    end;
 
-  function proc_const_smallarray_const_1(const arr : array of const): longint; safecall;
+  function proc_const_smallarray_const_1(const arr : array of const): longint; {$ifndef safecall_is_cdecl} safecall; {$endif}
   var
    i: integer;
   begin
@@ -263,7 +269,7 @@ var
   end;
 
 
-  function proc_const_smallarray_const_2(const arr : array of const): longint; safecall;
+  function proc_const_smallarray_const_2(const arr : array of const): longint; {$ifndef safecall_is_cdecl} safecall; {$endif}
   var
    i: integer;
   begin
@@ -369,7 +375,7 @@ var
      proc_const_s64bit_mixed := 0;
    end;
 
-  function proc_const_smallarray_const_1_mixed(b1 : byte; const arr : array of const; b2: byte): longint;safecall;
+  function proc_const_smallarray_const_1_mixed(b1 : byte; const arr : array of const; b2: byte): longint;{$ifndef safecall_is_cdecl} safecall; {$endif}
   var
    i: integer;
   begin
@@ -396,7 +402,7 @@ var
   end;
 
 
-  function proc_const_smallarray_const_2_mixed(b1: byte; const arr : array of const; b2: byte): longint;safecall;
+  function proc_const_smallarray_const_2_mixed(b1: byte; const arr : array of const; b2: byte): longint;{$ifndef safecall_is_cdecl} safecall; {$endif}
   var
    i: integer;
   begin
@@ -469,7 +475,7 @@ var
      proc_const_smallarray_mixed := 0;
   end;
 
-  function proc_const_smallarray_open_mixed(b1: byte; const arr : array of byte; b2: byte): longint; safecall;
+  function proc_const_smallarray_open_mixed(b1: byte; const arr : array of byte; b2: byte): longint; {$ifndef safecall_is_cdecl} safecall; {$endif}
   begin
     { form 0 to N-1 indexes in open arrays }
     if arr[high(arr)] = RESULT_U8BIT then

tests/test/cg/tcalvar6.pp

@@ -30,6 +30,11 @@ program tcalvar6;
   {$define tp}
 {$endif}
 
+{ On linux/i386 safecall is the same as cdecl, so it does not       }
+{ support all parameter types.                                      }
+{$if (defined(linux) and defined(cpui386))}
+  {$define safecall_is_cdecl}
+{$endif}
 
  { REAL should map to single or double }
  { so it is not checked, since single  }
@@ -277,7 +282,7 @@ var
    end;
 
 
-  procedure proc_var_openstring(var s: OpenString);safecall;
+  procedure proc_var_openstring(var s: OpenString);{$ifndef safecall_is_cdecl} safecall; {$endif}
    begin
     global_u8bit := high(s);
     s:=RESULT_SMALLSTRING;
@@ -289,13 +294,13 @@ var
     arr[1] := RESULT_U8BIT;
   end;
 
-  procedure proc_var_smallarray_open(var arr : array of byte);safecall;
+  procedure proc_var_smallarray_open(var arr : array of byte);{$ifndef safecall_is_cdecl} safecall; {$endif}
   begin
     arr[high(arr)] := RESULT_U8BIT;
     arr[low(arr)] := RESULT_U8BIT;
   end;
 
-  procedure proc_var_smallarray_const_1(var arr : array of const);safecall;
+  procedure proc_var_smallarray_const_1(var arr : array of const);{$ifndef safecall_is_cdecl} safecall; {$endif}
   var
    i: integer;
   begin
@@ -311,7 +316,7 @@ var
   end;
 
 
-  procedure proc_var_smallarray_const_2(var arr : array of const);safecall;
+  procedure proc_var_smallarray_const_2(var arr : array of const);{$ifndef safecall_is_cdecl} safecall; {$endif}
   var
    i: integer;
   begin
@@ -408,7 +413,7 @@ procedure proc_var_formaldef_string(var buf);safecall;
    end;
 
 
-  procedure proc_var_openstring_mixed(b1 : byte; var s: OpenString; b2: byte);safecall;
+  procedure proc_var_openstring_mixed(b1 : byte; var s: OpenString; b2: byte);{$ifndef safecall_is_cdecl} safecall; {$endif}
    begin
     global_u8bit := high(s);
     s:=RESULT_SMALLSTRING;
@@ -422,14 +427,14 @@ procedure proc_var_formaldef_string(var buf);safecall;
     value_u8bit := RESULT_U8BIT;
   end;
 
-  procedure proc_var_smallarray_open_mixed(b1 : byte; var arr : array of byte; b2: byte);safecall;
+  procedure proc_var_smallarray_open_mixed(b1 : byte; var arr : array of byte; b2: byte);{$ifndef safecall_is_cdecl} safecall; {$endif}
   begin
     arr[high(arr)] := RESULT_U8BIT;
     arr[low(arr)] := RESULT_U8BIT;
     value_u8bit := RESULT_U8BIT;
   end;
 
-  procedure proc_var_smallarray_const_1_mixed(b1 : byte; var arr : array of const; b2: byte);safecall;
+  procedure proc_var_smallarray_const_1_mixed(b1 : byte; var arr : array of const; b2: byte);{$ifndef safecall_is_cdecl} safecall; {$endif}
   var
    i: integer;
   begin
@@ -446,7 +451,7 @@ procedure proc_var_formaldef_string(var buf);safecall;
  end;
 
 
-  procedure proc_var_smallarray_const_2_mixed(b1 : byte; var arr : array of const; b2: byte);safecall;
+  procedure proc_var_smallarray_const_2_mixed(b1 : byte; var arr : array of const; b2: byte);{$ifndef safecall_is_cdecl} safecall; {$endif}
   var
    i: integer;
   begin