mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-12 06:46:05 +02:00
* cmem moved to rtl
* longint replaced with ptrint in heapmanagers
This commit is contained in:
parent
afe7a7b69c
commit
abfc396c40
@ -1,5 +1,5 @@
|
||||
#
|
||||
# Don't edit, this file is generated by FPCMake Version 1.1 [2004/01/05]
|
||||
# Don't edit, this file is generated by FPCMake Version 1.1 [2004/03/15]
|
||||
#
|
||||
default: all
|
||||
MAKEFILETARGETS=linux go32v2 win32 os2 freebsd beos netbsd amiga atari sunos qnx netware openbsd wdosx palmos macos darwin emx watcom
|
||||
@ -185,11 +185,14 @@ override FPCDIR:=$(FPCDIR)/..
|
||||
ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
|
||||
override FPCDIR:=$(FPCDIR)/..
|
||||
ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
|
||||
override FPCDIR:=$(BASEDIR)
|
||||
ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
|
||||
override FPCDIR=c:/pp
|
||||
endif
|
||||
endif
|
||||
endif
|
||||
endif
|
||||
endif
|
||||
ifndef CROSSDIR
|
||||
CROSSDIR:=$(FPCDIR)/cross/$(FULL_TARGET)
|
||||
endif
|
||||
@ -229,7 +232,7 @@ GRAPHDIR=$(INC)/graph
|
||||
ifndef USELIBGGI
|
||||
USELIBGGI=NO
|
||||
endif
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings sysctl baseunix unixtype unixutil unix initc dos dl objects printer sysutils typinfo systhrds classes math varutils charset ucomplex getopts heaptrc lineinfo errors terminfo termio video crt mouse keyboard console variants types sysctl dateutils sysconst cthreads strutils rtlconst
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings sysctl baseunix unixtype unixutil unix initc cmem dos dl objects printer sysutils typinfo systhrds classes math varutils charset ucomplex getopts heaptrc lineinfo errors terminfo termio video crt mouse keyboard console variants types sysctl dateutils sysconst cthreads strutils rtlconst
|
||||
override TARGET_RSTS+=math varutils typinfo classes variants dateutils systhrds sysconst rtlconst
|
||||
override INSTALL_FPCPACKAGE=y
|
||||
override COMPILER_INCLUDEDIR+=$(INC) $(PROCINC) $(UNIXINC) $(BSDINC) $(BSDPROCINC) $(OSPROCINC)
|
||||
@ -544,7 +547,8 @@ ZIPSUFFIX=nw
|
||||
endif
|
||||
ifeq ($(OS_TARGET),macos)
|
||||
EXEEXT=
|
||||
FPCMADE=fpcmade.mcc
|
||||
FPCMADE=fpcmade.macos
|
||||
ZIPSUFFIX=macos
|
||||
endif
|
||||
ifeq ($(OS_TARGET),darwin)
|
||||
EXEEXT=
|
||||
@ -843,9 +847,11 @@ ARNAME=$(BINUTILSPREFIX)ar
|
||||
RCNAME=$(BINUTILSPREFIX)rc
|
||||
ifneq ($(findstring 1.0.,$(FPC_VERSION)),)
|
||||
ifeq ($(OS_TARGET),win32)
|
||||
ASNAME=as
|
||||
LDNAME=ld
|
||||
ARNAME=ar
|
||||
ifeq ($(CROSSBINDIR),)
|
||||
ASNAME=asw
|
||||
LDNAME=ldw
|
||||
ARNAME=arw
|
||||
endif
|
||||
endif
|
||||
endif
|
||||
ifndef ASPROG
|
||||
@ -1393,5 +1399,6 @@ errors$(PPUEXT) : $(UNIXINC)/errors.pp strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
|
||||
ipc$(PPUEXT) : $(UNIXINC)/ipc.pp unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
|
||||
terminfo$(PPUEXT) : terminfo.pp unix$(PPUEXT)
|
||||
callspec$(PPUEXT) : $(INC)/callspec.pp $(SYSTEMUNIT)$(PPUEXT)
|
||||
cmem$(PPUEXT) : $(INC)/cmem.pp $(SYSTEMUNIT)$(PPUEXT)
|
||||
sysctl$(PPUEXT) : $(BSDINC)/sysctl.pp $(SYSTEMUNIT)$(PPUEXT)
|
||||
cthreads$(PPUEXT) : $(UNIXINC)/cthreads.pp systhrds$(PPUEXT)
|
||||
|
@ -9,7 +9,7 @@ main=rtl
|
||||
[target]
|
||||
loaders=
|
||||
units=$(SYSTEMUNIT) objpas strings sysctl baseunix unixtype unixutil \
|
||||
unix initc \
|
||||
unix initc cmem \
|
||||
dos dl objects printer \
|
||||
sysutils typinfo systhrds classes math varutils \
|
||||
charset ucomplex getopts heaptrc lineinfo \
|
||||
@ -230,6 +230,7 @@ terminfo$(PPUEXT) : terminfo.pp unix$(PPUEXT)
|
||||
|
||||
callspec$(PPUEXT) : $(INC)/callspec.pp $(SYSTEMUNIT)$(PPUEXT)
|
||||
|
||||
cmem$(PPUEXT) : $(INC)/cmem.pp $(SYSTEMUNIT)$(PPUEXT)
|
||||
|
||||
sysctl$(PPUEXT) : $(BSDINC)/sysctl.pp $(SYSTEMUNIT)$(PPUEXT)
|
||||
|
||||
|
@ -1,5 +1,5 @@
|
||||
#
|
||||
# Don't edit, this file is generated by FPCMake Version 1.1 [2004/01/05]
|
||||
# Don't edit, this file is generated by FPCMake Version 1.1 [2004/03/15]
|
||||
#
|
||||
default: all
|
||||
MAKEFILETARGETS=linux go32v2 win32 os2 freebsd beos netbsd amiga atari sunos qnx netware openbsd wdosx palmos macos darwin emx watcom
|
||||
@ -185,11 +185,14 @@ override FPCDIR:=$(FPCDIR)/..
|
||||
ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
|
||||
override FPCDIR:=$(FPCDIR)/..
|
||||
ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
|
||||
override FPCDIR:=$(BASEDIR)
|
||||
ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
|
||||
override FPCDIR=c:/pp
|
||||
endif
|
||||
endif
|
||||
endif
|
||||
endif
|
||||
endif
|
||||
ifndef CROSSDIR
|
||||
CROSSDIR:=$(FPCDIR)/cross/$(FULL_TARGET)
|
||||
endif
|
||||
@ -232,7 +235,7 @@ GRAPHDIR=$(INC)/graph
|
||||
ifndef USELIBGGI
|
||||
USELIBGGI=NO
|
||||
endif
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings syscall sysctl unixtype baseunix unixutil unix rtlconst initc dos dl termio objects printer sysutils typinfo systhrds types classes math varutils cpu mmx charset ucomplex crt getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard console serial variants sysctl dateutils sysconst cthreads
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings syscall sysctl unixtype baseunix unixutil unix rtlconst initc cmem dos dl termio objects printer sysutils typinfo systhrds types classes math varutils cpu mmx charset ucomplex crt getopts heaptrc lineinfo errors sockets gpm ipc terminfo video mouse keyboard console serial variants sysctl dateutils sysconst cthreads
|
||||
override TARGET_LOADERS+=prt0 cprt0 gprt0
|
||||
override TARGET_RSTS+=math varutils typinfo classes variants dateutils sysconst
|
||||
override INSTALL_FPCPACKAGE=y y
|
||||
@ -548,7 +551,8 @@ ZIPSUFFIX=nw
|
||||
endif
|
||||
ifeq ($(OS_TARGET),macos)
|
||||
EXEEXT=
|
||||
FPCMADE=fpcmade.mcc
|
||||
FPCMADE=fpcmade.macos
|
||||
ZIPSUFFIX=macos
|
||||
endif
|
||||
ifeq ($(OS_TARGET),darwin)
|
||||
EXEEXT=
|
||||
@ -847,9 +851,11 @@ ARNAME=$(BINUTILSPREFIX)ar
|
||||
RCNAME=$(BINUTILSPREFIX)rc
|
||||
ifneq ($(findstring 1.0.,$(FPC_VERSION)),)
|
||||
ifeq ($(OS_TARGET),win32)
|
||||
ASNAME=as
|
||||
LDNAME=ld
|
||||
ARNAME=ar
|
||||
ifeq ($(CROSSBINDIR),)
|
||||
ASNAME=asw
|
||||
LDNAME=ldw
|
||||
ARNAME=arw
|
||||
endif
|
||||
endif
|
||||
endif
|
||||
ifndef ASPROG
|
||||
@ -1415,5 +1421,6 @@ errors$(PPUEXT) : $(UNIXINC)/errors.pp strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
|
||||
ipc$(PPUEXT) : $(UNIXINC)/ipc.pp unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
|
||||
terminfo$(PPUEXT) : terminfo.pp unix$(PPUEXT)
|
||||
callspec$(PPUEXT) : $(INC)/callspec.pp $(SYSTEMUNIT)$(PPUEXT)
|
||||
cmem$(PPUEXT) : $(INC)/cmem.pp $(SYSTEMUNIT)$(PPUEXT)
|
||||
sysctl$(PPUEXT) : $(BSDINC)/sysctl.pp $(SYSTEMUNIT)$(PPUEXT)
|
||||
cthreads$(PPUEXT) : $(UNIXINC)/cthreads.pp systhrds$(PPUEXT)
|
||||
|
@ -11,7 +11,7 @@ fpcpackage=y
|
||||
[target]
|
||||
loaders=prt0 cprt0 gprt0
|
||||
units=$(SYSTEMUNIT) objpas strings syscall sysctl unixtype baseunix unixutil \
|
||||
unix rtlconst initc \
|
||||
unix rtlconst initc cmem \
|
||||
dos dl termio objects printer \
|
||||
sysutils typinfo systhrds types classes math varutils \
|
||||
cpu mmx charset ucomplex crt getopts heaptrc lineinfo \
|
||||
@ -241,6 +241,7 @@ terminfo$(PPUEXT) : terminfo.pp unix$(PPUEXT)
|
||||
|
||||
callspec$(PPUEXT) : $(INC)/callspec.pp $(SYSTEMUNIT)$(PPUEXT)
|
||||
|
||||
cmem$(PPUEXT) : $(INC)/cmem.pp $(SYSTEMUNIT)$(PPUEXT)
|
||||
|
||||
sysctl$(PPUEXT) : $(BSDINC)/sysctl.pp $(SYSTEMUNIT)$(PPUEXT)
|
||||
|
||||
|
202
rtl/inc/cmem.pp
Normal file
202
rtl/inc/cmem.pp
Normal file
@ -0,0 +1,202 @@
|
||||
{
|
||||
$Id$
|
||||
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;
|
||||
|
||||
{$mode objfpc}
|
||||
|
||||
interface
|
||||
|
||||
Const
|
||||
{$ifndef win32}
|
||||
{$ifdef netware}
|
||||
LibName = 'clib';
|
||||
{$else}
|
||||
LibName = 'c';
|
||||
{$endif}
|
||||
{$else}
|
||||
LibName = 'msvcrt';
|
||||
{$endif}
|
||||
|
||||
Function Malloc (Size : ptrint) : Pointer; {$ifdef win32}stdcall{$else}cdecl{$endif}; external LibName name 'malloc';
|
||||
Procedure Free (P : pointer); {$ifdef win32}stdcall{$else}cdecl{$endif}; external LibName name 'free';
|
||||
function ReAlloc (P : Pointer; Size : ptrint) : pointer; {$ifdef win32}stdcall{$else}cdecl{$endif}; external LibName name 'realloc';
|
||||
Function CAlloc (unitSize,UnitCount : ptrint) : pointer; {$ifdef win32}stdcall{$else}cdecl{$endif}; external LibName name 'calloc';
|
||||
|
||||
implementation
|
||||
|
||||
type
|
||||
pptrint = ^ptrint;
|
||||
|
||||
Function CGetMem (Size : ptrint) : Pointer;
|
||||
|
||||
begin
|
||||
result:=Malloc(Size+sizeof(ptrint));
|
||||
if (result <> nil) then
|
||||
begin
|
||||
pptrint(result)^ := size;
|
||||
inc(result,sizeof(ptrint));
|
||||
end;
|
||||
end;
|
||||
|
||||
Function CFreeMem ({$ifdef VER1_0}var{$endif} P : pointer) : ptrint;
|
||||
|
||||
begin
|
||||
if (p <> nil) then
|
||||
dec(p,sizeof(ptrint));
|
||||
Free(P);
|
||||
Result:=0;
|
||||
end;
|
||||
|
||||
Function CFreeMemSize({$ifdef VER1_0}var{$endif} p:pointer;Size:ptrint):ptrint;
|
||||
|
||||
begin
|
||||
if (p <> nil) then
|
||||
begin
|
||||
if (size <> pptrint(p-sizeof(ptrint))^) then
|
||||
runerror(204);
|
||||
end;
|
||||
Result:=CFreeMem(P);
|
||||
end;
|
||||
|
||||
Function CAllocMem(Size : ptrint) : Pointer;
|
||||
|
||||
begin
|
||||
Result:=calloc(Size+sizeof(ptrint),1);
|
||||
if (result <> nil) then
|
||||
begin
|
||||
pptrint(result)^ := size;
|
||||
inc(result,sizeof(ptrint));
|
||||
end;
|
||||
end;
|
||||
|
||||
Function CReAllocMem (var p:pointer;Size:ptrint):Pointer;
|
||||
|
||||
begin
|
||||
if size=0 then
|
||||
begin
|
||||
if p<>nil then
|
||||
begin
|
||||
free(p);
|
||||
p:=nil;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
inc(size,sizeof(ptrint));
|
||||
if p=nil then
|
||||
p:=calloc(Size,1)
|
||||
else
|
||||
begin
|
||||
dec(p,sizeof(ptrint));
|
||||
p:=realloc(p,size);
|
||||
end;
|
||||
if (p <> nil) then
|
||||
begin
|
||||
pptrint(p)^ := size-sizeof(ptrint);
|
||||
inc(p,sizeof(ptrint));
|
||||
end;
|
||||
end;
|
||||
Result:=p;
|
||||
end;
|
||||
|
||||
Function CMemSize (p:pointer): ptrint;
|
||||
|
||||
begin
|
||||
Result:=pptrint(p-sizeof(ptrint))^;
|
||||
end;
|
||||
|
||||
Function CMemAvail : ptrint;
|
||||
|
||||
begin
|
||||
Result:=0;
|
||||
end;
|
||||
|
||||
Function CMaxAvail: ptrint;
|
||||
|
||||
begin
|
||||
Result:=0;
|
||||
end;
|
||||
|
||||
Function CHeapSize : ptrint;
|
||||
|
||||
begin
|
||||
Result:=0;
|
||||
end;
|
||||
|
||||
|
||||
Const
|
||||
CMemoryManager : TMemoryManager =
|
||||
(
|
||||
{$ifndef VER1_0}
|
||||
NeedLock : false;
|
||||
{$endif VER1_0}
|
||||
GetMem : {$ifdef fpc}@{$endif}CGetmem;
|
||||
FreeMem : {$ifdef fpc}@{$endif}CFreeMem;
|
||||
FreememSize : {$ifdef fpc}@{$endif}CFreememSize;
|
||||
AllocMem : {$ifdef fpc}@{$endif}CAllocMem;
|
||||
ReallocMem : {$ifdef fpc}@{$endif}CReAllocMem;
|
||||
MemSize : {$ifdef fpc}@{$endif}CMemSize;
|
||||
MemAvail : {$ifdef fpc}@{$endif fpc}CMemAvail;
|
||||
MaxAvail : {$ifdef fpc}@{$endif}MaxAvail;
|
||||
HeapSize : {$ifdef fpc}@{$endif}CHeapSize;
|
||||
);
|
||||
|
||||
Var
|
||||
OldMemoryManager : TMemoryManager;
|
||||
|
||||
Initialization
|
||||
GetMemoryManager (OldMemoryManager);
|
||||
SetMemoryManager (CmemoryManager);
|
||||
|
||||
Finalization
|
||||
SetMemoryManager (OldMemoryManager);
|
||||
end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 2004-03-15 21:48:26 peter
|
||||
* cmem moved to rtl
|
||||
* longint replaced with ptrint in heapmanagers
|
||||
|
||||
Revision 1.9 2004/03/12 13:08:08 jonas
|
||||
+ added memsize() support (needed to use cmem with the compiler)
|
||||
|
||||
Revision 1.8 2003/03/17 15:40:05 armin
|
||||
+ LibName for netware
|
||||
|
||||
Revision 1.7 2002/11/01 17:56:39 peter
|
||||
* needlock field added for 1.1
|
||||
|
||||
Revision 1.6 2002/09/08 15:43:47 michael
|
||||
+ Fixed calling conventions
|
||||
|
||||
Revision 1.5 2002/09/07 15:42:54 peter
|
||||
* old logs removed and tabs fixed
|
||||
|
||||
Revision 1.4 2002/07/01 16:24:04 peter
|
||||
* updates for 1.0 compiler
|
||||
|
||||
Revision 1.3 2002/06/13 05:01:44 michael
|
||||
+ Added windows msvcrt support
|
||||
|
||||
Revision 1.2 2002/06/13 04:54:47 michael
|
||||
+ Fixed parameter type mismatch
|
||||
|
||||
Revision 1.1 2002/01/29 17:54:59 peter
|
||||
* splitted to base and extra
|
||||
|
||||
}
|
@ -86,7 +86,7 @@ type
|
||||
ppfreerecord = ^pfreerecord;
|
||||
pfreerecord = ^tfreerecord;
|
||||
tfreerecord = record
|
||||
size : longint;
|
||||
size : ptrint;
|
||||
next,
|
||||
prev : pfreerecord;
|
||||
end; { 12 bytes }
|
||||
@ -94,7 +94,7 @@ type
|
||||
pheaprecord = ^theaprecord;
|
||||
theaprecord = record
|
||||
{ this should overlap with tfreerecord }
|
||||
size : longint;
|
||||
size : ptrint;
|
||||
end; { 4 bytes }
|
||||
|
||||
tfreelists = array[0..maxblock] of pfreerecord;
|
||||
@ -104,8 +104,8 @@ type
|
||||
pfreelists = ^tfreelists;
|
||||
|
||||
var
|
||||
internal_memavail : longint;
|
||||
internal_heapsize : longint;
|
||||
internal_memavail : ptrint;
|
||||
internal_heapsize : ptrint;
|
||||
freelists : tfreelists;
|
||||
before_heapend_block : pfreerecord;
|
||||
{$ifdef SYSTEMDEBUG}
|
||||
@ -189,7 +189,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure GetMem(Var p:pointer;Size:Longint);
|
||||
procedure GetMem(Var p:pointer;Size:ptrint);
|
||||
begin
|
||||
if IsMultiThread and MemoryManager.NeedLock then
|
||||
begin
|
||||
@ -206,12 +206,12 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure GetMemory(Var p:pointer;Size:Longint);
|
||||
procedure GetMemory(Var p:pointer;Size:ptrint);
|
||||
begin
|
||||
GetMem(p,size);
|
||||
end;
|
||||
|
||||
procedure FreeMem(p:pointer;Size:Longint);
|
||||
procedure FreeMem(p:pointer;Size:ptrint);
|
||||
begin
|
||||
if IsMultiThread and MemoryManager.NeedLock then
|
||||
begin
|
||||
@ -228,12 +228,12 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure FreeMemory(p:pointer;Size:Longint);
|
||||
procedure FreeMemory(p:pointer;Size:ptrint);
|
||||
begin
|
||||
FreeMem(p,size);
|
||||
end;
|
||||
|
||||
function MaxAvail:Longint;
|
||||
function MaxAvail:ptrint;
|
||||
begin
|
||||
if IsMultiThread and MemoryManager.NeedLock then
|
||||
begin
|
||||
@ -251,7 +251,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
function MemAvail:Longint;
|
||||
function MemAvail:ptrint;
|
||||
begin
|
||||
if IsMultiThread and MemoryManager.NeedLock then
|
||||
begin
|
||||
@ -270,7 +270,7 @@ end;
|
||||
|
||||
|
||||
{ FPC Additions }
|
||||
function HeapSize:Longint;
|
||||
function HeapSize:ptrint;
|
||||
begin
|
||||
if IsMultiThread and MemoryManager.NeedLock then
|
||||
begin
|
||||
@ -288,7 +288,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
function MemSize(p:pointer):Longint;
|
||||
function MemSize(p:pointer):ptrint;
|
||||
begin
|
||||
if IsMultiThread and MemoryManager.NeedLock then
|
||||
begin
|
||||
@ -307,7 +307,7 @@ end;
|
||||
|
||||
|
||||
{ Delphi style }
|
||||
function FreeMem(p:pointer):Longint;
|
||||
function FreeMem(p:pointer):ptrint;
|
||||
begin
|
||||
if IsMultiThread and MemoryManager.NeedLock then
|
||||
begin
|
||||
@ -324,13 +324,13 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function FreeMemory(p:pointer):Longint;
|
||||
function FreeMemory(p:pointer):ptrint;
|
||||
|
||||
begin
|
||||
FreeMemory:=FreeMem(p);
|
||||
end;
|
||||
|
||||
function GetMem(size:longint):pointer;
|
||||
function GetMem(size:ptrint):pointer;
|
||||
begin
|
||||
if IsMultiThread and MemoryManager.NeedLock then
|
||||
begin
|
||||
@ -347,13 +347,13 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function GetMemory(size:longint):pointer;
|
||||
function GetMemory(size:ptrint):pointer;
|
||||
|
||||
begin
|
||||
GetMemory:=Getmem(size);
|
||||
end;
|
||||
|
||||
function AllocMem(Size:Longint):pointer;
|
||||
function AllocMem(Size:ptrint):pointer;
|
||||
begin
|
||||
if IsMultiThread and MemoryManager.NeedLock then
|
||||
begin
|
||||
@ -371,7 +371,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
function ReAllocMem(var p:pointer;Size:Longint):pointer;
|
||||
function ReAllocMem(var p:pointer;Size:ptrint):pointer;
|
||||
begin
|
||||
if IsMultiThread and MemoryManager.NeedLock then
|
||||
begin
|
||||
@ -389,7 +389,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
function ReAllocMemory(var p:pointer;Size:Longint):pointer;
|
||||
function ReAllocMemory(var p:pointer;Size:ptrint):pointer;
|
||||
|
||||
begin
|
||||
ReAllocMemory:=ReAllocMem(p,size);
|
||||
@ -398,7 +398,7 @@ end;
|
||||
{$ifdef ValueGetmem}
|
||||
|
||||
{ Needed for calls from Assembler }
|
||||
function fpc_getmem(size:longint):pointer;compilerproc;[public,alias:'FPC_GETMEM'];
|
||||
function fpc_getmem(size:ptrint):pointer;compilerproc;[public,alias:'FPC_GETMEM'];
|
||||
begin
|
||||
if IsMultiThread and MemoryManager.NeedLock then
|
||||
begin
|
||||
@ -418,7 +418,7 @@ end;
|
||||
{$else ValueGetmem}
|
||||
|
||||
{ Needed for calls from Assembler }
|
||||
procedure AsmGetMem(var p:pointer;size:longint);[public,alias:'FPC_GETMEM'];
|
||||
procedure AsmGetMem(var p:pointer;size:ptrint);[public,alias:'FPC_GETMEM'];
|
||||
begin
|
||||
p:=MemoryManager.GetMem(size);
|
||||
end;
|
||||
@ -461,19 +461,19 @@ end;
|
||||
Heapsize,Memavail,MaxAvail
|
||||
*****************************************************************************}
|
||||
|
||||
function SysHeapsize : longint;
|
||||
function SysHeapsize : ptrint;
|
||||
begin
|
||||
Sysheapsize:=internal_heapsize;
|
||||
end;
|
||||
|
||||
|
||||
function SysMemavail : longint;
|
||||
function SysMemavail : ptrint;
|
||||
begin
|
||||
Sysmemavail:=internal_memavail;
|
||||
end;
|
||||
|
||||
|
||||
function SysMaxavail : longint;
|
||||
function SysMaxavail : ptrint;
|
||||
var
|
||||
hp : pfreerecord;
|
||||
begin
|
||||
@ -491,7 +491,7 @@ end;
|
||||
{$ifdef DUMPBLOCKS}
|
||||
procedure DumpBlocks;
|
||||
var
|
||||
s,i,j : longint;
|
||||
s,i,j : ptrint;
|
||||
hp : pfreerecord;
|
||||
begin
|
||||
for i:=1 to maxblock do
|
||||
@ -524,7 +524,7 @@ end;
|
||||
{$ifdef TestFreeLists}
|
||||
procedure TestFreeLists;
|
||||
var
|
||||
i,j : longint;
|
||||
i,j : ptrint;
|
||||
hp : pfreerecord;
|
||||
begin
|
||||
for i:=0 to maxblock do
|
||||
@ -553,7 +553,7 @@ end;
|
||||
procedure TryConcatFreeRecord(pcurr:pfreerecord);
|
||||
var
|
||||
hp : pfreerecord;
|
||||
pcurrsize,s1 : longint;
|
||||
pcurrsize,s1 : ptrint;
|
||||
begin
|
||||
pcurrsize:=pcurr^.size and sizemask;
|
||||
hp:=pcurr;
|
||||
@ -621,14 +621,14 @@ end;
|
||||
SysGetMem
|
||||
*****************************************************************************}
|
||||
|
||||
function SysGetMem(size : longint):pointer;
|
||||
function SysGetMem(size : ptrint):pointer;
|
||||
type
|
||||
heaperrorproc=function(size:longint):integer;
|
||||
heaperrorproc=function(size:ptrint):integer;
|
||||
var
|
||||
proc : heaperrorproc;
|
||||
pcurr : pfreerecord;
|
||||
s,s1,maxs1,
|
||||
sizeleft : longint;
|
||||
sizeleft : ptrint;
|
||||
again : boolean;
|
||||
{$ifdef BESTMATCH}
|
||||
pbest : pfreerecord;
|
||||
@ -867,9 +867,9 @@ end;
|
||||
SysFreeMem
|
||||
*****************************************************************************}
|
||||
|
||||
Function SysFreeMem(p : pointer):Longint;
|
||||
Function SysFreeMem(p : pointer):ptrint;
|
||||
var
|
||||
pcurrsize,s : longint;
|
||||
pcurrsize,s : ptrint;
|
||||
pcurr : pfreerecord;
|
||||
begin
|
||||
if p=nil then
|
||||
@ -903,9 +903,9 @@ end;
|
||||
SysFreeMemSize
|
||||
*****************************************************************************}
|
||||
|
||||
Function SysFreeMemSize(p : pointer;size : longint):longint;
|
||||
Function SysFreeMemSize(p : pointer;size : ptrint):ptrint;
|
||||
var
|
||||
pcurrsize,s : longint;
|
||||
pcurrsize,s : ptrint;
|
||||
pcurr : pfreerecord;
|
||||
begin
|
||||
SysFreeMemSize:=0;
|
||||
@ -951,7 +951,7 @@ end;
|
||||
SysMemSize
|
||||
*****************************************************************************}
|
||||
|
||||
function SysMemSize(p:pointer):longint;
|
||||
function SysMemSize(p:pointer):ptrint;
|
||||
begin
|
||||
SysMemSize:=(pheaprecord(pointer(p)-sizeof(theaprecord))^.size and sizemask)-sizeof(theaprecord);
|
||||
end;
|
||||
@ -961,7 +961,7 @@ end;
|
||||
SysAllocMem
|
||||
*****************************************************************************}
|
||||
|
||||
function SysAllocMem(size : longint):pointer;
|
||||
function SysAllocMem(size : ptrint):pointer;
|
||||
begin
|
||||
sysallocmem:=MemoryManager.GetMem(size);
|
||||
if sysallocmem<>nil then
|
||||
@ -973,13 +973,13 @@ end;
|
||||
SysResizeMem
|
||||
*****************************************************************************}
|
||||
|
||||
function SysTryResizeMem(var p:pointer;size : longint):boolean;
|
||||
function SysTryResizeMem(var p:pointer;size : ptrint):boolean;
|
||||
var
|
||||
oldsize,
|
||||
currsize,
|
||||
foundsize,
|
||||
sizeleft,
|
||||
s : longint;
|
||||
s : ptrint;
|
||||
wasbeforeheapend : boolean;
|
||||
hp,
|
||||
pnew,
|
||||
@ -1135,9 +1135,9 @@ end;
|
||||
SysResizeMem
|
||||
*****************************************************************************}
|
||||
|
||||
function SysReAllocMem(var p:pointer;size : longint):pointer;
|
||||
function SysReAllocMem(var p:pointer;size : ptrint):pointer;
|
||||
var
|
||||
oldsize : longint;
|
||||
oldsize : ptrint;
|
||||
p2 : pointer;
|
||||
begin
|
||||
{ Free block? }
|
||||
@ -1334,7 +1334,11 @@ end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.27 2004-03-15 20:42:39 peter
|
||||
Revision 1.28 2004-03-15 21:48:26 peter
|
||||
* cmem moved to rtl
|
||||
* longint replaced with ptrint in heapmanagers
|
||||
|
||||
Revision 1.27 2004/03/15 20:42:39 peter
|
||||
* exit with rte 204 instead of looping infinite when a heap record
|
||||
size is overwritten with 0
|
||||
|
||||
|
@ -19,15 +19,15 @@ type
|
||||
PMemoryManager = ^TMemoryManager;
|
||||
TMemoryManager = record
|
||||
NeedLock : boolean;
|
||||
Getmem : Function(Size:Longint):Pointer;
|
||||
Freemem : Function(p:pointer):Longint;
|
||||
FreememSize : Function(p:pointer;Size:Longint):Longint;
|
||||
AllocMem : Function(Size:longint):Pointer;
|
||||
ReAllocMem : Function(var p:pointer;Size:longint):Pointer;
|
||||
MemSize : function(p:pointer):Longint;
|
||||
MemAvail : Function:Longint;
|
||||
MaxAvail : Function:Longint;
|
||||
HeapSize : Function:Longint;
|
||||
Getmem : Function(Size:ptrint):Pointer;
|
||||
Freemem : Function(p:pointer):ptrint;
|
||||
FreememSize : Function(p:pointer;Size:ptrint):ptrint;
|
||||
AllocMem : Function(Size:ptrint):Pointer;
|
||||
ReAllocMem : Function(var p:pointer;Size:ptrint):Pointer;
|
||||
MemSize : function(p:pointer):ptrint;
|
||||
MemAvail : Function:ptrint;
|
||||
MaxAvail : Function:ptrint;
|
||||
HeapSize : Function:ptrint;
|
||||
end;
|
||||
TMemoryMutexManager = record
|
||||
MutexInit : procedure;
|
||||
@ -42,44 +42,44 @@ procedure SetMemoryMutexManager(var MutexMgr: TMemoryMutexManager);
|
||||
|
||||
{ Variables }
|
||||
const
|
||||
growheapsize1 : longint=256*1024; { < 256k will grow with 256k }
|
||||
growheapsize2 : longint=1024*1024; { > 256k will grow with 1m }
|
||||
growheapsize1 : ptrint=256*1024; { < 256k will grow with 256k }
|
||||
growheapsize2 : ptrint=1024*1024; { > 256k will grow with 1m }
|
||||
ReturnNilIfGrowHeapFails : boolean = false;
|
||||
var
|
||||
heaporg,heapptr,heapend,heaperror,freelist : pointer;
|
||||
|
||||
{ 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 SysTryResizeMem(var p:pointer;size : longint):boolean;
|
||||
Function SysReAllocMem(var p:pointer;size:longint):Pointer;
|
||||
Function Sysmemavail:Longint;
|
||||
Function Sysmaxavail:Longint;
|
||||
Function Sysheapsize:longint;
|
||||
Function SysGetmem(Size:ptrint):Pointer;
|
||||
Function SysFreemem(p:pointer):ptrint;
|
||||
Function SysFreememSize(p:pointer;Size:ptrint):ptrint;
|
||||
Function SysMemSize(p:pointer):ptrint;
|
||||
Function SysAllocMem(size:ptrint):Pointer;
|
||||
function SysTryResizeMem(var p:pointer;size : ptrint):boolean;
|
||||
Function SysReAllocMem(var p:pointer;size:ptrint):Pointer;
|
||||
Function Sysmemavail:ptrint;
|
||||
Function Sysmaxavail:ptrint;
|
||||
Function Sysheapsize:ptrint;
|
||||
|
||||
{ Tp7 functions }
|
||||
Procedure Getmem(Var p:pointer;Size:Longint);
|
||||
Procedure Getmemory(Var p:pointer;Size:Longint);
|
||||
Procedure Freemem(p:pointer;Size:Longint);
|
||||
Procedure Freememory(p:pointer;Size:Longint);
|
||||
Function memavail:Longint;
|
||||
Function maxavail:Longint;
|
||||
Procedure Getmem(Var p:pointer;Size:ptrint);
|
||||
Procedure Getmemory(Var p:pointer;Size:ptrint);
|
||||
Procedure Freemem(p:pointer;Size:ptrint);
|
||||
Procedure Freememory(p:pointer;Size:ptrint);
|
||||
Function memavail:ptrint;
|
||||
Function maxavail:ptrint;
|
||||
|
||||
{ FPC additions }
|
||||
Function MemSize(p:pointer):Longint;
|
||||
Function heapsize:longint;
|
||||
Function MemSize(p:pointer):ptrint;
|
||||
Function heapsize:ptrint;
|
||||
|
||||
{ Delphi functions }
|
||||
function GetMem(size:longint):pointer;
|
||||
function GetMemory(size:longint):pointer;
|
||||
function Freemem(p:pointer):longint;
|
||||
function Freememory(p:pointer):longint;
|
||||
function AllocMem(Size:Longint):pointer;
|
||||
function ReAllocMem(var p:pointer;Size:Longint):pointer;
|
||||
function ReAllocMemory(var p:pointer;Size:Longint):pointer;
|
||||
function GetMem(size:ptrint):pointer;
|
||||
function GetMemory(size:ptrint):pointer;
|
||||
function Freemem(p:pointer):ptrint;
|
||||
function Freememory(p:pointer):ptrint;
|
||||
function AllocMem(Size:ptrint):pointer;
|
||||
function ReAllocMem(var p:pointer;Size:ptrint):pointer;
|
||||
function ReAllocMemory(var p:pointer;Size:ptrint):pointer;
|
||||
|
||||
{ Do nothing functions, are only here for tp7 compat }
|
||||
Procedure mark(var p : pointer);
|
||||
@ -87,7 +87,7 @@ Procedure release(var p : pointer);
|
||||
|
||||
{$ifndef ValueGetmem}
|
||||
{ Needed to solve overloading problem with call from assembler (PFV) }
|
||||
Procedure AsmGetmem(var p:pointer;size:Longint);
|
||||
Procedure AsmGetmem(var p:pointer;size:ptrint);
|
||||
{$endif ValueGetmem}
|
||||
{$ifndef ValueFreemem}
|
||||
Procedure AsmFreemem(var p:pointer);
|
||||
@ -95,7 +95,11 @@ Procedure AsmFreemem(var p:pointer);
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.7 2003-10-02 14:03:24 marco
|
||||
Revision 1.8 2004-03-15 21:48:26 peter
|
||||
* cmem moved to rtl
|
||||
* longint replaced with ptrint in heapmanagers
|
||||
|
||||
Revision 1.7 2003/10/02 14:03:24 marco
|
||||
* *memORY overloads
|
||||
|
||||
Revision 1.6 2002/10/30 20:39:13 peter
|
||||
|
@ -38,7 +38,7 @@ type
|
||||
|
||||
{ Allows to add info pre memory block, see ppheap.pas of the compiler
|
||||
for example source }
|
||||
procedure SetHeapExtraInfo( size : longint;fillproc : tfillextrainfoproc;displayproc : tdisplayextrainfoproc);
|
||||
procedure SetHeapExtraInfo( size : ptrint;fillproc : tfillextrainfoproc;displayproc : tdisplayextrainfoproc);
|
||||
|
||||
{ Redirection of the output to a file }
|
||||
procedure SetHeapTraceOutput(const name : string);
|
||||
@ -75,14 +75,14 @@ const
|
||||
implementation
|
||||
|
||||
type
|
||||
plongint = ^longint;
|
||||
pptrint = ^ptrint;
|
||||
|
||||
const
|
||||
{ allows to add custom info in heap_mem_info, this is the size that will
|
||||
be allocated for this information }
|
||||
extra_info_size : longint = 0;
|
||||
exact_info_size : longint = 0;
|
||||
EntryMemUsed : longint = 0;
|
||||
extra_info_size : ptrint = 0;
|
||||
exact_info_size : ptrint = 0;
|
||||
EntryMemUsed : ptrint = 0;
|
||||
{ function to fill this info up }
|
||||
fill_extra_info_proc : TFillExtraInfoProc = nil;
|
||||
display_extra_info_proc : TDisplayExtraInfoProc = nil;
|
||||
@ -112,7 +112,7 @@ type
|
||||
theap_mem_info = record
|
||||
previous,
|
||||
next : pheap_mem_info;
|
||||
size : longint;
|
||||
size : ptrint;
|
||||
sig : longword;
|
||||
{$ifdef EXTRA}
|
||||
release_sig : longword;
|
||||
@ -134,11 +134,11 @@ var
|
||||
{$endif EXTRA}
|
||||
heap_mem_root : pheap_mem_info;
|
||||
getmem_cnt,
|
||||
freemem_cnt : longint;
|
||||
freemem_cnt : ptrint;
|
||||
getmem_size,
|
||||
freemem_size : longint;
|
||||
freemem_size : ptrint;
|
||||
getmem8_size,
|
||||
freemem8_size : longint;
|
||||
freemem8_size : ptrint;
|
||||
|
||||
|
||||
{*****************************************************************************
|
||||
@ -166,9 +166,9 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
Function UpdateCrc32(InitCrc:longword;var InBuf;InLen:Longint):longword;
|
||||
Function UpdateCrc32(InitCrc:longword;var InBuf;InLen:ptrint):longword;
|
||||
var
|
||||
i : longint;
|
||||
i : ptrint;
|
||||
p : pchar;
|
||||
begin
|
||||
p:=@InBuf;
|
||||
@ -183,18 +183,18 @@ end;
|
||||
Function calculate_sig(p : pheap_mem_info) : longword;
|
||||
var
|
||||
crc : longword;
|
||||
pl : plongint;
|
||||
pl : pptrint;
|
||||
begin
|
||||
crc:=cardinal($ffffffff);
|
||||
crc:=UpdateCrc32(crc,p^.size,sizeof(longint));
|
||||
crc:=UpdateCrc32(crc,p^.calls,tracesize*sizeof(longint));
|
||||
crc:=UpdateCrc32(crc,p^.size,sizeof(ptrint));
|
||||
crc:=UpdateCrc32(crc,p^.calls,tracesize*sizeof(ptrint));
|
||||
if p^.extra_info_size>0 then
|
||||
crc:=UpdateCrc32(crc,p^.extra_info^,p^.exact_info_size);
|
||||
if add_tail then
|
||||
begin
|
||||
{ Check also 4 bytes just after allocation !! }
|
||||
pl:=pointer(p)+p^.extra_info_size+sizeof(theap_mem_info)+p^.size;
|
||||
crc:=UpdateCrc32(crc,pl^,sizeof(longint));
|
||||
crc:=UpdateCrc32(crc,pl^,sizeof(ptrint));
|
||||
end;
|
||||
calculate_sig:=crc;
|
||||
end;
|
||||
@ -203,11 +203,11 @@ end;
|
||||
Function calculate_release_sig(p : pheap_mem_info) : longword;
|
||||
var
|
||||
crc : longword;
|
||||
pl : plongint;
|
||||
pl : pptrint;
|
||||
begin
|
||||
crc:=$ffffffff;
|
||||
crc:=UpdateCrc32(crc,p^.size,sizeof(longint));
|
||||
crc:=UpdateCrc32(crc,p^.calls,tracesize*sizeof(longint));
|
||||
crc:=UpdateCrc32(crc,p^.size,sizeof(ptrint));
|
||||
crc:=UpdateCrc32(crc,p^.calls,tracesize*sizeof(ptrint));
|
||||
if p^.extra_info_size>0 then
|
||||
crc:=UpdateCrc32(crc,p^.extra_info^,p^.exact_info_size);
|
||||
{ Check the whole of the whole allocation }
|
||||
@ -218,7 +218,7 @@ begin
|
||||
begin
|
||||
{ Check also 4 bytes just after allocation !! }
|
||||
pl:=pointer(p)+p^.extra_info_size+sizeof(theap_mem_info)+p^.size;
|
||||
crc:=UpdateCrc32(crc,pl^,sizeof(longint));
|
||||
crc:=UpdateCrc32(crc,pl^,sizeof(ptrint));
|
||||
end;
|
||||
calculate_release_sig:=crc;
|
||||
end;
|
||||
@ -231,9 +231,9 @@ end;
|
||||
|
||||
procedure call_stack(pp : pheap_mem_info;var ptext : text);
|
||||
var
|
||||
i : longint;
|
||||
i : ptrint;
|
||||
begin
|
||||
writeln(ptext,'Call trace for block $',hexstr(longint(pointer(pp)+sizeof(theap_mem_info)),8),' size ',pp^.size);
|
||||
writeln(ptext,'Call trace for block $',hexstr(ptrint(pointer(pp)+sizeof(theap_mem_info)),8),' size ',pp^.size);
|
||||
for i:=1 to tracesize do
|
||||
if pp^.calls[i]<>nil then
|
||||
writeln(ptext,BackTraceStrFunc(pp^.calls[i]));
|
||||
@ -247,9 +247,9 @@ end;
|
||||
|
||||
procedure call_free_stack(pp : pheap_mem_info;var ptext : text);
|
||||
var
|
||||
i : longint;
|
||||
i : ptrint;
|
||||
begin
|
||||
writeln(ptext,'Call trace for block at $',hexstr(longint(pointer(pp)+sizeof(theap_mem_info)),8),' size ',pp^.size);
|
||||
writeln(ptext,'Call trace for block at $',hexstr(ptrint(pointer(pp)+sizeof(theap_mem_info)),8),' size ',pp^.size);
|
||||
for i:=1 to tracesize div 2 do
|
||||
if pp^.calls[i]<>nil then
|
||||
writeln(ptext,BackTraceStrFunc(pp^.calls[i]));
|
||||
@ -267,7 +267,7 @@ end;
|
||||
|
||||
procedure dump_already_free(p : pheap_mem_info;var ptext : text);
|
||||
begin
|
||||
Writeln(ptext,'Marked memory at $',HexStr(longint(pointer(p)+sizeof(theap_mem_info)),8),' released');
|
||||
Writeln(ptext,'Marked memory at $',HexStr(ptrint(pointer(p)+sizeof(theap_mem_info)),8),' released');
|
||||
call_free_stack(p,ptext);
|
||||
Writeln(ptext,'freed again at');
|
||||
dump_stack(ptext,get_caller_frame(get_frame));
|
||||
@ -275,7 +275,7 @@ end;
|
||||
|
||||
procedure dump_error(p : pheap_mem_info;var ptext : text);
|
||||
begin
|
||||
Writeln(ptext,'Marked memory at $',HexStr(longint(pointer(p)+sizeof(theap_mem_info)),8),' invalid');
|
||||
Writeln(ptext,'Marked memory at $',HexStr(ptrint(pointer(p)+sizeof(theap_mem_info)),8),' invalid');
|
||||
Writeln(ptext,'Wrong signature $',hexstr(p^.sig,8),' instead of ',hexstr(calculate_sig(p),8));
|
||||
dump_stack(ptext,get_caller_frame(get_frame));
|
||||
end;
|
||||
@ -283,9 +283,9 @@ end;
|
||||
{$ifdef EXTRA}
|
||||
procedure dump_change_after(p : pheap_mem_info;var ptext : text);
|
||||
var pp : pchar;
|
||||
i : longint;
|
||||
i : ptrint;
|
||||
begin
|
||||
Writeln(ptext,'Marked memory at $',HexStr(longint(pointer(p)+sizeof(theap_mem_info)),8),' invalid');
|
||||
Writeln(ptext,'Marked memory at $',HexStr(ptrint(pointer(p)+sizeof(theap_mem_info)),8),' invalid');
|
||||
Writeln(ptext,'Wrong release CRC $',hexstr(p^.release_sig,8),' instead of ',hexstr(calculate_release_sig(p),8));
|
||||
Writeln(ptext,'This memory was changed after call to freemem !');
|
||||
call_free_stack(p,ptext);
|
||||
@ -296,9 +296,9 @@ begin
|
||||
end;
|
||||
{$endif EXTRA}
|
||||
|
||||
procedure dump_wrong_size(p : pheap_mem_info;size : longint;var ptext : text);
|
||||
procedure dump_wrong_size(p : pheap_mem_info;size : ptrint;var ptext : text);
|
||||
begin
|
||||
Writeln(ptext,'Marked memory at $',HexStr(longint(pointer(p)+sizeof(theap_mem_info)),8),' invalid');
|
||||
Writeln(ptext,'Marked memory at $',HexStr(ptrint(pointer(p)+sizeof(theap_mem_info)),8),' invalid');
|
||||
Writeln(ptext,'Wrong size : ',p^.size,' allocated ',size,' freed');
|
||||
dump_stack(ptext,get_caller_frame(get_frame));
|
||||
{ the check is done to be sure that the procvar is not overwritten }
|
||||
@ -312,7 +312,7 @@ end;
|
||||
|
||||
function is_in_getmem_list (p : pheap_mem_info) : boolean;
|
||||
var
|
||||
i : longint;
|
||||
i : ptrint;
|
||||
pp : pheap_mem_info;
|
||||
begin
|
||||
is_in_getmem_list:=false;
|
||||
@ -341,9 +341,9 @@ end;
|
||||
TraceGetMem
|
||||
*****************************************************************************}
|
||||
|
||||
Function TraceGetMem(size:longint):pointer;
|
||||
Function TraceGetMem(size:ptrint):pointer;
|
||||
var
|
||||
allocsize,i : longint;
|
||||
allocsize,i : ptrint;
|
||||
oldbp,
|
||||
bp : pointer;
|
||||
pl : pdword;
|
||||
@ -355,7 +355,7 @@ begin
|
||||
{ Do the real GetMem, but alloc also for the info block }
|
||||
allocsize:=size+sizeof(theap_mem_info)+extra_info_size;
|
||||
if add_tail then
|
||||
inc(allocsize,sizeof(longint));
|
||||
inc(allocsize,sizeof(ptrint));
|
||||
p:=SysGetMem(allocsize);
|
||||
pp:=pheap_mem_info(p);
|
||||
inc(p,sizeof(theap_mem_info));
|
||||
@ -387,7 +387,7 @@ begin
|
||||
pp^.extra_info:=nil;
|
||||
if add_tail then
|
||||
begin
|
||||
pl:=pointer(pp)+allocsize-pp^.extra_info_size-sizeof(longint);
|
||||
pl:=pointer(pp)+allocsize-pp^.extra_info_size-sizeof(ptrint);
|
||||
pl^:=$DEADBEEF;
|
||||
end;
|
||||
{ clear the memory }
|
||||
@ -429,22 +429,22 @@ end;
|
||||
TraceFreeMem
|
||||
*****************************************************************************}
|
||||
|
||||
function TraceFreeMemSize(p:pointer;size:longint):longint;
|
||||
function TraceFreeMemSize(p:pointer;size:ptrint):ptrint;
|
||||
var
|
||||
i,ppsize : longint;
|
||||
i,ppsize : ptrint;
|
||||
bp : pointer;
|
||||
pp : pheap_mem_info;
|
||||
{$ifdef EXTRA}
|
||||
pp2 : pheap_mem_info;
|
||||
{$endif}
|
||||
extra_size : longint;
|
||||
extra_size : ptrint;
|
||||
begin
|
||||
inc(freemem_size,size);
|
||||
inc(freemem8_size,((size+7) div 8)*8);
|
||||
pp:=pheap_mem_info(p-sizeof(theap_mem_info));
|
||||
ppsize:= size + sizeof(theap_mem_info)+pp^.extra_info_size;
|
||||
if add_tail then
|
||||
inc(ppsize,sizeof(longint));
|
||||
inc(ppsize,sizeof(ptrint));
|
||||
if not quicktrace then
|
||||
begin
|
||||
if not(is_in_getmem_list(pp)) then
|
||||
@ -541,28 +541,28 @@ begin
|
||||
{ return the correct size }
|
||||
dec(i,sizeof(theap_mem_info)+extra_size);
|
||||
if add_tail then
|
||||
dec(i,sizeof(longint));
|
||||
dec(i,sizeof(ptrint));
|
||||
TraceFreeMemSize:=i;
|
||||
end;
|
||||
|
||||
|
||||
function TraceMemSize(p:pointer):Longint;
|
||||
function TraceMemSize(p:pointer):ptrint;
|
||||
var
|
||||
l : longint;
|
||||
l : ptrint;
|
||||
pp : pheap_mem_info;
|
||||
begin
|
||||
pp:=pheap_mem_info(p-sizeof(theap_mem_info));
|
||||
l:=SysMemSize(pp);
|
||||
dec(l,sizeof(theap_mem_info)+pp^.extra_info_size);
|
||||
if add_tail then
|
||||
dec(l,sizeof(longint));
|
||||
dec(l,sizeof(ptrint));
|
||||
TraceMemSize:=l;
|
||||
end;
|
||||
|
||||
|
||||
function TraceFreeMem(p:pointer):longint;
|
||||
function TraceFreeMem(p:pointer):ptrint;
|
||||
var
|
||||
size : longint;
|
||||
size : ptrint;
|
||||
pp : pheap_mem_info;
|
||||
begin
|
||||
pp:=pheap_mem_info(p-sizeof(theap_mem_info));
|
||||
@ -583,17 +583,17 @@ end;
|
||||
ReAllocMem
|
||||
*****************************************************************************}
|
||||
|
||||
function TraceReAllocMem(var p:pointer;size:longint):Pointer;
|
||||
function TraceReAllocMem(var p:pointer;size:ptrint):Pointer;
|
||||
var
|
||||
newP: pointer;
|
||||
oldsize,
|
||||
allocsize,
|
||||
i : longint;
|
||||
i : ptrint;
|
||||
bp : pointer;
|
||||
pl : pdword;
|
||||
pp : pheap_mem_info;
|
||||
oldextrasize,
|
||||
oldexactsize : longint;
|
||||
oldexactsize : ptrint;
|
||||
old_fill_extra_info_proc : tfillextrainfoproc;
|
||||
old_display_extra_info_proc : tdisplayextrainfoproc;
|
||||
begin
|
||||
@ -639,7 +639,7 @@ begin
|
||||
{ Do the real ReAllocMem, but alloc also for the info block }
|
||||
allocsize:=size+sizeof(theap_mem_info)+pp^.extra_info_size;
|
||||
if add_tail then
|
||||
inc(allocsize,sizeof(longint));
|
||||
inc(allocsize,sizeof(ptrint));
|
||||
{ Try to resize the block, if not possible we need to do a
|
||||
getmem, move data, freemem }
|
||||
if not SysTryResizeMem(pp,allocsize) then
|
||||
@ -683,7 +683,7 @@ begin
|
||||
pp^.extra_info:=nil;
|
||||
if add_tail then
|
||||
begin
|
||||
pl:=pointer(pp)+allocsize-pp^.extra_info_size-sizeof(longint);
|
||||
pl:=pointer(pp)+allocsize-pp^.extra_info_size-sizeof(ptrint);
|
||||
pl^:=$DEADBEEF;
|
||||
end;
|
||||
{ generate new backtrace }
|
||||
@ -731,7 +731,7 @@ var
|
||||
|
||||
procedure CheckPointer(p : pointer);[saveregisters,public, alias : 'FPC_CHECKPOINTER'];
|
||||
var
|
||||
i : longint;
|
||||
i : ptrint;
|
||||
pp : pheap_mem_info;
|
||||
get_ebp,stack_top : longword;
|
||||
data_end : longword;
|
||||
@ -825,7 +825,7 @@ begin
|
||||
goto _exit
|
||||
else
|
||||
begin
|
||||
writeln(ptext^,'pointer $',hexstr(longint(p),8),' points into invalid memory block');
|
||||
writeln(ptext^,'pointer $',hexstr(ptrint(p),8),' points into invalid memory block');
|
||||
dump_error(pp,ptext^);
|
||||
runerror(204);
|
||||
end;
|
||||
@ -837,7 +837,7 @@ begin
|
||||
halt(1);
|
||||
end;
|
||||
end;
|
||||
writeln(ptext^,'pointer $',hexstr(longint(p),8),' does not point to valid memory block');
|
||||
writeln(ptext^,'pointer $',hexstr(ptrint(p),8),' does not point to valid memory block');
|
||||
runerror(204);
|
||||
_exit:
|
||||
end;
|
||||
@ -849,8 +849,8 @@ end;
|
||||
procedure dumpheap;
|
||||
var
|
||||
pp : pheap_mem_info;
|
||||
i : longint;
|
||||
ExpectedMemAvail : longint;
|
||||
i : ptrint;
|
||||
ExpectedMemAvail : ptrint;
|
||||
begin
|
||||
pp:=heap_mem_root;
|
||||
Writeln(ptext^,'Heap dump by heaptrc unit');
|
||||
@ -923,7 +923,7 @@ end;
|
||||
AllocMem
|
||||
*****************************************************************************}
|
||||
|
||||
function TraceAllocMem(size:longint):Pointer;
|
||||
function TraceAllocMem(size:ptrint):Pointer;
|
||||
begin
|
||||
TraceAllocMem:=SysAllocMem(size);
|
||||
end;
|
||||
@ -933,17 +933,17 @@ end;
|
||||
No specific tracing calls
|
||||
*****************************************************************************}
|
||||
|
||||
function TraceMemAvail:longint;
|
||||
function TraceMemAvail:ptrint;
|
||||
begin
|
||||
TraceMemAvail:=SysMemAvail;
|
||||
end;
|
||||
|
||||
function TraceMaxAvail:longint;
|
||||
function TraceMaxAvail:ptrint;
|
||||
begin
|
||||
TraceMaxAvail:=SysMaxAvail;
|
||||
end;
|
||||
|
||||
function TraceHeapSize:longint;
|
||||
function TraceHeapSize:ptrint;
|
||||
begin
|
||||
TraceHeapSize:=SysHeapSize;
|
||||
end;
|
||||
@ -954,7 +954,7 @@ end;
|
||||
*****************************************************************************}
|
||||
|
||||
Procedure SetHeapTraceOutput(const name : string);
|
||||
var i : longint;
|
||||
var i : ptrint;
|
||||
begin
|
||||
if ptext<>@stderr then
|
||||
begin
|
||||
@ -973,7 +973,7 @@ begin
|
||||
writeln(ptext^);
|
||||
end;
|
||||
|
||||
procedure SetHeapExtraInfo( size : longint;fillproc : tfillextrainfoproc;displayproc : tdisplayextrainfoproc);
|
||||
procedure SetHeapExtraInfo( size : ptrint;fillproc : tfillextrainfoproc;displayproc : tdisplayextrainfoproc);
|
||||
begin
|
||||
{ the total size must stay multiple of 8, also allocate 2 pointers for
|
||||
the fill and display procvars }
|
||||
@ -1064,7 +1064,7 @@ end;
|
||||
Function GetEnv(envvar: string): string;
|
||||
var
|
||||
s : string;
|
||||
i : longint;
|
||||
i : ptrint;
|
||||
hp,p : pchar;
|
||||
begin
|
||||
getenv:='';
|
||||
@ -1093,7 +1093,7 @@ Function GetEnv(P:string):Pchar;
|
||||
}
|
||||
var
|
||||
ep : ppchar;
|
||||
i : longint;
|
||||
i : ptrint;
|
||||
found : boolean;
|
||||
Begin
|
||||
p:=p+'='; {Else HOST will also find HOSTNAME, etc}
|
||||
@ -1123,7 +1123,7 @@ end;
|
||||
|
||||
procedure LoadEnvironment;
|
||||
var
|
||||
i,j : longint;
|
||||
i,j : ptrint;
|
||||
s : string;
|
||||
begin
|
||||
s:=Getenv('HEAPTRC');
|
||||
@ -1156,7 +1156,11 @@ finalization
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.26 2004-03-15 14:22:39 michael
|
||||
Revision 1.27 2004-03-15 21:48:26 peter
|
||||
* cmem moved to rtl
|
||||
* longint replaced with ptrint in heapmanagers
|
||||
|
||||
Revision 1.26 2004/03/15 14:22:39 michael
|
||||
+ Fix from peter for win32 SIGTRAp signal
|
||||
|
||||
Revision 1.25 2004/02/06 20:17:12 daniel
|
||||
@ -1168,7 +1172,7 @@ end.
|
||||
|
||||
Revision 1.23 2003/03/17 14:30:11 peter
|
||||
* changed address parameter/return values to pointer instead
|
||||
of longint
|
||||
of ptrint
|
||||
|
||||
Revision 1.22 2002/12/26 10:46:54 peter
|
||||
* set p to nil when 0 is passed to reallocmem
|
||||
@ -1185,7 +1189,7 @@ end.
|
||||
|
||||
Revision 1.18 2002/09/09 15:45:49 jonas
|
||||
* made result type of calculate_release_sig() a longword instead of a
|
||||
longint
|
||||
ptrint
|
||||
|
||||
Revision 1.17 2002/09/07 15:07:45 peter
|
||||
* old logs removed and tabs fixed
|
||||
|
@ -1,5 +1,5 @@
|
||||
#
|
||||
# Don't edit, this file is generated by FPCMake Version 1.1 [2004/02/03]
|
||||
# Don't edit, this file is generated by FPCMake Version 1.1 [2004/03/15]
|
||||
#
|
||||
default: all
|
||||
MAKEFILETARGETS=linux go32v2 win32 os2 freebsd beos netbsd amiga atari sunos qnx netware openbsd wdosx palmos macos darwin emx watcom
|
||||
@ -243,7 +243,7 @@ GRAPHDIR=$(INC)/graph
|
||||
ifndef USELIBGGI
|
||||
USELIBGGI=NO
|
||||
endif
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) unixtype baseunix strings systhrds objpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc $(CPU_UNITS) dos crt objects printer ggigraph sysutils typinfo math varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconst
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) unixtype baseunix strings systhrds objpas syscall unixutil heaptrc lineinfo $(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) dos crt objects printer ggigraph sysutils typinfo math varutils charset ucomplex getopts errors sockets gpm ipc serial terminfo dl dynlibs video mouse keyboard variants types dateutils sysconst cthreads classes strutils rtlconst
|
||||
override TARGET_LOADERS+=prt0 dllprt0 cprt0 gprt0 $(CRT21)
|
||||
override TARGET_RSTS+=math varutils typinfo variants systhrds sysconst rtlconst
|
||||
override CLEAN_UNITS+=syslinux linux
|
||||
@ -560,7 +560,8 @@ ZIPSUFFIX=nw
|
||||
endif
|
||||
ifeq ($(OS_TARGET),macos)
|
||||
EXEEXT=
|
||||
FPCMADE=fpcmade.mcc
|
||||
FPCMADE=fpcmade.macos
|
||||
ZIPSUFFIX=macos
|
||||
endif
|
||||
ifeq ($(OS_TARGET),darwin)
|
||||
EXEEXT=
|
||||
@ -859,9 +860,11 @@ ARNAME=$(BINUTILSPREFIX)ar
|
||||
RCNAME=$(BINUTILSPREFIX)rc
|
||||
ifneq ($(findstring 1.0.,$(FPC_VERSION)),)
|
||||
ifeq ($(OS_TARGET),win32)
|
||||
ASNAME=as
|
||||
LDNAME=ld
|
||||
ARNAME=ar
|
||||
ifeq ($(CROSSBINDIR),)
|
||||
ASNAME=asw
|
||||
LDNAME=ldw
|
||||
ARNAME=arw
|
||||
endif
|
||||
endif
|
||||
endif
|
||||
ifndef ASPROG
|
||||
@ -1447,4 +1450,5 @@ errors$(PPUEXT) : errors.pp strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
|
||||
ipc$(PPUEXT) : ipc.pp unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
|
||||
terminfo$(PPUEXT) : terminfo.pp unix$(PPUEXT)
|
||||
callspec$(PPUEXT) : $(INC)/callspec.pp $(SYSTEMUNIT)$(PPUEXT)
|
||||
cmem$(PPUEXT) : $(INC)/cmem.pp $(SYSTEMUNIT)$(PPUEXT)
|
||||
cthreads$(PPUEXT) : $(UNIXINC)/cthreads.pp $(SYSTEMUNIT)$(PPUEXT) systhrds$(PPUEXT)
|
||||
|
@ -9,7 +9,7 @@ main=rtl
|
||||
loaders=prt0 dllprt0 cprt0 gprt0 $(CRT21)
|
||||
units=$(SYSTEMUNIT) unixtype baseunix strings systhrds objpas syscall unixutil \
|
||||
heaptrc lineinfo \
|
||||
$(LINUXUNIT1) termio unix $(LINUXUNIT2) initc $(CPU_UNITS) \
|
||||
$(LINUXUNIT1) termio unix $(LINUXUNIT2) initc cmem $(CPU_UNITS) \
|
||||
dos crt objects printer ggigraph \
|
||||
sysutils typinfo math varutils \
|
||||
charset ucomplex getopts \
|
||||
@ -278,4 +278,6 @@ terminfo$(PPUEXT) : terminfo.pp unix$(PPUEXT)
|
||||
|
||||
callspec$(PPUEXT) : $(INC)/callspec.pp $(SYSTEMUNIT)$(PPUEXT)
|
||||
|
||||
cmem$(PPUEXT) : $(INC)/cmem.pp $(SYSTEMUNIT)$(PPUEXT)
|
||||
|
||||
cthreads$(PPUEXT) : $(UNIXINC)/cthreads.pp $(SYSTEMUNIT)$(PPUEXT) systhrds$(PPUEXT)
|
@ -1,5 +1,5 @@
|
||||
#
|
||||
# Don't edit, this file is generated by FPCMake Version 1.1 [2004/02/22]
|
||||
# Don't edit, this file is generated by FPCMake Version 1.1 [2004/03/15]
|
||||
#
|
||||
default: all
|
||||
MAKEFILETARGETS=linux go32v2 win32 os2 freebsd beos netbsd amiga atari sunos qnx netware openbsd wdosx palmos macos darwin emx watcom
|
||||
@ -229,7 +229,7 @@ OBJPASDIR=$(RTL)/objpas
|
||||
GRAPHDIR=$(INC)/graph
|
||||
include $(WININC)/makefile.inc
|
||||
WINDOWS_SOURCE_FILES=$(addprefix $(WININC)/,$(addsuffix .inc,$(WINDOWS_FILES)))
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) systhrds objpas strings lineinfo heaptrc windows ole2 activex winsock initc dos crt objects graph messages sysutils classes typinfo math varutils variants cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer dynlibs video mouse keyboard types comobj dateutils rtlconst sysconst winsysut
|
||||
override TARGET_UNITS+=$(SYSTEMUNIT) systhrds objpas strings lineinfo heaptrc windows ole2 activex winsock initc cmem dos crt objects graph messages sysutils classes typinfo math varutils variants cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer dynlibs video mouse keyboard types comobj dateutils rtlconst sysconst winsysut
|
||||
override TARGET_LOADERS+=wprt0 wdllprt0 gprt0
|
||||
override TARGET_RSTS+=math varutils typinfo variants classes dateutils sysconst
|
||||
override INSTALL_FPCPACKAGE=y
|
||||
@ -545,7 +545,8 @@ ZIPSUFFIX=nw
|
||||
endif
|
||||
ifeq ($(OS_TARGET),macos)
|
||||
EXEEXT=
|
||||
FPCMADE=fpcmade.mcc
|
||||
FPCMADE=fpcmade.macos
|
||||
ZIPSUFFIX=macos
|
||||
endif
|
||||
ifeq ($(OS_TARGET),darwin)
|
||||
EXEEXT=
|
||||
@ -844,9 +845,11 @@ ARNAME=$(BINUTILSPREFIX)ar
|
||||
RCNAME=$(BINUTILSPREFIX)rc
|
||||
ifneq ($(findstring 1.0.,$(FPC_VERSION)),)
|
||||
ifeq ($(OS_TARGET),win32)
|
||||
ASNAME=as
|
||||
LDNAME=ld
|
||||
ARNAME=ar
|
||||
ifeq ($(CROSSBINDIR),)
|
||||
ASNAME=asw
|
||||
LDNAME=ldw
|
||||
ARNAME=arw
|
||||
endif
|
||||
endif
|
||||
endif
|
||||
ifndef ASPROG
|
||||
@ -1416,5 +1419,6 @@ heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
|
||||
$(COMPILER) -Sg $(INC)/heaptrc.pp
|
||||
lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT)
|
||||
charset$(PPUEXT) : $(INC)/charset.pp $(SYSTEMUNIT)$(PPUEXT)
|
||||
cmem$(PPUEXT) : $(INC)/cmem.pp $(SYSTEMUNIT)$(PPUEXT)
|
||||
ucomplex$(PPUEXT) : $(INC)/ucomplex.pp math$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
|
||||
callspec$(PPUEXT) : $(INC)/callspec.pp $(SYSTEMUNIT)$(PPUEXT)
|
||||
|
@ -9,7 +9,7 @@ main=rtl
|
||||
loaders=wprt0 wdllprt0 gprt0
|
||||
units=$(SYSTEMUNIT) systhrds objpas strings \
|
||||
lineinfo heaptrc \
|
||||
windows ole2 activex winsock initc \
|
||||
windows ole2 activex winsock initc cmem \
|
||||
dos crt objects graph messages \
|
||||
sysutils classes typinfo math varutils variants \
|
||||
cpu mmx charset ucomplex getopts \
|
||||
@ -226,6 +226,8 @@ lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT)
|
||||
|
||||
charset$(PPUEXT) : $(INC)/charset.pp $(SYSTEMUNIT)$(PPUEXT)
|
||||
|
||||
cmem$(PPUEXT) : $(INC)/cmem.pp $(SYSTEMUNIT)$(PPUEXT)
|
||||
|
||||
ucomplex$(PPUEXT) : $(INC)/ucomplex.pp math$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
|
||||
|
||||
#
|
||||
|
Loading…
Reference in New Issue
Block a user