paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-04 09:02:22 +01: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 pushal
{ Memory size } { Memory size }
pushl (%eax) pushl (%eax)
{$ifdef valuegetmem}
call AsmGetMem
movl %eax,(%esi)
{$else valuegetmem}
pushl %esi pushl %esi
call AsmGetMem call AsmGetMem
{$endif valuegetmem}
movl $-1,8(%ebp) movl $-1,8(%ebp)
popal popal
{ Avoid 80386DX bug } { Avoid 80386DX bug }
@ -506,9 +511,14 @@ asm
movl (%esi,%edi,1),%eax movl (%esi,%edi,1),%eax
movl %esi,12(%ebp) movl %esi,12(%ebp)
{ push object position } { push object position }
{$ifdef valuefreemem}
pushl %esi
call AsmFreeMem
{$else valuefreemem}
leal 12(%ebp),%eax leal 12(%ebp),%eax
pushl %eax pushl %eax
call AsmFreeMem call AsmFreeMem
{$endif valuefreemem}
{ set both object places to zero } { set both object places to zero }
xorl %esi,%esi xorl %esi,%esi
movl %esi,12(%ebp) movl %esi,12(%ebp)
@ -539,6 +549,11 @@ asm
{ I think for precaution } { I think for precaution }
{ that we should clear the VMT here } { that we should clear the VMT here }
movl $0,(%eax,%edi,1) movl $0,(%eax,%edi,1)
{$ifdef valuefreemem}
{ Freemem }
pushl %eax
call AsmFreeMem
{$else valuefreemem}
{ temporary Variable } { temporary Variable }
subl $4,%esp subl $4,%esp
movl %esp,%edi movl %esp,%edi
@ -547,6 +562,7 @@ asm
pushl %edi pushl %edi
call AsmFreeMem call AsmFreeMem
addl $4,%esp addl $4,%esp
{$endif valuefreemem}
.LHD_3: .LHD_3:
popal popal
{ avoid the 80386DX bug } { avoid the 80386DX bug }
@ -1154,7 +1170,10 @@ procedure inclocked(var l : longint);assembler;
{ {
$Log$ $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) * bugfix #1639 (IsMultiThread varialbe setting)
Revision 1.17 2001/08/30 15:43:14 jonas Revision 1.17 2001/08/30 15:43:14 jonas

13
rtl/inc/compproc.inc
View File

@ -30,6 +30,14 @@ type
{$ifdef hascompilerproc} {$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; 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_to_shortstr(len:longint; const sstr: shortstring): shortstring; compilerproc;
function fpc_shortstr_concat(const s1,s2: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$ $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 * almost all second pass typeconvnode helpers are now processor independent
* fixed converting boolean to int64/qword * fixed converting boolean to int64/qword
* fixed register allocation bugs which could cause internalerror 10 * fixed register allocation bugs which could cause internalerror 10

58
rtl/inc/heap.inc
View File

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

29
rtl/inc/heaph.inc
View File

@ -19,8 +19,8 @@ type
PMemoryManager = ^TMemoryManager; PMemoryManager = ^TMemoryManager;
TMemoryManager = record TMemoryManager = record
Getmem : Function(Size:Longint):Pointer; Getmem : Function(Size:Longint):Pointer;
Freemem : Function(var p:pointer):Longint; Freemem : Function(p:pointer):Longint;
FreememSize : Function(var p:pointer;Size:Longint):Longint; FreememSize : Function(p:pointer;Size:Longint):Longint;
AllocMem : Function(Size:longint):Pointer; AllocMem : Function(Size:longint):Pointer;
ReAllocMem : Function(var p:pointer;Size:longint):Pointer; ReAllocMem : Function(var p:pointer;Size:longint):Pointer;
MemSize : function(p:pointer):Longint; MemSize : function(p:pointer):Longint;
@ -42,8 +42,8 @@ var
{ Default MemoryManager functions } { Default MemoryManager functions }
Function SysGetmem(Size:Longint):Pointer; Function SysGetmem(Size:Longint):Pointer;
Function SysFreemem(var p:pointer):Longint; Function SysFreemem(p:pointer):Longint;
Function SysFreememSize(var p:pointer;Size:Longint):Longint; Function SysFreememSize(p:pointer;Size:Longint):Longint;
Function SysMemSize(p:pointer):Longint; Function SysMemSize(p:pointer):Longint;
Function SysAllocMem(size:longint):Pointer; Function SysAllocMem(size:longint):Pointer;
function SysTryResizeMem(var p:pointer;size : longint):boolean; function SysTryResizeMem(var p:pointer;size : longint):boolean;
@ -54,7 +54,7 @@ Function Sysheapsize:longint;
{ Tp7 functions } { Tp7 functions }
Procedure Getmem(Var p:pointer;Size:Longint); Procedure Getmem(Var p:pointer;Size:Longint);
Procedure Freemem(Var p:pointer;Size:Longint); Procedure Freemem(p:pointer;Size:Longint);
Function memavail:Longint; Function memavail:Longint;
Function maxavail:Longint; Function maxavail:Longint;
@ -64,21 +64,28 @@ Function heapsize:longint;
{ Delphi functions } { Delphi functions }
function GetMem(size:longint):pointer; function GetMem(size:longint):pointer;
function Freemem(var p:pointer):longint; function Freemem(p:pointer):longint;
function AllocMem(Size:Longint):pointer; function AllocMem(Size:Longint):pointer;
function ReAllocMem(var p:pointer;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 } { Do nothing functions, are only here for tp7 compat }
Procedure mark(var p : pointer); Procedure mark(var p : pointer);
Procedure release(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$ $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 + removed logs
} }

12
rtl/inc/heaptrc.pp
View File

@ -421,7 +421,7 @@ end;
TraceFreeMem TraceFreeMem
*****************************************************************************} *****************************************************************************}
function TraceFreeMemSize(var p:pointer;size:longint):longint; function TraceFreeMemSize(p:pointer;size:longint):longint;
var var
i,bp, ppsize : longint; i,bp, ppsize : longint;
pp : pheap_mem_info; pp : pheap_mem_info;
@ -507,7 +507,6 @@ begin
if pp=heap_valid_first then if pp=heap_valid_first then
heap_valid_first:=nil; heap_valid_first:=nil;
TraceFreememsize:=size; TraceFreememsize:=size;
p:=nil;
exit; exit;
end; end;
pp2:=heap_valid_last; pp2:=heap_valid_last;
@ -519,7 +518,6 @@ begin
if pp=heap_valid_first then if pp=heap_valid_first then
heap_valid_first:=pp2; heap_valid_first:=pp2;
TraceFreememsize:=size; TraceFreememsize:=size;
p:=nil;
exit; exit;
end end
else else
@ -527,7 +525,6 @@ begin
end; end;
{$endif EXTRA} {$endif EXTRA}
TraceFreememsize:=size; TraceFreememsize:=size;
p:=nil;
exit; exit;
end; end;
{ release the normal memory at least } { release the normal memory at least }
@ -554,7 +551,7 @@ begin
end; end;
function TraceFreeMem(var p:pointer):longint; function TraceFreeMem(p:pointer):longint;
var var
size : longint; size : longint;
pp : pheap_mem_info; pp : pheap_mem_info;
@ -1148,7 +1145,10 @@ finalization
end. end.
{ {
$Log$ $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 * m68k updates merged
Revision 1.14 2001/06/06 17:20:22 jonas Revision 1.14 2001/06/06 17:20:22 jonas