From 8784dbc095442790a2f24cb675fdc67d1fe2d08f Mon Sep 17 00:00:00 2001
From: Rika Ichinose <rrunewalsh@gmail.com>
Date: Thu, 21 Apr 2022 00:47:04 +0300
Subject: [PATCH] Outline freeing TFPList with disposing its items into
TFPList.FreeAndNilDisposing.
---
compiler/cclasses.pas | 23 +++++++++++++++++++++++
compiler/globals.pas | 35 ++---------------------------------
compiler/pgentype.pas | 6 +-----
compiler/psub.pas | 9 +--------
compiler/symdef.pas | 10 +---------
compiler/symtable.pas | 32 +-------------------------------
6 files changed, 29 insertions(+), 86 deletions(-)
diff --git a/compiler/cclasses.pas b/compiler/cclasses.pas
index d3f8e32cc6..f01bb0d36c 100644
--- a/compiler/cclasses.pas
+++ b/compiler/cclasses.pas
@@ -116,6 +116,9 @@ type
{ FreeAndNil the list, and its items as TObjects. }
class procedure FreeAndNilObjects(var Lst: TFPList); static;
+
+ { FreeAndNil the list, and dispose() its items. 'ItemType' is TypeInfo() of items. }
+ class procedure FreeAndNilDisposing(var Lst: TFPList; ItemType: Pointer); static;
end;
@@ -1058,6 +1061,26 @@ begin
Lst := nil;
end;
+procedure fpc_finalize(data, typeinfo: pointer); external;
+
+class procedure TFPList.FreeAndNilDisposing(var Lst: TFPList; ItemType: Pointer);
+var
+ Lp: PPointer;
+ I: SizeInt;
+begin
+ if not Assigned(Lst) then
+ exit;
+ Lp := Lst.FList;
+ for I := 0 to Lst.Count-1 do
+ if Assigned(Lp[I]) then
+ begin
+ fpc_finalize(Lp[I],ItemType);
+ FreeMem(Lp[I]);
+ end;
+ Lst.Free;
+ Lst := nil;
+end;
+
{*****************************************************************************
TFPObjectList (Copied from rtl/objpas/classes/lists.inc)
diff --git a/compiler/globals.pas b/compiler/globals.pas
index 1b5ef51248..750a1c54c6 100644
--- a/compiler/globals.pas
+++ b/compiler/globals.pas
@@ -1639,15 +1639,6 @@ implementation
initdoneprocs : TFPList = nil;
- procedure allocinitdoneprocs;
- begin
- { Avoid double initialization }
- if assigned(initdoneprocs) then
- exit;
- initdoneprocs:=tfplist.create;
- end;
-
-
procedure register_initdone_proc(init,done:tprocedure);
var
entry : pinitdoneentry;
@@ -1655,14 +1646,7 @@ implementation
new(entry);
entry^.init:=init;
entry^.done:=done;
- { Do not rely on the fact that
- globals unit initialization code
- has already been executed.
- Unit initialization order is too
- uncertian for that. PM }
- if not assigned(initdoneprocs) then
- allocinitdoneprocs;
- initdoneprocs.add(entry);
+ TFPList.AddOnDemand(initdoneprocs,entry);
end;
@@ -1692,20 +1676,6 @@ implementation
end;
- procedure freeinitdoneprocs;
- var
- i : longint;
- begin
- if not assigned(initdoneprocs) then
- exit;
- for i:=0 to initdoneprocs.count-1 do
- dispose(pinitdoneentry(initdoneprocs[i]));
- initdoneprocs.free;
- { Reset variable, to be on the safe side }
- initdoneprocs:=nil;
- end;
-
-
procedure DoneGlobals;
begin
calldoneprocs;
@@ -1810,12 +1780,11 @@ implementation
end;
initialization
- allocinitdoneprocs;
{$ifdef LLVM}
cgbackend:=cg_llvm;
{$else}
cgbackend:=cg_fpc;
{$endif}
finalization
- freeinitdoneprocs;
+ tfplist.FreeAndNilDisposing(initdoneprocs,TypeInfo(tinitdoneentry));
end.
diff --git a/compiler/pgentype.pas b/compiler/pgentype.pas
index 9354fe2f50..d7acba6a72 100644
--- a/compiler/pgentype.pas
+++ b/compiler/pgentype.pas
@@ -65,13 +65,9 @@ begin
end;
destructor tspecializationcontext.destroy;
-var
- i : longint;
begin
paramlist.free;
- for i:=0 to poslist.count-1 do
- dispose(pfileposinfo(poslist[i]));
- poslist.free;
+ tfplist.FreeAndNilDisposing(poslist,TypeInfo(tfileposinfo));
inherited destroy;
end;
diff --git a/compiler/psub.pas b/compiler/psub.pas
index ecb67441fd..06bca7299d 100644
--- a/compiler/psub.pas
+++ b/compiler/psub.pas
@@ -684,15 +684,8 @@ implementation
****************************************************************************}
destructor tcgprocinfo.destroy;
- var
- i : longint;
begin
- if assigned(tempinfo_flags_map) then
- begin
- for i:=0 to tempinfo_flags_map.count-1 do
- dispose(ptempinfo_flags_entry(tempinfo_flags_map[i]));
- tempinfo_flags_map.free;
- end;
+ TFPList.FreeAndNilDisposing(tempinfo_flags_map,TypeInfo(ttempinfo_flags_entry));
code.free;
inherited destroy;
end;
diff --git a/compiler/symdef.pas b/compiler/symdef.pas
index 2da87ff372..37ae0bcf96 100644
--- a/compiler/symdef.pas
+++ b/compiler/symdef.pas
@@ -8024,8 +8024,6 @@ implementation
destructor tobjectdef.destroy;
- var
- i: longint;
begin
if assigned(symtable) then
begin
@@ -8044,13 +8042,7 @@ implementation
dispose(iidguid);
iidguid:=nil;
end;
- if assigned(vmtentries) then
- begin
- for i:=0 to vmtentries.count-1 do
- dispose(pvmtentry(vmtentries[i]));
- vmtentries.free;
- vmtentries:=nil;
- end;
+ TFPList.FreeAndNilDisposing(vmtentries,TypeInfo(tvmtentry));
if assigned(vmcallstaticinfo) then
begin
freemem(vmcallstaticinfo);
diff --git a/compiler/symtable.pas b/compiler/symtable.pas
index 6c62f71f38..33213cd20c 100644
--- a/compiler/symtable.pas
+++ b/compiler/symtable.pas
@@ -1211,29 +1211,8 @@ implementation
destructor tabstractrecordsymtable.destroy;
-
- { for some reason a compiler built with 3.3.1 fails building the libxml2
- package if the below define is not defined and thus the code snippet is
- part of the destructor itself and not a nested procedure; until that bug
- is fixed this is used as a workaround :/ }
-{$define codegen_workaround}
-{$ifdef codegen_workaround}
- procedure free_mop_list(mop:tmanagementoperator);
- var
- i : longint;
- begin
- if assigned(mop_list[mop]) then
- for i:=0 to mop_list[mop].count-1 do
- dispose(pmanagementoperator_offset_entry(mop_list[mop][i]));
- mop_list[mop].free;
- end;
-{$endif codegen_workaround}
-
var
mop : tmanagementoperator;
-{$ifndef codegen_workaround}
- i : longint;
-{$endif codegen_workaround}
begin
if refcount>1 then
exit;
@@ -1241,16 +1220,7 @@ implementation
fllvmst.free;
{$endif llvm}
for mop:=low(tmanagementoperator) to high(tmanagementoperator) do
- begin
-{$ifdef codegen_workaround}
- free_mop_list(mop);
-{$else codegen_workaround}
- if assigned(mop_list[mop]) then
- for i:=0 to mop_list[mop].count-1 do
- dispose(pmanagementoperator_offset_entry(mop_list[mop][i]));
- mop_list[mop].free;
-{$endif codegen_workaround}
- end;
+ TFPList.FreeAndNilDisposing(mop_list[mop],TypeInfo(tmanagementoperator_offset_entry));
inherited destroy;
end;