* cleaned up safecall support: use a hidden localvarsym instead of result

    register hacking
   o this also allowed fixing/adding safecall support for LLVM

git-svn-id: trunk@43578 -

compiler/hlcgobj.pas

@@ -1936,7 +1936,13 @@ implementation
 
   function thlcgobj.get_call_result_cgpara(pd: tabstractprocdef; forceresdef: tdef): tcgpara;
     begin
-      if not assigned(forceresdef) then
+      if pd.generate_safecall_wrapper then
+        begin
+          if assigned(forceresdef) then
+            internalerror(2019112401);
+          result:=paramanager.get_safecallresult_funcretloc(pd,callerside)
+        end
+      else if not assigned(forceresdef) then
         begin
           pd.init_paraloc_info(callerside);
           result:=pd.funcretloc[callerside];
@@ -5307,27 +5313,39 @@ implementation
       retdef : tdef;
     begin
       { Is the loading needed? }
-      if is_void(current_procinfo.procdef.returndef) or
+      if (is_void(current_procinfo.procdef.returndef) and
+          not current_procinfo.procdef.generate_safecall_wrapper) or
          (
           (po_assembler in current_procinfo.procdef.procoptions) and
-          (not(assigned(current_procinfo.procdef.funcretsym)) or
+          (current_procinfo.procdef.generate_safecall_wrapper or
+           not assigned(current_procinfo.procdef.funcretsym) or
            (tabstractvarsym(current_procinfo.procdef.funcretsym).refs=0) or
-           (po_nostackframe in current_procinfo.procdef.procoptions))
+           (po_nostackframe in current_procinfo.procdef.procoptions)
+          )
          ) then
         exit;
 
       { constructors return self }
-      if not current_procinfo.procdef.getfuncretsyminfo(ressym,retdef) then
-        internalerror(2018122501);
-      if (ressym.refs>0) or
-         is_managed_type(retdef) then
+      if current_procinfo.procdef.generate_safecall_wrapper then
         begin
-          { was: don't do anything if funcretloc.loc in [LOC_INVALID,LOC_REFERENCE] }
-          if not paramanager.ret_in_param(current_procinfo.procdef.returndef,current_procinfo.procdef) then
-            gen_load_loc_function_result(list,retdef,tabstractnormalvarsym(ressym).localloc);
+          if not current_procinfo.procdef.get_safecall_funcretsym_info(ressym,retdef) then
+            internalerror(2019112402);
+          gen_load_loc_function_result(list,retdef,tabstractnormalvarsym(ressym).localloc);
         end
       else
-        gen_load_uninitialized_function_result(list,current_procinfo.procdef,retdef,current_procinfo.procdef.funcretloc[calleeside]);
+        begin
+          if not current_procinfo.procdef.get_funcretsym_info(ressym,retdef) then
+            internalerror(2018122501);
+          if (ressym.refs>0) or
+             is_managed_type(retdef) then
+            begin
+              { was: don't do anything if funcretloc.loc in [LOC_INVALID,LOC_REFERENCE] }
+              if not paramanager.ret_in_param(current_procinfo.procdef.returndef,current_procinfo.procdef) then
+                gen_load_loc_function_result(list,retdef,tabstractnormalvarsym(ressym).localloc);
+            end
+          else
+            gen_load_uninitialized_function_result(list,current_procinfo.procdef,retdef,current_procinfo.procdef.funcretloc[calleeside]);
+        end;
       if tabstractnormalvarsym(ressym).localloc.loc=LOC_REFERENCE then
         tg.UnGetLocal(list,tabstractnormalvarsym(ressym).localloc.reference);
     end;

compiler/i386/n386flw.pas

@@ -375,14 +375,10 @@ procedure ti386tryfinallynode.pass_generate_code;
     emit_scope_end;
     if is_safecall then
       begin
-        current_asmdata.getjumplabel(safecalllabel);
-        hreg:=cg.GetIntRegister(current_asmdata.CurrAsmList,OS_INT);
-        cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT,0,hreg);
         cg.a_jmp_always(current_asmdata.CurrAsmList,safecalllabel);
         { RTL handler will jump here on exception }
         cg.a_label(current_asmdata.CurrAsmList,exceptlabel);
         handle_safecall_exception;
-        cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,NR_FUNCTION_RESULT_REG,hreg);
         cg.a_label(current_asmdata.CurrAsmList,safecalllabel);
       end;
 
