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

  + h2pas preprocessor to remove specific defines from a .h file
    (you need to run h2paspp manual)

utils/h2pas/Makefile

@@ -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
+	$(ECHO) $(ZIPCMD_CDPACK) > $(ZIPWRAPPER)
+	$(ECHO) $(ZIPCMD_ZIP) >> $(ZIPWRAPPER)
+	$(ECHO) $(ZIPCMD_CDBASE) >> $(ZIPWRAPPER)
+endif
+ifdef inUnix
+	/bin/sh $(ZIPWRAPPER)
+else
+	$(ZIPWRAPPER)
+endif
+	$(DEL) $(ZIPWRAPPER)
 else
-	$(DEL) $(DESTZIPDIR)/$(ZIPNAME)$(ZIPEXT)
-	cd $(PACKDIR) ; $(ZIPPROG) -Dr $(ZIPOPT) $(DESTZIPDIR)/$(ZIPNAME)$(ZIPEXT) * ; cd $(BASEDIR)
+	$(ZIPCMD_CDPACK) ; $(ZIPCMD_ZIP) ; $(ZIPCMD_CDBASE)
 endif
 	$(DELTREE) $(PACKDIR)
 endif

utils/h2pas/Makefile.fpc

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

utils/h2pas/converu.pas

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

utils/h2pas/h2paspp.pas

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

utils/h2pas/scan.l

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