paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-02 20:19:34 +01:00
Code Issues Packages Projects Releases Wiki Activity

* big update, it now converts much more files without serious errors

Browse Source 
+ h2pas preprocessor to remove specific defines from a .h file
    (you need to run h2paspp manual)
This commit is contained in:
peter 2000-12-27 21:59:58 +00:00
parent 5a5ac3872b
commit 8835bfd0c6
8 changed files with 8486 additions and 6930 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

73
utils/h2pas/Makefile
View File

@ -1,5 +1,5 @@
#
# Makefile generated by fpcmake v1.00 [2000/12/19]
# Makefile generated by fpcmake v1.00 [2000/12/22]
#
defaultrule: all
@ -50,6 +50,25 @@ else
SRCEXEEXT=.exe
endif
# The extension of batch files / scripts
ifdef inUnix
BATCHEXT=.sh
else
ifdef inOS2
BATCHEXT=.cmd
else
BATCHEXT=.bat
endif
endif
# Path Separator, the subst trick is necessary for the \ that can't exists
# at the end of a line
ifdef inUnix
PATHSEP=/
else
PATHSEP=$(subst /,\,/)
endif
# The path which is searched separated by spaces
ifdef inUnix
SEARCHPATH=$(subst :, ,$(PATH))
@ -178,7 +197,7 @@ endif
# Targets
override EXEOBJECTS+=h2pas
override EXEOBJECTS+=h2pas h2paspp
# Clean
@ -297,15 +316,7 @@ LD=ld
endif
# ppas.bat / ppas.sh
ifdef inUnix
PPAS=ppas.sh
else
ifdef inOS2
PPAS=ppas.cmd
else
PPAS=ppas.bat
endif
endif
PPAS=ppas$(BATCHEXT)
# ldconfig to rebuild .so cache
ifdef inUnix
@ -1086,18 +1097,48 @@ USETAR=1
endif
endif
# Use a wrapper script by default for OS/2
ifdef inOS2
USEZIPWRAPPER=1
endif
# Create commands to create the zip/tar file
ZIPWRAPPER=$(DESTZIPDIR)/fpczip$(BATCHEXT)
ZIPCMD_CDPACK:=cd $(subst /,$(PATHSEP),$(PACKDIR))
ZIPCMD_CDBASE:=cd $(subst /,$(PATHSEP),$(BASEDIR))
ifdef USETAR
ZIPDESTFILE:=$(DESTZIPDIR)/$(ZIPNAME)$(TAREXT)
ZIPCMD_ZIP:=$(TARPROG) cf$(TAROPT) $(ZIPDESTFILE) *
else
ZIPDESTFILE:=$(DESTZIPDIR)/$(ZIPNAME)$(ZIPEXT)
ZIPCMD_ZIP:=$(subst /,$(PATHSEP),$(ZIPPROG)) -Dr $(ZIPOPT) $(ZIPDESTFILE) *
endif
fpc_zipinstall:
ifndef ZIPNAME
@$(ECHO) "Please specify ZIPNAME!"
@exit 1
else
$(MAKE) $(ZIPTARGET) PREFIXINSTALLDIR=$(PACKDIR)
ifdef USETAR
$(DEL) $(DESTZIPDIR)/$(ZIPNAME)$(TAREXT)
cd $(PACKDIR) ; $(TARPROG) cf$(TAROPT) $(DESTZIPDIR)/$(ZIPNAME)$(TAREXT) * ; cd $(BASEDIR)
$(DEL) $(ZIPDESTFILE)
ifdef USEZIPWRAPPER
ifneq ($(ECHO),echo)
$(ECHO) "$(ZIPCMD_CDPACK)" > $(ZIPWRAPPER)
$(ECHO) "$(ZIPCMD_ZIP)" >> $(ZIPWRAPPER)
$(ECHO) "$(ZIPCMD_CDBASE)" >> $(ZIPWRAPPER)
else
$(DEL) $(DESTZIPDIR)/$(ZIPNAME)$(ZIPEXT)
cd $(PACKDIR) ; $(ZIPPROG) -Dr $(ZIPOPT) $(DESTZIPDIR)/$(ZIPNAME)$(ZIPEXT) * ; cd $(BASEDIR)
$(ECHO) $(ZIPCMD_CDPACK) > $(ZIPWRAPPER)
$(ECHO) $(ZIPCMD_ZIP) >> $(ZIPWRAPPER)
$(ECHO) $(ZIPCMD_CDBASE) >> $(ZIPWRAPPER)
endif
ifdef inUnix
/bin/sh $(ZIPWRAPPER)
else
$(ZIPWRAPPER)
endif
$(DEL) $(ZIPWRAPPER)
else
$(ZIPCMD_CDPACK) ; $(ZIPCMD_ZIP) ; $(ZIPCMD_CDBASE)
endif
$(DELTREE) $(PACKDIR)
endif

