View Issue Details

IDProjectCategoryView StatusLast Update
0038751FPCRTLpublic2021-04-15 14:29
ReporterPavel Assigned ToSven Barth  
PrioritynormalSeverityminorReproducibilityN/A
Status assignedResolutionopen 
Platformx86OSWindows 
Product Version3.3.1 
Summary0038751: Simplify cmem header
DescriptionIn general, I propose to simplify the cmem header, perhaps this topic has already been raised and I'm not sure if this will work fine on all platforms. I suggest testing and expressing your opinion. Tested by me on Linux and Windows.
TagsNo tags attached.
Fixed in Revision
FPCOldBugId
FPCTarget-
Attached Files

Activities

Pavel

2021-04-13 13:44

reporter  

cmem.pas (4,261 bytes)   
{
    This file is part of the Free Pascal run time library.
    Copyright (c) 1999 by Michael Van Canneyt, member of the
    Free Pascal development team

    Implements a memory manager that uses the C memory management.

    See the file COPYING.FPC, included in this distribution,
    for details about the copyright.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

 **********************************************************************}
unit cmem;

interface

Const

{$if defined(go32v2) or defined(wii)}
  {$define USE_STATIC_LIBC}
{$endif}

{$if defined(win32)}
  LibName = 'msvcrt';
  MsizeName='_msize';
{$elseif defined(win64)}
  LibName = 'msvcrt';
  MsizeName='_msize';
{$elseif defined(wince)}
  LibName = 'coredll';
  MsizeName='_msize';
{$elseif defined(netware)}
  LibName = 'clib';
  MsizeName='_msize';
{$elseif defined(netwlibc)}
  LibName = 'libc';
  MsizeName='malloc_usable_size';
{$elseif defined(macos)}
  LibName = 'StdCLib';
  MsizeName='malloc_usable_size';
{$elseif defined(beos)}
  LibName = 'root';
  MsizeName='malloc_usable_size';
{$else}
  LibName = 'c';
  MsizeName='malloc_usable_size';
{$endif}

{$ifdef USE_STATIC_LIBC}
  {$linklib c}
Function  malloc (Size : ptruint) : Pointer;cdecl; external;
Procedure free (P : pointer); cdecl; external;
function  realloc (P : Pointer; Size : ptruint) : pointer;cdecl; external;
Function  calloc (unitSize,UnitCount : ptruint) : pointer;cdecl; external;
Function  _msize (P : Pointer) : ptruint; cdecl; external;
{$else not USE_STATIC_LIBC}
Function  Malloc (Size : ptruint) : Pointer; cdecl; external LibName name 'malloc';
Procedure Free (P : pointer); cdecl; external LibName name 'free';
function  ReAlloc (P : Pointer; Size : ptruint) : pointer; cdecl; external LibName name 'realloc';
Function  CAlloc (unitSize,UnitCount : ptruint) : pointer; cdecl; external LibName name 'calloc';
Function  _msize (P : Pointer) : ptruint; cdecl; external LibName name MsizeName;
{$endif not USE_STATIC_LIBC}

implementation

var
 CurrHeapSize:ptruint=0;

Function CMemSize (p:pointer): ptruint; forward;

Function CGetMem  (Size : ptruint) : Pointer;

begin
  Result:=Malloc(Size);
  CurrHeapSize:=CurrHeapSize+CMemSize(Result);
end;

Function CFreeMem (P : pointer) : ptruint;

begin
  CurrHeapSize:=CurrHeapSize-CMemSize(p);
  Free(P);
  Result:=0;
end;

Function CFreeMemSize(p:pointer;Size:ptruint):ptruint;

begin
  Result:=0;
  if size<=0 then
    exit;
  if (p <> nil) then
    begin
      if (size > CMemSize(p)) then
        runerror(204);
    end;
  Result:=CFreeMem(P);
end;

Function CAllocMem(Size : ptruint) : Pointer;

begin
  Result:=calloc(Size,1);
  CurrHeapSize:=CurrHeapSize+CMemSize(Result);
