Bläddra i källkod

--- Merging r21355 into '.':
U utils/fpcmkcfg/fpcmkcfg.pp
--- Merging r22235 into '.':
U rtl/x86_64/x86_64.inc
--- Merging r22249 into '.':
U rtl/inc/heap.inc
A tests/webtbs/tw14315.pp
--- Merging r22270 into '.':
U rtl/nds/system.pp
U rtl/bsd/system.pp
U rtl/solaris/system.pp
C rtl/aix
U rtl/wii/system.pp
U rtl/linux/system.pp
Summary of conflicts:
Tree conflicts: 1

git-svn-id: branches/fixes_2_6@22640 -

Jonas Maebe 13 år sedan
förälder
incheckning
73a837e867

+ 1 - 0
.gitattributes

@@ -11616,6 +11616,7 @@ tests/webtbs/tw14230.pp svneol=native#text/plain
 tests/webtbs/tw14236.pp svneol=native#text/plain
 tests/webtbs/tw14236.pp svneol=native#text/plain
 tests/webtbs/tw1430.pp svneol=native#text/plain
 tests/webtbs/tw1430.pp svneol=native#text/plain
 tests/webtbs/tw14307.pp svneol=native#text/plain
 tests/webtbs/tw14307.pp svneol=native#text/plain
+tests/webtbs/tw14315.pp svneol=native#text/plain
 tests/webtbs/tw1433.pp svneol=native#text/plain
 tests/webtbs/tw1433.pp svneol=native#text/plain
 tests/webtbs/tw14363.pp svneol=native#text/plain
 tests/webtbs/tw14363.pp svneol=native#text/plain
 tests/webtbs/tw14388.pp svneol=native#text/pascal
 tests/webtbs/tw14388.pp svneol=native#text/pascal

+ 1 - 1
rtl/bsd/system.pp

@@ -265,7 +265,7 @@ begin
         buf[bufsize]:='"';
         buf[bufsize]:='"';
         inc(bufsize);
         inc(bufsize);
       end;
       end;
-     if i<argc then
+     if i<argc-1 then
       buf[bufsize]:=' '
       buf[bufsize]:=' '
      else
      else
       buf[bufsize]:=#0;
       buf[bufsize]:=#0;

+ 11 - 1
rtl/inc/heap.inc

@@ -1146,7 +1146,7 @@ begin
     exit(chunksize);
     exit(chunksize);
   end;
   end;
 
 
-  { insert the block in it's freelist }
+  { insert the block in its freelist }
   pmcv^.size := pmcv^.size and (not usedflag);
   pmcv^.size := pmcv^.size and (not usedflag);
   append_to_list_var(pmcv);
   append_to_list_var(pmcv);
   pmcv := try_concat_free_chunk(pmcv);
   pmcv := try_concat_free_chunk(pmcv);
@@ -1357,6 +1357,16 @@ begin
     currsize := pcurr^.size and sizemask;
     currsize := pcurr^.size and sizemask;
   if size>currsize then
   if size>currsize then
     begin
     begin
+      { adjust statistics (try_concat_free_chunk_forward may have merged a free
+        block into the current block, which we will subsequently free (so the
+        combined size will be freed -> make sure the combined size is marked as
+        used) }
+      with loc_freelists^.internal_status do
+      begin
+        inc(currheapused, currsize-oldsize);
+        if currheapused > maxheapused then
+          maxheapused := currheapused;
+      end;
       { the size is bigger than the previous size, we need to allocate more mem
       { the size is bigger than the previous size, we need to allocate more mem
         but we could not concatenate with next block or not big enough }
         but we could not concatenate with next block or not big enough }
       exit;
       exit;

+ 1 - 1
rtl/linux/system.pp

@@ -197,7 +197,7 @@ begin
         buf[bufsize]:='"';
         buf[bufsize]:='"';
         inc(bufsize);
         inc(bufsize);
       end;
       end;
-     if i<argc then
+     if i<argc-1 then
       buf[bufsize]:=' '
       buf[bufsize]:=' '
      else
      else
       buf[bufsize]:=#0;
       buf[bufsize]:=#0;

+ 1 - 1
rtl/nds/system.pp

@@ -234,7 +234,7 @@ begin
         buf[bufsize]:='"';
         buf[bufsize]:='"';
         inc(bufsize);
         inc(bufsize);
       end;
       end;
-     if i<argc then
+     if i<argc-1 then
       buf[bufsize]:=' '
       buf[bufsize]:=' '
      else
      else
       buf[bufsize]:=#0;
       buf[bufsize]:=#0;

+ 1 - 1
rtl/solaris/system.pp

@@ -232,7 +232,7 @@ begin
         buf[bufsize]:='"';
         buf[bufsize]:='"';
         inc(bufsize);
         inc(bufsize);
       end;
       end;
-     if i<argc then
+     if i<argc-1 then
       buf[bufsize]:=' '
       buf[bufsize]:=' '
      else
      else
       buf[bufsize]:=#0;
       buf[bufsize]:=#0;

+ 1 - 1
rtl/wii/system.pp

@@ -208,7 +208,7 @@ begin
         buf[bufsize]:='"';
         buf[bufsize]:='"';
         inc(bufsize);
         inc(bufsize);
       end;
       end;
-     if i<argc then
+     if i<argc-1 then
       buf[bufsize]:=' '
       buf[bufsize]:=' '
      else
      else
       buf[bufsize]:=#0;
       buf[bufsize]:=#0;

+ 2 - 2
rtl/x86_64/x86_64.inc

@@ -25,14 +25,14 @@
 ****************************************************************************}
 ****************************************************************************}
 
 
 {$define FPC_SYSTEM_HAS_SPTR}
 {$define FPC_SYSTEM_HAS_SPTR}