@@ -432,8 +428,6 @@ procedure ti386tryfinallynode.pass_generate_code;
             cg.a_jmp_always(current_asmdata.CurrAsmList,oldContinueLabel);
           end;
       end;
-    if is_safecall then
-      cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,hreg,NR_FUNCTION_RETURN_REG);
     cg.a_label(current_asmdata.CurrAsmList,endfinallylabel);
 
     { end cleanup }

compiler/jvm/symcpu.pas

@@ -100,6 +100,7 @@ type
     procedure buildderef;override;
     procedure deref;override;
     function getcopy: tstoreddef; override;
+    function generate_safecall_wrapper: boolean; override;
   end;
   tcpuprocvardefclass = class of tcpuprocvardef;
 
@@ -109,7 +110,8 @@ type
     exprasmlist      : TAsmList;
     function  jvmmangledbasename(signature: boolean): TSymStr;
     function mangledname: TSymStr; override;
-    function getfuncretsyminfo(out ressym: tsym; out resdef: tdef): boolean; override;
+    function get_funcretsym_info(out ressym: tsym; out resdef: tdef): boolean; override;
+    function generate_safecall_wrapper: boolean; override;
     destructor destroy; override;
   end;
   tcpuprocdefclass = class of tcpuprocdef;
@@ -748,7 +750,8 @@ implementation
         result:=_mangledname;
     end;
 