end;

Function CReAllocMem (var p:pointer;Size:ptruint):Pointer;

begin
 CurrHeapSize:=CurrHeapSize-CMemSize(p);
 p:=ReAlloc(P,Size);
 Result:=p;
 CurrHeapSize:=CurrHeapSize+CMemSize(p);
end;

Function CMemSize (p:pointer): ptruint;

begin
 Result:=0;
 if (P=nil) then Exit;
 Result:=_msize(P);
end;

function CGetHeapStatus:THeapStatus;
begin
  Result:=Default(THeapStatus);
  Result.TotalAddrSpace:=CurrHeapSize;
  Result.TotalCommitted:=CurrHeapSize;
  Result.TotalAllocated:=CurrHeapSize;
end;

function CGetFPCHeapStatus:TFPCHeapStatus;
begin
 Result:=Default(TFPCHeapStatus);
 Result.CurrHeapSize:=CurrHeapSize;
 Result.CurrHeapUsed:=CurrHeapSize;
end;

Const
 CMemoryManager : TMemoryManager =
    (
      NeedLock : false;
      GetMem : @CGetmem;
      FreeMem : @CFreeMem;
      FreememSize : @CFreememSize;
      AllocMem : @CAllocMem;
      ReallocMem : @CReAllocMem;
      MemSize : @CMemSize;
      InitThread : nil;
      DoneThread : nil;
      RelocateHeap : nil;
      GetHeapStatus : @CGetHeapStatus;
      GetFPCHeapStatus: @CGetFPCHeapStatus;
    );

Var
  OldMemoryManager : TMemoryManager;

Initialization
  GetMemoryManager (OldMemoryManager);
  SetMemoryManager (CmemoryManager);

Finalization
  SetMemoryManager (OldMemoryManager);
end.

cmem.pas (4,261 bytes)   

Sven Barth

2021-04-14 09:17

manager   ~0130368

Please provide a patch instead of a whole file so that one can see what the differences are.

Pavel

2021-04-14 15:30

reporter   ~0130374

up
cmem.patch (5,071 bytes)   
--- cmem_old.pas	2021-04-14 16:22:56.000000000 +0300
+++ cmem.pas	2021-04-14 16:29:32.155193480 +0300
@@ -25,131 +25,118 @@
 
 {$if defined(win32)}
   LibName = 'msvcrt';
+  MsizeName='_msize';
 {$elseif defined(win64)}
   LibName = 'msvcrt';
+  MsizeName='_msize';
 {$elseif defined(wince)}
   LibName = 'coredll';
+  MsizeName='_msize';
 {$elseif defined(netware)}
   LibName = 'clib';
+  MsizeName='_msize';
 {$elseif defined(netwlibc)}
   LibName = 'libc';
+  MsizeName='malloc_usable_size';
 {$elseif defined(macos)}
   LibName = 'StdCLib';
+  MsizeName='malloc_usable_size';
 {$elseif defined(beos)}
   LibName = 'root';
+  MsizeName='malloc_usable_size';
 {$else}
   LibName = 'c';
+  MsizeName='malloc_usable_size';
 {$endif}
 
 {$ifdef USE_STATIC_LIBC}
   {$linklib c}
-Function malloc (Size : ptruint) : Pointer;cdecl; external;
+Function  malloc (Size : ptruint) : Pointer;cdecl; external;
 Procedure free (P : pointer); cdecl; external;
-function realloc (P : Pointer; Size : ptruint) : pointer;cdecl; external;
-Function calloc (unitSize,UnitCount : ptruint) : pointer;cdecl; external;
+function  realloc (P : Pointer; Size : ptruint) : pointer;cdecl; external;
+Function  calloc (unitSize,UnitCount : ptruint) : pointer;cdecl; external;
+Function  _msize (P : Pointer) : ptruint; cdecl; external;
 {$else not USE_STATIC_LIBC}
