* fixed location_free() for locations consisting of multiple

    physical registers
  * free the physical return registers at the caller side for 64 bit
    systems
  * make sure that we do not double-free registers in case a return
    value is not used (mantis #13536)

git-svn-id: trunk@13023 -

.gitattributes

@@ -8821,6 +8821,7 @@ tests/webtbs/tw13345x.pp svneol=native#text/plain
 tests/webtbs/tw13456.pp svneol=native#text/plain
 tests/webtbs/tw1348.pp svneol=native#text/plain
 tests/webtbs/tw1351.pp svneol=native#text/plain
+tests/webtbs/tw13536.pp svneol=native#text/plain
 tests/webtbs/tw1364.pp svneol=native#text/plain
 tests/webtbs/tw1365.pp svneol=native#text/plain
 tests/webtbs/tw1374.pp svneol=native#text/plain

compiler/ncgcal.pas

@@ -538,11 +538,22 @@ implementation
 {$ifdef x86}
                tcgx86(cg).inc_fpu_stack;
 {$else x86}
-               if getsupreg(procdefinition.funcretloc[callerside].register)<first_fpu_imreg then
-                 cg.ungetcpuregister(current_asmdata.CurrAsmList,procdefinition.funcretloc[callerside].register);
-               hregister:=cg.getfpuregister(current_asmdata.CurrAsmList,location.size);
-               cg.a_loadfpu_reg_reg(current_asmdata.CurrAsmList,location.size,location.size,location.register,hregister);
-               location.register:=hregister;
+               { Do not move the physical register to a virtual one in case
+                 the return value is not used, because if the virtual one is
+                 then mapped to the same register as the physical one, we will
+                 end up with two deallocs of this register (one inserted here,
+                 one inserted by the register allocator), which unbalances the
+                 register allocation information.  The return register(s) will
+                 be freed by location_free() in release_unused_return_value
+                 (mantis #13536).  }
+               if (cnf_return_value_used in callnodeflags) then
+                 begin
+                   if getsupreg(procdefinition.funcretloc[callerside].register)<first_fpu_imreg then
+                     cg.ungetcpuregister(current_asmdata.CurrAsmList,procdefinition.funcretloc[callerside].register);
+                   hregister:=cg.getfpuregister(current_asmdata.CurrAsmList,location.size);
+                   cg.a_loadfpu_reg_reg(current_asmdata.CurrAsmList,location.size,location.size,location.register,hregister);
+                   location.register:=hregister;
+                 end;
 {$endif x86}
              end;
 
@@ -556,12 +567,25 @@ implementation
                     structs with up to 16 bytes are returned in registers }
                   if cgsize in [OS_128,OS_S128] then
                     begin
-                      tg.GetTemp(current_asmdata.CurrAsmList,16,8,tt_normal,ref);
-                      location_reset_ref(location,LOC_REFERENCE,OS_NO,0);
-                      location.reference:=ref;
-                      cg.a_load_reg_ref(current_asmdata.CurrAsmList,OS_64,OS_64,procdefinition.funcretloc[callerside].register,ref);
-                      inc(ref.offset,8);
-                      cg.a_load_reg_ref(current_asmdata.CurrAsmList,OS_64,OS_64,procdefinition.funcretloc[callerside].registerhi,ref);
+                      retloc:=procdefinition.funcretloc[callerside];
+                      if retloc.loc<>LOC_REGISTER then
+                        internalerror(2009042001);
+                      { See #13536 comment above.  }
+                      if (cnf_return_value_used in callnodeflags) then
+                        begin
+                          tg.GetTemp(current_asmdata.CurrAsmList,16,8,tt_normal,ref);
+                          location_reset_ref(location,LOC_REFERENCE,OS_NO,0);
+                          location.reference:=ref;
+                          if getsupreg(retloc.register)<first_int_imreg then
+                            cg.ungetcpuregister(current_asmdata.CurrAsmList,retloc.register);
+                          cg.a_load_reg_ref(current_asmdata.CurrAsmList,OS_64,OS_64,retloc.register,ref);
+                          inc(ref.offset,8);
+                          if getsupreg(retloc.registerhi)<first_int_imreg then
+                            cg.ungetcpuregister(current_asmdata.CurrAsmList,retloc.registerhi);
+                          cg.a_load_reg_ref(current_asmdata.CurrAsmList,OS_64,OS_64,retloc.registerhi,ref);
+                        end
+                      else
+                        location:=retloc;
                     end
                   else
 {$else cpu64bitaddr}
@@ -570,15 +594,21 @@ implementation
                       retloc:=procdefinition.funcretloc[callerside];
                       if retloc.loc<>LOC_REGISTER then
                         internalerror(200409141);
-                      { the function result registers are already allocated }
-                      if getsupreg(retloc.register64.reglo)<first_int_imreg then
-                        cg.ungetcpuregister(current_asmdata.CurrAsmList,retloc.register64.reglo);
-                      location.register64.reglo:=cg.getintregister(current_asmdata.CurrAsmList,OS_32);
-                      cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_32,OS_32,retloc.register64.reglo,location.register64.reglo);
-                      if getsupreg(retloc.register64.reghi)<first_int_imreg then
-                        cg.ungetcpuregister(current_asmdata.CurrAsmList,retloc.register64.reghi);
-                      location.register64.reghi:=cg.getintregister(current_asmdata.CurrAsmList,OS_32);
-                      cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_32,OS_32,retloc.register64.reghi,location.register64.reghi);
+                      { See #13536 comment above.  }
+                      if (cnf_return_value_used in callnodeflags) then
+                        begin
+                          { the function result registers are already allocated }
+                          if getsupreg(retloc.register64.reglo)<first_int_imreg then
+                            cg.ungetcpuregister(current_asmdata.CurrAsmList,retloc.register64.reglo);
+                          location.register64.reglo:=cg.getintregister(current_asmdata.CurrAsmList,OS_32);
+                          cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_32,OS_32,retloc.register64.reglo,location.register64.reglo);
+                          if getsupreg(retloc.register64.reghi)<first_int_imreg then
+                            cg.ungetcpuregister(current_asmdata.CurrAsmList,retloc.register64.reghi);
+                          location.register64.reghi:=cg.getintregister(current_asmdata.CurrAsmList,OS_32);
+                          cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_32,OS_32,retloc.register64.reghi,location.register64.reghi);
+                        end
+                      else
+                        location:=retloc;
                     end
                   else
 {$endif not cpu64bitaddr}