-  function tcpuprocdef.getfuncretsyminfo(out ressym: tsym; out resdef: tdef): boolean;
+
+  function tcpuprocdef.get_funcretsym_info(out ressym: tsym; out resdef: tdef): boolean;
     begin
       { constructors don't have a result on the JVM platform }
       if proctypeoption<>potype_constructor then
@@ -758,6 +761,12 @@ implementation
     end;
 
 
+  function tcpuprocdef.generate_safecall_wrapper: boolean;
+    begin
+      result:=false;
+    end;
+
+
   destructor tcpuprocdef.destroy;
     begin
       exprasmlist.free;
@@ -802,6 +811,12 @@ implementation
     end;
 
 
+  function tcpuprocvardef.generate_safecall_wrapper: boolean;
+    begin
+      result:=false;
+    end;
+
+
 {****************************************************************************
                              tcpuprocsym
 ****************************************************************************}

compiler/llvm/hlcgllvm.pas

@@ -526,15 +526,24 @@ implementation
       end;
     { the Pascal level may expect a different returndef compared to the
       declared one }
-    if not assigned(forceresdef) then
-      hlretdef:=pd.returndef
-    else
-      hlretdef:=forceresdef;
-    { llvm will always expect the original return def }
-    if not paramanager.ret_in_param(hlretdef, pd) then
-      llvmretdef:=llvmgetcgparadef(pd.funcretloc[callerside], true, callerside)
+    if pd.generate_safecall_wrapper then
+      begin
+        hlretdef:=ossinttype;
+        llvmretdef:=ossinttype;
+      end
     else
-      llvmretdef:=voidtype;
+      begin
+        if not assigned(forceresdef) then
+          hlretdef:=pd.returndef
+        else
+          hlretdef:=forceresdef;
+        { llvm will always expect the original return def }
+        if not paramanager.ret_in_param(hlretdef, pd) or
+           pd.generate_safecall_wrapper then
+          llvmretdef:=llvmgetcgparadef(pd.funcretloc[callerside], true, callerside)
+        else
+          llvmretdef:=voidtype;
+      end;
     if not is_void(llvmretdef) then
       res:=getregisterfordef(list, llvmretdef)
     else
@@ -1354,10 +1363,11 @@ implementation
       retpara:=get_call_result_cgpara(current_procinfo.procdef,nil);
       retpara.check_simple_location;
       retdef:=retpara.location^.def;
-      if is_void(retdef) or
-         { don't check retdef here, it is e.g. a pshortstring in case it's
-           shortstring that's returned in a parameter }
-         paramanager.ret_in_param(current_procinfo.procdef.returndef,current_procinfo.procdef) then
+      if (is_void(retdef) or
+          { don't check retdef here, it is e.g. a pshortstring in case it's
+            shortstring that's returned in a parameter }
+          paramanager.ret_in_param(current_procinfo.procdef.returndef,current_procinfo.procdef)) and
+         not current_procinfo.procdef.generate_safecall_wrapper then
         list.concat(taillvm.op_size(la_ret,voidtype))
       else
         begin
@@ -1371,7 +1381,8 @@ implementation
                   in the code generator -> remove any explicit extensions here }
                 retreg:=retpara.location^.register;
                 if (current_procinfo.procdef.returndef.typ in [orddef,enumdef]) and
-                   (retdef.typ in [orddef,enumdef]) then
+                   (retdef.typ in [orddef,enumdef]) and
+                   not current_procinfo.procdef.generate_safecall_wrapper then
                   begin
                     if (current_procinfo.procdef.returndef.size<retpara.location^.def.size) then
                       begin
@@ -1951,8 +1962,9 @@ implementation
       hreg: tregister;
       rettemp: treference;
     begin
-      if not is_void(hlretdef) and
-         not paramanager.ret_in_param(hlretdef, pd) then
+      if (not is_void(hlretdef) and
+          not paramanager.ret_in_param(hlretdef, pd)) or
+         pd.generate_safecall_wrapper then
         begin
           { should already be a copy, because it currently describes the llvm
             return location }

compiler/llvm/llvmdef.pas

@@ -823,9 +823,13 @@ implementation
         def.init_paraloc_info(useside);
         first:=true;
         { function result (return-by-ref is handled explicitly) }
-        if not paramanager.ret_in_param(def.returndef,def) then
+        if not paramanager.ret_in_param(def.returndef,def) or
+           def.generate_safecall_wrapper then
           begin
-            usedef:=llvmgetcgparadef(def.funcretloc[useside],false,useside);
+            if not def.generate_safecall_wrapper then
+              usedef:=llvmgetcgparadef(def.funcretloc[useside],false,useside)
+            else
+              usedef:=ossinttype;
             llvmextractvalueextinfo(def.returndef,usedef,signext);
             { specifying result sign extention information for an alias causes
               an error for some reason }

compiler/ncgcal.pas

@@ -929,9 +929,8 @@ implementation
         sym : tasmsymbol;
         vmtoffset : aint;
 {$endif vtentry}
-{$ifdef SUPPORT_SAFECALL}
         cgpara : tcgpara;
-{$endif}
+        tmploc: tlocation;
       begin
          if not assigned(procdefinition) or
             not(procdefinition.has_paraloc_info in [callerside,callbothsides]) then
@@ -1263,19 +1262,21 @@ implementation
            cg.dealloccpuregisters(current_asmdata.CurrAsmList,R_ADDRESSREGISTER,regs_to_save_address);
          cg.dealloccpuregisters(current_asmdata.CurrAsmList,R_INTREGISTER,regs_to_save_int);
 
-{$ifdef SUPPORT_SAFECALL}
-         if (procdefinition.proccalloption=pocall_safecall) and
-            (tf_safecall_exceptions in target_info.flags) then
+         if procdefinition.generate_safecall_wrapper then
            begin
              pd:=search_system_proc('fpc_safecallcheck');
              cgpara.init;
+             { fpc_safecallcheck returns its parameter value (= function result of function we just called) }
              paramanager.getintparaloc(current_asmdata.CurrAsmList,pd,1,cgpara);
-             cg.a_load_reg_cgpara(current_asmdata.CurrAsmList,OS_INT,NR_FUNCTION_RESULT_REG,cgpara);
+             location_reset(tmploc,LOC_REGISTER,def_cgsize(retloc.Def));
+             tmploc.register:=hlcg.getregisterfordef(current_asmdata.CurrAsmList,retloc.Def);
+             hlcg.gen_load_cgpara_loc(current_asmdata.CurrAsmList,retloc.Def,retloc,tmploc,true);
              paramanager.freecgpara(current_asmdata.CurrAsmList,cgpara);
-             cg.g_call(current_asmdata.CurrAsmList,'FPC_SAFECALLCHECK');
+             hlcg.a_load_loc_cgpara(current_asmdata.CurrAsmList,retloc.Def,tmploc,cgpara);
+             retloc.resetiftemp;
+             retloc:=hlcg.g_call_system_proc(current_asmdata.CurrAsmList,pd,[@cgpara],nil);
              cgpara.done;
            end;
-{$endif}
 
          { handle function results }
          if (not is_void(resultdef)) then

compiler/ncgflw.pas

@@ -879,9 +879,10 @@ implementation
 
     procedure tcgtryfinallynode.handle_safecall_exception;
       var
-        cgpara: tcgpara;
+        cgpara, resultpara: tcgpara;
         selfsym: tparavarsym;
         pd: tprocdef;
+        safecallresult: tlocalvarsym;
       begin
         { call fpc_safecallhandler, passing self for methods of classes,
           nil otherwise. }
@@ -893,14 +894,16 @@ implementation
             selfsym:=tparavarsym(current_procinfo.procdef.parast.Find('self'));
             if (selfsym=nil) or (selfsym.typ<>paravarsym) then
               InternalError(2011123101);
-            cg.a_load_loc_cgpara(current_asmdata.CurrAsmList,selfsym.localloc,cgpara);
+            hlcg.a_load_loc_cgpara(current_asmdata.CurrAsmList,selfsym.vardef,selfsym.localloc,cgpara);
           end
         else
-          cg.a_load_const_cgpara(current_asmdata.CurrAsmList,OS_ADDR,0,cgpara);
+          hlcg.a_load_const_cgpara(current_asmdata.CurrAsmList,voidpointertype,0,cgpara);
         paramanager.freecgpara(current_asmdata.CurrAsmList,cgpara);
+        resultpara:=hlcg.g_call_system_proc(current_asmdata.CurrAsmList,pd,[@cgpara],nil);
         cgpara.done;
-        cg.g_call(current_asmdata.CurrAsmList,'FPC_SAFECALLHANDLER');
-        cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,NR_FUNCTION_RESULT_REG, NR_FUNCTION_RETURN_REG);
+        safecallresult:=tlocalvarsym(current_procinfo.procdef.localst.Find('safecallresult'));
+        hlcg.gen_load_cgpara_loc(current_asmdata.CurrAsmList,resultpara.def,resultpara,safecallresult.localloc,false);
+        resultpara.resetiftemp;
       end;
 
 
@@ -1052,8 +1055,7 @@ implementation
                  hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,osuinttype,OC_EQ,0,reasonreg,endfinallylabel);
                  { finally code only needed to be executed on exception (-> in
                    if-branch -> fc_inflowcontrol) }