-Function Malloc (Size : ptruint) : Pointer; cdecl; external LibName name 'malloc';
+Function  Malloc (Size : ptruint) : Pointer; cdecl; external LibName name 'malloc';
 Procedure Free (P : pointer); cdecl; external LibName name 'free';
-function ReAlloc (P : Pointer; Size : ptruint) : pointer; cdecl; external LibName name 'realloc';
-Function CAlloc (unitSize,UnitCount : ptruint) : pointer; cdecl; external LibName name 'calloc';
+function  ReAlloc (P : Pointer; Size : ptruint) : pointer; cdecl; external LibName name 'realloc';
+Function  CAlloc (unitSize,UnitCount : ptruint) : pointer; cdecl; external LibName name 'calloc';
+Function  _msize (P : Pointer) : ptruint; cdecl; external LibName name MsizeName;
 {$endif not USE_STATIC_LIBC}
 
 implementation
 
+var
+ CurrHeapSize:ptruint=0;
+
+Function CMemSize (p:pointer): ptruint; forward;
+
 Function CGetMem  (Size : ptruint) : Pointer;
 
 begin
-  CGetMem:=Malloc(Size+sizeof(ptruint));
-  if (CGetMem <> nil) then
-    begin
-      Pptruint(CGetMem)^ := size;
-      inc(CGetMem,sizeof(ptruint));
-    end;
+  Result:=Malloc(Size);
+  CurrHeapSize:=CurrHeapSize+CMemSize(Result);
 end;
 
 Function CFreeMem (P : pointer) : ptruint;
 
 begin
-  if (p <> nil) then
-    dec(p,sizeof(ptruint));
+  CurrHeapSize:=CurrHeapSize-CMemSize(p);
   Free(P);
-  CFreeMem:=0;
+  Result:=0;
 end;
 
 Function CFreeMemSize(p:pointer;Size:ptruint):ptruint;
 
 begin
+  Result:=0;
   if size<=0 then
     exit;
   if (p <> nil) then
     begin
-      if (size <> Pptruint(p-sizeof(ptruint))^) then
+      if (size > CMemSize(p)) then
         runerror(204);
     end;
-  CFreeMemSize:=CFreeMem(P);
+  Result:=CFreeMem(P);
 end;
 
 Function CAllocMem(Size : ptruint) : Pointer;
 
 begin
-  CAllocMem:=calloc(Size+sizeof(ptruint),1);
-  if (CAllocMem <> nil) then
-    begin
-      Pptruint(CAllocMem)^ := size;
-      inc(CAllocMem,sizeof(ptruint));
-    end;
+  Result:=calloc(Size,1);
+  CurrHeapSize:=CurrHeapSize+CMemSize(Result);
 end;
 
 Function CReAllocMem (var p:pointer;Size:ptruint):Pointer;
 
 begin
-  if size=0 then
-    begin
-      if p<>nil then
-        begin
-          dec(p,sizeof(ptruint));
-          free(p);
-          p:=nil;
-        end;
-    end
-  else
-    begin
-      inc(size,sizeof(ptruint));
-      if p=nil then
-        p:=malloc(Size)
-      else
-        begin
-          dec(p,sizeof(ptruint));
-          p:=realloc(p,size);
-        end;
-      if (p <> nil) then
-        begin
-          Pptruint(p)^ := size-sizeof(ptruint);
-          inc(p,sizeof(ptruint));
-        end;
-    end;
-  CReAllocMem:=p;
+ CurrHeapSize:=CurrHeapSize-CMemSize(p);
+ p:=ReAlloc(P,Size);
+ Result:=p;
+ CurrHeapSize:=CurrHeapSize+CMemSize(p);
 end;
 
 Function CMemSize (p:pointer): ptruint;
 
 begin
-  CMemSize:=Pptruint(p-sizeof(ptruint))^;
+ Result:=0;
+ if (P=nil) then Exit;
+ Result:=_msize(P);
 end;
 
 function CGetHeapStatus:THeapStatus;
