fcl-res: begin implementing rc reader (preprocessor)

Reintegrate fpcres-rc branch by Martok

git-svn-id: trunk@46372 -

.gitattributes

@@ -4120,6 +4120,11 @@ 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/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
@@ -4135,6 +4140,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

packages/fcl-res/src/rclex.inc

@@ -0,0 +1,400 @@
+
+(* lexical analyzer template (TP Lex V3.0), V1.0 3-2-91 AG *)
+
+(* global definitions: *)
+
+const INCOMLINE = 2;
+const INCOMMENT = 4;
+const INSTRING = 6;
+
+
+
+function yylex : Integer;
+
+procedure yyaction ( yyruleno : Integer );
+  (* local definitions: *)
+
+begin
+  (* actions: *)
+  case yyruleno of
+  1:
+                        start(INCOMLINE);
+  2:
+                        begin start(0); unget_char(nl); end;
+  3:
+                        yymore;
+
+  4:
+                        start(INCOMMENT);
+  5:
+                        ;
+  6:
+                        start(0);
+  7:
+                        return(ILLEGAL);
+
+  8:
+                         begin
+                           if ypreproc.isdefine(yytext) then begin
+                             unget_char(' ');
+                             unget_string(ypreproc.getdefine(yytext));
+                           end else
+                             return(ID);
+                         end;
+  9:
+                         return(ID);
+(*
+[ \t\n\f]               ;
+#define
+#else
+#endif
+#ifdef
+#ifndef
+#include
+#undef
+              
+.                       begin
+                           writeln(erroutput, 'Illegal character in line ',yylineno, ' col ', yycolno);
+                           writeln(erroutput, '"',yyline,'"');
+                           return(ILLEGAL);
+                        end;          
+*)
+  end;
+end(*yyaction*);
+
+(* DFA table: *)
+
+type YYTRec = record
+                cc : set of Char;
+                s  : Integer;
+              end;
+
+const
+
+yynmarks   = 13;
+yynmatches = 13;
+yyntrans   = 21;
+yynstates  = 20;
+
+yyk : array [1..yynmarks] of Integer = (
+  { 0: }
+  { 1: }
+  { 2: }
+  { 3: }
+  { 4: }
+  { 5: }
+  { 6: }
+  { 7: }
+  { 8: }
+  9,
+  { 9: }
+  8,
+  9,
+  { 10: }
+  9,
+  { 11: }
+  2,
+  { 12: }
+  3,
+  { 13: }
+  5,
+  { 14: }
+  5,
+  { 15: }
+  7,
+  { 16: }
+  1,
+  { 17: }
+  4,
+  { 18: }
+  8,
+  { 19: }
+  6
+);
+
+yym : array [1..yynmatches] of Integer = (
+{ 0: }
+{ 1: }
+{ 2: }
+{ 3: }
+{ 4: }
+{ 5: }
+{ 6: }
+{ 7: }
+{ 8: }
+  9,
+{ 9: }
+  8,
+  9,
+{ 10: }
+  9,
+{ 11: }
+  2,
+{ 12: }
+  3,
+{ 13: }
+  5,
+{ 14: }
+  5,
+{ 15: }
+  7,
+{ 16: }
+  1,
+{ 17: }
+  4,
+{ 18: }
+  8,
+{ 19: }
+  6
+);
+
+yyt : array [1..yyntrans] of YYTrec = (
+{ 0: }
+  ( cc: [ #1..#9,#11..'.','0'..'@','['..'^','`','{'..#255 ]; s: 10),
+  ( cc: [ '/' ]; s: 8),
+  ( cc: [ 'A'..'Z','_','a'..'z' ]; s: 9),
+{ 1: }
+  ( cc: [ #1..#9,#11..'.','0'..'@','['..'^','`','{'..#255 ]; s: 10),
+  ( cc: [ '/' ]; s: 8),
+  ( cc: [ 'A'..'Z','_','a'..'z' ]; s: 9),
+{ 2: }
+  ( cc: [ #1..#9,#11..#255 ]; s: 12),
+  ( cc: [ #10 ]; s: 11),
+{ 3: }
+  ( cc: [ #1..#9,#11..#255 ]; s: 12),
+  ( cc: [ #10 ]; s: 11),
+{ 4: }
+  ( cc: [ #0 ]; s: 15),
+  ( cc: [ #1..#9,#11..')','+'..#255 ]; s: 13),
+  ( cc: [ '*' ]; s: 14),
+{ 5: }
+  ( cc: [ #0 ]; s: 15),
+  ( cc: [ #1..#9,#11..')','+'..#255 ]; s: 13),
+  ( cc: [ '*' ]; s: 14),
+{ 6: }
+{ 7: }
+{ 8: }
+  ( cc: [ '*' ]; s: 17),
+  ( cc: [ '/' ]; s: 16),
+{ 9: }
+  ( cc: [ '0'..'9','A'..'Z','_','a'..'z' ]; s: 18),
+{ 10: }
+{ 11: }
+{ 12: }
+{ 13: }
+{ 14: }
+  ( cc: [ '/' ]; s: 19),
+{ 15: }
+{ 16: }
+{ 17: }
+{ 18: }
+  ( cc: [ '0'..'9','A'..'Z','_','a'..'z' ]; s: 18)
+{ 19: }
+);
+
+yykl : array [0..yynstates-1] of Integer = (
+{ 0: } 1,
+{ 1: } 1,
+{ 2: } 1,
+{ 3: } 1,
+{ 4: } 1,
+{ 5: } 1,
+{ 6: } 1,
+{ 7: } 1,
+{ 8: } 1,
+{ 9: } 2,
+{ 10: } 4,
+{ 11: } 5,
+{ 12: } 6,
+{ 13: } 7,
+{ 14: } 8,
+{ 15: } 9,
+{ 16: } 10,
+{ 17: } 11,
+{ 18: } 12,
+{ 19: } 13
+);
+
+yykh : array [0..yynstates-1] of Integer = (
+{ 0: } 0,
+{ 1: } 0,
+{ 2: } 0,
+{ 3: } 0,
+{ 4: } 0,
+{ 5: } 0,
+{ 6: } 0,
+{ 7: } 0,
+{ 8: } 1,
+{ 9: } 3,
+{ 10: } 4,
+{ 11: } 5,
+{ 12: } 6,
+{ 13: } 7,
+{ 14: } 8,
+{ 15: } 9,
+{ 16: } 10,
+{ 17: } 11,
+{ 18: } 12,
+{ 19: } 13
+);
+
+yyml : array [0..yynstates-1] of Integer = (
+{ 0: } 1,
+{ 1: } 1,
+{ 2: } 1,
+{ 3: } 1,
+{ 4: } 1,
+{ 5: } 1,
+{ 6: } 1,
+{ 7: } 1,
+{ 8: } 1,
+{ 9: } 2,
+{ 10: } 4,
+{ 11: } 5,
+{ 12: } 6,
+{ 13: } 7,
+{ 14: } 8,
+{ 15: } 9,
+{ 16: } 10,
+{ 17: } 11,
+{ 18: } 12,
+{ 19: } 13
+);
+
+yymh : array [0..yynstates-1] of Integer = (
+{ 0: } 0,
+{ 1: } 0,
+{ 2: } 0,
+{ 3: } 0,
+{ 4: } 0,
+{ 5: } 0,
+{ 6: } 0,
+{ 7: } 0,
+{ 8: } 1,
+{ 9: } 3,
+{ 10: } 4,
+{ 11: } 5,
+{ 12: } 6,
+{ 13: } 7,
+{ 14: } 8,
+{ 15: } 9,
+{ 16: } 10,
+{ 17: } 11,
+{ 18: } 12,
+{ 19: } 13
+);
+
+yytl : array [0..yynstates-1] of Integer = (
+{ 0: } 1,
+{ 1: } 4,
+{ 2: } 7,
+{ 3: } 9,
+{ 4: } 11,
+{ 5: } 14,
+{ 6: } 17,
+{ 7: } 17,
+{ 8: } 17,
+{ 9: } 19,
+{ 10: } 20,
+{ 11: } 20,
+{ 12: } 20,
+{ 13: } 20,
+{ 14: } 20,
+{ 15: } 21,
+{ 16: } 21,
+{ 17: } 21,
+{ 18: } 21,
+{ 19: } 22
+);
+
+yyth : array [0..yynstates-1] of Integer = (
+{ 0: } 3,
+{ 1: } 6,
+{ 2: } 8,
+{ 3: } 10,
+{ 4: } 13,
+{ 5: } 16,
+{ 6: } 16,
+{ 7: } 16,
+{ 8: } 18,
+{ 9: } 19,
+{ 10: } 19,
+{ 11: } 19,
+{ 12: } 19,
+{ 13: } 19,
+{ 14: } 20,
+{ 15: } 20,
+{ 16: } 20,
+{ 17: } 20,
+{ 18: } 21,
+{ 19: } 21
+);
+
+
+var yyn : Integer;
+
+label start, scan, action;
+
+begin
+
+start:
+
+  (* initialize: *)
+
+  yynew;
+
+scan:
+
+  (* mark positions and matches: *)
+
+  for yyn := yykl[yystate] to     yykh[yystate] do yymark(yyk[yyn]);
+  for yyn := yymh[yystate] downto yyml[yystate] do yymatch(yym[yyn]);
+
+  if yytl[yystate]>yyth[yystate] then goto action; (* dead state *)
+
+  (* get next character: *)
+
+  yyscan;
+
+  (* determine action: *)
+
+  yyn := yytl[yystate];
+  while (yyn<=yyth[yystate]) and not (yyactchar in yyt[yyn].cc) do inc(yyn);
+  if yyn>yyth[yystate] then goto action;
+    (* no transition on yyactchar in this state *)
+
+  (* switch to new state: *)
+
+  yystate := yyt[yyn].s;
+
+  goto scan;
+
+action:
+
+  (* execute action: *)
+
+  if yyfind(yyrule) then
+    begin
+      yyaction(yyrule);
+      if yyreject then goto action;
+    end
+  else if not yydefault and yywrap() then
+    begin
+      yyclear;
+      return(0);
+    end;
+
+  if not yydone then goto start;
+
+  yylex := yyretval;
+
+end(*yylex*);
+
+
+
+// end.
+
+
+
+
+

packages/fcl-res/src/rclex.l

@@ -0,0 +1,51 @@
+
+%x INCOMLINE INCOMMENT INSTRING
+
+D [0-9]    
+H [0-9a-fA-F]
+
+%%
+
+"//"                    start(INCOMLINE);
+<INCOMLINE>\n           begin start(0); unget_char(nl); end;
+<INCOMLINE>.            yymore;
+
+"/*"                    start(INCOMMENT);
+<INCOMMENT>.            ;
+<INCOMMENT>"*/"         start(0);
+<INCOMMENT>\0           return(ILLEGAL);
+
+[a-zA-Z_]([a-zA-Z0-9_])* begin
+                           if ypreproc.isdefine(yytext) then begin
+                             unget_char(' ');
+                             unget_string(ypreproc.getdefine(yytext));
+                           end else
+                             return(ID);
+                         end;
+.                        return(ID);
+%{
+(*
+[ \t\n\f]               ;
+#define
+#else
+#endif
+#ifdef
+#ifndef
+#include
+#undef
+              
+.                       begin
+                           writeln(erroutput, 'Illegal character in line ',yylineno, ' col ', yycolno);
+                           writeln(erroutput, '"',yyline,'"');
+                           return(ILLEGAL);
+                        end;          
+*)
+%}
+%%
+
+// end.
+
+
+
+
+

packages/fcl-res/src/rcparser.pas

@@ -0,0 +1,381 @@
+
+(* Yacc parser template (TP Yacc V3.0), V1.2 6-17-91 AG *)
+
+(* global definitions: *)
+
+(*
+Vorspann
+ ****************************************************************************)
+
+unit rcparser;
+
+{$modeswitch advancedrecords}
+
+interface
+
+uses
+  SysUtils, Classes, StrUtils, lexlib, yacclib, resource;
+
+function yyparse : Integer;
+
+var
+  aktresources: TResources;
+  opt_code_page: TSystemCodePage;
+  yyfilename: AnsiString;
+  yyparseresult: YYSType;
+
+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,'"');
+  WriteLn(ErrOutput, '  ',msg);
+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;
+
+
+var
+  yycapture: AnsiString;
+const ILLEGAL = 257;
+const CSTRING = 258;
+const NUMBER = 259;
+const ID = 260;
+const EQUAL = 261;
+const R_AND = 262;
+const UNEQUAL = 263;
+const GT = 264;
+const LT = 265;
+const GTE = 266;
+const LTE = 267;
+const QUESTIONMARK = 268;
+const COLON = 269;
+
+var yylval : YYSType;
+
+function yylex : Integer; forward;
+
+function yyparse : Integer;
+
+var yystate, yysp, yyn : Integer;
+    yys : array [1..yymaxdepth] of Integer;
+    yyv : array [1..yymaxdepth] of YYSType;
+    yyval : YYSType;
+
+procedure yyaction ( yyruleno : Integer );
+  (* local definitions: *)
+begin
+  (* actions: *)
+  case yyruleno of
+   1 : begin
+         Echo; 
+       end;
+   2 : begin
+       end;
+  end;
+end(*yyaction*);
+
+(* parse table: *)
+
+type YYARec = record
+                sym, act : Integer;
+              end;
+     YYRRec = record
+                len, sym : Integer;
+              end;
+
+const
+
+yynacts   = 2;
+yyngotos  = 1;
+yynstates = 3;
+yynrules  = 2;
+
+yya : array [1..yynacts] of YYARec = (
+{ 0: }
+{ 1: }
+  ( sym: 0; act: 0 ),
+  ( sym: 260; act: 2 )
+{ 2: }
+);
+
+yyg : array [1..yyngotos] of YYARec = (
+{ 0: }
+  ( sym: -2; act: 1 )
+{ 1: }
+{ 2: }
+);
+
+yyd : array [0..yynstates-1] of Integer = (
+{ 0: } -2,
+{ 1: } 0,
+{ 2: } -1
+);
+
+yyal : array [0..yynstates-1] of Integer = (
+{ 0: } 1,
+{ 1: } 1,
+{ 2: } 3
+);
+
+yyah : array [0..yynstates-1] of Integer = (
+{ 0: } 0,
+{ 1: } 2,
+{ 2: } 2
+);
+
+yygl : array [0..yynstates-1] of Integer = (
+{ 0: } 1,
+{ 1: } 2,
+{ 2: } 2
+);
+
+yygh : array [0..yynstates-1] of Integer = (
+{ 0: } 1,
+{ 1: } 1,
+{ 2: } 1
+);
+
+yyr : array [1..yynrules] of YYRRec = (
+{ 1: } ( len: 2; sym: -2 ),
+{ 2: } ( len: 0; sym: -2 )
+);
+
+
+const _error = 256; (* error token *)
+
+function yyact(state, sym : Integer; var act : Integer) : Boolean;
+  (* search action table *)
+  var k : Integer;
+  begin
+    k := yyal[state];
+    while (k<=yyah[state]) and (yya[k].sym<>sym) do inc(k);
+    if k>yyah[state] then
+      yyact := false
+    else
+      begin
+        act := yya[k].act;
+        yyact := true;
+      end;
+  end(*yyact*);
+
+function yygoto(state, sym : Integer; var nstate : Integer) : Boolean;
+  (* search goto table *)
+  var k : Integer;
+  begin
+    k := yygl[state];
+    while (k<=yygh[state]) and (yyg[k].sym<>sym) do inc(k);
+    if k>yygh[state] then
+      yygoto := false
+    else
+      begin
+        nstate := yyg[k].act;
+        yygoto := true;
+      end;
+  end(*yygoto*);
+
+label parse, next, error, errlab, shift, reduce, accept, abort;
+
+begin(*yyparse*)
+
+  (* initialize: *)
+
+  yystate := 0; yychar := -1; yynerrs := 0; yyerrflag := 0; yysp := 0;
+
+{$ifdef yydebug}
+  yydebug := true;
+{$else}
+  yydebug := false;
+{$endif}
+
+parse:
+
+  (* push state and value: *)
+
+  inc(yysp);
+  if yysp>yymaxdepth then
+    begin
+      yyerror('yyparse stack overflow');
+      goto abort;
+    end;
+  yys[yysp] := yystate; yyv[yysp] := yyval;
+
+next:
+
+  if (yyd[yystate]=0) and (yychar=-1) then
+    (* get next symbol *)
+    begin
+      yychar := yylex; if yychar<0 then yychar := 0;
+    end;
+
+  if yydebug then writeln('state ', yystate, ', char ', yychar);
+
+  (* determine parse action: *)
+
+  yyn := yyd[yystate];
+  if yyn<>0 then goto reduce; (* simple state *)
+
+  (* no default action; search parse table *)
+
+  if not yyact(yystate, yychar, yyn) then goto error
+  else if yyn>0 then                      goto shift
+  else if yyn<0 then                      goto reduce
+  else                                    goto accept;
+
+error:
+
+  (* error; start error recovery: *)
+
+  if yyerrflag=0 then yyerror('syntax error');
+
+errlab:
+
+  if yyerrflag=0 then inc(yynerrs);     (* new error *)
+
+  if yyerrflag<=2 then                  (* incomplete recovery; try again *)
+    begin
+      yyerrflag := 3;
+      (* uncover a state with shift action on error token *)
+      while (yysp>0) and not ( yyact(yys[yysp], _error, yyn) and
+                               (yyn>0) ) do
+        begin
+          if yydebug then
+            if yysp>1 then
+              writeln('error recovery pops state ', yys[yysp], ', uncovers ',
+                      yys[yysp-1])
+            else
+              writeln('error recovery fails ... abort');
+          dec(yysp);
+        end;
+      if yysp=0 then goto abort; (* parser has fallen from stack; abort *)
+      yystate := yyn;            (* simulate shift on error *)
+      goto parse;
+    end
+  else                                  (* no shift yet; discard symbol *)
+    begin
+      if yydebug then writeln('error recovery discards char ', yychar);
+      if yychar=0 then goto abort; (* end of input; abort *)
+      yychar := -1; goto next;     (* clear lookahead char and try again *)
+    end;
+
+shift:
+
+  (* go to new state, clear lookahead character: *)
+
+  yystate := yyn; yychar := -1; yyval := yylval;
+  if yyerrflag>0 then dec(yyerrflag);
+
+  goto parse;
+
+reduce:
+
+  (* execute action, pop rule from stack, and go to next state: *)
+
+  if yydebug then writeln('reduce ', -yyn);
+
+  yyflag := yyfnone; yyaction(-yyn);
+  dec(yysp, yyr[-yyn].len);
+  if yygoto(yys[yysp], yyr[-yyn].sym, yyn) then yystate := yyn;
+
+  (* handle action calls to yyaccept, yyabort and yyerror: *)
+
+  case yyflag of
+    yyfaccept : goto accept;
+    yyfabort  : goto abort;
+    yyferror  : goto errlab;
+  end;
+
+  goto parse;
+
+accept:
+
+  yyparse := 0; exit;
+
+abort:
+
+  yyparse := 1; exit;
+
+end(*yyparse*);
+
+
+{$I rclex.inc}
+begin
+  bufptr:= 0;
+  lexlib.get_char:= @rc_get_char;
+  lexlib.unget_char:= @rc_unget_char;
+end.

packages/fcl-res/src/rcparser.y

@@ -0,0 +1,137 @@
+%{
+(*
+Vorspann
+ ****************************************************************************)
+
+unit rcparser;
+
+{$modeswitch advancedrecords}
+
+interface
+
+uses
+  SysUtils, Classes, StrUtils, lexlib, yacclib, resource;
+
+function yyparse : Integer;
+
+var
+  aktresources: TResources;
+  opt_code_page: TSystemCodePage;
+  yyfilename: AnsiString;
+  yyparseresult: YYSType;
+
+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,'"');
+  WriteLn(ErrOutput, '  ',msg);
+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;
+
+
+var
+  yycapture: AnsiString;
+%}
+
+%token ILLEGAL
+%token CSTRING NUMBER
+%token ID
+
+%right EQUAL
+%right R_AND
+
+%left UNEQUAL GT LT GTE LTE
+%left QUESTIONMARK COLON
+%%
+
+rcfile
+    : rcfile ID               { Echo; }
+    |
+    ;
+
+%%
+
+{$I rclex.inc}
+begin
+  bufptr:= 0;
+  lexlib.get_char:= @rc_get_char;
+  lexlib.unget_char:= @rc_unget_char;
+end.
+

packages/fcl-res/src/rcreader.pp

@@ -0,0 +1,119 @@
+{
+    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;
+  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;
+  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);
+begin
+  AssignStream(lexlib.yyinput, aStream);
+  Reset(lexlib.yyinput);
+  try
+    rcparser.yyfilename:= '#MAIN.RC';
+    rcparser.PragmaCodePage('DEFAULT');
+    SetTextCodePage(lexlib.yyinput, rcparser.opt_code_page);
+    rcparser.yinclude.init();
+    rcparser.yinclude.WorkDir:= aLocation;
+    rcparser.ypreproc.init();
+    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
+  end;
+end;
+
+constructor TRCResourceReader.Create;
+begin
+  fExtensions:='.rc';
+  fDescription:='RC script resource reader';
+end;
+
+destructor TRCResourceReader.Destroy;
+begin
+
+end;
+
+initialization
+  TResources.RegisterReader('.fpcres',TRCResourceReader);
+  TResources.RegisterReader('.frs',TRCResourceReader);
+
+end.

packages/fcl-res/src/yyinclude.pp

@@ -0,0 +1,119 @@
+{%MainUnit rcparser.pas}
+
+{$IFDEF INC_HEADER}
+
+type
+  tyinclude = record
+  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
+    procedure init();
+    procedure done();
+    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('Invalid 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);
+      yyerror('Invalid file not found: "'+fn+'"');
+    end;
+  end;
+  yyerror('Invalid include directive: "'+fn+'"');
+end;
+
+procedure tyinclude.init();
+begin
+  level:= 0;
+  WorkDir:= GetCurrentDir;
+  SearchPaths:= TStringList.Create;
+end;
+
+procedure tyinclude.done();
+begin
+  FreeAndNil(SearchPaths);
+end;
+
+{$ENDIF}
+

packages/fcl-res/src/yypreproc.pp

@@ -0,0 +1,150 @@
+{%MainUnit rcparser.pas}
+
+{$IFDEF INC_HEADER}
+
+type
+  typreproc = record
+  const
+    yp_maxlevels = 16;
+  var
+    Defines: TStringList;
+    skip  : array[0..yp_maxlevels-1] of boolean;
+    cheadermode: boolean;
+    level : longint;
+  public
+    procedure init();
+    procedure done();
+    function isdefine(ident: string): boolean;
+    function getdefine(ident: string): string;
+    function useline(line: string): boolean;
+    procedure newfile(fn: string);
+  end;
+
+var
+  ypreproc: typreproc;
+
+{$ELSE}
+
+procedure typreproc.init();
+begin
+  Defines:= TStringList.Create;
+  Defines.CaseSensitive:= False;
+  level:= 0;
+  cheadermode:= false;
+  fillchar(skip,sizeof(skip),0);
+end;
+
+procedure typreproc.done();
+begin
+  FreeAndNil(Defines);
+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.IndexOfName(ident) >= 0;
+end;
+
+function typreproc.getdefine(ident: string): string;
+begin
+  Result:= Defines.Values[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;
+      '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.Values[arg1]:= w;
+          end;
+          'undef': begin
+            Defines.Delete(Defines.IndexOfName(arg1));
+          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}

utils/fpcres/fpcres.pas

@@ -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;