diff options
author | svenbarth <svenbarth@3ad0048d-3df7-0310-abae-a5850022a9f2> | 2020-08-12 19:06:12 +0000 |
---|---|---|
committer | svenbarth <svenbarth@3ad0048d-3df7-0310-abae-a5850022a9f2> | 2020-08-12 19:06:12 +0000 |
commit | 5c4a032fe7583c663c47310d4b9f1b0a7e94af36 (patch) | |
tree | f1a7979654de5da89210f9bb8771cb83a4a82774 /packages/fcl-res | |
parent | 35a5e06d3af4ccaceb9de8363ed573fffa60c488 (diff) | |
download | fpc-5c4a032fe7583c663c47310d4b9f1b0a7e94af36.tar.gz |
fcl-res: memory management
Reintegrate fpcres-rc branch by Martok
git-svn-id: https://svn.freepascal.org/svn/fpc/trunk@46386 3ad0048d-3df7-0310-abae-a5850022a9f2
Diffstat (limited to 'packages/fcl-res')
-rw-r--r-- | packages/fcl-res/src/rcparserfn.inc | 33 | ||||
-rw-r--r-- | packages/fcl-res/src/rcreader.pp | 12 | ||||
-rw-r--r-- | packages/fcl-res/src/yyinclude.pp | 12 | ||||
-rw-r--r-- | packages/fcl-res/src/yypreproc.pp | 12 |
4 files changed, 50 insertions, 19 deletions
diff --git a/packages/fcl-res/src/rcparserfn.inc b/packages/fcl-res/src/rcparserfn.inc index b982df034f..7bd6d1f298 100644 --- a/packages/fcl-res/src/rcparserfn.inc +++ b/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; diff --git a/packages/fcl-res/src/rcreader.pp b/packages/fcl-res/src/rcreader.pp index 881fd6ff4c..613510571d 100644 --- a/packages/fcl-res/src/rcreader.pp +++ b/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. diff --git a/packages/fcl-res/src/yyinclude.pp b/packages/fcl-res/src/yyinclude.pp index a27d4216f2..9be7fb3ebe 100644 --- a/packages/fcl-res/src/yyinclude.pp +++ b/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} diff --git a/packages/fcl-res/src/yypreproc.pp b/packages/fcl-res/src/yypreproc.pp index a860579fb0..7a07ebe9b8 100644 --- a/packages/fcl-res/src/yypreproc.pp +++ b/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; |