-
-var res: THeapStatus;
-
 begin
-  fillchar(res,sizeof(res),0);
-  CGetHeapStatus:=res;
+  Result:=Default(THeapStatus);
+  Result.TotalAddrSpace:=CurrHeapSize;
+  Result.TotalCommitted:=CurrHeapSize;
+  Result.TotalAllocated:=CurrHeapSize;
 end;
 
 function CGetFPCHeapStatus:TFPCHeapStatus;
-
 begin
-  fillchar(CGetFPCHeapStatus,sizeof(CGetFPCHeapStatus),0);
+ Result:=Default(TFPCHeapStatus);
+ Result.CurrHeapSize:=CurrHeapSize;
+ Result.CurrHeapUsed:=CurrHeapSize;
 end;
 
 Const
@@ -178,4 +165,4 @@
 
 Finalization
   SetMemoryManager (OldMemoryManager);
-end.
\ В конце файла нет новой строки
+end.
cmem.patch (5,071 bytes)   

Sven Barth

2021-04-15 09:49

manager   ~0130388

Thank you for the patch.

I have the following remarks:

- please leave out the cosmetic changes of the declarations
- did you check whether the MsizeName is indeed correct for those OSes, especially the more "exotic" ones? Are there version restrictions? (e.g. macOS)
- also it might be better to retain the current code with ifdefs for OSes where the C library does not provide a way to query the size (you could simply check for {$if declared(MsizeName)} and not declare it for such platforms)
- the static case might now fail on Linux, so you'll need to use external name MsizeName there instead of just external
- which platforms did you test?

Pavel

2021-04-15 11:56

reporter   ~0130390

1) ok
2) i find proc name for win, wince, netware, macos, linux.
 I did not check the OS version restrictions it need to test.
3) maybe. Seems to by the code, static compilation is used in defined (go32v2) or defined (wii).
4) yes. But I can’t imagine for which Linux platforms it can be useful.
5) win64, linux64 (gui application)

Sven Barth

2021-04-15 13:38

manager   ~0130392

2) I doubt that Windows and Windows CE will be problems, cause their MSVCRT should have that for a long time. I don't know whether Netware works right now at all. macOS would be interesting as we still support the PowerPC based Mac OS X as well. Linux might probably have that function for eternity as well... Other question is whether e.g. go32v2 or Wii or BeOS really have that function...
3) Better leave it in then with ifdefs.
4) Ah, right, hadn't noticed that the static case is only defined for go32v2 and Wii. But do these provide _msize or malloc_usable_size? To be safe, use external name MsizeName nevertheless, cause this way it can be easily adjusted if need be.
5) Okay, so I'll try at least on Mac OS X 10.4 on PowerPC and Windows CE cause I have those available.

Pavel

2021-04-15 14:29

reporter   ~0130393

Will probably have to leave backward compatibility for exotic platforms and static compilation. Another question that worries me is whether to read directly somewhere in a different code is the size of memory bypassing the MemSize function.

Issue History

Date Modified Username Field Change
2021-04-13 13:44 Pavel New Issue
2021-04-13 13:44 Pavel File Added: cmem.pas
2021-04-14 09:17 Sven Barth Assigned To => Sven Barth
2021-04-14 09:17 Sven Barth Status new => feedback
2021-04-14 09:17 Sven Barth FPCTarget => -
2021-04-14 09:17 Sven Barth Note Added: 0130368
2021-04-14 15:30 Pavel Note Added: 0130374
2021-04-14 15:30 Pavel File Added: cmem.patch
2021-04-14 15:30 Pavel Status feedback => assigned
2021-04-15 09:49 Sven Barth Status assigned => feedback
2021-04-15 09:49 Sven Barth Note Added: 0130388
2021-04-15 11:56 Pavel Note Added: 0130390
2021-04-15 11:56 Pavel Status feedback => assigned
2021-04-15 13:38 Sven Barth Note Added: 0130392
2021-04-15 14:29 Pavel Note Added: 0130393