paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-10-21 22:41:49 +02:00
Code Issues Packages Projects Releases Wiki Activity

* freemem(var) -> freemem(value)

Browse Source
This commit is contained in:
peter 2001-12-03 21:39:19 +00:00
parent 4490bc91f7
commit 7484da248d
5 changed files with 94 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
rtl/i386/i386.inc
View File

@ -427,8 +427,13 @@ asm
pushal
{ Memory size }
pushl (%eax)
{$ifdef valuegetmem}
call AsmGetMem
movl %eax,(%esi)
{$else valuegetmem}
pushl %esi
call AsmGetMem
{$endif valuegetmem}
movl $-1,8(%ebp)
popal
{ Avoid 80386DX bug }
@ -506,9 +511,14 @@ asm
movl (%esi,%edi,1),%eax
movl %esi,12(%ebp)
{ push object position }
{$ifdef valuefreemem}
pushl %esi
call AsmFreeMem
{$else valuefreemem}
leal 12(%ebp),%eax
pushl %eax
call AsmFreeMem
{$endif valuefreemem}
{ set both object places to zero }
xorl %esi,%esi
movl %esi,12(%ebp)
@ -539,6 +549,11 @@ asm
{ I think for precaution }
{ that we should clear the VMT here }
movl $0,(%eax,%edi,1)
{$ifdef valuefreemem}
{ Freemem }
pushl %eax
call AsmFreeMem
{$else valuefreemem}
{ temporary Variable }
subl $4,%esp
movl %esp,%edi
@ -547,6 +562,7 @@ asm
pushl %edi
call AsmFreeMem
addl $4,%esp
{$endif valuefreemem}
.LHD_3:
popal
{ avoid the 80386DX bug }
@ -1154,7 +1170,10 @@ procedure inclocked(var l : longint);assembler;
{
$Log$
Revision 1.18 2001-10-09 02:43:58 carl
Revision 1.19 2001-12-03 21:39:19 peter
* freemem(var) -> freemem(value)
Revision 1.18 2001/10/09 02:43:58 carl
* bugfix #1639 (IsMultiThread varialbe setting)
Revision 1.17 2001/08/30 15:43:14 jonas

13
rtl/inc/compproc.inc
View File

@ -30,6 +30,14 @@ type
{$ifdef hascompilerproc}
{ Needed to solve overloading problem with call from assembler (PFV) }
{$ifdef valuegetmem}
Function AsmGetmem(size:Longint):pointer;compilerproc;
{$endif}
{$ifdef valuefreemem}
Procedure AsmFreemem(p:pointer);compilerproc;
{$endif valuefreemem}
procedure fpc_Shortstr_SetLength(var s:shortstring;len:StrLenInt); compilerproc;
function fpc_shortstr_to_shortstr(len:longint; const sstr: shortstring): shortstring; compilerproc;
function fpc_shortstr_concat(const s1,s2:shortstring): shortstring; compilerproc;
@ -247,7 +255,10 @@ Procedure fpc_typed_read(TypeSize : Longint;var f : TypedFile;var Buf); compiler
{
$Log$
Revision 1.11 2001-09-29 21:32:47 jonas
Revision 1.12 2001-12-03 21:39:20 peter
* freemem(var) -> freemem(value)
Revision 1.11 2001/09/29 21:32:47 jonas
* almost all second pass typeconvnode helpers are now processor independent
* fixed converting boolean to int64/qword
* fixed register allocation bugs which could cause internalerror 10

58
rtl/inc/heap.inc
View File

@ -193,7 +193,7 @@ begin
end;
procedure FreeMem(Var p:pointer;Size:Longint);
procedure FreeMem(p:pointer;Size:Longint);
begin
{$ifdef MT}
if IsMultiThreaded then
@ -210,7 +210,6 @@ begin
begin
MemoryManager.FreeMemSize(p,Size);
end;
p:=nil;
end;
@ -296,7 +295,7 @@ end;
{ Delphi style }
function FreeMem(var p:pointer):Longint;
function FreeMem(p:pointer):Longint;
begin
{$ifdef MT}
if IsMultiThreaded then
@ -376,15 +375,17 @@ begin
end;
{$ifdef ValueGetmem}
{ Needed for calls from Assembler }
procedure AsmGetMem(var p:pointer;size:longint);[public,alias:'FPC_GETMEM'];
function AsmGetMem(size:longint):pointer;compilerproc;[public,alias:'FPC_GETMEM'];
begin
{$ifdef MT}
if IsMultiThreaded then
begin
try
EnterCriticalSection(cs_systemheap);
p:=MemoryManager.GetMem(size);
AsmGetMem:=MemoryManager.GetMem(size);
finally
LeaveCriticalSection(cs_systemheap);
end;
@ -392,12 +393,23 @@ begin
else
{$endif MT}
begin
p:=MemoryManager.GetMem(size);
AsmGetMem:=MemoryManager.GetMem(size);
end;
end;
{$else ValueGetmem}
procedure AsmFreeMem(var p:pointer);[public,alias:'FPC_FREEMEM'];
{ Needed for calls from Assembler }
procedure AsmGetMem(var p:pointer;size:longint);[public,alias:'FPC_GETMEM'];
begin
p:=MemoryManager.GetMem(size);
end;
{$endif ValueGetmem}
{$ifdef ValueFreemem}
procedure AsmFreeMem(p:pointer);compilerproc;[public,alias:'FPC_FREEMEM'];
begin
{$ifdef MT}
if IsMultiThreaded then
@ -405,10 +417,7 @@ begin
try
EnterCriticalSection(cs_systemheap);
if p <> nil then
begin
MemoryManager.FreeMem(p);
p:=nil;
end;
MemoryManager.FreeMem(p);
finally
LeaveCriticalSection(cs_systemheap);
end;
@ -417,13 +426,20 @@ begin
{$endif MT}
begin
if p <> nil then
begin
MemoryManager.FreeMem(p);
p:=nil;
end;
MemoryManager.FreeMem(p);
end;
end;
{$else ValueFreemem}
procedure AsmFreeMem(var p:pointer);[public,alias:'FPC_FREEMEM'];
begin
if p <> nil then
MemoryManager.FreeMem(p);
end;
{$endif ValueFreemem}
{*****************************************************************************
Heapsize,Memavail,MaxAvail
@ -800,7 +816,7 @@ end;
SysFreeMem
*****************************************************************************}
Function SysFreeMem(var p : pointer):Longint;
Function SysFreeMem(p : pointer):Longint;
var
pcurrsize,s : longint;
pcurr : pfreerecord;
@ -831,7 +847,6 @@ begin
inc(freecount[s]);
{$endif SYSTEMDEBUG}
end;
p:=nil;
SysFreeMem:=pcurrsize;
{$ifdef TestFreeLists}
if test_each then
@ -844,7 +859,7 @@ end;
SysFreeMemSize
*****************************************************************************}
Function SysFreeMemSize(var p : pointer;size : longint):longint;
Function SysFreeMemSize(p : pointer;size : longint):longint;
var
pcurrsize,s : longint;
pcurr : pfreerecord;
@ -854,7 +869,6 @@ begin
begin
if size<0 then
HandleError(204);
p:=nil;
exit;
end;
if p=nil then
@ -888,7 +902,6 @@ begin
inc(freecount[s]);
{$endif SYSTEMDEBUG}
end;
p:=nil;
SysFreeMemSize:=pcurrsize;
{$ifdef TestFreeLists}
if test_each then
@ -1241,7 +1254,10 @@ end;
{
$Log$
Revision 1.8 2001-10-25 21:22:34 peter
Revision 1.9 2001-12-03 21:39:20 peter
* freemem(var) -> freemem(value)
Revision 1.8 2001/10/25 21:22:34 peter
* moved locking of heap
Revision 1.7 2001/10/23 21:51:03 peter

31
rtl/inc/heaph.inc
View File

@ -19,8 +19,8 @@ type
PMemoryManager = ^TMemoryManager;
TMemoryManager = record
Getmem : Function(Size:Longint):Pointer;
Freemem : Function(var p:pointer):Longint;
FreememSize : Function(var p:pointer;Size:Longint):Longint;
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;
@ -42,8 +42,8 @@ var
{ Default MemoryManager functions }
Function SysGetmem(Size:Longint):Pointer;
Function SysFreemem(var p:pointer):Longint;
Function SysFreememSize(var p:pointer;Size:Longint):Longint;
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;
@ -54,7 +54,7 @@ Function Sysheapsize:longint;
{ Tp7 functions }
Procedure Getmem(Var p:pointer;Size:Longint);
Procedure Freemem(Var p:pointer;Size:Longint);
Procedure Freemem(p:pointer;Size:Longint);
Function memavail:Longint;
Function maxavail:Longint;
@ -64,21 +64,28 @@ Function heapsize:longint;
{ Delphi functions }
function GetMem(size:longint):pointer;
function Freemem(var p:pointer):longint;
function Freemem(p:pointer):longint;
function AllocMem(Size:Longint):pointer;
function ReAllocMem(var 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);
{$ifndef ValueGetmem}
{ Needed to solve overloading problem with call from assembler (PFV) }
Procedure AsmGetmem(var p:pointer;size:Longint);
{$endif ValueGetmem}
{$ifndef ValueFreemem}
Procedure AsmFreemem(var p:pointer);
{$endif ValueFreemem}
{
$Log$
Revision 1.2 2000-07-13 11:33:44 michael
Revision 1.3 2001-12-03 21:39:20 peter
* freemem(var) -> freemem(value)
Revision 1.2 2000/07/13 11:33:44 michael
+ removed logs
}

12
rtl/inc/heaptrc.pp
View File

@ -421,7 +421,7 @@ end;
TraceFreeMem
*****************************************************************************}
function TraceFreeMemSize(var p:pointer;size:longint):longint;
function TraceFreeMemSize(p:pointer;size:longint):longint;
var
i,bp, ppsize : longint;
pp : pheap_mem_info;
@ -507,7 +507,6 @@ begin
if pp=heap_valid_first then
heap_valid_first:=nil;
TraceFreememsize:=size;
p:=nil;
exit;
end;
pp2:=heap_valid_last;
@ -519,7 +518,6 @@ begin
if pp=heap_valid_first then
heap_valid_first:=pp2;
TraceFreememsize:=size;
p:=nil;
exit;
end
else
@ -527,7 +525,6 @@ begin
end;
{$endif EXTRA}
TraceFreememsize:=size;
p:=nil;
exit;
end;
{ release the normal memory at least }
@ -554,7 +551,7 @@ begin
end;
function TraceFreeMem(var p:pointer):longint;
function TraceFreeMem(p:pointer):longint;
var
size : longint;
pp : pheap_mem_info;
@ -1148,7 +1145,10 @@ finalization
end.
{
$Log$
Revision 1.15 2001-07-29 13:43:57 peter
Revision 1.16 2001-12-03 21:39:20 peter
* freemem(var) -> freemem(value)
Revision 1.15 2001/07/29 13:43:57 peter
* m68k updates merged
Revision 1.14 2001/06/06 17:20:22 jonas