-                 if (tf_safecall_exceptions in target_info.flags) and
-                    (current_procinfo.procdef.proccalloption=pocall_safecall) then
+                 if current_procinfo.procdef.generate_safecall_wrapper then
                    begin
                      handle_safecall_exception;
                      { we have to jump immediatly as we have to return the value of FPC_SAFECALL }
@@ -1073,8 +1075,7 @@ implementation
            begin
              if implicitframe then
                begin
-                 if (tf_safecall_exceptions in target_info.flags) and
-                    (current_procinfo.procdef.proccalloption=pocall_safecall) then
+                 if current_procinfo.procdef.generate_safecall_wrapper then
                    handle_safecall_exception
                  else
                    cexceptionstatehandler.handle_reraise(current_asmdata.CurrAsmList,excepttemps,finallyexceptionstate,exceptframekind);

compiler/ncgutil.pas

@@ -767,9 +767,7 @@ implementation
             parasize:=0;
             { For safecall functions with safecall-exceptions enabled the funcret is always returned as a para
               which is considered a normal para on the c-side, so the funcret has to be pop'ed normally. }
-            if 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) then
+            if not current_procinfo.procdef.generate_safecall_wrapper then
               inc(parasize,sizeof(pint));
           end
         else

compiler/nflw.pas

@@ -1946,7 +1946,7 @@ implementation
           gets inserted before the exit label to which this node will jump }
         if (target_info.system in systems_fpnestedstruct) and
            not(nf_internal in flags) and
