paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-17 06:39:34 +02:00
Code Issues Packages Projects Releases Wiki Activity

* adaption to compile with 1.0.x in new rtl

Browse Source
This commit is contained in:
peter 2004-03-16 15:25:16 +00:00
parent ac2371b771
commit 4f32f8ca93
1 changed files with 33 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

67
rtl/inc/cmem.pp
View File

@ -16,8 +16,6 @@
**********************************************************************} **********************************************************************}
unit cmem; unit cmem;
{$mode objfpc}
interface interface
Const Const
@ -44,24 +42,24 @@ type
Function CGetMem (Size : ptrint) : Pointer; Function CGetMem (Size : ptrint) : Pointer;
begin begin
result:=Malloc(Size+sizeof(ptrint)); CGetMem:=Malloc(Size+sizeof(ptrint));
if (result <> nil) then if (CGetMem <> nil) then
begin begin
pptrint(result)^ := size; pptrint(CGetMem)^ := size;
inc(result,sizeof(ptrint)); inc(CGetMem,sizeof(ptrint));
end; end;
end; end;
Function CFreeMem ({$ifdef VER1_0}var{$endif} P : pointer) : ptrint; Function CFreeMem (P : pointer) : ptrint;
begin begin
if (p <> nil) then if (p <> nil) then
dec(p,sizeof(ptrint)); dec(p,sizeof(ptrint));
Free(P); Free(P);
Result:=0; CFreeMem:=0;
end; end;
Function CFreeMemSize({$ifdef VER1_0}var{$endif} p:pointer;Size:ptrint):ptrint; Function CFreeMemSize(p:pointer;Size:ptrint):ptrint;
begin begin
if (p <> nil) then if (p <> nil) then
@ -69,17 +67,17 @@ begin
if (size <> pptrint(p-sizeof(ptrint))^) then if (size <> pptrint(p-sizeof(ptrint))^) then
runerror(204); runerror(204);
end; end;
Result:=CFreeMem(P); CFreeMemSize:=CFreeMem(P);
end; end;
Function CAllocMem(Size : ptrint) : Pointer; Function CAllocMem(Size : ptrint) : Pointer;
begin begin
Result:=calloc(Size+sizeof(ptrint),1); CAllocMem:=calloc(Size+sizeof(ptrint),1);
if (result <> nil) then if (CAllocMem <> nil) then
begin begin
pptrint(result)^ := size; pptrint(CAllocMem)^ := size;
inc(result,sizeof(ptrint)); inc(CAllocMem,sizeof(ptrint));
end; end;
end; end;
@ -92,7 +90,7 @@ begin
begin begin
free(p); free(p);
p:=nil; p:=nil;
end; end;
end end
else else
begin begin
@ -103,56 +101,54 @@ begin
begin begin
dec(p,sizeof(ptrint)); dec(p,sizeof(ptrint));
p:=realloc(p,size); p:=realloc(p,size);
end; end;
if (p <> nil) then if (p <> nil) then
begin begin
pptrint(p)^ := size-sizeof(ptrint); pptrint(p)^ := size-sizeof(ptrint);
inc(p,sizeof(ptrint)); inc(p,sizeof(ptrint));
end; end;
end; end;
Result:=p; CReAllocMem:=p;
end; end;
Function CMemSize (p:pointer): ptrint; Function CMemSize (p:pointer): ptrint;
begin begin
Result:=pptrint(p-sizeof(ptrint))^; CMemSize:=pptrint(p-sizeof(ptrint))^;
end; end;
Function CMemAvail : ptrint; Function CMemAvail : ptrint;
begin begin
Result:=0; CMemAvail:=0;
end; end;
Function CMaxAvail: ptrint; Function CMaxAvail: ptrint;
begin begin
Result:=0; CMaxAvail:=0;
end; end;
Function CHeapSize : ptrint; Function CHeapSize : ptrint;
begin begin
Result:=0; CHeapSize:=0;
end; end;
Const Const
CMemoryManager : TMemoryManager = CMemoryManager : TMemoryManager =
( (
{$ifndef VER1_0}
NeedLock : false; NeedLock : false;
{$endif VER1_0} GetMem : @CGetmem;
GetMem : {$ifdef fpc}@{$endif}CGetmem; FreeMem : @CFreeMem;
FreeMem : {$ifdef fpc}@{$endif}CFreeMem; FreememSize : @CFreememSize;
FreememSize : {$ifdef fpc}@{$endif}CFreememSize; AllocMem : @CAllocMem;
AllocMem : {$ifdef fpc}@{$endif}CAllocMem; ReallocMem : @CReAllocMem;
ReallocMem : {$ifdef fpc}@{$endif}CReAllocMem; MemSize : @CMemSize;
MemSize : {$ifdef fpc}@{$endif}CMemSize; MemAvail : @CMemAvail;
MemAvail : {$ifdef fpc}@{$endif fpc}CMemAvail; MaxAvail : @MaxAvail;
MaxAvail : {$ifdef fpc}@{$endif}MaxAvail; HeapSize : @CHeapSize;
HeapSize : {$ifdef fpc}@{$endif}CHeapSize;
); );
Var Var
@ -168,7 +164,10 @@ end.
{ {
$Log$ $Log$
Revision 1.1 2004-03-15 21:48:26 peter Revision 1.2 2004-03-16 15:25:16 peter
* adaption to compile with 1.0.x in new rtl
Revision 1.1 2004/03/15 21:48:26 peter
* cmem moved to rtl * cmem moved to rtl
* longint replaced with ptrint in heapmanagers * longint replaced with ptrint in heapmanagers