فهرست منبع

* memorymanager expanded with allocmem/reallocmem

peter 26 سال پیش
والد
کامیت
71d7f4ef38
6فایلهای تغییر یافته به همراه412 افزوده شده و 133 حذف شده
  1. 5 2
      rtl/i386/i386.inc
  2. 236 36
      rtl/inc/heap.inc
  3. 43 20
      rtl/inc/heaph.inc
  4. 116 10
      rtl/inc/heaptrc.pp
  5. 8 3
      rtl/objpas/objpas.pp
  6. 4 62
      rtl/objpas/sysutils.pp

+ 5 - 2
rtl/i386/i386.inc

@@ -182,7 +182,7 @@ asm
       { Memory size }
         pushl   (%eax)
         pushl   %esi
-        call    GetMem
+        call    AsmGetMem
         movl    $-1,8(%ebp)
         popal
       { Memory position to %esi }
@@ -884,7 +884,10 @@ end;
 
 {
   $Log$
-  Revision 1.57  1999-10-08 14:40:54  pierre
+  Revision 1.58  1999-10-30 17:39:05  peter
+    * memorymanager expanded with allocmem/reallocmem
+
+  Revision 1.57  1999/10/08 14:40:54  pierre
    * fix for FPC_HELP_FAIL_CLASS
 
   Revision 1.56  1999/10/05 20:50:06  pierre

+ 236 - 36
rtl/inc/heap.inc

@@ -52,7 +52,12 @@ const
     GetMem: SysGetMem;
     FreeMem: SysFreeMem;
     FreeMemSize: SysFreeMemSize;
-    MemSize: SysMemSize
+    AllocMem: SysAllocMem;
+    ReAllocMem: SysReAllocMem;
+    MemSize: SysMemSize;
+    MemAvail: SysMemAvail;
+    MaxAvail: SysMaxAvail;
+    HeapSize: SysHeapSize;
   );
 
 type
@@ -101,22 +106,35 @@ begin
 end;
 
 
-procedure GetMem(Var p:pointer;Size:Longint);[public,alias:'FPC_GETMEM'];
+procedure GetMem(Var p:pointer;Size:Longint);{$ifndef NEWMM}[public,alias:'FPC_GETMEM'];{$endif}
 begin
-  MemoryManager.GetMem(p,Size);
+  p:=MemoryManager.GetMem(Size);
 end;
 
 
-procedure FreeMem(Var p:pointer);
+procedure FreeMem(Var p:pointer;Size:Longint);{$ifndef NEWMM}[public,alias:'FPC_FREEMEM'];{$endif}
 begin
-  if p <> nil then
-    MemoryManager.FreeMem(p);
+  MemoryManager.FreeMemSize(p,Size);
+  p:=nil;
 end;
 
 
-procedure FreeMem(Var p:pointer;Size:Longint);[public,alias:'FPC_FREEMEM'];
+function MaxAvail:Longint;
 begin
-  MemoryManager.FreeMemSize(p,Size);
+  MaxAvail:=MemoryManager.MaxAvail();
+end;
+
+
+function MemAvail:Longint;
+begin
+  MemAvail:=MemoryManager.MemAvail();
+end;
+
+
+{ FPC Additions }
+function HeapSize:Longint;
+begin
+  HeapSize:=MemoryManager.HeapSize();
 end;
 
 
@@ -126,39 +144,75 @@ begin
 end;
 
 
+{ Delphi style }
+function FreeMem(p:pointer):Longint;
+begin
+  if p <> nil then
+    Freemem:=MemoryManager.FreeMem(p);
+end;
+
+
+function GetMem(size:longint):pointer;
+begin
+  GetMem:=MemoryManager.GetMem(Size);
+end;
+
+
+function AllocMem(Size:Longint):pointer;
+begin
+  AllocMem:=MemoryManager.AllocMem(size);
+end;
+
+
+function ReAllocMem(p:pointer;Size:Longint):pointer;
+begin
+  ReAllocMem:=MemoryManager.ReAllocMem(p,size);
+end;
+
+
 { Needed for calls from Assembler }