@@ -588,19 +618,25 @@ implementation
                         def_cgsize(resultdef) is used here because
                         it could be a constructor call }
 
-                      if getsupreg(procdefinition.funcretloc[callerside].register)<first_int_imreg then
-                        cg.ungetcpuregister(current_asmdata.CurrAsmList,procdefinition.funcretloc[callerside].register);
-
-                      { but use def_size only if it returns something valid because in
-                        case of odd sized structured results in registers def_cgsize(resultdef)
-                        could return OS_NO }
-                      if def_cgsize(resultdef)<>OS_NO then
-                        tmpcgsize:=def_cgsize(resultdef)
+                      { See #13536 comment above.  }
+                      if (cnf_return_value_used in callnodeflags) then
+                        begin
+                          if getsupreg(procdefinition.funcretloc[callerside].register)<first_int_imreg then
+                            cg.ungetcpuregister(current_asmdata.CurrAsmList,procdefinition.funcretloc[callerside].register);
+
+                          { but use def_size only if it returns something valid because in
+                            case of odd sized structured results in registers def_cgsize(resultdef)
+                            could return OS_NO }
+                          if def_cgsize(resultdef)<>OS_NO then
+                            tmpcgsize:=def_cgsize(resultdef)
+                          else
+                            tmpcgsize:=cgsize;
+
+                          location.register:=cg.getintregister(current_asmdata.CurrAsmList,tmpcgsize);
+                          cg.a_load_reg_reg(current_asmdata.CurrAsmList,cgsize,tmpcgsize,procdefinition.funcretloc[callerside].register,location.register);
+                        end
                       else
-                        tmpcgsize:=cgsize;
-
-                      location.register:=cg.getintregister(current_asmdata.CurrAsmList,tmpcgsize);
-                      cg.a_load_reg_reg(current_asmdata.CurrAsmList,cgsize,tmpcgsize,procdefinition.funcretloc[callerside].register,location.register);
+                        location:=procdefinition.funcretloc[callerside];
                     end;
 {$ifdef arm}
                   if (resultdef.typ=floatdef) and (current_settings.fputype in [fpu_fpa,fpu_fpa10,fpu_fpa11]) then
@@ -618,11 +654,17 @@ implementation
 
            LOC_MMREGISTER:
              begin
-               location_reset(location,LOC_MMREGISTER,cgsize);
-               if getsupreg(procdefinition.funcretloc[callerside].register)<first_mm_imreg then
-                 cg.ungetcpuregister(current_asmdata.CurrAsmList,procdefinition.funcretloc[callerside].register);
-               location.register:=cg.getmmregister(current_asmdata.CurrAsmList,cgsize);
-               cg.a_loadmm_reg_reg(current_asmdata.CurrAsmList,cgsize,cgsize,procdefinition.funcretloc[callerside].register,location.register,mms_movescalar);
+               { See #13536 comment above.  }
+               if (cnf_return_value_used in callnodeflags) then
+                 begin
+                   location_reset(location,LOC_MMREGISTER,cgsize);
+                   if getsupreg(procdefinition.funcretloc[callerside].register)<first_mm_imreg then
+                     cg.ungetcpuregister(current_asmdata.CurrAsmList,procdefinition.funcretloc[callerside].register);
+                   location.register:=cg.getmmregister(current_asmdata.CurrAsmList,cgsize);
+                   cg.a_loadmm_reg_reg(current_asmdata.CurrAsmList,cgsize,cgsize,procdefinition.funcretloc[callerside].register,location.register,mms_movescalar);
+                 end
+               else
+                 location:=procdefinition.funcretloc[callerside];
              end;
 
            else

compiler/ncgutil.pas

@@ -185,8 +185,28 @@ implementation
           LOC_REGISTER,
           LOC_CREGISTER:
             begin
-              if getsupreg(location.register)<first_int_imreg then
-                cg.ungetcpuregister(list,location.register);
+{$ifdef cpu64bitaddr}
+                { x86-64 system v abi:
+                  structs with up to 16 bytes are returned in registers }
+                if location.size in [OS_128,OS_S128] then
+                  begin
+                    if getsupreg(location.register)<first_int_imreg then
+                      cg.ungetcpuregister(list,location.register);
+                    if getsupreg(location.registerhi)<first_int_imreg then
+                      cg.ungetcpuregister(list,location.registerhi);
+                  end
+{$else cpu64bitaddr}
+                if location.size in [OS_64,OS_S64] then
+                  begin
+                    if getsupreg(location.register64.reglo)<first_int_imreg then
+                      cg.ungetcpuregister(list,location.register64.reglo);
+                    if getsupreg(location.register64.reghi)<first_int_imreg then
+                      cg.ungetcpuregister(list,location.register64.reghi);
+                  end
+{$endif}
+                else
+                  if getsupreg(location.register)<first_int_imreg then
+                    cg.ungetcpuregister(list,location.register);
             end;
           LOC_FPUREGISTER,
           LOC_CFPUREGISTER:

tests/webtbs/tw13536.pp

@@ -0,0 +1,87 @@
+
+// without -O3 prints  0002020200010101
+// with -O3 prints 0001010100010101
+
+{$mode objfpc}{$H+}
+
+uses sysutils;
+
+Const
+   MAXDWORD = $FFFFFFFF;
+
+
+Type
+ Filetime=longint;
+ tchar=char;
+ XWIN32_FIND_DATA = record
+          dwFileAttributes : DWORD;
+          ftLastWriteTime : FILETIME;
+          nFileSizeHigh : DWORD;
+          nFileSizeLow : DWORD;
+          cFileName : array[0..(MAX_PATH)-1] of TCHAR;
+       end;
+
+Type
+  TMySearchRec = Record
+    Time : Longint;
+    Size : Int64;
+    Attr : Longint;
+    Name : TFileName;
+    ExcludeAttr : Longint;
+    FindHandle : THandle;
+    FindData : XWIN32_FIND_DATA;
+  end;
+
+function getlasterror:integer;
+begin
+end;
+
+function aFindNextFile (F:thandle;fd:XWIN32_FIND_DATA):boolean;
+begin
+
+end;
+
+function WinToDosTime( Var Wtime : FileTime;var DTime:longint):longbool;
+begin
+end;
+
+Function aFindMatch(var f: TMySearchRec) : Longint;
+begin
+  // commenting code before the f.size:= line seems to alter the behaviour
+  { Find file with correct attribute }
+  While (F.FindData.dwFileAttributes and cardinal(F.ExcludeAttr))<>0 do
+   begin
+     if not aFindNextFile (F.FindHandle,F.FindData) then
+      begin
+        Result:=GetLastError;
+        exit;
+      end;
+   end; 
+
+  { Convert some attributes back }
+  WinToDosTime(F.FindData.ftLastWriteTime,F.Time);
+
+  f.size:=F.FindData.NFileSizeLow+(qword(maxdword)+1)*F.FindData.NFileSizeHigh;
+  f.attr:=F.FindData.dwFileAttributes;
+  f.Name:=StrPas(@F.FindData.cFileName[0]);
+  Result:=0;
+end;
+
+var n : TMySearchRec;
+
+begin 
+ // make sure it gets past the while loop.
+ n.finddata.dwfileattributes:=1;
+ n.excludeattr:=0;
+
+ n.FindData.NFileSizeLow:=$10101;
+ n.FindData.NFileSizehigh:=$20202;
+ // attempt to avoid problems with strpas.
+ n.finddata.cfilename:='bla'#0;
+ aFindMatch(n);
+
+ writeln(n.size);
+ writeln(inttohex(n.size,16));
+ if (n.size<>$0002020200010101) then
+   halt(1);
+end.