-Function Sptr : Pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif}
+Function Sptr : Pointer;assembler;nostackframe;{$ifdef SYSTEMINLINE}inline;{$endif}
 asm
 asm
         movq    %rsp,%rax
         movq    %rsp,%rax
 end;
 end;
 
 
 {$IFNDEF INTERNAL_BACKTRACE}
 {$IFNDEF INTERNAL_BACKTRACE}
 {$define FPC_SYSTEM_HAS_GET_FRAME}
 {$define FPC_SYSTEM_HAS_GET_FRAME}
-function get_frame:pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif}
+function get_frame:pointer;assembler;nostackframe;{$ifdef SYSTEMINLINE}inline;{$endif}
 asm
 asm
         movq    %rbp,%rax
         movq    %rbp,%rax
 end;
 end;

+ 46 - 0
tests/webtbs/tw14315.pp

@@ -0,0 +1,46 @@
+program Project1;
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes, SysUtils;
+
+function RandomRange(const low : longint;
+                     const high : longint) : longint;
+begin
+  if (high < low) then
+    result := high + random(low - high + 1)
+  else
+    Result := low + random(high - low + 1);
+end;
+
+procedure GetStats(out used: ptruint);
+var
+  fpcHeapStatus : TFPCHeapStatus;
+begin
+  fpcHeapStatus := GetFPCHeapStatus();
+  used:=fpcHeapStatus.CurrHeapUsed;
+  writeln(' heap status: cu=' +
+          IntToStr(fpcHeapStatus.CurrHeapUsed) + ', cs=' +
+          IntToStr(fpcHeapStatus.CurrHeapSize) + ', cf=' +
+          IntToStr(fpcHeapStatus.CurrHeapFree) + ', mu=' +
+          IntToStr(fpcHeapStatus.MaxHeapUsed) + ', ms=' +
+          IntToStr(fpcHeapStatus.MaxHeapSize));
+end;
+
+var
+  i : integer;
+  a : array of byte;
+  u1, u2: ptruint;
+begin
+  randomize();
+  writeln('randseed: ',randseed);
+  GetStats(u1);
+  for i := 0 to 50 do begin
+    SetLength(a, RandomRange(1024,1024*1024*15));
+  end;
+  SetLength(a, 0);
+  GetStats(u2);
+  if u1<>u2 then
+    halt(1);
+end.

+ 7 - 0
utils/fpcmkcfg/fpcmkcfg.pp

@@ -79,6 +79,7 @@ Resourcestring
   SErrBackupFailed    = 'Error: Backup of file "%s" to "%s" failed.';
   SErrBackupFailed    = 'Error: Backup of file "%s" to "%s" failed.';
   SErrDelBackupFailed = 'Error: Delete of old backup file "%s" failed.';
   SErrDelBackupFailed = 'Error: Delete of old backup file "%s" failed.';
   SErrCreateDirFailed = 'Error: Could not create the directory for file "%s".';
   SErrCreateDirFailed = 'Error: Could not create the directory for file "%s".';
+  SErrDestDirectory   = 'Error: The output file "%s" is a directory.';
 
 
   SWarnIgnoringFile   = 'Warning: Ignoring non-existent file: ';
   SWarnIgnoringFile   = 'Warning: Ignoring non-existent file: ';
   SWarnIgnoringPair   = 'Warning: Ignoring wrong name/value pair: ';
   SWarnIgnoringPair   = 'Warning: Ignoring wrong name/value pair: ';
@@ -490,6 +491,12 @@ Var
   I : Integer;
   I : Integer;
 
 
 begin
 begin
+  if (OutputFileName<>'') and
+     DirectoryExists(OutputFileName) then
+    begin
+      Writeln(StdErr,Format(SErrDestDirectory,[OutputFileName]));
+      Halt(1);
+    end;
   If (OutputFileName<>'')
   If (OutputFileName<>'')
      and FileExists(OutputFileName)
      and FileExists(OutputFileName)
      and not SkipBackup then
      and not SkipBackup then