-procedure AsmFreeMem(Var p:pointer);
+procedure AsmGetMem(var p:pointer;size:longint);{$ifdef NEWMM}[public,alias:'FPC_GETMEM'];{$endif}
 begin
-  MemoryManager.FreeMem(p);
+  p:=MemoryManager.GetMem(size);
+end;
+
+
+procedure AsmFreeMem(var p:pointer);{$ifdef NEWMM}[public,alias:'FPC_FREEMEM'];{$endif}
+begin
+  if p <> nil then
+   begin
+     MemoryManager.FreeMem(p);
+     p:=nil;
+   end;
 end;
 
 
 {*****************************************************************************
-                       Heapsize,Memavail,MaxAvail
+                         Heapsize,Memavail,MaxAvail
 *****************************************************************************}
 
-function heapsize : longint;
+function SysHeapsize : longint;
 begin
-  heapsize:=internal_heapsize;
+  Sysheapsize:=internal_heapsize;
 end;
 
 
-function memavail : longint;
+function SysMemavail : longint;
 begin
-  memavail:=internal_memavail;
+  Sysmemavail:=internal_memavail;
 end;
 
 
-function maxavail : longint;
+function SysMaxavail : longint;
 var
   hp : pfreerecord;
 begin
-  maxavail:=heapend-heapptr;
+  Sysmaxavail:=heapend-heapptr;
   hp:=freelists[0];
   while assigned(hp) do
    begin
-     if hp^.size>maxavail then
-       maxavail:=hp^.size;
+     if hp^.size>Sysmaxavail then
+       Sysmaxavail:=hp^.size;
      hp:=hp^.next;
    end;
 end;
@@ -201,7 +255,7 @@ end;
                                  SysGetMem
 *****************************************************************************}
 
-procedure SysGetMem(var p : pointer;size : longint);
+function SysGetMem(size : longint):pointer;
 type
   heaperrorproc=function(size:longint):integer;
 var
@@ -236,7 +290,7 @@ begin
      if assigned(pcurr) then
       begin
         { create the block we should return }
-        p:=pointer(pcurr)+sizeof(theaprecord);
+        sysgetmem:=pointer(pcurr)+sizeof(theaprecord);
         { fix size }
         pcurr^.size:=pcurr^.size or usedmask;
         { update freelist }
@@ -248,9 +302,9 @@ begin
 {$ifdef SMALLATHEAPPTR}
      if heapend-heapptr>size then
       begin
-        p:=heapptr;
-        pheaprecord(p)^.size:=size;
-        inc(p,sizeof(theaprecord));
+        sysgetmem:=heapptr;
+        pheaprecord(sysgetmem)^.size:=size or usedmask;
+        inc(sysgetmem,sizeof(theaprecord));
         inc(heapptr,size);
         exit;
       end;
@@ -312,7 +366,7 @@ begin
   if assigned(pcurr) then
    begin
      { get pointer of the block we should return }
-     p:=pointer(pcurr);
+     sysgetmem:=pointer(pcurr);
      { remove the current block from the freelist }
      if assigned(pcurr^.next) then
       pcurr^.next^.prev:=pcurr^.prev;
@@ -337,8 +391,8 @@ begin
         freelists[s1]:=pcurr;
       end;
      { create the block we need to return }
-     pheaprecord(p)^.size:=size;
-     inc(p,sizeof(theaprecord));
+     pheaprecord(sysgetmem)^.size:=size or usedmask;
+     inc(sysgetmem,sizeof(theaprecord));
      exit;
    end;
   { Lastly, the top of the heap is checked, to see if there is }
@@ -347,9 +401,9 @@ begin
     again:=false;
     if heapend-heapptr>size then
      begin
-       p:=heapptr;
-       pheaprecord(p)^.size:=size;
-       inc(p,sizeof(theaprecord));
+       sysgetmem:=heapptr;
+       pheaprecord(sysgetmem)^.size:=size or usedmask;
+       inc(sysgetmem,sizeof(theaprecord));
        inc(heapptr,size);
        exit;
      end;
@@ -359,7 +413,7 @@ begin
        proc:=heaperrorproc(heaperror);
        case proc(size) of
         0 : HandleError(203);
-        1 : p:=nil;
+        1 : sysgetmem:=nil;
         2 : again:=true;
        end;
      end