-           current_procinfo.procdef.getfuncretsyminfo(ressym,resdef) and
+           current_procinfo.procdef.get_funcretsym_info(ressym,resdef) and
            (tabstractnormalvarsym(ressym).inparentfpstruct) then
           begin
             if not assigned(result) then

compiler/ngenutil.pas

@@ -618,6 +618,21 @@ implementation
     begin
       result:=maybe_insert_trashing(pd,n);
 
+      { initialise safecall result variable }
+      if pd.generate_safecall_wrapper then
+        begin
+          ressym:=tsym(pd.localst.Find('safecallresult'));
+          block:=internalstatements(stat);
+          addstatement(stat,
+            cassignmentnode.create(
+              cloadnode.create(ressym,ressym.owner),
+              genintconstnode(0)
+            )
+          );
+          addstatement(stat,result);
+          result:=block;
+        end;
+
       if (m_isolike_program_para in current_settings.modeswitches) and
         (pd.proctypeoption=potype_proginit) then
         begin
@@ -687,7 +702,7 @@ implementation
           end;
         end;
       if (target_info.system in systems_fpnestedstruct) and
-         pd.getfuncretsyminfo(ressym,resdef) and
+         pd.get_funcretsym_info(ressym,resdef) and
          (tabstractnormalvarsym(ressym).inparentfpstruct) then
         begin
           block:=internalstatements(stat);

compiler/paramgr.pas

@@ -128,6 +128,7 @@ unit paramgr;
             forces the function result to something different than the real
             result.  }
           function  get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;virtual;abstract;
