mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-12 19:49:31 +02:00
# revisions: 46370,46371,46372,46373,46374,46375,46376,46377,46378,46379,46380,46381,46382,46383,46384,46385,46386,46387,46388,46389,46390,46391,46392,46393,46394,46395,46397
git-svn-id: branches/fixes_3_2@46812 -
This commit is contained in:
marco
parent
74ce84f8e4
commit
9739a91133
23
.gitattributes
vendored
23
.gitattributes
vendored
@ -2958,9 +2958,6 @@ packages/fcl-base/examples/parser.dat -text
|
||||
packages/fcl-base/examples/poolmm1.pp svneol=native#text/plain
|
||||
packages/fcl-base/examples/poolmm2.pp svneol=native#text/plain
|
||||
packages/fcl-base/examples/restest.pp svneol=native#text/plain
|
||||
packages/fcl-base/examples/showver.pp svneol=native#text/plain
|
||||
packages/fcl-base/examples/showver.rc -text
|
||||
packages/fcl-base/examples/showver.res -text
|
||||
packages/fcl-base/examples/simple.xml -text
|
||||
packages/fcl-base/examples/sitest.pp svneol=native#text/plain
|
||||
packages/fcl-base/examples/sockcli.pp svneol=native#text/plain
|
||||
@ -3022,7 +3019,6 @@ packages/fcl-base/src/csvreadwrite.pp svneol=native#text/plain
|
||||
packages/fcl-base/src/custapp.pp svneol=native#text/plain
|
||||
packages/fcl-base/src/dummy/eventlog.inc svneol=native#text/plain
|
||||
packages/fcl-base/src/eventlog.pp svneol=native#text/plain
|
||||
packages/fcl-base/src/fileinfo.pp svneol=native#text/plain
|
||||
packages/fcl-base/src/fpexprpars.pp svneol=native#text/plain
|
||||
packages/fcl-base/src/fpobserver.pp svneol=native#text/plain
|
||||
packages/fcl-base/src/fptemplate.pp svneol=native#text/plain
|
||||
@ -3373,8 +3369,12 @@ packages/fcl-extra/examples/double/daemonunit2.lfm svneol=native#text/plain
|
||||
packages/fcl-extra/examples/double/daemonunit2.pas svneol=native#text/plain
|
||||
packages/fcl-extra/examples/double/double.pp svneol=native#text/plain
|
||||
packages/fcl-extra/examples/double/resdaemonapp.pp svneol=native#text/plain
|
||||
packages/fcl-extra/examples/showver.pp svneol=native#text/pascal
|
||||
packages/fcl-extra/examples/showver.rc svneol=native#text/plain
|
||||
packages/fcl-extra/examples/showver.res -text
|
||||
packages/fcl-extra/fpmake.pp svneol=native#text/pascal
|
||||
packages/fcl-extra/src/daemonapp.pp svneol=native#text/plain
|
||||
packages/fcl-extra/src/fileinfo.pp svneol=native#text/pascal
|
||||
packages/fcl-extra/src/unix/daemonapp.inc svneol=native#text/plain
|
||||
packages/fcl-extra/src/win/ServiceManager.pas svneol=native#text/plain
|
||||
packages/fcl-extra/src/win/daemonapp.inc svneol=native#text/plain
|
||||
@ -3897,6 +3897,12 @@ packages/fcl-res/src/machosubreader.inc svneol=native#text/plain
|
||||
packages/fcl-res/src/machosubwriter.inc svneol=native#text/plain
|
||||
packages/fcl-res/src/machotypes.pp svneol=native#text/plain
|
||||
packages/fcl-res/src/machowriter.pp svneol=native#text/plain
|
||||
packages/fcl-res/src/rclex.inc svneol=native#text/plain
|
||||
packages/fcl-res/src/rclex.l svneol=native#text/plain
|
||||
packages/fcl-res/src/rcparser.pas svneol=native#text/pascal
|
||||
packages/fcl-res/src/rcparser.y svneol=native#text/plain
|
||||
packages/fcl-res/src/rcparserfn.inc svneol=native#text/plain
|
||||
packages/fcl-res/src/rcreader.pp svneol=native#text/pascal
|
||||
packages/fcl-res/src/resdatastream.pp svneol=native#text/plain
|
||||
packages/fcl-res/src/resfactory.pp svneol=native#text/plain
|
||||
packages/fcl-res/src/resmerger.pp svneol=native#text/plain
|
||||
@ -3912,6 +3918,8 @@ packages/fcl-res/src/versionresource.pp svneol=native#text/plain
|
||||
packages/fcl-res/src/versiontypes.pp svneol=native#text/plain
|
||||
packages/fcl-res/src/winpeimagereader.pp svneol=native#text/plain
|
||||
packages/fcl-res/src/xcoffwriter.pp svneol=native#text/plain
|
||||
packages/fcl-res/src/yyinclude.pp svneol=native#text/pascal
|
||||
packages/fcl-res/src/yypreproc.pp svneol=native#text/pascal
|
||||
packages/fcl-res/xml/acceleratorsresource.xml svneol=native#text/plain
|
||||
packages/fcl-res/xml/bitmapresource.xml svneol=native#text/plain
|
||||
packages/fcl-res/xml/clean.sh svneol=native#text/plain
|
||||
@ -8826,6 +8834,11 @@ packages/tosunits/src/aes.pas svneol=native#text/plain
|
||||
packages/tosunits/src/gemdos.pas svneol=native#text/plain
|
||||
packages/tosunits/src/vdi.pas svneol=native#text/plain
|
||||
packages/tosunits/src/xbios.pas svneol=native#text/plain
|
||||
packages/tplylib/Makefile svneol=native#text/plain
|
||||
packages/tplylib/Makefile.fpc svneol=native#text/plain
|
||||
packages/tplylib/fpmake.pp svneol=native#text/pascal
|
||||
packages/tplylib/src/lexlib.pas svneol=native#text/pascal
|
||||
packages/tplylib/src/yacclib.pas svneol=native#text/pascal
|
||||
packages/univint/Makefile svneol=native#text/plain
|
||||
packages/univint/Makefile.fpc svneol=native#text/plain
|
||||
packages/univint/Makefile.fpc.fpcmake svneol=native#text/plain
|
||||
@ -18721,7 +18734,6 @@ utils/tply/README.txt svneol=native#text/plain
|
||||
utils/tply/fpmake.pp svneol=native#text/plain
|
||||
utils/tply/lexbase.pas svneol=native#text/plain
|
||||
utils/tply/lexdfa.pas svneol=native#text/plain
|
||||
utils/tply/lexlib.pas svneol=native#text/plain
|
||||
utils/tply/lexlist.pas svneol=native#text/plain
|
||||
utils/tply/lexmsgs.pas svneol=native#text/plain
|
||||
utils/tply/lexopt.pas svneol=native#text/plain
|
||||
@ -18735,7 +18747,6 @@ utils/tply/tply.doc -text
|
||||
utils/tply/tply.tex -text
|
||||
utils/tply/yaccbase.pas svneol=native#text/plain
|
||||
utils/tply/yaccclos.pas svneol=native#text/plain
|
||||
utils/tply/yacclib.pas svneol=native#text/plain
|
||||
utils/tply/yacclook.pas svneol=native#text/plain
|
||||
utils/tply/yacclr0.pas svneol=native#text/plain
|
||||
utils/tply/yaccmsgs.pas svneol=native#text/plain
|
||||
|
||||
@ -19,7 +19,6 @@ begin
|
||||
{$endif ALLPACKAGES}
|
||||
P.Version:='3.2.1';
|
||||
P.Dependencies.Add('univint',[Darwin,iPhoneSim]);
|
||||
P.Dependencies.Add('fcl-res');
|
||||
p.Dependencies.Add('rtl-objpas');
|
||||
|
||||
P.Author := '<various>';
|
||||
@ -120,8 +119,6 @@ begin
|
||||
T:=P.Targets.AddUnit('fpexprpars.pp');
|
||||
T.ResourceStrings:=true;
|
||||
|
||||
T:=P.Targets.AddUnit('fileinfo.pp');
|
||||
T.ResourceStrings:=true;
|
||||
T:=P.Targets.AddUnit('csvreadwrite.pp');
|
||||
T:=P.Targets.addUnit('csvdocument.pp');
|
||||
With T.Dependencies do
|
||||
@ -166,7 +163,6 @@ begin
|
||||
T:=P.Targets.AddExampleProgram('poolmm1.pp');
|
||||
T:=P.Targets.AddExampleProgram('poolmm2.pp');
|
||||
T:=P.Targets.AddExampleProgram('restest.pp');
|
||||
T:=P.Targets.AddExampleProgram('showver.pp');
|
||||
T:=P.Targets.AddExampleProgram('sockcli.pp');
|
||||
T:=P.Targets.AddExampleProgram('socksvr.pp');
|
||||
T:=P.Targets.AddExampleProgram('sstream.pp');
|
||||
@ -208,8 +204,6 @@ begin
|
||||
// README
|
||||
// kword.xml
|
||||
// overview.rtf
|
||||
// showver.rc
|
||||
// showver.res
|
||||
// simple.xml
|
||||
// parser.dat
|
||||
// testcgi.html
|
||||
|
||||
@ -18,6 +18,7 @@ begin
|
||||
{$endif ALLPACKAGES}
|
||||
P.Version:='3.2.1';
|
||||
P.Dependencies.Add('fcl-base');
|
||||
P.Dependencies.Add('fcl-res');
|
||||
P.OSes:=[Win32,Win64]+AllUnixOSes;
|
||||
if Defaults.CPU=jvm then
|
||||
P.OSes := P.OSes - [java,android];
|
||||
@ -46,10 +47,21 @@ begin
|
||||
end;
|
||||
T.ResourceStrings:=true;
|
||||
|
||||
T:=P.Targets.AddUnit('fileinfo.pp');
|
||||
T.ResourceStrings:=true;
|
||||
|
||||
// Windows units
|
||||
T:=P.Targets.AddUnit('ServiceManager.pas',[Win32,Win64]);
|
||||
T.ResourceStrings:=true;
|
||||
|
||||
// Examples
|
||||
P.ExamplePath.Add('examples');
|
||||
T:=P.Targets.AddExampleProgram('showver.pp');
|
||||
|
||||
// example data files.
|
||||
// showver.rc
|
||||
// showver.res
|
||||
|
||||
{$ifndef ALLPACKAGES}
|
||||
Run;
|
||||
end;
|
||||
|
||||
@ -18,6 +18,9 @@ begin
|
||||
P.Directory:=ADirectory;
|
||||
{$endif ALLPACKAGES}
|
||||
P.Version:='3.2.1';
|
||||
P.Dependencies.Add('rtl-objpas');
|
||||
P.Dependencies.Add('fcl-base');
|
||||
P.Dependencies.Add('tplylib');
|
||||
P.Author := 'Giulio Bernardi';
|
||||
P.License := 'LGPL with modification, ';
|
||||
P.HomepageURL := 'www.freepascal.org';
|
||||
@ -189,6 +192,30 @@ begin
|
||||
AddInclude('machosubwriter.inc');
|
||||
AddInclude('machodefaulttarget.inc');
|
||||
end;
|
||||
T:=P.Targets.AddUnit('rcparser.pas');
|
||||
with T.Dependencies do
|
||||
begin
|
||||
AddUnit('resource');
|
||||
AddUnit('acceleratorsresource');
|
||||
AddUnit('groupiconresource');
|
||||
AddUnit('stringtableresource');
|
||||
AddUnit('bitmapresource');
|
||||
AddUnit('versionresource');
|
||||
AddUnit('versiontypes');
|
||||
AddUnit('groupcursorresource');
|
||||
AddInclude('rcparserfn.inc');
|
||||
AddInclude('rclex.inc');
|
||||
AddInclude('yyinclude.pp');
|
||||
AddInclude('yypreproc.pp');
|
||||
end;
|
||||
T:=P.Targets.AddUnit('rcreader.pp');
|
||||
with T.Dependencies do
|
||||
begin
|
||||
AddUnit('resource');
|
||||
AddUnit('resdatastream');
|
||||
AddUnit('resfactory');
|
||||
AddUnit('rcparser');
|
||||
end;
|
||||
T:=P.Targets.AddUnit('resdatastream.pp');
|
||||
with T.Dependencies do
|
||||
begin
|
||||
|
||||
1363
packages/fcl-res/src/rclex.inc
Normal file
1363
packages/fcl-res/src/rclex.inc
Normal file
File diff suppressed because it is too large
Load Diff
121
packages/fcl-res/src/rclex.l
Normal file
121
packages/fcl-res/src/rclex.l
Normal file
@ -0,0 +1,121 @@
|
||||
%{
|
||||
var
|
||||
kwtmp: integer;
|
||||
|
||||
const
|
||||
KeywordDefs: array [0..33] of TIdentMapEntry = (
|
||||
// attribs
|
||||
(Value: _LANGUAGE; Name: 'LANGUAGE'),
|
||||
(Value: _CHARACTERISTICS; Name: 'CHARACTERISTICS'),
|
||||
(Value: _VERSION; Name: 'VERSION'),
|
||||
(Value: _MOVEABLE; Name: 'MOVEABLE'),
|
||||
(Value: _FIXED; Name: 'FIXED'),
|
||||
(Value: _PURE; Name: 'PURE'),
|
||||
(Value: _IMPURE; Name: 'IMPURE'),
|
||||
(Value: _PRELOAD; Name: 'PRELOAD'),
|
||||
(Value: _LOADONCALL; Name: 'LOADONCALL'),
|
||||
(Value: _DISCARDABLE; Name: 'DISCARDABLE'),
|
||||
// resource names
|
||||
(Value: _ANICURSOR; Name: 'ANICURSOR'),
|
||||
(Value: _ANIICON; Name: 'ANIICON'),
|
||||
(Value: _BITMAP; Name: 'BITMAP'),
|
||||
(Value: _CURSOR; Name: 'CURSOR'),
|
||||
(Value: _DLGINCLUDE; Name: 'DLGINCLUDE'),
|
||||
(Value: _DLGINIT; Name: 'DLGINIT'),
|
||||
(Value: _HTML; Name: 'HTML'),
|
||||
(Value: _ICON; Name: 'ICON'),
|
||||
(Value: _MANIFEST; Name: 'MANIFEST'),
|
||||
(Value: _MESSAGETABLE; Name: 'MESSAGETABLE'),
|
||||
(Value: _PLUGPLAY; Name: 'PLUGPLAY'),
|
||||
(Value: _STRINGTABLE; Name: 'STRINGTABLE'),
|
||||
(Value: _RCDATA; Name: 'RCDATA'),
|
||||
(Value: _VERSIONINFO; Name: 'VERSIONINFO'),
|
||||
(Value: _VXD; Name: 'VXD'),
|
||||
// file version fields names
|
||||
(Value: _FILEVERSION; Name: 'FILEVERSION'),
|
||||
(Value: _PRODUCTVERSION; Name: 'PRODUCTVERSION'),
|
||||
(Value: _FILEFLAGSMASK; Name: 'FILEFLAGSMASK'),
|
||||
(Value: _FILEFLAGS; Name: 'FILEFLAGS'),
|
||||
(Value: _FILEOS; Name: 'FILEOS'),
|
||||
(Value: _FILETYPE; Name: 'FILETYPE'),
|
||||
(Value: _FILESUBTYPE; Name: 'FILESUBTYPE'),
|
||||
(Value: _BLOCK; Name: 'BLOCK'),
|
||||
(Value: _VALUE; Name: 'VALUE')
|
||||
);
|
||||
|
||||
function KeywordToInt(k: string; out kw: integer): boolean;
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
Result:= False;
|
||||
for i:= low(KeywordDefs) to high(KeywordDefs) do begin
|
||||
if k = KeywordDefs[i].Name then begin
|
||||
kw:= KeywordDefs[i].Value;
|
||||
Exit(True);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
%}
|
||||
%x INCOMLINE INCOMMENT INSTRING INSTRINGL
|
||||
|
||||
O [0-7]
|
||||
D [0-9]
|
||||
H [0-9a-fA-F]
|
||||
IDENT [a-zA-Z_]([a-zA-Z0-9_])*
|
||||
|
||||
%%
|
||||
|
||||
"//" start(INCOMLINE);
|
||||
<INCOMLINE>\n begin start(0); unget_char(nl); end;
|
||||
<INCOMLINE>. yymore;
|
||||
|
||||
"/*" start(INCOMMENT);
|
||||
<INCOMMENT>. ;
|
||||
<INCOMMENT>"*/" start(0);
|
||||
<INCOMMENT>\0 return(_ILLEGAL);
|
||||
|
||||
{D}+L? return(_NUMBER);
|
||||
0x{H}+L? return(_NUMBER);
|
||||
0o{O}+L? return(_NUMBER);
|
||||
L\" begin start(INSTRINGL); strbuf_begin(); end;
|
||||
\" begin start(INSTRING); strbuf_begin(); end;
|
||||
<INSTRING,INSTRINGL>\"\" strbuf_append('"');
|
||||
<INSTRING>\" begin
|
||||
start(0);
|
||||
return(_QUOTEDSTR);
|
||||
end;
|
||||
<INSTRINGL>\" begin
|
||||
start(0);
|
||||
return(_QUOTEDSTRL);
|
||||
end;
|
||||
<INSTRING,INSTRINGL>\\\n ;
|
||||
<INSTRING,INSTRINGL>\n return(_ILLEGAL);
|
||||
<INSTRING,INSTRINGL>. strbuf_append(yytext);
|
||||
\"StringFileInfo\" begin yytext:= 'StringFileInfo'; return(_STR_StringFileInfo); end;
|
||||
\"VarFileInfo\" begin yytext:= 'VarFileInfo'; return(_STR_VarFileInfo); end;
|
||||
\"Translation\" begin yytext:= 'Translation'; return(_STR_Translation); end;
|
||||
|
||||
BEGIN|{ return(_BEGIN);
|
||||
END|} return(_END);
|
||||
{IDENT} begin
|
||||
if ypreproc.isdefine(yytext) then begin
|
||||
unget_char(' ');
|
||||
unget_string(ypreproc.getdefine(yytext));
|
||||
end else
|
||||
if KeywordToInt(yytext, kwtmp) then
|
||||
return(kwtmp)
|
||||
else
|
||||
return(_ID);
|
||||
end;
|
||||
[ \t\n\f] ;
|
||||
[,()|^&+-*/%~] returnc(yytext[1]);
|
||||
. return(_ILLEGAL);
|
||||
%%
|
||||
|
||||
// end.
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
2747
packages/fcl-res/src/rcparser.pas
Normal file
2747
packages/fcl-res/src/rcparser.pas
Normal file
File diff suppressed because it is too large
Load Diff
234
packages/fcl-res/src/rcparser.y
Normal file
234
packages/fcl-res/src/rcparser.y
Normal file
@ -0,0 +1,234 @@
|
||||
%{
|
||||
(*
|
||||
Vorspann
|
||||
****************************************************************************)
|
||||
|
||||
unit rcparser;
|
||||
|
||||
{$I rcparserfn.inc}
|
||||
|
||||
%}
|
||||
|
||||
%token _ILLEGAL
|
||||
%token _NUMBER _QUOTEDSTR _QUOTEDSTRL
|
||||
%token _STR_StringFileInfo _STR_VarFileInfo _STR_Translation
|
||||
%token _BEGIN _END _ID
|
||||
%token _LANGUAGE _CHARACTERISTICS _VERSION _MOVEABLE _FIXED _PURE _IMPURE _PRELOAD _LOADONCALL _DISCARDABLE
|
||||
%token _BITMAP _CURSOR _ICON _STRINGTABLE _VERSIONINFO
|
||||
%token _ANICURSOR _ANIICON _DLGINCLUDE _DLGINIT _HTML _MANIFEST _MESSAGETABLE _PLUGPLAY _RCDATA _VXD
|
||||
%token _FILEVERSION _PRODUCTVERSION _FILEFLAGSMASK _FILEFLAGS _FILEOS _FILETYPE _FILESUBTYPE _BLOCK _VALUE
|
||||
%token _ACCELERATORS _DIALOG _DIALOGEX _MENU _MENUEX
|
||||
|
||||
%type <rcnumtype> numpos numexpr numeral
|
||||
%type <rcstrtype> ident_string long_string
|
||||
%type <TResourceDesc> resid rcdataid
|
||||
%type <TMemoryStream> raw_data raw_item
|
||||
%type <TFileStream> filename_string
|
||||
|
||||
%left '|'
|
||||
%left '^'
|
||||
%left '&'
|
||||
%left '+' '-'
|
||||
%left '*' '/' '%'
|
||||
%right '~' _NUMNEG
|
||||
|
||||
%%
|
||||
|
||||
rcfile
|
||||
: /* empty */
|
||||
| rcfile defnstatement
|
||||
;
|
||||
|
||||
defnstatement
|
||||
: resourcedef
|
||||
| languagedef
|
||||
;
|
||||
|
||||
resourcedef
|
||||
: res_stringtable
|
||||
| res_bitmap
|
||||
| res_cursor
|
||||
| res_icon
|
||||
| res_version
|
||||
| res_rcdata
|
||||
;
|
||||
|
||||
res_bitmap
|
||||
: resid _BITMAP { create_resource($1, RT_BITMAP); } suboptions filename_string { TBitmapResource(aktresource).SetCustomBitmapDataStream($5); }
|
||||
|
||||
res_cursor
|
||||
: resid _CURSOR { create_resource($1, RT_CURSOR); } suboptions filename_string { TGroupCursorResource(aktresource).SetCustomItemDataStream($5); }
|
||||
|
||||
res_icon
|
||||
: resid _ICON { create_resource($1, RT_ICON); } suboptions filename_string { TGroupIconResource(aktresource).SetCustomItemDataStream($5); }
|
||||
|
||||
res_version
|
||||
: resid _VERSIONINFO { create_resource($1, RT_VERSION); } version_fixed _BEGIN version_blocks _END
|
||||
|
||||
version_fixed
|
||||
: /* empty */
|
||||
| version_fixed _FILEVERSION numeral ',' numeral ',' numeral ',' numeral { TVersionResource(aktresource).FixedInfo.FileVersion:= make_version($3.v, $5.v, $7.v, $9.v); }
|
||||
| version_fixed _PRODUCTVERSION numeral ',' numeral ',' numeral ',' numeral { TVersionResource(aktresource).FixedInfo.ProductVersion:= make_version($3.v, $5.v, $7.v, $9.v); }
|
||||
| version_fixed _FILEFLAGSMASK numpos { TVersionResource(aktresource).FixedInfo.FileFlagsMask:= $3.v; }
|
||||
| version_fixed _FILEFLAGS numpos { TVersionResource(aktresource).FixedInfo.FileFlags:= $3.v; }
|
||||
| version_fixed _FILEOS numpos { TVersionResource(aktresource).FixedInfo.FileOS:= $3.v; }
|
||||
| version_fixed _FILETYPE numpos { TVersionResource(aktresource).FixedInfo.FileType:= $3.v; }
|
||||
| version_fixed _FILESUBTYPE numpos { TVersionResource(aktresource).FixedInfo.FileSubType:= $3.v; }
|
||||
;
|
||||
|
||||
version_blocks
|
||||
: /* empty */
|
||||
| version_blocks _BLOCK _STR_StringFileInfo _BEGIN ver_strings_lang _END
|
||||
| version_blocks _BLOCK _STR_VarFileInfo _BEGIN ver_translation_data _END
|
||||
;
|
||||
|
||||
ver_strings_lang
|
||||
: /* empty */
|
||||
| ver_strings_lang _BLOCK long_string _BEGIN { version_string_tab_begin($3.v^); }
|
||||
ver_strings_data _END
|
||||
;
|
||||
|
||||
ver_strings_data
|
||||
: /* empty */
|
||||
| ver_strings_data _VALUE long_string ',' long_string { version_string_tab_add($3.v^, $5.v^); }
|
||||
;
|
||||
|
||||
ver_translation_data
|
||||
: _VALUE _STR_Translation ',' ver_translation_pair
|
||||
;
|
||||
|
||||
ver_translation_pair
|
||||
: numeral ',' numeral { version_var_translation_add($1.v, $3.v); }
|
||||
| ver_translation_pair ',' numeral ',' numeral { version_var_translation_add($3.v, $5.v); }
|
||||
;
|
||||
|
||||
res_rcdata
|
||||
: resid rcdataid { create_resource($1, $2); } suboptions filename_string { aktresource.SetCustomRawDataStream($5); }
|
||||
| resid rcdataid { create_resource($1, $2); } suboptions _BEGIN raw_data _END { aktresource.SetCustomRawDataStream($6); }
|
||||
;
|
||||
|
||||
res_stringtable
|
||||
: _STRINGTABLE { stringtable_begin(); } suboptions _BEGIN stringtable_data _END { stringtable_end(); }
|
||||
|
||||
stringtable_data
|
||||
: /* empty */
|
||||
| stringtable_data stringtable_entry
|
||||
;
|
||||
|
||||
stringtable_entry
|
||||
: numeral ',' long_string { stringtable_add($1.v, $3.v^); }
|
||||
| numeral long_string { stringtable_add($1.v, $2.v^); }
|
||||
;
|
||||
|
||||
rcdataid
|
||||
: _ANICURSOR { $$:= TResourceDesc.Create(RT_ANICURSOR); }
|
||||
| _ANIICON { $$:= TResourceDesc.Create(RT_ANIICON); }
|
||||
| _DLGINCLUDE { $$:= TResourceDesc.Create(RT_DLGINCLUDE); }
|
||||
| _DLGINIT { $$:= TResourceDesc.Create(RT_DLGINIT); }
|
||||
| _HTML { $$:= TResourceDesc.Create(23); }
|
||||
| _MANIFEST { $$:= TResourceDesc.Create(RT_MANIFEST); }
|
||||
| _MESSAGETABLE { $$:= TResourceDesc.Create(RT_MESSAGETABLE); }
|
||||
| _PLUGPLAY { $$:= TResourceDesc.Create(RT_PLUGPLAY); }
|
||||
| _RCDATA { $$:= TResourceDesc.Create(RT_RCDATA); }
|
||||
| _VXD { $$:= TResourceDesc.Create(RT_VXD); }
|
||||
| resid
|
||||
;
|
||||
|
||||
resid
|
||||
: numpos { $$:= TResourceDesc.Create($1.v); }
|
||||
| ident_string { $$:= TResourceDesc.Create($1.v^); }
|
||||
;
|
||||
|
||||
suboptions
|
||||
: /* empty */
|
||||
| suboptions suboption
|
||||
;
|
||||
|
||||
suboption
|
||||
: _LANGUAGE numpos ',' numpos { change_lang_id(MakeLangID($2.v, $4.v)); }
|
||||
| _CHARACTERISTICS numpos { aktresource.Characteristics:= $2.v; }
|
||||
| _VERSION numpos { aktresource.Version:= $2.v; }
|
||||
| _MOVEABLE { aktresource.MemoryFlags:= aktresource.MemoryFlags or MF_MOVEABLE; }
|
||||
| _FIXED { aktresource.MemoryFlags:= aktresource.MemoryFlags and not MF_MOVEABLE; }
|
||||
| _PURE { aktresource.MemoryFlags:= aktresource.MemoryFlags or MF_PURE; }
|
||||
| _IMPURE { aktresource.MemoryFlags:= aktresource.MemoryFlags and not MF_PURE; }
|
||||
| _PRELOAD { aktresource.MemoryFlags:= aktresource.MemoryFlags or MF_PRELOAD; }
|
||||
| _LOADONCALL { aktresource.MemoryFlags:= aktresource.MemoryFlags and not MF_PRELOAD; }
|
||||
| _DISCARDABLE { aktresource.MemoryFlags:= aktresource.MemoryFlags or MF_DISCARDABLE; }
|
||||
;
|
||||
|
||||
languagedef
|
||||
: _LANGUAGE numpos ',' numpos { language:= MakeLangID($2.v, $4.v); }
|
||||
|
||||
numpos
|
||||
: numexpr
|
||||
;
|
||||
|
||||
numeral
|
||||
: _NUMBER { $$:= str_to_num(yytext); }
|
||||
;
|
||||
|
||||
numexpr
|
||||
: numeral
|
||||
| '(' numexpr ')' { $$:= $2; }
|
||||
| '~' numexpr %prec '~' { $$.v:= not $2.v; $$.long:= $2.long; }
|
||||
| '-' numexpr %prec _NUMNEG { $$.v:= -$2.v; $$.long:= $2.long; }
|
||||
| numexpr '*' numexpr { $$.v:= $1.v * $3.v; $$.long:= $1.long or $3.long; }
|
||||
| numexpr '/' numexpr { $$.v:= $1.v div Max(1, $3.v); $$.long:= $1.long or $3.long; }
|
||||
| numexpr '%' numexpr { $$.v:= $1.v mod Max(1, $3.v); $$.long:= $1.long or $3.long; }
|
||||
| numexpr '+' numexpr { $$.v:= $1.v + $3.v; $$.long:= $1.long or $3.long; }
|
||||
| numexpr '-' numexpr { $$.v:= $1.v - $3.v; $$.long:= $1.long or $3.long; }
|
||||
| numexpr '&' numexpr { $$.v:= $1.v and $3.v; $$.long:= $1.long or $3.long; }
|
||||
| numexpr '^' numexpr { $$.v:= $1.v xor $3.v; $$.long:= $1.long or $3.long; }
|
||||
| numexpr '|' numexpr { $$.v:= $1.v or $3.v; $$.long:= $1.long or $3.long; }
|
||||
;
|
||||
|
||||
ident_string
|
||||
: _ID { string_new($$, yytext, opt_code_page); }
|
||||
| long_string
|
||||
;
|
||||
|
||||
filename_string
|
||||
: long_string { $$:= TFileStream.Create($1.v^, fmOpenRead or fmShareDenyWrite); }
|
||||
;
|
||||
|
||||
long_string
|
||||
: _QUOTEDSTR { string_new_uni($$, @strbuf[0], strbuflen, opt_code_page, true); }
|
||||
| _QUOTEDSTRL { string_new_uni($$, @strbuf[0], strbuflen, CP_UTF16, true); }
|
||||
| _STR_StringFileInfo { string_new($$, yytext, opt_code_page); }
|
||||
| _STR_VarFileInfo { string_new($$, yytext, opt_code_page); }
|
||||
| _STR_Translation { string_new($$, yytext, opt_code_page); }
|
||||
;
|
||||
|
||||
raw_data
|
||||
: { $$:= TMemoryStream.Create; }
|
||||
raw_item
|
||||
| raw_data ',' { $$:= $1; } raw_item
|
||||
;
|
||||
|
||||
raw_item
|
||||
: /* empty */
|
||||
{
|
||||
$$:= $<TMemoryStream>0;
|
||||
}
|
||||
| long_string
|
||||
{
|
||||
$$:= $<TMemoryStream>0;
|
||||
raw_write_string($$, $1);
|
||||
}
|
||||
| numeral
|
||||
{
|
||||
$$:= $<TMemoryStream>0;
|
||||
raw_write_int($$, $1);
|
||||
}
|
||||
;
|
||||
|
||||
%%
|
||||
|
||||
{$I rclex.inc}
|
||||
begin
|
||||
bufptr:= 0;
|
||||
lexlib.get_char:= @rc_get_char;
|
||||
lexlib.unget_char:= @rc_unget_char;
|
||||
end.
|
||||
|
||||
435
packages/fcl-res/src/rcparserfn.inc
Normal file
435
packages/fcl-res/src/rcparserfn.inc
Normal file
@ -0,0 +1,435 @@
|
||||
{%MainUnit rcparser.pas}
|
||||
|
||||
interface
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
{$COPERATORS ON}
|
||||
{$GOTO ON}
|
||||
|
||||
uses
|
||||
SysUtils, Classes, StrUtils, fgl, lexlib, yacclib, resource,
|
||||
acceleratorsresource, groupiconresource, stringtableresource,
|
||||
bitmapresource, versionresource, versiontypes, groupcursorresource;
|
||||
|
||||
type
|
||||
TStringHashTable = specialize TFPGMap<String, String>;
|
||||
|
||||
function yyparse : Integer;
|
||||
|
||||
var
|
||||
aktresources: TResources;
|
||||
opt_code_page: TSystemCodePage;
|
||||
yyfilename: AnsiString;
|
||||
yyparseresult: YYSType;
|
||||
|
||||
procedure DisposePools;
|
||||
procedure SetDefaults;
|
||||
procedure PragmaCodePage(cp: string);
|
||||
|
||||
{$DEFINE INC_HEADER}
|
||||
{$I yyinclude.pp}
|
||||
{$I yypreproc.pp}
|
||||
{$UNDEF INC_HEADER}
|
||||
|
||||
implementation
|
||||
|
||||
procedure yyerror ( msg : String );
|
||||
begin
|
||||
writeln(ErrOutput, yyfilename, '(',yylineno,':',yycolno,'): at "',yytext,'": ', msg);
|
||||
WriteLn(ErrOutput, yyline);
|
||||
WriteLn(ErrOutput, '^':yycolno);
|
||||
end(*yyerrmsg*);
|
||||
|
||||
{$I yyinclude.pp}
|
||||
{$I yypreproc.pp}
|
||||
|
||||
(* I/O routines: *)
|
||||
|
||||
const nl = #10; (* newline character *)
|
||||
|
||||
const max_chars = 2048;
|
||||
|
||||
var
|
||||
bufptr : Integer;
|
||||
buf : array [1..max_chars] of Char;
|
||||
|
||||
function rc_get_char : Char;
|
||||
var i : Integer;
|
||||
ok : boolean;
|
||||
begin
|
||||
if (bufptr=0) and not eof(yyinput) then
|
||||
begin
|
||||
repeat
|
||||
readln(yyinput, yyline);
|
||||
inc(yylineno); yycolno := 1;
|
||||
ok:= ypreproc.useline(yyline);
|
||||
until (ok or eof(yyinput));
|
||||
if ok then begin
|
||||
buf[1] := nl;
|
||||
for i := 1 to length(yyline) do
|
||||
buf[i+1] := yyline[length(yyline)-i+1];
|
||||
inc(bufptr, length(yyline)+1);
|
||||
end;
|
||||
end;
|
||||
if bufptr>0 then
|
||||
begin
|
||||
rc_get_char := buf[bufptr];
|
||||
dec(bufptr);
|
||||
inc(yycolno);
|
||||
end
|
||||
else
|
||||
rc_get_char := #0;
|
||||
end(*get_char*);
|
||||
|
||||
procedure rc_unget_char ( c : Char );
|
||||
begin
|
||||
if bufptr=max_chars then yyerror('input buffer overflow');
|
||||
inc(bufptr);
|
||||
dec(yycolno);
|
||||
buf[bufptr] := c;
|
||||
end(*unget_char*);
|
||||
|
||||
procedure unget_string(s: string);
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
for i:= Length(s) downto 1 do
|
||||
rc_unget_char(s[i]);
|
||||
end;
|
||||
|
||||
procedure PragmaCodePage(cp: string);
|
||||
var cpi: integer;
|
||||
begin
|
||||
if Uppercase(cp) = 'DEFAULT' then
|
||||
opt_code_page:= DefaultFileSystemCodePage
|
||||
else begin
|
||||
if TryStrToInt(cp, cpi) and (cpi>=0) and (cpi<=high(TSystemCodePage)) then
|
||||
opt_code_page:= cpi
|
||||
else
|
||||
yyerror('Invalid code_page pragma: "' + cp + '"');
|
||||
end;
|
||||
end;
|
||||
|
||||
type
|
||||
rcnumtype = record
|
||||
v: LongWord;
|
||||
long: boolean;
|
||||
end;
|
||||
|
||||
rcstrtype = record
|
||||
v: PUnicodeString;
|
||||
cp: TSystemCodePage;
|
||||
end;
|
||||
|
||||
function str_to_cbase(s: string): LongWord;
|
||||
begin
|
||||
if s = '0' then
|
||||
Exit(0);
|
||||
if Copy(s, 1, 2) = '0x' then
|
||||
Exit(StrToInt('$' + Copy(s, 3, Maxint)));
|
||||
if Copy(s, 1, 2) = '0o' then
|
||||
Exit(StrToInt('&' + Copy(s, 3, Maxint)));
|
||||
if Copy(s, 1, 1) = '0' then
|
||||
Exit(StrToInt('&' + Copy(s, 2, Maxint)));
|
||||
Result:= StrToInt(s);
|
||||
end;
|
||||
|
||||
function str_to_num(s:string): rcnumtype;
|
||||
begin
|
||||
// this does not handle empty strings - should never get them from the lexer
|
||||
Result.long:= s[Length(s)] = 'L';
|
||||
if Result.long then
|
||||
setlength(s, Length(s) - 1);
|
||||
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
|
||||
FillChar(strbuf[0], sizeof(strbuf), 0);
|
||||
strbuflen:= 0;
|
||||
end;
|
||||
|
||||
procedure strbuf_append(s: string);
|
||||
var
|
||||
rem: integer;
|
||||
begin
|
||||
rem:= MAX_RCSTR_LEN - strbuflen;
|
||||
if Length(s) < rem then
|
||||
rem:= Length(s);
|
||||
Move(s[1], strbuf[strbuflen], rem);
|
||||
inc(strbuflen, rem);
|
||||
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);
|
||||
function translateChar(c: AnsiChar): UnicodeChar;
|
||||
var
|
||||
u: UnicodeString = '';
|
||||
begin
|
||||
if cp = CP_UTF16 then
|
||||
Result:= c
|
||||
else begin
|
||||
// TODO: there has to be a better way to translate a single codepoint
|
||||
widestringmanager.Ansi2UnicodeMoveProc(@c, cp, u, 1);
|
||||
Result:= u[1];
|
||||
end;
|
||||
end;
|
||||
|
||||
var
|
||||
uni: UnicodeString;
|
||||
wc: PUnicodeChar;
|
||||
rc, endin: PAnsiChar;
|
||||
h: string;
|
||||
hexlen, i: integer;
|
||||
begin
|
||||
uni:= '';
|
||||
if not escapes then
|
||||
widestringmanager.Ansi2UnicodeMoveProc(val, cp, uni, len)
|
||||
else begin
|
||||
if cp = CP_UTF16 then
|
||||
hexlen:= 4
|
||||
else
|
||||
hexlen:= 2;
|
||||
setlength(uni, len);
|
||||
wc:= @uni[1];
|
||||
rc:= val;
|
||||
endin:= @val[len];
|
||||
while rc < endin do begin
|
||||
if (rc^ = '\') then begin
|
||||
inc(rc);
|
||||
case rc^ of
|
||||
#0: exit {Error: End too soon};
|
||||
'\': wc^:= '\';
|
||||
'f': wc^:= #&14;
|
||||
'n': wc^:= #&12;
|
||||
'r': wc^:= #&15;
|
||||
't': wc^:= #&11;
|
||||
'x',
|
||||
'X': begin
|
||||
h:= '$';
|
||||
for i:= 1 to hexlen do begin
|
||||
inc(rc);
|
||||
if rc >= endin then
|
||||
exit {Error: End too soon};
|
||||
h += rc^;
|
||||
end;
|
||||
if cp = CP_UTF16 then
|
||||
wc^:= WideChar(StrToInt(h))
|
||||
else
|
||||
wc^:= translateChar(Char(StrToInt(h)));
|
||||
end;
|
||||
'0'..'7': begin
|
||||
h:= '&' + rc^;
|
||||
for i:= 2 to 3 do begin
|
||||
inc(rc);
|
||||
if (rc >= endin) or not (rc^ in ['0'..'7']) then begin
|
||||
dec(rc);
|
||||
break;
|
||||
end;
|
||||
h += rc^;
|
||||
end;
|
||||
if cp = CP_UTF16 then
|
||||
wc^:= WideChar(StrToInt(h))
|
||||
else
|
||||
wc^:= translateChar(Char(StrToInt(h)));
|
||||
end;
|
||||
else
|
||||
wc^:= translateChar(rc^);
|
||||
end;
|
||||
end else
|
||||
wc^:= translateChar(rc^);
|
||||
inc(wc);
|
||||
inc(rc);
|
||||
end;
|
||||
i:= (PtrUInt(wc) - PtrUInt(@uni[1])) div SizeOf(WideChar);
|
||||
SetLength(uni, i);
|
||||
end;
|
||||
string_new(str, uni, cp);
|
||||
end;
|
||||
|
||||
function Max(a, b: LongWord): LongWord; inline;
|
||||
begin
|
||||
if a > b then
|
||||
Result:= a
|
||||
else
|
||||
Result:= b;
|
||||
end;
|
||||
|
||||
var
|
||||
aktresource: TAbstractResource;
|
||||
language: TLangID;
|
||||
|
||||
procedure create_resource(aId, aType: TResourceDesc; aClass: TResourceClass);
|
||||
var
|
||||
r: TAbstractResource;
|
||||
begin
|
||||
r:= aClass.Create(aType, aId);
|
||||
r.LangID:= language;
|
||||
aktresources.Add(r);
|
||||
aktresource:= r;
|
||||
aId.Free;
|
||||
aType.Free;
|
||||
end;
|
||||
|
||||
procedure create_resource(aId, aType: TResourceDesc); overload;
|
||||
begin
|
||||
create_resource(aId, aType, TGenericResource);
|
||||
end;
|
||||
|
||||
procedure create_resource(aId: TResourceDesc; aType: Word); overload;
|
||||
var
|
||||
cls: TResourceClass;
|
||||
begin
|
||||
case aType of
|
||||
RT_BITMAP: cls:= TBitmapResource;
|
||||
RT_ICON: cls:= TGroupIconResource;
|
||||
RT_CURSOR: cls:= TGroupCursorResource;
|
||||
RT_VERSION: cls:= TVersionResource;
|
||||
else
|
||||
raise EResourceDescTypeException.CreateFmt('Resource type not supported: %d', [aType]);
|
||||
end;
|
||||
create_resource(aId, nil, cls);
|
||||
end;
|
||||
|
||||
procedure change_lang_id(newlang: TLangID);
|
||||
begin
|
||||
// cannot change a language id while it is contained in a list, so remove and re-add
|
||||
aktresources.Remove(aktresource);
|
||||
aktresource.LangID:= newlang;
|
||||
aktresources.Add(aktresource);
|
||||
end;
|
||||
|
||||
procedure raw_write_string(Stream: TMemoryStream; str: rcstrtype);
|
||||
var
|
||||
i: integer;
|
||||
u: UnicodeString;
|
||||
r: RawByteString = '';
|
||||
begin
|
||||
u:= str.v^;
|
||||
if str.cp = CP_UTF16 then begin
|
||||
for i:=1 to length(u) do
|
||||
Stream.WriteWord(NtoLE(Word(u[i])));
|
||||
end else begin
|
||||
widestringmanager.Unicode2AnsiMoveProc(@u[1], r, str.cp, Length(u));
|
||||
Stream.WriteBuffer(r[1], Length(r));
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure raw_write_int(Stream: TMemoryStream; num: rcnumtype);
|
||||
begin
|
||||
if num.long then
|
||||
Stream.WriteDWord(NtoLE(num.v))
|
||||
else
|
||||
Stream.WriteWord(NtoLE(Word(num.v)));
|
||||
end;
|
||||
|
||||
procedure stringtable_begin();
|
||||
begin
|
||||
// create dummy resource that we will use to capture suboptions
|
||||
create_resource(TResourceDesc.create(1), TResourceDesc.create(1));
|
||||
aktresources.Remove(aktresource);
|
||||
end;
|
||||
|
||||
procedure stringtable_add(ident: Word; str: AnsiString);
|
||||
var
|
||||
table: word;
|
||||
r: TStringTableResource;
|
||||
begin
|
||||
table:= (ident div 16) + 1;
|
||||
try
|
||||
{ TODO : This is stupid }
|
||||
r:= aktresources.Find(RT_STRING, table, aktresource.LangID) as TStringTableResource;
|
||||
except
|
||||
on e: EResourceNotFoundException do begin
|
||||
r:= TStringTableResource.Create;
|
||||
r.LangID:= aktresource.LangID;
|
||||
r.MemoryFlags:= aktresource.MemoryFlags;
|
||||
r.Characteristics:= aktresource.Characteristics;
|
||||
r.Version:= aktresource.Version;
|
||||
r.FirstID:= ident;
|
||||
aktresources.Add(r);
|
||||
end;
|
||||
end;
|
||||
r.Strings[ident]:= str;
|
||||
end;
|
||||
|
||||
procedure stringtable_end();
|
||||
begin
|
||||
FreeAndNil(aktresource);
|
||||
end;
|
||||
|
||||
function make_version(a, b, c, d: Word): TFileProductVersion;
|
||||
begin
|
||||
Result[0]:= a;
|
||||
Result[1]:= b;
|
||||
Result[2]:= c;
|
||||
Result[3]:= d;
|
||||
end;
|
||||
|
||||
procedure version_string_tab_begin(lcs: AnsiString);
|
||||
var
|
||||
vst: TVersionStringTable;
|
||||
begin
|
||||
vst:= TVersionStringTable.Create(lcs);
|
||||
TVersionResource(aktresource).StringFileInfo.Add(vst);
|
||||
end;
|
||||
|
||||
procedure version_string_tab_add(key, value: AnsiString);
|
||||
begin
|
||||
TVersionResource(aktresource).StringFileInfo.Items[TVersionResource(aktresource).StringFileInfo.Count-1].Add(key, value);
|
||||
end;
|
||||
|
||||
procedure version_var_translation_add(langid, cpid: word);
|
||||
var
|
||||
ti: TVerTranslationInfo;
|
||||
begin
|
||||
ti.language:= langid;
|
||||
ti.codepage:= cpid;
|
||||
TVersionResource(aktresource).VarFileInfo.Add(ti);
|
||||
end;
|
||||
|
||||
procedure SetDefaults;
|
||||
begin
|
||||
language:= $0409; // MS RC starts up as en-US
|
||||
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;
|
||||
|
||||
133
packages/fcl-res/src/rcreader.pp
Normal file
133
packages/fcl-res/src/rcreader.pp
Normal file
@ -0,0 +1,133 @@
|
||||
{
|
||||
This file is part of the Free Pascal run time library.
|
||||
Copyright (c) 2008 by Giulio Bernardi
|
||||
|
||||
Resource reader/compiler for MS RC script files
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||
|
||||
**********************************************************************}
|
||||
|
||||
unit rcreader;
|
||||
|
||||
{$MODE OBJFPC} {$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, resource;
|
||||
|
||||
type
|
||||
|
||||
{ TRCResourceReader }
|
||||
|
||||
TRCResourceReader = class(TAbstractResourceReader)
|
||||
private
|
||||
fExtensions : string;
|
||||
fDescription : string;
|
||||
fRCIncludeDirs: TStringList;
|
||||
fRCDefines: TStringList;
|
||||
protected
|
||||
function GetExtensions : string; override;
|
||||
function GetDescription : string; override;
|
||||
procedure Load(aResources : TResources; aStream : TStream); override;
|
||||
function CheckMagic(aStream : TStream) : boolean; override;
|
||||
procedure ReadRCFile(aResources : TResources; aLocation: String; aStream : TStream);
|
||||
public
|
||||
constructor Create; override;
|
||||
destructor Destroy; override;
|
||||
property RCIncludeDirs: TStringList read fRCIncludeDirs;
|
||||
property RCDefines: TStringList read fRCDefines;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
StreamIO, resdatastream, resfactory, lexlib, rcparser;
|
||||
|
||||
{ TRCResourceReader }
|
||||
|
||||
function TRCResourceReader.GetExtensions: string;
|
||||
begin
|
||||
Result:=fExtensions;
|
||||
end;
|
||||
|
||||
function TRCResourceReader.GetDescription: string;
|
||||
begin
|
||||
Result:=fDescription;
|
||||
end;
|
||||
|
||||
procedure TRCResourceReader.Load(aResources: TResources; aStream: TStream);
|
||||
var
|
||||
fd: String;
|
||||
begin
|
||||
if aStream is TFileStream then
|
||||
fd:= ExtractFilePath(TFileStream(aStream).FileName)
|
||||
else
|
||||
fd:= IncludeTrailingPathDelimiter(GetCurrentDir);
|
||||
try
|
||||
ReadRCFile(aResources, fd, aStream);
|
||||
except
|
||||
on e : EReadError do
|
||||
raise EResourceReaderUnexpectedEndOfStreamException.Create('');
|
||||
end;
|
||||
end;
|
||||
|
||||
function TRCResourceReader.CheckMagic(aStream: TStream): boolean;
|
||||
begin
|
||||
{ TODO : Check for Text-Only file }
|
||||
Result:= True;
|
||||
end;
|
||||
|
||||
procedure TRCResourceReader.ReadRCFile(aResources: TResources; aLocation: String; aStream: TStream);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
AssignStream(lexlib.yyinput, aStream);
|
||||
Reset(lexlib.yyinput);
|
||||
try
|
||||
rcparser.yyfilename:= '#MAIN.RC';
|
||||
rcparser.SetDefaults;
|
||||
SetTextCodePage(lexlib.yyinput, rcparser.opt_code_page);
|
||||
rcparser.yinclude:= tyinclude.Create;
|
||||
rcparser.yinclude.WorkDir:= aLocation;
|
||||
rcparser.yinclude.SearchPaths.Assign(fRCIncludeDirs);
|
||||
rcparser.ypreproc:= typreproc.Create;
|
||||
rcparser.ypreproc.Defines.Add('RC_INVOKED', '');
|
||||
for i:= 0 to fRCDefines.Count-1 do
|
||||
rcparser.ypreproc.Defines.KeyData[fRCDefines.Names[i]]:= fRCDefines.ValueFromIndex[i];
|
||||
rcparser.aktresources:= aResources;
|
||||
if rcparser.yyparse <> 0 then
|
||||
raise EReadError.Create('Parse Error');
|
||||
finally
|
||||
rcparser.DisposePools;
|
||||
FreeAndNil(rcparser.ypreproc);
|
||||
FreeAndNil(rcparser.yinclude);
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TRCResourceReader.Create;
|
||||
begin
|
||||
fExtensions:='.rc';
|
||||
fDescription:='RC script resource reader';
|
||||
fRCDefines:= TStringList.Create;
|
||||
fRCIncludeDirs:= TStringList.Create;
|
||||
end;
|
||||
|
||||
destructor TRCResourceReader.Destroy;
|
||||
begin
|
||||
fRCIncludeDirs.Free;
|
||||
fRCDefines.Free;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
initialization
|
||||
{ don't register automatically, as this is essentially a "catch all" }
|
||||
//TResources.RegisterReader('.rc',TRCResourceReader);
|
||||
|
||||
end.
|
||||
@ -44,6 +44,7 @@ const
|
||||
RT_ANIICON = 22; //Animated icon.
|
||||
RT_HTML = 23; //HTML.
|
||||
RT_MANIFEST = 24; //Microsoft Windows XP: Side-by-Side Assembly XML Manifest.
|
||||
RT_DLGINIT = 240; //Never present in compiled form
|
||||
|
||||
CREATEPROCESS_MANIFEST_RESOURCE_ID = 1;
|
||||
ISOLATIONAWARE_MANIFEST_RESOURCE_ID = 2;
|
||||
|
||||
@ -21,13 +21,13 @@ interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, resource;
|
||||
|
||||
|
||||
type
|
||||
EStringTableResourceException = class(EResourceException);
|
||||
EStringTableNameNotAllowedException = class(EStringTableResourceException);
|
||||
EStringTableIndexOutOfBoundsException = class(EStringTableResourceException);
|
||||
|
||||
|
||||
|
||||
resourcestring
|
||||
SNameNotAllowed = 'Resource ID must be an ordinal in the range 1-4096';
|
||||
SIndexOutOfBounds = 'String ID out of bounds: %d';
|
||||
@ -42,7 +42,7 @@ type
|
||||
fName : TResourceDesc;
|
||||
fFirstID : word;
|
||||
fCount : integer;
|
||||
fList : TStringList;
|
||||
fList : array of UnicodeString;
|
||||
fCanChangeDesc : boolean;
|
||||
function IDtoIndex(const aId : word) : integer;
|
||||
procedure CheckListLoaded;
|
||||
@ -85,54 +85,47 @@ end;
|
||||
procedure TStringTableResource.CheckListLoaded;
|
||||
var i : integer;
|
||||
begin
|
||||
if fList<>nil then exit;
|
||||
fList:=TStringList.Create;
|
||||
fList.Capacity:=16;
|
||||
if Length(fList) <> 0 then exit;
|
||||
SetLength(fList, fCount);
|
||||
for i:=0 to high(fList) do
|
||||
fList[i]:= '';
|
||||
if RawData.Size=0 then exit;
|
||||
RawData.Position:=0;
|
||||
for i:=0 to 15 do
|
||||
fList.Add(ReadWideString);
|
||||
for i:=0 to high(fList) do
|
||||
fList[i]:= ReadWideString;
|
||||
end;
|
||||
|
||||
function TStringTableResource.ReadWideString: string;
|
||||
var ws : widestring;
|
||||
var ws : unicodestring;
|
||||
w : word;
|
||||
i : integer;
|
||||
begin
|
||||
RawData.ReadBuffer(w,2);
|
||||
{$IFDEF ENDIAN_BIG}
|
||||
w:=SwapEndian(w);
|
||||
{$ENDIF}
|
||||
w:= LEtoN(w);
|
||||
setlength(ws,w);
|
||||
|
||||
for i:=1 to length(ws) do
|
||||
begin
|
||||
RawData.ReadBuffer(w,2);
|
||||
{$IFDEF ENDIAN_BIG}
|
||||
w:=SwapEndian(w);
|
||||
{$ENDIF}
|
||||
w:= LEtoN(w);
|
||||
ws[i]:=widechar(w);
|
||||
end;
|
||||
Result:=ws;
|
||||
end;
|
||||
|
||||
procedure TStringTableResource.WriteWideString(const aString: string);
|
||||
var ws : widestring;
|
||||
var ws : unicodestring;
|
||||
w : word;
|
||||
i : integer;
|
||||
begin
|
||||
w:=length(aString);
|
||||
{$IFDEF ENDIAN_BIG}
|
||||
w:=SwapEndian(w);
|
||||
{$ENDIF}
|
||||
w:= NtoLE(w);
|
||||
RawData.WriteBuffer(w,2);
|
||||
ws:=aString;
|
||||
for i:=1 to length(ws) do
|
||||
begin
|
||||
w:=word(ws[i]);
|
||||
{$IFDEF ENDIAN_BIG}
|
||||
w:=SwapEndian(w);
|
||||
{$ENDIF}
|
||||
w:= NtoLE(w);
|
||||
RawData.WriteBuffer(w,2);
|
||||
end;
|
||||
end;
|
||||
@ -157,8 +150,8 @@ begin
|
||||
CheckIndex(id);
|
||||
CheckListLoaded;
|
||||
idx:=IDtoIndex(id);
|
||||
if idx>=fList.Count then Result:=''
|
||||
else Result:=fList[idx];
|
||||
if idx>high(fList) then Result:= ''
|
||||
else Result:= fList[idx];
|
||||
end;
|
||||
|
||||
procedure TStringTableResource.SetString(id: word; aString: string);
|
||||
@ -167,13 +160,7 @@ begin
|
||||
CheckIndex(id);
|
||||
CheckListLoaded;
|
||||
idx:=IDtoIndex(id);
|
||||
if idx<fList.Count then fList[idx]:=aString
|
||||
else if idx>=fList.Count then
|
||||
begin
|
||||
for i:=fList.Count to idx-1 do
|
||||
fList.Add('');
|
||||
fList.Add(aString);
|
||||
end;
|
||||
fList[idx]:= aString;
|
||||
end;
|
||||
|
||||
procedure TStringTableResource.UpdateRawData;
|
||||
@ -184,7 +171,7 @@ begin
|
||||
RawData.Position:=0;
|
||||
for i:=FirstID to LastID do
|
||||
WriteWideString(Strings[i]);
|
||||
FreeAndNil(fList);
|
||||
fList:= nil;
|
||||
end;
|
||||
|
||||
function TStringTableResource.GetType: TResourceDesc;
|
||||
@ -223,7 +210,7 @@ constructor TStringTableResource.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
fCanChangeDesc:=false;
|
||||
fList:=nil;
|
||||
fList:= nil;
|
||||
fType:=TResourceDesc.Create(RT_STRING);
|
||||
fName:=TResourceDesc.Create(1);
|
||||
fCount:=16;
|
||||
@ -248,8 +235,7 @@ destructor TStringTableResource.Destroy;
|
||||
begin
|
||||
fType.Free;
|
||||
fName.Free;
|
||||
if fList<>nil then
|
||||
fList.Free;
|
||||
SetLength(fList, 0);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
|
||||
127
packages/fcl-res/src/yyinclude.pp
Normal file
127
packages/fcl-res/src/yyinclude.pp
Normal file
@ -0,0 +1,127 @@
|
||||
{%MainUnit rcparser.pas}
|
||||
|
||||
{$IFDEF INC_HEADER}
|
||||
|
||||
type
|
||||
tyinclude = class
|
||||
const
|
||||
yi_maxlevels = 5;
|
||||
var
|
||||
stack: array[0..yi_maxlevels] of record
|
||||
yyinput : Text; (* input and output file *)
|
||||
yyline : String; (* current input line *)
|
||||
yylineno, yycolno : Integer; (* current input position *)
|
||||
fn : AnsiString;
|
||||
prev_wrap : yywrap_t;
|
||||
end;
|
||||
level: integer;
|
||||
WorkDir: string;
|
||||
SearchPaths: TStringList;
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
class function wrapone(): Boolean; static;
|
||||
function push(const incfile: ansistring): Boolean;
|
||||
function pop(): Boolean;
|
||||
function expand(fn: AnsiString): AnsiString;
|
||||
end;
|
||||
|
||||
var
|
||||
yinclude: tyinclude;
|
||||
|
||||
{$ELSE}
|
||||
|
||||
class function tyinclude.wrapone(): Boolean;
|
||||
begin
|
||||
Result:= yinclude.pop;
|
||||
end;
|
||||
|
||||
function tyinclude.push(const incfile: ansistring): Boolean;
|
||||
begin
|
||||
stack[level].yyinput:= yyinput;
|
||||
stack[level].yyline:= yyline;
|
||||
stack[level].yylineno:= yylineno;
|
||||
stack[level].yycolno:= yycolno;
|
||||
stack[level].prev_wrap:= yywrap;
|
||||
stack[level].fn:= yyfilename;
|
||||
inc(level);
|
||||
yywrap:= @tyinclude.wrapone;
|
||||
AssignFile(yyinput, incfile);
|
||||
Reset(yyinput);
|
||||
yyfilename:= incfile;
|
||||
yyline:= '';
|
||||
yylineno:= 0;
|
||||
yycolno:= 0;
|
||||
{$if declared(ypreproc)}
|
||||
ypreproc.newfile(yyfilename);
|
||||
{$endif}
|
||||
Result:= true;
|
||||
end;
|
||||
|
||||
function tyinclude.pop(): Boolean;
|
||||
begin
|
||||
Close(yyinput);
|
||||
Result:= level = 0;
|
||||
if not Result then begin
|
||||
Dec(level);
|
||||
yyinput:= stack[level].yyinput;
|
||||
yyline:= stack[level].yyline;
|
||||
yylineno:= stack[level].yylineno;
|
||||
yycolno:= stack[level].yycolno;
|
||||
yywrap:= stack[level].prev_wrap;
|
||||
yyfilename:= stack[level].fn;
|
||||
{$if declared(ypreproc)}
|
||||
ypreproc.newfile(yyfilename);
|
||||
{$endif}
|
||||
end;
|
||||
end;
|
||||
|
||||
function tyinclude.expand(fn: AnsiString): AnsiString;
|
||||
var
|
||||
i: integer;
|
||||
f: string;
|
||||
begin
|
||||
result:= '';
|
||||
if Length(fn) > 3 then begin
|
||||
if (fn[1] = '<') and (fn[length(fn)] = '>') then begin
|
||||
fn:= copy(fn, 2, Length(fn)-2);
|
||||
for i:= 0 to SearchPaths.Count - 1 do begin
|
||||
f:= ConcatPaths([SearchPaths[i], fn]);
|
||||
if FileExists(f) then
|
||||
Exit(f);
|
||||
end;
|
||||
yyerror('Include file not found on search paths: <'+fn+'>');
|
||||
end
|
||||
else if (fn[1] = '"') and (fn[length(fn)] = '"') then begin
|
||||
fn:= copy(fn, 2, Length(fn)-2);
|
||||
f:= ConcatPaths([WorkDir, fn]);
|
||||
if FileExists(f) then
|
||||
Exit(f);
|
||||
if fn = 'windows.h' then begin
|
||||
// treat windows.h as an alias for windres.h
|
||||
f:= ConcatPaths([WorkDir, 'windres.h']);
|
||||
if FileExists(f) then
|
||||
Exit(f);
|
||||
end;
|
||||
yyerror('Include file not found: "'+fn+'"');
|
||||
end;
|
||||
end;
|
||||
yyerror('Invalid include directive: "'+fn+'"');
|
||||
end;
|
||||
|
||||
constructor tyinclude.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
level:= 0;
|
||||
WorkDir:= GetCurrentDir;
|
||||
SearchPaths:= TStringList.Create;
|
||||
end;
|
||||
|
||||
destructor tyinclude.Destroy;
|
||||
begin
|
||||
FreeAndNil(SearchPaths);
|
||||
inherited;
|
||||
end;
|
||||
|
||||
{$ENDIF}
|
||||
|
||||
160
packages/fcl-res/src/yypreproc.pp
Normal file
160
packages/fcl-res/src/yypreproc.pp
Normal file
@ -0,0 +1,160 @@
|
||||
{%MainUnit rcparser.pas}
|
||||
|
||||
{$IFDEF INC_HEADER}
|
||||
|
||||
type
|
||||
typreproc = class
|
||||
const
|
||||
yp_maxlevels = 16;
|
||||
var
|
||||
Defines: TStringHashTable;
|
||||
skip : array[0..yp_maxlevels-1] of boolean;
|
||||
cheadermode: boolean;
|
||||
level : longint;
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
function isdefine(ident: string): boolean;
|
||||
function getdefine(ident: string): string;
|
||||
function useline(line: string): boolean;
|
||||
procedure newfile(fn: string);
|
||||
end;
|
||||
|
||||
var
|
||||
ypreproc: typreproc;
|
||||
|
||||
{$ELSE}
|
||||
|
||||
constructor typreproc.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
Defines:= TStringHashTable.Create;
|
||||
level:= 0;
|
||||
cheadermode:= false;
|
||||
fillchar(skip,sizeof(skip),0);
|
||||
end;
|
||||
|
||||
destructor typreproc.Destroy;
|
||||
begin
|
||||
FreeAndNil(Defines);
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function Copy2SpaceDelTrim(var s: string): string;
|
||||
const
|
||||
whitespace = [#9, ' '];
|
||||
var
|
||||
p: integer;
|
||||
begin
|
||||
p:= PosSet(whitespace, s);
|
||||
if p <= 0 then begin
|
||||
result:= s;
|
||||
s:= '';
|
||||
end else begin
|
||||
result:= Copy(S, 1, p-1);
|
||||
while (p < Length(s)) and (s[p] in whitespace) do
|
||||
inc(p);
|
||||
Delete(s, 1, p-1);
|
||||
end;
|
||||
end;
|
||||
|
||||
function Substring(s: string; First, Last: integer): string;
|
||||
begin
|
||||
Result:= Copy(s, First, Last-First+1);
|
||||
end;
|
||||
|
||||
function typreproc.isdefine(ident: string): boolean;
|
||||
begin
|
||||
Result:= Defines.IndexOf(ident) >= 0;
|
||||
end;
|
||||
|
||||
function typreproc.getdefine(ident: string): string;
|
||||
begin
|
||||
Result:= Defines[ident];
|
||||
end;
|
||||
|
||||
function typreproc.useline(line: string): boolean;
|
||||
var
|
||||
w, word, arg1: string;
|
||||
begin
|
||||
Result:= true;
|
||||
w:= trim(line);
|
||||
if (yystate <= 1) and
|
||||
(Length(w) > 2) and (w[1] = '#') then begin
|
||||
Delete(w, 1, 1);
|
||||
word:= Copy2SpaceDelTrim(w);
|
||||
case word of
|
||||
'ifdef': begin
|
||||
inc(Level);
|
||||
if Level >= yp_maxlevels then begin
|
||||
yyerror('Too many ifdef levels');
|
||||
exit;
|
||||
end;
|
||||
skip[level]:= (skip[level-1] or (not isdefine(w)));
|
||||
end;
|
||||
'ifndef': begin
|
||||
inc(Level);
|
||||
if Level >= yp_maxlevels then begin
|
||||
yyerror('Too many ifdef levels');
|
||||
exit;
|
||||
end;
|
||||
skip[level]:= (skip[level-1] or (isdefine(w)));
|
||||
end;
|
||||
'if': begin
|
||||
inc(Level);
|
||||
if Level >= yp_maxlevels then begin
|
||||
yyerror('Too many ifdef levels');
|
||||
exit;
|
||||
end;
|
||||
{ TODO : implement some expressions? for now, always returns false }
|
||||
skip[level]:= (skip[level-1] or False);
|
||||
end;
|
||||
'else': begin
|
||||
skip[level]:= skip[level-1] or (not skip[level]);
|
||||
end;
|
||||
'endif': begin
|
||||
skip[level]:= false;
|
||||
if Level = 0 then begin
|
||||
yyerror('Too many endif found');
|
||||
exit;
|
||||
end;
|
||||
dec(level);
|
||||
end;
|
||||
else
|
||||
if not skip[level] then
|
||||
case word of
|
||||
'pragma': begin
|
||||
if StartsStr('code_page(', w) then begin
|
||||
arg1:= Substring(w, Length('code_page(') + 1, Pos(')', w) - 1);
|
||||
PragmaCodePage(arg1);
|
||||
end;
|
||||
end;
|
||||
'define': begin
|
||||
arg1:= Copy2SpaceDelTrim(w);
|
||||
Defines[arg1]:= w;
|
||||
end;
|
||||
'undef': begin
|
||||
Defines.Remove(w);
|
||||
end;
|
||||
'include': begin
|
||||
arg1:= yinclude.expand(w);
|
||||
yinclude.push(arg1);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
Result:= false;
|
||||
end else begin
|
||||
Result:= (not cheadermode) and (not skip[level]);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure typreproc.newfile(fn: string);
|
||||
var
|
||||
ex: String;
|
||||
begin
|
||||
ex:= UpperCase(ExtractFileExt(yyfilename));
|
||||
cheadermode:= (ex = '.C') or (ex = '.H');
|
||||
end;
|
||||
|
||||
|
||||
{$ENDIF}
|
||||
@ -118,6 +118,7 @@
|
||||
add_syslog(ADirectory+IncludeTrailingPathDelimiter('syslog'));
|
||||
add_tcl(ADirectory+IncludeTrailingPathDelimiter('tcl'));
|
||||
add_tosunits(ADirectory+IncludeTrailingPathDelimiter('tosunits'));
|
||||
add_tplylib(ADirectory+IncludeTrailingPathDelimiter('tplylib'));
|
||||
add_univint(ADirectory+IncludeTrailingPathDelimiter('univint'));
|
||||
add_unixutil(ADirectory+IncludeTrailingPathDelimiter('unixutil'));
|
||||
add_unzip(ADirectory+IncludeTrailingPathDelimiter('unzip'));
|
||||
|
||||
@ -679,6 +679,12 @@ begin
|
||||
{$include tosunits/fpmake.pp}
|
||||
end;
|
||||
|
||||
procedure add_tplylib(const ADirectory: string);
|
||||
begin
|
||||
with Installer do
|
||||
{$include tplylib/fpmake.pp}
|
||||
end;
|
||||
|
||||
procedure add_univint(const ADirectory: string);
|
||||
begin
|
||||
with Installer do
|
||||
|
||||
2745
packages/tplylib/Makefile
Normal file
2745
packages/tplylib/Makefile
Normal file
File diff suppressed because it is too large
Load Diff
102
packages/tplylib/Makefile.fpc
Normal file
102
packages/tplylib/Makefile.fpc
Normal file
@ -0,0 +1,102 @@
|
||||
#
|
||||
# Makefile.fpc for running fpmake
|
||||
#
|
||||
|
||||
[package]
|
||||
name=tplylib
|
||||
version=3.3.1
|
||||
|
||||
[require]
|
||||
packages=rtl fpmkunit
|
||||
|
||||
[install]
|
||||
fpcpackage=y
|
||||
|
||||
[default]
|
||||
fpcdir=../..
|
||||
|
||||
[prerules]
|
||||
FPMAKE_BIN_CLEAN=$(wildcard ./fpmake$(SRCEXEEXT))
|
||||
ifdef OS_TARGET
|
||||
FPC_TARGETOPT+=--os=$(OS_TARGET)
|
||||
endif
|
||||
ifdef CPU_TARGET
|
||||
FPC_TARGETOPT+=--cpu=$(CPU_TARGET)
|
||||
endif
|
||||
LOCALFPMAKE=./fpmake$(SRCEXEEXT)
|
||||
|
||||
[rules]
|
||||
# Do not pass the Makefile's unit and binary target locations. Fpmake uses it's own.
|
||||
override FPCOPT:=$(filter-out -FU%,$(FPCOPT))
|
||||
override FPCOPT:=$(filter-out -FE%,$(FPCOPT))
|
||||
# Do not pass the package-unitdirectories. Fpmake adds those and this way they don't apear in the .fpm
|
||||
override FPCOPT:=$(filter-out $(addprefix -Fu,$(COMPILER_UNITDIR)),$(FPCOPT))# Compose general fpmake-parameters
|
||||
# Compose general fpmake-parameters
|
||||
ifdef FPMAKEOPT
|
||||
FPMAKE_OPT+=$(FPMAKEOPT)
|
||||
endif
|
||||
FPMAKE_OPT+=--localunitdir=../..
|
||||
FPMAKE_OPT+=--globalunitdir=..
|
||||
FPMAKE_OPT+=$(FPC_TARGETOPT)
|
||||
FPMAKE_OPT+=$(addprefix -o ,$(FPCOPT))
|
||||
FPMAKE_OPT+=--compiler=$(FPC)
|
||||
FPMAKE_OPT+=-bu
|
||||
.NOTPARALLEL:
|
||||
|
||||
fpmake$(SRCEXEEXT): fpmake.pp
|
||||
$(FPCFPMAKE) fpmake.pp $(FPMAKE_SKIP_CONFIG) $(addprefix -Fu,$(COMPILER_FPMAKE_UNITDIR)) $(FPCMAKEOPT) $(OPT)
|
||||
all: fpmake$(SRCEXEEXT)
|
||||
$(LOCALFPMAKE) compile $(FPMAKE_OPT)
|
||||
smart: fpmake$(SRCEXEEXT)
|
||||
$(LOCALFPMAKE) compile $(FPMAKE_OPT) -o -XX -o -CX
|
||||
release: fpmake$(SRCEXEEXT)
|
||||
$(LOCALFPMAKE) compile $(FPMAKE_OPT) -o -dRELEASE
|
||||
debug: fpmake$(SRCEXEEXT)
|
||||
$(LOCALFPMAKE) compile $(FPMAKE_OPT) -o -dDEBUG
|
||||
# If no fpmake exists and (dist)clean is called, do not try to build fpmake, it will
|
||||
# most often fail because the dependencies are cleared.
|
||||
# In case of a clean, simply do nothing
|
||||
ifeq ($(FPMAKE_BIN_CLEAN),)
|
||||
clean:
|
||||
else
|
||||
clean:
|
||||
$(FPMAKE_BIN_CLEAN) clean $(FPMAKE_OPT)
|
||||
endif
|
||||
# In case of a distclean, perform an 'old'-style distclean. This to avoid problems
|
||||
# when the package is compiled using fpcmake prior to running this clean using fpmake
|
||||
ifeq ($(FPMAKE_BIN_CLEAN),)
|
||||
distclean: $(addsuffix _distclean,$(TARGET_DIRS)) fpc_cleanall
|
||||
else
|
||||
distclean:
|
||||
ifdef inUnix
|
||||
{ $(FPMAKE_BIN_CLEAN) distclean $(FPMAKE_OPT); if [ $$? != "0" ]; then { echo Something wrong with fpmake exectable. Remove the executable and call make recursively to recover.; $(DEL) $(FPMAKE_BIN_CLEAN); $(MAKE) fpc_cleanall; }; fi; }
|
||||
else
|
||||
$(FPMAKE_BIN_CLEAN) distclean $(FPMAKE_OPT)
|
||||
endif
|
||||
-$(DEL) $(LOCALFPMAKE)
|
||||
endif
|
||||
cleanall: distclean
|
||||
install: fpmake$(SRCEXEEXT)
|
||||
ifdef UNIXHier
|
||||
$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_PREFIX) --baseinstalldir=$(INSTALL_LIBDIR)/fpc/$(FPC_VERSION) --unitinstalldir=$(INSTALL_UNITDIR)
|
||||
else
|
||||
$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_BASEDIR) --baseinstalldir=$(INSTALL_BASEDIR) --unitinstalldir=$(INSTALL_UNITDIR)
|
||||
endif
|
||||
# distinstall also installs the example-sources and omits the location of the source-
|
||||
# files from the fpunits.cfg files.
|
||||
distinstall: fpmake$(SRCEXEEXT)
|
||||
ifdef UNIXHier
|
||||
$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_PREFIX) --baseinstalldir=$(INSTALL_LIBDIR)/fpc/$(FPC_VERSION) --unitinstalldir=$(INSTALL_UNITDIR) -ie -fsp 0
|
||||
else
|
||||
$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_BASEDIR) --baseinstalldir=$(INSTALL_BASEDIR) --unitinstalldir=$(INSTALL_UNITDIR) -ie -fsp 0
|
||||
endif
|
||||
zipinstall: fpmake$(SRCEXEEXT)
|
||||
$(LOCALFPMAKE) zipinstall $(FPMAKE_OPT) --zipprefix=$(DIST_DESTDIR)/$(ZIPPREFIX)
|
||||
zipdistinstall: fpmake$(SRCEXEEXT)
|
||||
$(LOCALFPMAKE) zipinstall $(FPMAKE_OPT) --zipprefix=$(DIST_DESTDIR)/$(ZIPPREFIX) -ie -fsp 0
|
||||
zipsourceinstall: fpmake$(SRCEXEEXT)
|
||||
ifdef UNIXHier
|
||||
$(LOCALFPMAKE) archive $(FPMAKE_OPT) --zipprefix=$(DIST_DESTDIR)/$(ZIPPREFIX) --prefix=share/src/fpc-\$$\(PACKAGEVERSION\)/$(INSTALL_FPCSUBDIR)/\$$\(PACKAGEDIRECTORY\)
|
||||
else
|
||||
$(LOCALFPMAKE) archive $(FPMAKE_OPT) --zipprefix=$(DIST_DESTDIR)/$(ZIPPREFIX) --prefix=source\\$(INSTALL_FPCSUBDIR)\\\$$\(PACKAGEDIRECTORY\)
|
||||
endif
|
||||
54
packages/tplylib/fpmake.pp
Normal file
54
packages/tplylib/fpmake.pp
Normal file
@ -0,0 +1,54 @@
|
||||
{$ifndef ALLPACKAGES}
|
||||
{$mode objfpc}{$H+}
|
||||
program fpmake;
|
||||
|
||||
uses fpmkunit;
|
||||
|
||||
Var
|
||||
T : TTarget;
|
||||
P : TPackage;
|
||||
begin
|
||||
With Installer do
|
||||
begin
|
||||
{$endif ALLPACKAGES}
|
||||
|
||||
P:=AddPackage('tplylib');
|
||||
P.ShortName:='tplylib';
|
||||
{$ifdef ALLPACKAGES}
|
||||
P.Directory:=ADirectory;
|
||||
{$endif ALLPACKAGES}
|
||||
P.Version:='3.3.1';
|
||||
|
||||
{ java and jvm-android do not support
|
||||
fpc_get_output used in these sources }
|
||||
if Defaults.CPU=jvm then
|
||||
P.OSes := P.OSes - [java,android];
|
||||
{ palmos does not support command line parameters }
|
||||
P.OSes := P.OSes - [palmos];
|
||||
{ Program does not fit in 16-bit memory constraints }
|
||||
P.OSes := P.OSes - [msdos,win16];
|
||||
{ avr-embedded and i8086-embedded do not meet needed requirements }
|
||||
if Defaults.CPU in [avr,i8086] then
|
||||
P.OSes := P.OSes - [embedded];
|
||||
|
||||
P.Author := '<various>';
|
||||
P.License := 'LGPL with modification';
|
||||
P.HomepageURL := 'www.freepascal.org';
|
||||
P.Email := '';
|
||||
P.Description := 'Library units for a compiler generator for Turbo Pascal and compatibles.';
|
||||
P.NeedLibC:= false;
|
||||
|
||||
P.SourcePath.Add('src');
|
||||
P.IncludePath.Add('src');
|
||||
|
||||
P.Options.Add('-Sg');
|
||||
|
||||
P.Targets.AddUnit('lexlib.pas');
|
||||
P.Targets.AddUnit('yacclib.pas');
|
||||
|
||||
{$ifndef ALLPACKAGES}
|
||||
Run;
|
||||
end;
|
||||
end.
|
||||
{$endif ALLPACKAGES}
|
||||
|
||||
@ -70,15 +70,15 @@ yyleng : Byte (* length of matched text *)
|
||||
put_char by another suitable set of routines, e.g. if you want to read
|
||||
from/write to memory, etc. *)
|
||||
|
||||
function get_char : Char;
|
||||
var get_char: function : Char;
|
||||
(* obtain one character from the input file (null character at end-of-
|
||||
file) *)
|
||||
|
||||
procedure unget_char ( c : Char );
|
||||
var unget_char : procedure ( c : Char );
|
||||
(* return one character to the input file to be reread in subsequent calls
|
||||
to get_char *)
|
||||
|
||||
procedure put_char ( c : Char );
|
||||
var put_char: procedure ( c : Char );
|
||||
(* write one character to the output file *)
|
||||
|
||||
(* Utility routines: *)
|
||||
@ -185,7 +185,7 @@ var
|
||||
bufptr : Integer;
|
||||
buf : array [1..max_chars] of Char;
|
||||
|
||||
function get_char : Char;
|
||||
function lexlib_get_char : Char;
|
||||
var i : Integer;
|
||||
begin
|
||||
if (bufptr=0) and not eof(yyinput) then
|
||||
@ -199,15 +199,15 @@ function get_char : Char;
|
||||
end;
|
||||
if bufptr>0 then
|
||||
begin
|
||||
get_char := buf[bufptr];
|
||||
lexlib_get_char := buf[bufptr];
|
||||
dec(bufptr);
|
||||
inc(yycolno);
|
||||
end
|
||||
else
|
||||
get_char := #0;
|
||||
lexlib_get_char := #0;
|
||||
end(*get_char*);
|
||||
|
||||
procedure unget_char ( c : Char );
|
||||
procedure lexlib_unget_char ( c : Char );
|
||||
begin
|
||||
if bufptr=max_chars then fatal('input buffer overflow');
|
||||
inc(bufptr);
|
||||
@ -215,7 +215,7 @@ procedure unget_char ( c : Char );
|
||||
buf[bufptr] := c;
|
||||
end(*unget_char*);
|
||||
|
||||
procedure put_char ( c : Char );
|
||||
procedure lexlib_put_char ( c : Char );
|
||||
begin
|
||||
if c=#0 then
|
||||
{ ignore }
|
||||
@ -285,7 +285,7 @@ procedure reject;
|
||||
begin
|
||||
yyreject := true;
|
||||
for i := yyleng+1 to yysleng do
|
||||
yytext := yytext+get_char;
|
||||
yytext := yytext+get_char();
|
||||
dec(yymatches);
|
||||
end(*reject*);
|
||||
|
||||
@ -334,7 +334,7 @@ procedure yynew;
|
||||
procedure yyscan;
|
||||
begin
|
||||
if yyleng=255 then fatal('yytext overflow');
|
||||
yyactchar := get_char;
|
||||
yyactchar := get_char();
|
||||
inc(yyleng);
|
||||
yytext[yyleng] := yyactchar;
|
||||
end(*yyscan*);
|
||||
@ -380,7 +380,7 @@ function yyfind ( var n : Integer ) : Boolean;
|
||||
function yydefault : Boolean;
|
||||
begin
|
||||
yyreject := false;
|
||||
yyactchar := get_char;
|
||||
yyactchar := get_char();
|
||||
if yyactchar<>#0 then
|
||||
begin
|
||||
put_char(yyactchar);
|
||||
@ -406,6 +406,9 @@ procedure yyclear;
|
||||
|
||||
begin
|
||||
yywrap := @lexlib_yywrap;
|
||||
get_char:= @lexlib_get_char;
|
||||
unget_char:= @lexlib_unget_char;
|
||||
put_char:= @lexlib_put_char;
|
||||
assign(yyinput, '');
|
||||
assign(yyoutput, '');
|
||||
reset(yyinput); rewrite(yyoutput);
|
||||
@ -23,12 +23,11 @@ uses
|
||||
closablefilestream, resource,
|
||||
//readers
|
||||
resreader, coffreader, winpeimagereader, elfreader, machoreader,
|
||||
externalreader, dfmreader, tlbreader,
|
||||
externalreader, dfmreader, tlbreader, rcreader,
|
||||
//writers
|
||||
reswriter, coffwriter, xcoffwriter, elfwriter, machowriter, externalwriter,
|
||||
//misc
|
||||
elfconsts, cofftypes, machotypes, externaltypes
|
||||
;
|
||||
elfconsts, cofftypes, machotypes, externaltypes;
|
||||
|
||||
const
|
||||
halt_no_err = 0;
|
||||
@ -66,6 +65,10 @@ begin
|
||||
writeln(' --version, -V Show program version.');
|
||||
writeln(' --verbose, -v Be verbose.');
|
||||
writeln(' --input, -i <x> Ignored for compatibility.');
|
||||
writeln(' --include, -I <x> RC files: add a path for include searches');
|
||||
writeln(' --define, -D <sym>[=<val>]');
|
||||
writeln(' RC files: define a symbol (and value)');
|
||||
writeln(' --undefine, -U <sym> RC files: undefine a symbol');
|
||||
writeln(' --output, -o <x> Set the output file name.');
|
||||
writeln(' -of <format> Set the output file format. Supported formats:');
|
||||
writeln(' res, elf, coff, mach-o, external');
|
||||
@ -212,6 +215,9 @@ begin
|
||||
resources:=TResources.Create;
|
||||
sourcefiles:=TSourceFiles.Create;
|
||||
sourcefiles.FileList.AddStrings(params.InputFiles);
|
||||
sourcefiles.RCDefines.AddStrings(params.RCDefines);
|
||||
sourcefiles.RCIncludeDirs.AddStrings(params.RCIncludeDirs);
|
||||
sourcefiles.RCMode:=CurrentTarget.objformat=ofRes;
|
||||
try
|
||||
sourcefiles.Load(resources);
|
||||
except
|
||||
|
||||
@ -45,8 +45,12 @@ type
|
||||
fInputFiles : TStringList;
|
||||
fOutputFile : string;
|
||||
fTarget : TResTarget;
|
||||
fRCIncludeDirs: TStringList;
|
||||
fRCDefines: TStringList;
|
||||
|
||||
procedure ParseInputFiles(aList : TStringList; var index : integer; const parname : string);
|
||||
procedure ParseRCInclude(aList: TStringList; var index: integer; const parname: string);
|
||||
procedure ParseRCUnDefine(aList: TStringList; var index: integer; const parname: string);
|
||||
procedure ParseOutputFile(aList : TStringList; var index : integer; const parname : string);
|
||||
procedure ParseOutputFormat(aList : TStringList; var index : integer; const parname : string);virtual;
|
||||
procedure ParseArchitecture(aList : TStringList; var index : integer; const parname : string);virtual;
|
||||
@ -65,6 +69,8 @@ type
|
||||
property Version : boolean read fVersion;
|
||||
property Verbose : boolean read fVerbose;
|
||||
property InputFiles : TStringList read fInputFiles;
|
||||
property RCIncludeDirs: TStringList read fRCIncludeDirs;
|
||||
property RCDefines: TStringList read fRCDefines;
|
||||
property OutputFile : string read fOutputFile write fOutputFile;
|
||||
property Target : TResTarget read fTarget;
|
||||
end;
|
||||
@ -195,6 +201,42 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TParameters.ParseRCInclude(aList: TStringList; var index: integer;
|
||||
const parname : string);
|
||||
var
|
||||
tmp: String;
|
||||
begin
|
||||
inc(index);
|
||||
tmp:=DoMandatoryArgument(aList,index);
|
||||
if tmp='' then
|
||||
raise EArgumentMissingException.Create(parname);
|
||||
fRCIncludeDirs.Add(tmp);
|
||||
end;
|
||||
|
||||
procedure TParameters.ParseRCUnDefine(aList: TStringList; var index: integer;
|
||||
const parname : string);
|
||||
var
|
||||
tmp: String;
|
||||
i: integer;
|
||||
begin
|
||||
inc(index);
|
||||
tmp:=DoMandatoryArgument(aList,index);
|
||||
if tmp='' then
|
||||
raise EArgumentMissingException.Create(parname);
|
||||
if (parname='-D') or (parname='--define') then begin
|
||||
i:= pos('=', tmp);
|
||||
if i<1 then
|
||||
fRCDefines.Values[tmp]:= ''
|
||||
else
|
||||
fRCDefines.Values[Copy(tmp, 1, i-1)]:= Copy(tmp, i+1);
|
||||
end else begin
|
||||
i:= fRCDefines.IndexOfName(tmp);
|
||||
if i >= 0 then
|
||||
fRCDefines.Delete(i);
|
||||
end;
|
||||
fRCIncludeDirs.Add(tmp);
|
||||
end;
|
||||
|
||||
procedure TParameters.ParseOutputFile(aList: TStringList; var index: integer;
|
||||
const parname : string);
|
||||
begin
|
||||
@ -361,6 +403,11 @@ begin
|
||||
fVerbose:=true
|
||||
else if ((tmp='-i') or (tmp='--input')) then
|
||||
ParseInputFiles(fList,i,tmp)
|
||||
else if ((tmp='-I') or (tmp='--include')) then
|
||||
ParseRCInclude(fList,i,tmp)
|
||||
else if ((tmp='-D') or (tmp='--define'))
|
||||
or ((tmp='-U') or (tmp='--undefine')) then
|
||||
ParseRCUnDefine(fList,i,tmp)
|
||||
else if ((tmp='-o') or (tmp='--output')) then
|
||||
ParseOutputFile(fList,i,tmp)
|
||||
else if (tmp='-of') then
|
||||
@ -386,10 +433,14 @@ end;
|
||||
|
||||
constructor TParameters.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
fHelp:=false;
|
||||
fVersion:=false;
|
||||
fVerbose:=false;
|
||||
fInputFiles:=TStringList.Create;
|
||||
fRCIncludeDirs:= TStringList.Create;
|
||||
fRCIncludeDirs.Duplicates:= dupIgnore;
|
||||
fRCDefines:= TStringList.Create;
|
||||
fOutputFile:='';
|
||||
fTarget.machine:=mtnone;
|
||||
GetDefaultSubMachineForMachine(fTarget.machine);
|
||||
@ -398,7 +449,10 @@ end;
|
||||
|
||||
destructor TParameters.Destroy;
|
||||
begin
|
||||
fRCDefines.Free;
|
||||
fRCIncludeDirs.Free;
|
||||
fInputFiles.Free;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@ -36,33 +36,46 @@ type
|
||||
private
|
||||
protected
|
||||
fFileList : TStringList;
|
||||
fRCIncludeDirs: TStringList;
|
||||
fRCDefines: TStringList;
|
||||
fStreamList : TFPList;
|
||||
fRCMode: Boolean;
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
procedure Load(aResources : TResources);
|
||||
property FileList : TStringList read fFileList;
|
||||
property RCIncludeDirs: TStringList read fRCIncludeDirs;
|
||||
property RCDefines: TStringList read fRCDefines;
|
||||
property RCMode: Boolean read fRCMode write fRCMode;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses msghandler, closablefilestream;
|
||||
uses msghandler, closablefilestream, rcreader;
|
||||
|
||||
{ TSourceFiles }
|
||||
|
||||
constructor TSourceFiles.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
fFileList:=TStringList.Create;
|
||||
fStreamList:=TFPList.Create;
|
||||
fRCDefines:= TStringList.Create;
|
||||
fRCIncludeDirs:= TStringList.Create;
|
||||
fRCMode:=False;
|
||||
end;
|
||||
|
||||
destructor TSourceFiles.Destroy;
|
||||
var i : integer;
|
||||
begin
|
||||
fRCIncludeDirs.Free;
|
||||
fRCDefines.Free;
|
||||
fFileList.Free;
|
||||
for i:=0 to fStreamList.Count-1 do
|
||||
TStream(fStreamList[i]).Free;
|
||||
fStreamList.Free;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TSourceFiles.Load(aResources: TResources);
|
||||
@ -70,7 +83,9 @@ var aReader : TAbstractResourceReader;
|
||||
aStream : TClosableFileStream;
|
||||
i : integer;
|
||||
tmpres : TResources;
|
||||
olddir : String;
|
||||
begin
|
||||
olddir:=GetCurrentDir;
|
||||
tmpres:=TResources.Create;
|
||||
try
|
||||
for i:=0 to fFileList.Count-1 do
|
||||
@ -82,18 +97,30 @@ begin
|
||||
raise ECantOpenFileException.Create(fFileList[i]);
|
||||
end;
|
||||
fStreamList.Add(aStream);
|
||||
try
|
||||
aReader:=TResources.FindReader(aStream);
|
||||
except
|
||||
raise EUnknownInputFormatException.Create(fFileList[i]);
|
||||
end;
|
||||
{ the RC reader reads anything, so handle that separately }
|
||||
if fRCMode then
|
||||
aReader:=TRCResourceReader.Create
|
||||
else
|
||||
try
|
||||
aReader:=TResources.FindReader(aStream);
|
||||
except
|
||||
raise EUnknownInputFormatException.Create(fFileList[i]);
|
||||
end;
|
||||
Messages.DoVerbose(Format('Chosen reader: %s',[aReader.Description]));
|
||||
try
|
||||
Messages.DoVerbose('Reading resource information...');
|
||||
if aReader is TRCResourceReader then begin
|
||||
TRCResourceReader(aReader).RCIncludeDirs.Assign(fRCIncludeDirs);
|
||||
TRCResourceReader(aReader).RCDefines.Assign(fRCDefines);
|
||||
SetCurrentDir(ExtractFilePath(ExpandFileName(fFileList[i])));
|
||||
end;
|
||||
tmpres.LoadFromStream(aStream,aReader);
|
||||
aResources.MoveFrom(tmpres);
|
||||
Messages.DoVerbose('Resource information read');
|
||||
finally
|
||||
if aReader is TRCResourceReader then begin
|
||||
SetCurrentDir(olddir);
|
||||
end;
|
||||
aReader.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -39,6 +39,8 @@ begin
|
||||
P.Directory:=ADirectory;
|
||||
P.Version:='3.2.1';
|
||||
|
||||
P.Dependencies.Add('tplylib');
|
||||
|
||||
P.Options.Add('-Sg');
|
||||
|
||||
T:=P.Targets.AddProgram('plex.pas');
|
||||
@ -62,10 +64,6 @@ begin
|
||||
T.Dependencies.AddUnit('yacclr0');
|
||||
T.Dependencies.AddUnit('yacctabl');
|
||||
|
||||
|
||||
P.Targets.AddUnit('lexlib.pas');
|
||||
P.Targets.AddUnit('yacclib.pas');
|
||||
|
||||
P.Targets.AddUnit('lexbase.pas').install:=false;
|
||||
P.Targets.AddUnit('lexopt.pas').install:=false;
|
||||
P.Targets.AddUnit('lexdfa.pas').install:=false;
|
||||
|
||||
@ -53,7 +53,8 @@ procedure makeDFATable;
|
||||
begin
|
||||
(* initialize start states: *)
|
||||
for i := 2 to 2*n_start_states+1 do
|
||||
setunion(first_pos_table^[i]^, first_pos_table^[i mod 2]^);
|
||||
if not start_excl^[i div 2] then
|
||||
setunion(first_pos_table^[i]^, first_pos_table^[i mod 2]^);
|
||||
for i := 0 to 2*n_start_states+1 do
|
||||
act_state := newState(first_pos_table^[i]);
|
||||
act_state := -1;
|
||||
|
||||
@ -105,6 +105,8 @@ FirstPosTable = array [0..2*max_start_states+1] of IntSetPtr;
|
||||
default, states 2..2*n_start_states+1 user-defined
|
||||
start states) *)
|
||||
|
||||
StartStateExclusive = array[0..max_start_states] of Boolean;
|
||||
|
||||
StateTableEntry = record
|
||||
state_pos : IntSetPtr;
|
||||
(* positions covered by state *)
|
||||
@ -137,6 +139,7 @@ optimize : Boolean; (* status of the optimization option *)
|
||||
sym_table : ^SymTable; (* symbol table *)
|
||||
pos_table : ^PosTable; (* position table *)
|
||||
first_pos_table : ^FirstPosTable; (* first positions table *)
|
||||
start_excl : ^StartStateExclusive; (* user-defined start state type *)
|
||||
state_table : ^StateTable; (* DFA state table *)
|
||||
trans_table : ^TransTable; (* DFA transition table *)
|
||||
|
||||
@ -460,6 +463,7 @@ begin
|
||||
new(sym_table);
|
||||
new(pos_table);
|
||||
new(first_pos_table);
|
||||
new(start_excl);
|
||||
new(state_table);
|
||||
new(trans_table);
|
||||
|
||||
|
||||
@ -88,7 +88,7 @@ procedure next_section;
|
||||
|
||||
var n_rules : Integer; (* current number of rules *)
|
||||
|
||||
procedure define_start_state ( symbol : String; pos : Integer );
|
||||
procedure define_start_state ( symbol : String; pos : Integer; excl : Boolean );
|
||||
(* process start state definition *)
|
||||
begin
|
||||
{$ifdef fpc}
|
||||
@ -106,6 +106,7 @@ procedure define_start_state ( symbol : String; pos : Integer );
|
||||
writeln(yyout, 'const ', symbol, ' = ', 2*start_state, ';');
|
||||
first_pos_table^[2*start_state] := newIntSet;
|
||||
first_pos_table^[2*start_state+1] := newIntSet;
|
||||
start_excl^[start_state] := excl;
|
||||
end
|
||||
else
|
||||
error(symbol_already_defined, pos)
|
||||
@ -505,12 +506,12 @@ procedure definitions;
|
||||
begin
|
||||
split(line, 2);
|
||||
com := upper(itemv(1));
|
||||
if (com='%S') or (com='%START') then
|
||||
if (com='%S') or (com='%START') or (com='%X') then
|
||||
begin
|
||||
split(line, max_items);
|
||||
for i := 2 to itemc do
|
||||
if check_id(itemv(i)) then
|
||||
define_start_state(itemv(i), itempos[i])
|
||||
define_start_state(itemv(i), itempos[i], com='%X')
|
||||
else
|
||||
error(syntax_error, itempos[i]);
|
||||
end
|
||||
|
||||
Loading…
Reference in New Issue
Block a user