@@ -373,7 +427,7 @@ end;
                                SysFreeMem
 *****************************************************************************}
 
-procedure SysFreeMem(var p : pointer);
+Function SysFreeMem(p : pointer):Longint;
 var
   s : longint;
   pcurr : pfreerecord;
@@ -393,15 +447,20 @@ begin
   if assigned(pcurr^.next) then
    pcurr^.next^.prev:=pcurr;
   freelists[s]:=pcurr;
-  p:=nil;
+  SysFreeMem:=pcurr^.size;
 end;
 
 
-procedure SysFreeMemSize(var p : pointer;size : longint);
+{*****************************************************************************
+                              SysFreeMemSize
+*****************************************************************************}
+
+Function SysFreeMemSize(p : pointer;size : longint):longint;
 var
   s : longint;
   pcurr : pfreerecord;
 begin
+  SysFreeMemSize:=0;
   if size<=0 then
    begin
      if size<0 then
@@ -429,11 +488,12 @@ begin
    pcurr^.next^.prev:=pcurr;
   freelists[s]:=pcurr;
   p:=nil;
+  SysFreeMemSize:=pcurr^.size;
 end;
 
 
 {*****************************************************************************
-                                    MemSize
+                                 SysMemSize
 *****************************************************************************}
 
 function SysMemSize(p:pointer):longint;
@@ -442,6 +502,143 @@ begin
 end;
 
 