2
utils/h2pas/Makefile.fpc
View File

@ -3,7 +3,7 @@
#
[targets]
programs=h2pas
programs=h2pas h2paspp
[clean]
units=options lexlib scan yacclib converu

1
utils/h2pas/converu.pas
View File

@ -66,6 +66,7 @@ const P_AND = 317;
const POINT = 318;
const DEREF = 319;
const STICK = 320;
const SIGNED = 321;
implementation

8316
utils/h2pas/h2pas.pas
View File

File diff suppressed because it is too large Load Diff

735
utils/h2pas/h2pas.y
View File

File diff suppressed because it is too large Load Diff

303
utils/h2pas/h2paspp.pas Normal file
View File

@ -0,0 +1,303 @@
{
$Id$
Copyright (c) 2000 by Peter Vreman
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
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. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
****************************************************************************}
program h2paspp;
type
PSymbol=^TSymbol;
TSymbol=record
name : string[32];
next : PSymbol;
end;
var
Symbols : PSymbol;
OutFile : string;
procedure def_symbol(const s:string);
var
p : PSymbol;
begin
new(p);
p^.name:=s;
p^.next:=Symbols;
Symbols:=p;
end;
procedure undef_symbol(const s:string);
var
p,plast : PSymbol;
begin
p:=Symbols;
plast:=nil;
while assigned(p) do
begin
if p^.name=s then
begin
if assigned(plast) then
plast^.next:=p^.next
else
Symbols:=p^.next;
dispose(p);
exit;
end;
p:=p^.next;
end;
end;
function check_symbol(const s:string):boolean;
var
p : PSymbol;
begin
check_symbol:=false;
p:=Symbols;
while assigned(p) do
begin
if p^.name=s then
begin
check_symbol:=true;
exit;
end;
p:=p^.next;
end;
end;
procedure clear_symbols;
var
hp : PSymbol;
begin
while assigned(Symbols) do
begin
hp:=Symbols;
Symbols:=Symbols^.next;
dispose(hp);
end;
end;
function dofile(const filename : string):boolean;
procedure RemoveSpace(var fn:string);
var
i : longint;
begin
i:=0;
while (i<length(fn)) and (fn[i+1] in [' ',#9]) do
inc(i);
Delete(fn,1,i);
i:=length(fn);
while (i>0) and (fn[i] in [' ',#9]) do
dec(i);
fn:=copy(fn,1,i);
end;
function GetName(var fn:string):string;
var
i : longint;
begin
i:=0;
while (i<length(fn)) and (fn[i+1] in ['a'..'z','A'..'Z','0'..'9','_','-']) do
inc(i);
GetName:=Copy(fn,1,i);
Delete(fn,1,i);
end;
const
maxlevel=16;
var
f,g : text;
s,orgs,
opts : string;
skip : array[0..maxlevel-1] of boolean;
level : longint;
begin
dofile:=false;
{ open file }
assign(f,filename);
{$I-}
reset(f);
{$I+}
if ioresult<>0 then
begin
Writeln('Unable to open file ',filename);
exit;
end;
if outfile='' then
assign(g,'h2paspp.tmp')
else
assign(g,outfile);
{$I-}
rewrite(g);
{$I+}
if ioresult<>0 then
begin
Writeln('Unable to create file tmp');
Close(f);
exit;
end;
fillchar(skip,sizeof(skip),0);
level:=0;
while not eof(f) do
begin
readln(f,orgs);
opts:=orgs;
if (opts<>'') and (opts[1]='#') then
begin
Delete(opts,1,1);
RemoveSpace(opts);
s:=GetName(opts);
if (s='ifdef') then
begin
RemoveSpace(opts);
if Level>=maxlevel then
begin
Writeln('Too many ifdef levels');
exit;
end;
inc(Level);
skip[level]:=(skip[level-1] or (not check_symbol(GetName(opts))));
end
else
if (s='if') then
begin
RemoveSpace(opts);
if Level>=maxlevel then
begin
Writeln('Too many ifdef levels');
exit;
end;
inc(Level);
skip[level]:=(skip[level-1] or (not check_symbol(GetName(opts))));
end
else
if (s='ifndef') then
begin
RemoveSpace(opts);
if Level>=maxlevel then
begin
Writeln('Too many ifdef levels');
exit;
end;
inc(Level);
skip[level]:=(skip[level-1] or (check_symbol(GetName(opts))));
end
else
if (s='else') then
skip[level]:=skip[level-1] or (not skip[level])
else
if (s='endif') then
begin
skip[level]:=false;
if Level=0 then
begin
Writeln('Too many endif found');
exit;
end;
dec(level);
end
else
if (not skip[level]) then
begin
if (s='define') then
begin
RemoveSpace(opts);
def_symbol(GetName(opts));
end
else
if (s='undef') then
begin
RemoveSpace(opts);
undef_symbol(GetName(opts));
end
else
if (s='include') then
begin
RemoveSpace(opts);
Writeln('Uses include: ',opts);
opts:='';
end;
{ Add defines also to the output }
if opts<>'' then
writeln(g,orgs);
end;
end
else
begin
if (not skip[level]) then
writeln(g,orgs);
end;
end;
if Level>0 then
Writeln('Error: too less endif found');
Close(f);
Close(g);
if outfile='' then
begin
Erase(f);
Rename(g,filename);
end;
DoFile:=true;
end;
procedure Usage;
begin
writeln('h2paspp [options] <file(s)>');
writeln('options:');
writeln(' -d<symbol> define symbol');
writeln(' -o<outfile> output file');
writeln(' -i include also includes (default is to remove)');
writeln(' -h or -? this helpscreen');
halt(0);
end;
var
i,j : longint;
s : string;
begin
{ process options }
j:=0;
for i:=1to paramcount do
begin
s:=paramstr(i);
if s[1]='-' then
begin
case s[2] of
'd' :
def_symbol(Copy(s,3,255));
'o' :
outfile:=Copy(s,3,255);
'h','?' :
Usage;
end;
end
else
inc(j);
end;
{ no files? }
if j=0 then
Usage;
{ process files }
for i:=1to paramcount do
begin
s:=paramstr(i);
if s[1]<>'-' then
dofile(s);
end;
end.

78
utils/h2pas/scan.l
View File

@ -75,6 +75,14 @@ unit scan;
{ p contains the operator string
p1 contains the left expr
p2 contains the right expr }
t_arrayop,
{
p1 contains the array expr
p2 contains the index expressions }
t_callop,
{
p1 contains the proc expr
p2 contains the index expressions }
t_arg,
{
p1 contain the typedef
@ -110,12 +118,14 @@ unit scan;
p : pchar;
next : presobject;
p1,p2,p3 : presobject;
{ dtyp : tdtyp; }
{ name of int/real, then no T prefix is required }
intname : boolean;
constructor init_no(t : ttyp);
constructor init_one(t : ttyp;_p1 : presobject);
constructor init_two(t : ttyp;_p1,_p2 : presobject);
constructor init_three(t : ttyp;_p1,_p2,_p3 : presobject);
constructor init_id(const s : string);
constructor init_intid(const s : string);
constructor init_bop(const s : string;_p1,_p2 : presobject);
constructor init_preop(const s : string;_p1 : presobject);
procedure setstr(const s:string);
@ -208,6 +218,7 @@ unit scan;
p2:=nil;
p3:=nil;
next:=nil;
intname:=false;
end;
constructor tresobject.init_bop(const s : string;_p1,_p2 : presobject);
@ -218,6 +229,7 @@ unit scan;
p2:=_p2;
p3:=nil;
next:=nil;
intname:=false;
end;
constructor tresobject.init_id(const s : string);
@ -228,6 +240,18 @@ unit scan;
p2:=nil;
p3:=nil;
next:=nil;
intname:=false;
end;
constructor tresobject.init_intid(const s : string);
begin
typ:=t_id;
p:=strpnew(s);
p1:=nil;
p2:=nil;
p3:=nil;
next:=nil;
intname:=true;
end;
constructor tresobject.init_two(t : ttyp;_p1,_p2 : presobject);
@ -238,6 +262,7 @@ unit scan;
p3:=nil;
p:=nil;
next:=nil;
intname:=false;
end;
constructor tresobject.init_three(t : ttyp;_p1,_p2,_p3 : presobject);
@ -248,6 +273,7 @@ unit scan;
p3:=_p3;
p:=nil;
next:=nil;
intname:=false;
end;
constructor tresobject.init_one(t : ttyp;_p1 : presobject);
@ -258,6 +284,7 @@ unit scan;
p3:=nil;
next:=nil;
p:=nil;
intname:=false;
end;
constructor tresobject.init_no(t : ttyp);
@ -268,6 +295,7 @@ unit scan;
p2:=nil;
p3:=nil;
next:=nil;
intname:=false;
end;
procedure tresobject.setstr(const s : string);
@ -310,6 +338,7 @@ unit scan;
newres : presobject;
begin
newres:=new(presobject,init_no(typ));
newres^.intname:=intname;
if assigned(p) then
newres^.p:=strnew(p);
if assigned(p1) then
@ -415,10 +444,8 @@ D [0-9]
else
return(256);
{D}*[U]?[L]? begin
if yytext[length(yytext)]='L' then
dec(byte(yytext[0]));
if yytext[length(yytext)]='U' then
dec(byte(yytext[0]));
if yytext[length(yytext)] in ['L','U'] then
Delete(yytext,length(yytext),1);
return(NUMBER);
end;
"0x"[0-9A-Fa-f]*[U]?[L]?
@ -429,10 +456,8 @@ D [0-9]
delete(yytext,1,2);
yytext:='$'+yytext;
end;
if yytext[length(yytext)]='L' then
dec(byte(yytext[0]));
if yytext[length(yytext)]='U' then
dec(byte(yytext[0]));
if yytext[length(yytext)] in ['L','U'] then
Delete(yytext,length(yytext),1);
return(NUMBER);
end;
{D}+(\.{D}+)?([Ee][+-]?{D}+)?
@ -455,6 +480,7 @@ D [0-9]
"<" return(LT);
"|" return(_OR);
"&" return(_AND);
"~" return(_NOT); (* inverse, but handled as not operation *)
"!" return(_NOT);
"/" return(_SLASH);
"+" return(_PLUS);
@ -527,17 +553,17 @@ D [0-9]
if not stripinfo then
writeln(outfile,'{ C++ end of extern C conditionnal removed }');
end;
"#else" begin
"#"[ \t]*"else" begin
writeln(outfile,'{$else}');
block_type:=bt_no;
flush(outfile);
end;
"#endif" begin
"#"[ \t]*"endif" begin
writeln(outfile,'{$endif}');
block_type:=bt_no;
flush(outfile);
end;
"#elif" begin
"#"[ \t]*"elif" begin
if not stripinfo then
write(outfile,'(*** was #elif ****)');
write(outfile,'{$else');
@ -546,33 +572,48 @@ D [0-9]
block_type:=bt_no;
flush(outfile);
end;
"#undef" begin
"#"[ \t]*"undef" begin
write(outfile,'{$undef');
copy_until_eol;
writeln(outfile,'}');
flush(outfile);
end;
"#error" begin
"#"[ \t]*"error" begin
write(outfile,'{$error');
copy_until_eol;
writeln(outfile,'}');
flush(outfile);
end;
"#include" begin
"#"[ \t]*"include" begin
write(outfile,'{$include');
copy_until_eol;
writeln(outfile,'}');
flush(outfile);
block_type:=bt_no;
end;
"#if" begin
"#"[ \t]*"if" begin
write(outfile,'{$if');
copy_until_eol;
writeln(outfile,'}');
flush(outfile);
block_type:=bt_no;
end;
"#pragma" begin
"# "[0-9]+" " begin
(* preprocessor line info *)
repeat
c:=get_char;
case c of
newline :
begin
unget_char(c);
exit;
end;
#0 :
commenteof;
end;
until false;
end;
"#"[ \t]*"pragma" begin
if not stripinfo then
begin
write(outfile,'(** unsupported pragma');
@ -585,7 +626,7 @@ D [0-9]
skip_until_eol;
block_type:=bt_no;
end;
"#define" begin
"#"[ \t]*"define" begin
in_define:=true;
in_space_define:=1;
return(DEFINE);
@ -600,6 +641,7 @@ D [0-9]
"int" return(INT);
"short" return(SHORT);
"long" return(LONG);
"signed" return(SIGNED);
"unsigned" return(UNSIGNED);
"float" return(REAL);
"const" return(_CONST);

5908
utils/h2pas/scan.pas
View File

File diff suppressed because it is too large Load Diff