Browse Source

+ ReturnNilIfGrowHeapFails used in objects unit
to handle TMemoryStream out of memory properly
as MaxAvail is not a good test anymore.

pierre 25 years ago
parent
commit
e9f1439f5a
3 changed files with 45 additions and 12 deletions
  1. 11 3
      rtl/inc/heap.inc
  2. 8 2
      rtl/inc/heaph.inc
  3. 26 7
      rtl/inc/objects.pp

+ 11 - 3
rtl/inc/heap.inc

@@ -826,7 +826,10 @@ begin
      NewPos:=Sbrk(size);
      if NewPos=-1 then
       begin
-        GrowHeap:=0;
+        if ReturnNilIfGrowHeapFails then
+          GrowHeap:=1
+        else
+          GrowHeap:=0;
         Exit;
       end;
    end;
@@ -881,7 +884,12 @@ end;
 
 {
   $Log$
-  Revision 1.36  2000-03-13 21:22:28  peter
+  Revision 1.37  2000-04-07 21:10:35  pierre
+    + ReturnNilIfGrowHeapFails used in objects unit
+      to handle TMemoryStream out of memory properly
+      as MaxAvail is not a good test anymore.
+
+  Revision 1.36  2000/03/13 21:22:28  peter
     * concat free blocks in main freelist
 
   Revision 1.35  2000/03/10 12:41:21  pierre
@@ -952,4 +960,4 @@ end;
   Revision 1.16  1999/09/17 17:14:12  peter
     + new heap manager supporting delphi freemem(pointer)
 
-}
+}

+ 8 - 2
rtl/inc/heaph.inc

@@ -36,6 +36,7 @@ function  IsMemoryManagerSet: Boolean;
 const
   growheapsize1 : longint=256*1024;  { < 256k will grow with 256k }
   growheapsize2 : longint=1024*1024; { > 256k will grow with 1m }
+  ReturnNilIfGrowHeapFails : boolean = false;
 var
   heaporg,heapptr,heapend,heaperror,freelist : pointer;
 
@@ -77,7 +78,12 @@ Procedure release(var p : pointer);
 
 {
   $Log$
-  Revision 1.17  2000-02-09 16:59:30  peter
+  Revision 1.18  2000-04-07 21:10:35  pierre
+    + ReturnNilIfGrowHeapFails used in objects unit
+      to handle TMemoryStream out of memory properly
+      as MaxAvail is not a good test anymore.
+
+  Revision 1.17  2000/02/09 16:59:30  peter
     * truncated log
 
   Revision 1.16  2000/01/31 23:41:30  peter
@@ -101,4 +107,4 @@ Procedure release(var p : pointer);
   Revision 1.10  1999/09/17 17:14:12  peter
     + new heap manager supporting delphi freemem(pointer)
 
-}
+}

+ 26 - 7
rtl/inc/objects.pp

@@ -1639,6 +1639,7 @@ END;
 {---------------------------------------------------------------------------}
 FUNCTION TMemoryStream.ChangeListSize (ALimit: Sw_Word): Boolean;
 VAR I, W: Word; Li: LongInt; P: PPointerArray;
+    OldVal : Boolean;
 BEGIN
    If (ALimit <> BlkCount) Then Begin                 { Change is needed }
      ChangeListSize := False;                         { Preset failure }
@@ -1648,7 +1649,14 @@ BEGIN
        If (MaxAvail > Li) Then Begin
          GetMem(P, Li);                               { Allocate memory }
          FillChar(P^, Li, #0);                        { Clear the memory }
-       End Else Exit;                                 { Insufficient memory }
+       End Else Begin
+         OldVal:=ReturnNilIfGrowHeapFails;
+         ReturnNilIfGrowHeapFails:=true;
+         GetMem(P,Li);
+         ReturnNilIfGrowHeapFails:=OldVal;
+         If P = Nil Then Exit;
+         FillChar(P^, Li, #0);                        { Clear the memory }
+       End;                           { Insufficient memory }
        If (BlkCount <> 0) AND (BlkList <> Nil) Then   { Current list valid }
          If (BlkCount <= ALimit) Then Move(BlkList^,
            P^, BlkCount * SizeOf(Pointer)) Else       { Move whole old list }
@@ -1660,10 +1668,16 @@ BEGIN
      If (P <> Nil) AND (ALimit > BlkCount) Then Begin { Expand stream size }
        For W := BlkCount To ALimit-1 Do Begin
          If (MaxAvail < BlkSize) Then Begin           { Check enough memory }
-           For I := BlkCount To W-1 Do
-             FreeMem(P^[I], BlkSize);                 { Free mem allocated }
-           FreeMem(P, Li);                            { Release memory }
-           Exit;                                      { Now exit }
+           OldVal:=ReturnNilIfGrowHeapFails;
+           ReturnNilIfGrowHeapFails:=true;
+           GetMem(P^[W],BlkSize);
+           ReturnNilIfGrowHeapFails:=OldVal;
+           If P = Nil Then Begin
+             For I := BlkCount To W-1 Do
+               FreeMem(P^[I], BlkSize);                 { Free mem allocated }
+             FreeMem(P, Li);                            { Release memory }
+             Exit;
+           End                      { Now exit }
          End Else GetMem(P^[W], BlkSize);             { Allocate memory }
        End;
      End;
@@ -2786,7 +2800,12 @@ END;
 END.
 {
   $Log$
-  Revision 1.36  2000-03-06 20:15:32  daniel
+  Revision 1.37  2000-04-07 21:10:35  pierre
+    + ReturnNilIfGrowHeapFails used in objects unit
+      to handle TMemoryStream out of memory properly
+      as MaxAvail is not a good test anymore.
+
+  Revision 1.36  2000/03/06 20:15:32  daniel
     + Added is_object method to Tobject. It is similar to the is operator.
 
   Revision 1.35  2000/02/09 16:59:30  peter
@@ -2807,4 +2826,4 @@ END.
   Revision 1.30  1999/09/10 17:15:13  peter
     * fixed freeall
 
-}
+}