+{*****************************************************************************
+                                 SysAllocMem
+*****************************************************************************}
+
+function SysAllocMem(size : longint):pointer;
+begin
+  sysallocmem:=MemoryManager.GetMem(size);
+  if sysallocmem<>nil then
+   FillChar(sysallocmem^,size,0);
+end;
+
+
+{*****************************************************************************
+                                 SysReAllocMem
+*****************************************************************************}
+
+function SysReAllocMem(p:pointer;size : longint):pointer;
+var
+  currsize,
+  foundsize,
+  sizeleft,
+  s     : longint;
+  p2    : pointer;
+  hp,
+  pnew,
+  pcurr : pfreerecord;
+begin
+{ Allocate a new block? }
+  if p=nil then
+   begin
+     SysReAllocMem:=MemoryManager.GetMem(size);
+     exit;
+   end;
+{ fix needed size }
+  size:=(size+sizeof(theaprecord)+(blocksize-1)) and (not (blocksize-1));
+{ fix p to point to the heaprecord }
+  pcurr:=pfreerecord(pointer(p)-sizeof(theaprecord));
+  currsize:=pcurr^.size and sizemask;
+{ is the allocated block still correct? }
+  if currsize=size then
+   begin
+     SysReAllocMem:=p;
+     exit;
+   end;
+{ do we need to allocate more memory ? }
+  if size>currsize then
+   begin
+   { the size is bigger than the previous size, we need to allocated more mem.
+     We first check if the blocks after the current block are free. If not we
+     simply call getmem/freemem to get the new block }
+     foundsize:=pcurr^.size and sizemask;
+     hp:=pcurr;
+     repeat
+       { get next block }
+       hp:=pfreerecord(pointer(hp)+(hp^.size and sizemask));
+       { when we're at heapptr then we can stop }
+       if (hp=heapptr) then
+        begin
+          inc(foundsize,heapend-heapptr);
+          break;
+        end;
+       { block used? }
+       if (hp^.size and usedmask)<>0 then
+        break;
+       inc(foundsize,hp^.size and sizemask);
+     until (foundsize>=size);
+   { found enough free blocks? }
+     if foundsize>=size then
+      begin
+        { we walk the list again and remove all blocks }
+        foundsize:=pcurr^.size and sizemask;
+        hp:=pcurr;
+        repeat
+          { get next block }
+          hp:=pfreerecord(pointer(hp)+(hp^.size and sizemask));
+          { when we're at heapptr then we can increase it, if there is enough
+            room is already checked }
+          if (hp=heapptr) then
+           begin
+             inc(heapptr,size-foundsize);
+             foundsize:=size;
+             break;
+           end;
+          s:=hp^.size and sizemask;
+          inc(foundsize,s);
+          s:=s shr blockshr;
+          if s>maxblock then
+           s:=0;
+          { remove block from freelist }
+          if assigned(hp^.next) then
+           hp^.next^.prev:=hp^.prev;
+          if assigned(hp^.prev) then
+           hp^.prev^.next:=hp^.next
+          else
+           freelists[s]:=hp^.next;
+        until (foundsize>=size);
+        pcurr^.size:=foundsize or usedmask;
+      end
+     else
+      begin
+        { we need to call getmem/move/freemem }
+        p2:=MemoryManager.GetMem(size);
+        if p2<>nil then
+         Move(p^,p2^,size);
+        MemoryManager.Freemem(p);
+        SysReAllocMem:=p2;
+        exit;
+      end;
+     currsize:=pcurr^.size and sizemask;
+   end;
+{ is the size smaller then we can adjust the block to that size and insert
+  the other part into the freelist }
+  if size<currsize then
+   begin
+     { create the left over freelist block, if at least 16 bytes are free }
+     sizeleft:=currsize-size;
+     if sizeleft>sizeof(tfreerecord) then
+      begin
+        pnew:=pfreerecord(pointer(pcurr)+size);
+        pnew^.size:=sizeleft;
+        { insert the block in the freelist }
+        pnew^.prev:=nil;
+        s:=sizeleft shr blockshr;
+        if s>maxblock then
+         s:=0;
+        pnew^.next:=freelists[s];
+        if assigned(freelists[s]) then
+         freelists[s]^.prev:=pnew;
+        freelists[s]:=pnew;
+      end;
+     { fix the size of the current block and leave }
+     pcurr^.size:=size or usedmask;
+   end;
+  SysReAllocMem:=p;
+end;
+
+
 {*****************************************************************************
                                 Mark/Release
 *****************************************************************************}
@@ -553,7 +750,10 @@ end;
 
 {
   $Log$
-  Revision 1.20  1999-10-22 22:03:07  sg
+  Revision 1.21  1999-10-30 17:39:05  peter
+    * memorymanager expanded with allocmem/reallocmem
+
+  Revision 1.20  1999/10/22 22:03:07  sg
   * FreeMem(p) is ignored if p is NIL, instead of throwing an
     runtime error 204. (Delphi ignores NIL FreeMem's, too)
 

+ 43 - 20
rtl/inc/heaph.inc

@@ -18,20 +18,20 @@
 type
   PMemoryManager = ^TMemoryManager;
   TMemoryManager = record
-    Getmem  : procedure(Var p:pointer;Size:Longint);
-    Freemem : procedure(Var p:pointer);
-    FreememSize : procedure(Var p:pointer;Size:Longint);
-    MemSize : function(p:pointer):Longint;
+    Getmem      : Function(Size:Longint):Pointer;
+    Freemem     : Function(p:pointer):Longint;
+    FreememSize : Function(p:pointer;Size:Longint):Longint;
+    AllocMem    : Function(Size:longint):Pointer;
+    ReAllocMem  : Function(p:pointer;Size:longint):Pointer;
+    MemSize     : function(p:pointer):Longint;
+    MemAvail    : Function:Longint;
+    MaxAvail    : Function:Longint;
+    HeapSize    : Function:Longint;
   end;
 procedure GetMemoryManager(var MemMgr: TMemoryManager);
 procedure SetMemoryManager(const MemMgr: TMemoryManager);
 function  IsMemoryManagerSet: Boolean;
 
-Procedure SysGetmem(Var p:pointer;Size:Longint);
-Procedure SysFreemem(Var p:pointer);
-Procedure SysFreememSize(Var p:pointer;Size:Longint);
-Function  SysMemSize(p:pointer):Longint;
-
 { Variables }
 const
   growheapsize1 : longint=256*1024;  { < 256k will grow with 256k }
@@ -39,24 +39,47 @@ const
 var
   heaporg,heapptr,heapend,heaperror,freelist : pointer;
 
-{ Needed to some overloading problem with call from assembler (PFV) }
-Procedure AsmFreemem(Var p:pointer);
-
-{ Basic (TP7,Delphi) functions }
-Procedure getmem(Var p:pointer;Size:Longint);
-Procedure freemem(Var p:pointer);
-Procedure freemem(Var p:pointer;Size:Longint);
+{ Default MemoryManager functions }
+Function  SysGetmem(Size:Longint):Pointer;
+Function  SysFreemem(p:pointer):Longint;
+Function  SysFreememSize(p:pointer;Size:Longint):Longint;
+Function  SysMemSize(p:pointer):Longint;
+Function  SysAllocMem(size:longint):Pointer;
+Function  SysReAllocMem(p:pointer;size:longint):Pointer;
+Function  Sysmemavail:Longint;
+Function  Sysmaxavail:Longint;
+Function  Sysheapsize:longint;
+
+{ Tp7 functions }
+Procedure Getmem(Var p:pointer;Size:Longint);
+Procedure Freemem(Var p:pointer;Size:Longint);
 Function  memavail:Longint;
 Function  maxavail:Longint;
+
+{ FPC additions }
+Function  MemSize(p:pointer):Longint;
+Function  heapsize:longint;
+
+{ Delphi functions }
+function Freemem(p:pointer):longint;
+function GetMem(size:longint):pointer;
+function AllocMem(Size:Longint):pointer;
+function ReAllocMem(p:pointer;Size:Longint):pointer;
+
+{ Needed to solve overloading problem with call from assembler (PFV) }
+Procedure AsmGetmem(var p:pointer;size:Longint);
+Procedure AsmFreemem(var p:pointer);
+
+{ Do nothing functions, are only here for tp7 compat }
 Procedure mark(var p : pointer);
 Procedure release(var p : pointer);
 
-{ Fpc Functions }
-Function  heapsize : longint;
-
 {
   $Log$
-  Revision 1.10  1999-09-17 17:14:12  peter
+  Revision 1.11  1999-10-30 17:39:05  peter
+    * memorymanager expanded with allocmem/reallocmem
+
+  Revision 1.10  1999/09/17 17:14:12  peter
     + new heap manager supporting delphi freemem(pointer)
 
   Revision 1.9  1999/05/31 20:36:35  peter

+ 116 - 10
rtl/inc/heaptrc.pp

@@ -330,10 +330,11 @@ end;
                                TraceGetMem
 *****************************************************************************}
 
-procedure TraceGetMem(var p:pointer;size:longint);
+Function TraceGetMem(size:longint):pointer;
 var
   i,bp : longint;
   pl : plongint;
+  p : pointer;
 begin
   inc(getmem_size,size);
   inc(getmem8_size,((size+7) div 8)*8);
@@ -341,7 +342,7 @@ begin
   bp:=size+sizeof(theap_mem_info)+extra_info_size;
   if add_tail then
     inc(bp,sizeof(longint));
-  SysGetMem(p,bp);
+  p:=SysGetMem(bp);
 { Create the info block }
   pheap_mem_info(p)^.sig:=$DEADBEEF;
   pheap_mem_info(p)^.size:=size;
@@ -377,6 +378,7 @@ begin
     pheap_mem_info(p)^.sig:=calculate_sig(pheap_mem_info(p));
   inc(p,sizeof(theap_mem_info)+extra_info_size);
   inc(getmem_cnt);
+  TraceGetmem:=p;
 end;
 
 
@@ -384,9 +386,9 @@ end;
                                TraceFreeMem
 *****************************************************************************}
 
-procedure TraceFreeMemSize(var p:pointer;size:longint);
-
-  var i,bp, ppsize : longint;
+function TraceFreeMemSize(p:pointer;size:longint):longint;
+var
+  i,bp, ppsize : longint;
   pp : pheap_mem_info;
 {$ifdef EXTRA}
   pp2 : pheap_mem_info;
@@ -486,7 +488,11 @@ begin
        exit;
 {$endif EXTRA}
     end;
-  SysFreeMemSize(p,ppsize);
+  i:=SysFreeMemSize(p,ppsize);
+  dec(i,sizeof(theap_mem_info)+extra_info_size);
+  if add_tail then
+   dec(i,sizeof(longint));
+  TraceFreeMemSize:=i;
 end;
 
 
@@ -502,7 +508,7 @@ begin
 end;
 
 
-procedure TraceFreeMem(var p:pointer);
+function TraceFreeMem(p:pointer):longint;
 var
   size : longint;
   pp : pheap_mem_info;
@@ -517,7 +523,7 @@ begin
      dump_wrong_size(pp,size,error_file);
 {$endif EXTRA}
    end;
-  TraceFreeMemSize(p,pp^.size);
+  TraceFreeMem:=TraceFreeMemSize(p,pp^.size);
 end;
 
 
@@ -705,6 +711,98 @@ begin
 end;
 
 
+{*****************************************************************************
+                                AllocMem
+*****************************************************************************}
+
+function TraceAllocMem(size:longint):Pointer;
+begin
+  TraceAllocMem:=SysAllocMem(size);
+end;
+
+
+{*****************************************************************************
+                                ReAllocMem
+*****************************************************************************}
+
+function TraceReAllocMem(p:pointer;size:longint):Pointer;
+var
+  i,bp : longint;
+  pl : plongint;
+  pp : pheap_mem_info;
+begin
+  dec(p,sizeof(theap_mem_info)+extra_info_size);
+{ remove heap_mem_info for linked list }
+  pp:=pheap_mem_info(p);
+  if pp^.next<>nil then
+    pp^.next^.previous:=pp^.previous;
+  if pp^.previous<>nil then
+    pp^.previous^.next:=pp^.next;
+  if pp=heap_mem_root then
+    heap_mem_root:=heap_mem_root^.previous;
+{ Do the real GetMem, but alloc also for the info block }
+  bp:=size+sizeof(theap_mem_info)+extra_info_size;
+  if add_tail then
+    inc(bp,sizeof(longint));
+  p:=SysReAllocMem(p,bp);
+{ Create the info block }
+  pheap_mem_info(p)^.sig:=$DEADBEEF;
+  pheap_mem_info(p)^.size:=size;
+  if add_tail then
+    begin
+      pl:=pointer(p)+bp-sizeof(longint);
+      pl^:=$DEADBEEF;
+    end;
+  bp:=get_caller_frame(get_frame);
+  for i:=1 to tracesize do
+   begin
+     pheap_mem_info(p)^.calls[i]:=get_caller_addr(bp);
+     bp:=get_caller_frame(bp);
+   end;
+  { insert in the linked list }
+  if heap_mem_root<>nil then
+   heap_mem_root^.next:=pheap_mem_info(p);
+  pheap_mem_info(p)^.previous:=heap_mem_root;
+  pheap_mem_info(p)^.next:=nil;
+{$ifdef EXTRA}
+  pheap_mem_info(p)^.next_valid:=nil;
+  if assigned(heap_valid_last) then
+    heap_valid_last^.next_valid:=pheap_mem_info(p);
+  heap_valid_last:=pheap_mem_info(p);
+  if not assigned(heap_valid_first) then
+    heap_valid_first:=pheap_mem_info(p);
+{$endif EXTRA}
+  heap_mem_root:=p;
+  if assigned(fill_extra_info) then
+    fill_extra_info(@pheap_mem_info(p)^.extra_info);
+{ update the pointer }
+  if usecrc then
+    pheap_mem_info(p)^.sig:=calculate_sig(pheap_mem_info(p));
+  inc(p,sizeof(theap_mem_info)+extra_info_size);
+  inc(getmem_cnt);
+  TraceReAllocmem:=p;
+end;
+
+
+{*****************************************************************************
+                            No specific tracing calls
+*****************************************************************************}
+
+function TraceMemAvail:longint;
+begin
+  TraceMemAvail:=SysMemAvail;
+end;
+
+function TraceMaxAvail:longint;
+begin
+  TraceMaxAvail:=SysMaxAvail;
+end;
+
+function TraceHeapSize:longint;
+begin
+  TraceHeapSize:=SysHeapSize;
+end;
+
 
 {*****************************************************************************
                            Install MemoryManager
@@ -715,7 +813,12 @@ const
     Getmem  : TraceGetMem;
     Freemem : TraceFreeMem;
     FreememSize : TraceFreeMemSize;
-    MemSize : TraceMemSize
+    AllocMem : TraceAllocMem;
+    ReAllocMem : TraceReAllocMem;
+    MemSize : TraceMemSize;
+    MemAvail : TraceMemAvail;
+    MaxAvail : TraceMaxAvail;
+    HeapSize : TraceHeapsize;
   );
 
 procedure TraceExit;
@@ -794,7 +897,10 @@ finalization
 end.
 {
   $Log$
-  Revision 1.24  1999-09-17 17:14:12  peter
+  Revision 1.25  1999-10-30 17:39:05  peter
+    * memorymanager expanded with allocmem/reallocmem
+
+  Revision 1.24  1999/09/17 17:14:12  peter
     + new heap manager supporting delphi freemem(pointer)
 
   Revision 1.23  1999/09/10 17:13:41  peter

+ 8 - 3
rtl/objpas/objpas.pp

@@ -14,8 +14,10 @@
 
  **********************************************************************}
 {$Mode ObjFpc}
-{$I-,S-}
-
+{$I-}
+{$ifndef linux}
+  {$S-}
+{$endif}
 unit objpas;
 
   interface
@@ -360,7 +362,10 @@ end.
 
 {
   $Log$
-  Revision 1.42  1999-10-03 19:41:30  peter
+  Revision 1.43  1999-10-30 17:39:05  peter
+    * memorymanager expanded with allocmem/reallocmem
+
+  Revision 1.42  1999/10/03 19:41:30  peter
     * moved tvarrec to systemunit
 
   Revision 1.41  1999/09/28 21:13:33  florian

+ 4 - 62
rtl/objpas/sysutils.pp

@@ -103,11 +103,6 @@ type
    EAbstractError   = Class(Exception);
    EAssertionFailed = Class(Exception);
 
-
-   { Memory management routines }
-   function AllocMem(size : longint) : Pointer;
-   procedure ReAllocMem(var P: Pointer; currentSize: longint; newSize: longint);
-
   { FileRec/TextRec }
   {$i filerec.inc}
   {$i textrec.inc}
@@ -286,62 +281,6 @@ begin
   ErrorProc:=@RunErrorToExcept;
 end;
 
-{ ---------------------------------------------------------------------
-    Memory handling routines.
-  ---------------------------------------------------------------------}
-
-
-function AllocMem(size : longint) : Pointer;
-var
-   newP : Pointer;
-begin
-   GetMem(newP, size);
-   if newP <> nil then
-      FillChar(newP^, size, 0);
-   result := newP;
-end;
-
-{ ReAllocMem
-1. if P is nil and newSize is zero do nothing
-2. if P is nil and newSize is NOT zero allocate memory and clear it to 0
-3. if P is NOT nil and newSize is NOT zero a new memory block is allocated
-   the data is copied from the old block to the new block and the old
-   block is disposed of.
-
-if P is NOT nil then currentSize must be the size used to allocate memory
-for P whether it was using AllocMem or ReAllocMem.
-
-This is similar to the functions found in Delphi 1
-The same functions in Dephi 2, 3, and 4 use memory management. When
-I get a chance I might attempt to incorporate that feature.
-}
-
-procedure ReAllocMem(var P: Pointer; currentSize: longint; newSize: longint);
-var
-   newP : Pointer;
-
-begin
-   if (P = nil) then
-     begin
-     If NewSize>0 then
-       P := AllocMem(newSize)
-     end
-   else
-     begin
-     If NewSize>0 then
-       NewP := AllocMem(newSize)
-     else
-       NewP:=Nil;
-     if NewSize > currentSize then
-       NewSize := currentSize;
-     If NewSize>0 then
-        Move(P^, newP^, NewSize);
-     If CurrentSize>0 then
-       FreeMem(P, currentSize);
-     P := newP;
-     end;
-end;
-
 
 {  Initialization code. }
 
@@ -354,7 +293,10 @@ Finalization
 end.
 {
     $Log$
-    Revision 1.33  1999-10-26 12:29:07  peter
+    Revision 1.34  1999-10-30 17:39:05  peter
+      * memorymanager expanded with allocmem/reallocmem
+
+    Revision 1.33  1999/10/26 12:29:07  peter
       * assert handler must use shortstring
 
     Revision 1.32  1999/09/15 20:26:30  florian