fcl-res: memory management

Reintegrate fpcres-rc branch by Martok

git-svn-id: trunk@46386 -

packages/fcl-res/src/rcparserfn.inc

@@ -1,11 +1,9 @@
 {%MainUnit rcparser.pas}
 
-{$modeswitch advancedrecords}
-
 interface
 
 uses
-  SysUtils, Classes, StrUtils, lexlib, yacclib, resource,
+  SysUtils, Classes, StrUtils, Contnrs, lexlib, yacclib, resource,
   acceleratorsresource, groupiconresource, stringtableresource,
   bitmapresource, versionresource, versiontypes, groupcursorresource;
 
@@ -17,6 +15,7 @@ var
   yyfilename: AnsiString;
   yyparseresult: YYSType;
 
+procedure DisposePools;
 procedure SetDefaults;
 procedure PragmaCodePage(cp: string);
 
@@ -137,11 +136,19 @@ begin
   Result.v:= str_to_cbase(s);
 end;
 
+type
+  PStrPoolItem = ^TStrPoolItem;
+  TStrPoolItem = record
+    str: PUnicodeString;
+    next: PStrPoolItem;
+  end;
+
 const
   MAX_RCSTR_LEN = 4096;
 var
   strbuf: array[0..MAX_RCSTR_LEN + 1] of char;
   strbuflen: Integer;
+  stringpool: PStrPoolItem = nil;
 
 procedure strbuf_begin();
 begin
@@ -161,10 +168,17 @@ begin
 end;
 
 procedure string_new(var str: rcstrtype; val: UnicodeString; cp: TSystemCodePage);
+var
+  s: PStrPoolItem;
 begin
   New(str.v);
   str.v^:= val;
   str.cp:= cp;
+
+  New(s);
+  s^.next:= stringpool;
+  s^.str:= str.v;
+  stringpool:= s;
 end;
 
 procedure string_new_uni(var str: rcstrtype; val: PAnsiChar; len: integer; cp: TSystemCodePage; escapes: boolean);
@@ -273,6 +287,8 @@ begin
   r.LangID:= language;
   aktresources.Add(r);
   aktresource:= r;
+  aId.Free;
+  aType.Free;
 end;
 
 procedure create_resource(aId, aType: TResourceDesc); overload;
@@ -398,4 +414,15 @@ begin
   PragmaCodePage('DEFAULT');
 end;
 
+procedure DisposePools;
+var
+  s: PStrPoolItem;
+begin
+  while stringpool <> nil do begin
+    s:= stringpool;
+    stringpool:= s^.next;
+    dispose(s^.str);
+    dispose(s);
+  end;
+end;
 

packages/fcl-res/src/rcreader.pp

@@ -88,16 +88,17 @@ begin
     rcparser.yyfilename:= '#MAIN.RC';
     rcparser.SetDefaults;
     SetTextCodePage(lexlib.yyinput, rcparser.opt_code_page);
-    rcparser.yinclude.init();
+    rcparser.yinclude:= tyinclude.Create;
     rcparser.yinclude.WorkDir:= aLocation;
-    rcparser.ypreproc.init();
+    rcparser.ypreproc:= typreproc.Create;
     rcparser.ypreproc.Defines.Add('RC_INVOKED', '');
     rcparser.aktresources:= aResources;
     if rcparser.yyparse <> 0 then
       raise EReadError.Create('Parse Error');
-    rcparser.ypreproc.done();
-    rcparser.yinclude.done();
   finally
+    rcparser.DisposePools;
+    FreeAndNil(rcparser.ypreproc);
+    FreeAndNil(rcparser.yinclude);
   end;
 end;
 
@@ -113,7 +114,6 @@ begin
 end;
 
 initialization
-  TResources.RegisterReader('.fpcres',TRCResourceReader);
-  TResources.RegisterReader('.frs',TRCResourceReader);
+  TResources.RegisterReader('.rc',TRCResourceReader);
 
 end.

packages/fcl-res/src/yyinclude.pp

@@ -3,7 +3,7 @@
 {$IFDEF INC_HEADER}
 
 type
-  tyinclude = record
+  tyinclude = class
   const
     yi_maxlevels = 5;
   var
@@ -18,8 +18,8 @@ type
     WorkDir: string;
     SearchPaths: TStringList;
   public
-    procedure init();
-    procedure done();
+    constructor Create;
+    destructor Destroy; override;
     class function wrapone(): Boolean; static;
     function push(const incfile: ansistring): Boolean;
     function pop(): Boolean;
@@ -103,16 +103,18 @@ begin
   yyerror('Invalid include directive: "'+fn+'"');
 end;
 
-procedure tyinclude.init();
+constructor tyinclude.Create;
 begin
+  inherited;
   level:= 0;
   WorkDir:= GetCurrentDir;
   SearchPaths:= TStringList.Create;
 end;
 
-procedure tyinclude.done();
+destructor tyinclude.Destroy;
 begin
   FreeAndNil(SearchPaths);
+  inherited;
 end;
 
 {$ENDIF}

packages/fcl-res/src/yypreproc.pp

@@ -3,7 +3,7 @@
 {$IFDEF INC_HEADER}
 
 type
-  typreproc = record
+  typreproc = class
   const
     yp_maxlevels = 16;
   var
@@ -12,8 +12,8 @@ type
     cheadermode: boolean;
     level : longint;
   public
-    procedure init();
-    procedure done();
+    constructor Create;
+    destructor Destroy; override;
     function isdefine(ident: string): boolean;
     function getdefine(ident: string): string;
     function useline(line: string): boolean;
@@ -25,17 +25,19 @@ var
 
 {$ELSE}
 
-procedure typreproc.init();
+constructor typreproc.Create;
 begin
+  inherited;
   Defines:= TFPStringHashTable.Create;
   level:= 0;
   cheadermode:= false;
   fillchar(skip,sizeof(skip),0);
 end;
 
-procedure typreproc.done();
+destructor typreproc.Destroy;
 begin
   FreeAndNil(Defines);
+  inherited;
 end;
 
 function Copy2SpaceDelTrim(var s: string): string;