+          function  get_safecallresult_funcretloc(p : tabstractprocdef; side: tcallercallee): tcgpara; virtual;
           procedure create_funcretloc_info(p : tabstractprocdef; side: tcallercallee);
 
           { This is used to populate the location information on all parameters
@@ -441,6 +442,27 @@ implementation
       end;
 
 
+    function tparamanager.get_safecallresult_funcretloc(p: tabstractprocdef; side: tcallercallee): tcgpara;
+      var
+        paraloc: pcgparalocation;
+      begin
+        result.init;
+        result.def:=ossinttype;
+        result.intsize:=result.def.size;
+        result.size:=def_cgsize(result.def);
+        result.alignment:=result.def.alignment;
+        paraloc:=result.add_location;
+        paraloc^.size:=result.size;
+        paraloc^.def:=result.def;
+        paraloc^.loc:=LOC_REGISTER;
+        if side=callerside then
+          paraloc^.register:=NR_FUNCTION_RESULT_REG
+        else
+          paraloc^.register:=NR_FUNCTION_RETURN_REG;
+        result.Temporary:=true;;
+      end;
+
+
     function tparamanager.is_stack_paraloc(paraloc: pcgparalocation): boolean;
       begin
         result:=

compiler/pparautl.pas

@@ -300,14 +300,14 @@ implementation
         sl       : tpropaccesslist;
         hs       : string;
       begin
+        storepos:=current_tokenpos;
+        current_tokenpos:=pd.fileinfo;
+
         { The result from constructors and destructors can't be accessed directly }
         if not(pd.proctypeoption in [potype_constructor,potype_destructor]) and
            not is_void(pd.returndef) and
            (not(po_assembler in pd.procoptions) or paramanager.asm_result_var(pd.returndef,pd)) then
          begin
-           storepos:=current_tokenpos;
-           current_tokenpos:=pd.fileinfo;
-
            { We need to insert a varsym for the result in the localst
              when it is returning in a register }
            { we also need to do this for a generic procdef as we didn't allow
@@ -348,8 +348,17 @@ implementation
               tlocalsymtable(pd.localst).insert(aliasvs);
             end;
 
-           current_tokenpos:=storepos;
          end;
+
+        if pd.generate_safecall_wrapper then
+          begin
+            { vo_is_funcret is necessary so the local only gets freed after we loaded its
+              value into the return register }
+            vs:=clocalvarsym.create('$safecallresult',vs_value,search_system_type('HRESULT').typedef,[vo_is_funcret]);
+            pd.localst.insert(vs);
+          end;
+
+        current_tokenpos:=storepos;
       end;
 
 

compiler/symdef.pas

@@ -688,6 +688,7 @@ interface
           function ofs_address_type:tdef;virtual;
           procedure declared_far;virtual;
           procedure declared_near;virtual;
+          function generate_safecall_wrapper: boolean; virtual;
        private
           procedure count_para(p:TObject;arg:pointer);
           procedure insert_para(p:TObject;arg:pointer);
@@ -878,7 +879,8 @@ interface
           procedure make_external;
           procedure init_genericdecl;
 
-          function getfuncretsyminfo(out ressym: tsym; out resdef: tdef): boolean; virtual;
+          function get_funcretsym_info(out ressym: tsym; out resdef: tdef): boolean; virtual;
+          function get_safecall_funcretsym_info(out ressym: tsym; out resdef: tdef): boolean; virtual;
 
           { returns whether the mangled name or any of its aliases is equal to
             s }
@@ -5716,6 +5718,19 @@ implementation
       end;
 
 
+    function tabstractprocdef.generate_safecall_wrapper: boolean;
+      begin
+{$ifdef SUPPORT_SAFECALL}
+        result:=
+          (proccalloption=pocall_safecall) and
+          not(po_assembler in procoptions) and
+          (tf_safecall_exceptions in target_info.flags);
+{$else SUPPORT_SAFECALL}
+        result:=false;
+{$endif}
+      end;
+
+
 {***************************************************************************
                                   TPROCDEF
 ***************************************************************************}
@@ -6382,7 +6397,7 @@ implementation
       end;
 
 
-    function tprocdef.getfuncretsyminfo(out ressym: tsym; out resdef: tdef): boolean;
+    function tprocdef.get_funcretsym_info(out ressym: tsym; out resdef: tdef): boolean;
       begin
         result:=false;
         if proctypeoption=potype_constructor then
@@ -6394,6 +6409,13 @@ implementation
             if is_object(resdef) then
               resdef:=cpointerdef.getreusable(resdef);
           end
+        else if (proccalloption=pocall_safecall) and
+           (tf_safecall_exceptions in target_info.flags) then
+          begin
+            result:=true;
+            ressym:=tsym(localst.Find('safecallresult'));
+            resdef:=tabstractnormalvarsym(ressym).vardef;
+          end
         else if not is_void(returndef) then
           begin
             result:=true;
@@ -6403,6 +6425,20 @@ implementation
       end;
 
 
+    function tprocdef.get_safecall_funcretsym_info(out ressym: tsym; out resdef: tdef): boolean;
+      begin
+        result:=false;
+        if (proctypeoption<>potype_constructor) and
+           (proccalloption=pocall_safecall) and
+           (tf_safecall_exceptions in target_info.flags) then
+          begin
+            result:=true;
+            ressym:=tsym(localst.Find('safecallresult'));
+            resdef:=tabstractnormalvarsym(ressym).vardef;
+          end
+      end;
+
+
     function tprocdef.has_alias_name(const s: TSymStr): boolean;
       var
         item : TCmdStrListItem;