Browse Source

+ Patch for heap allocation from Florian

michael 26 years ago
parent
commit
50ae4cf315
1 changed files with 33 additions and 2 deletions
  1. 33 2
      rtl/inc/heap.inc

+ 33 - 2
rtl/inc/heap.inc

@@ -532,7 +532,8 @@ var
   proc     : heaperrorproc;
   last,hp  : pfreerecord;
   again    : boolean;
-  s,hpsize : longint;
+  s,sizeleft,hpsize : longint;
+  pp : pointer;
 {$IfDef CHECKHEAP}
   i,bp,orsize : longint;
 label
@@ -588,6 +589,33 @@ begin
 {$else CHECKHEAP}
            exit;
 {$endif CHECKHEAP}
+         end
+        else
+         begin
+            inc(s);
+            while s<=maxblock do
+              begin
+                 p:=blocks^[s];
+                 if assigned(p) then
+                   begin
+                      blocks^[s]:=pointer(p^);
+                      dec(nblocks^[s]);
+                      sizeleft:=s-(size shr 3);
+
+                      // reinsert the rest of the block
+                      pp:=p+size;
+                      ppointer(pp)^:=blocks^[sizeleft];
+                      blocks^[sizeleft]:=pp;
+                      inc(nblocks^[sizeleft]);
+{$ifdef CHECKHEAP}
+                      goto check_new;
+{$else CHECKHEAP}
+                      exit;
+{$endif CHECKHEAP}
+                       
+                   end;
+                 inc(s);
+              end;
          end;
       end;
    end;
@@ -1098,7 +1126,10 @@ end;
 
 {
   $Log$
-  Revision 1.11  1999-05-31 20:36:34  peter
+  Revision 1.12  1999-08-20 10:31:17  michael
+  + Patch for heap allocation from Florian
+
+  Revision 1.11  1999/05/31 20:36:34  peter
     * growing is now 256k or 1mb
 
   Revision 1.10  1999/05/17 21:52:36  florian