Browse Source

* Add switch to revert to using char

Michael VAN CANNEYT 2 years ago
parent
commit
24109eb2a6
4 changed files with 36 additions and 26 deletions
  1. 0 1
      utils/h2pas/h2pas.pas
  2. 2 1
      utils/h2pas/h2pconst.pas
  3. 6 2
      utils/h2pas/h2poptions.pas
  4. 28 22
      utils/h2pas/h2ptypes.pas

+ 0 - 1
utils/h2pas/h2pas.pas

@@ -38,7 +38,6 @@ begin
   EnableDebug;
   EnableDebug;
   aktspace:='';
   aktspace:='';
   block_type:=bt_no;
   block_type:=bt_no;
-  IsExtern:=false;
 { Read commandline options }
 { Read commandline options }
   ProcessOptions;
   ProcessOptions;
   if not CompactMode then
   if not CompactMode then

+ 2 - 1
utils/h2pas/h2pconst.pas

@@ -89,6 +89,7 @@ const
   INT_STR    = 'longint';
   INT_STR    = 'longint';
   UINT_STR   = 'dword';
   UINT_STR   = 'dword';
   CHAR_STR   = 'char';
   CHAR_STR   = 'char';
+  ANSICHAR_STR   = 'ansichar';
   UCHAR_STR  = USHORT_STR; { should we use byte or char for 'unsigned char' ?? }
   UCHAR_STR  = USHORT_STR; { should we use byte or char for 'unsigned char' ?? }
 
 
   INT64_STR  = 'int64';
   INT64_STR  = 'int64';
@@ -135,7 +136,7 @@ const
   cdouble_STR     = 'cdouble';
   cdouble_STR     = 'cdouble';
   clongdouble_STR = 'clongdouble';
   clongdouble_STR = 'clongdouble';
 
 
-  const
+const
   MAX_CTYPESARRAY = 25;
   MAX_CTYPESARRAY = 25;
   CTypesArray : array [0..MAX_CTYPESARRAY] of string =
   CTypesArray : array [0..MAX_CTYPESARRAY] of string =
   (cint8_STR,     cuint8_STR,
   (cint8_STR,     cuint8_STR,

+ 6 - 2
utils/h2pas/h2poptions.pas

@@ -34,13 +34,14 @@ var
    stripinfo,                 { Don't write info comments to output }
    stripinfo,                 { Don't write info comments to output }
    UseLib,                    { Append external to implementation ?  }
    UseLib,                    { Append external to implementation ?  }
    UseName,                   { Append 'libname name 'funcname ' }
    UseName,                   { Append 'libname name 'funcname ' }
-   UsePPOinters,              { Use P instead of ^ for pointers    }
+   UsePPointers,              { Use P instead of ^ for pointers }
    EnumToConst,               { Write enumeration types as constants }
    EnumToConst,               { Write enumeration types as constants }
    Win32headers,              { allows dec_specifier }
    Win32headers,              { allows dec_specifier }
    stripcomment,              { strip comments from inputfile }
    stripcomment,              { strip comments from inputfile }
    PrependTypes,              { Print T in front of type names ?   }
    PrependTypes,              { Print T in front of type names ?   }
    UseCTypesUnit,             { Use types defined in the ctypes unit}
    UseCTypesUnit,             { Use types defined in the ctypes unit}
    createdynlib,              { creates a unit which loads dynamically the imports to proc vars }
    createdynlib,              { creates a unit which loads dynamically the imports to proc vars }
+   useansichar,               { use ansichar instead of char }
    RemoveUnderscore : Boolean;
    RemoveUnderscore : Boolean;
    usevarparas : boolean;     { generate var parameters, when a pointer }
    usevarparas : boolean;     { generate var parameters, when a pointer }
                               { is passed                               }
                               { is passed                               }
@@ -48,7 +49,7 @@ var
    palmpilot : boolean;       { handling of PalmOS SYS_CALLs }
    palmpilot : boolean;       { handling of PalmOS SYS_CALLs }
    packrecords: boolean;      { All records should be packed in the file }
    packrecords: boolean;      { All records should be packed in the file }
    pointerprefix: boolean;    { put P in front of pointers }
    pointerprefix: boolean;    { put P in front of pointers }
-   PTypeList : TStringList;   { list of all types }
+   PTypeList : TStringList;   { list of all pointer types }
    freedynlibproc,
    freedynlibproc,
    loaddynlibproc : tstringlist;
    loaddynlibproc : tstringlist;
 
 
@@ -121,6 +122,7 @@ Procedure Usage;
 begin
 begin
   writeln ('Usage : ',paramstr(0),' [options]  filename');
   writeln ('Usage : ',paramstr(0),' [options]  filename');
   writeln ('        Where [options] is one or more of:');
   writeln ('        Where [options] is one or more of:');
+  writeln ('        -a                 Do not use ansichar, use char instead;');
   writeln ('        -d                 Use external;');
   writeln ('        -d                 Use external;');
   writeln ('        -D                 use external libname name ''func_name'';');
   writeln ('        -D                 use external libname name ''func_name'';');
   writeln ('        -e                 change enum type to list of constants');
   writeln ('        -e                 change enum type to list of constants');
@@ -192,6 +194,7 @@ begin
   includefile:=false;
   includefile:=false;
   packrecords:=false;
   packrecords:=false;
   createdynlib:=false;
   createdynlib:=false;
+  useansichar:=True;
   i:=1;
   i:=1;
   while i<=paramcount do
   while i<=paramcount do
    begin
    begin
@@ -199,6 +202,7 @@ begin
      if cp[1]='-' then
      if cp[1]='-' then
       begin
       begin
         case cp[2] of
         case cp[2] of
+         'a' : useansichar:=false;
          'c' : CompactMode:=true;
          'c' : CompactMode:=true;
          'C' : UseCTypesUnit := true;
          'C' : UseCTypesUnit := true;
          'e' : EnumToConst :=true;
          'e' : EnumToConst :=true;

+ 28 - 22
utils/h2pas/h2ptypes.pas

@@ -148,7 +148,7 @@ type
      next : presobject;
      next : presobject;
      p1,p2,p3 : presobject;
      p1,p2,p3 : presobject;
      { name of int/real, then no T prefix is required }
      { name of int/real, then no T prefix is required }
-     intname : boolean;
+     skiptprefix : boolean;
      constructor init_no(t : ttyp);
      constructor init_no(t : ttyp);
      constructor init_one(t : ttyp;_p1 : presobject);
      constructor init_one(t : ttyp;_p1 : presobject);
      constructor init_two(t : ttyp;_p1,_p2 : presobject);
      constructor init_two(t : ttyp;_p1,_p2 : presobject);
@@ -168,19 +168,19 @@ type
 
 
   tblocktype = (bt_type,bt_const,bt_var,bt_func,bt_no);
   tblocktype = (bt_type,bt_const,bt_var,bt_func,bt_no);
 
 
-Function NewUnaryOp(aop : string; aright : presobject) : presobject; inline;
-Function NewBinaryOp(aop : string; aleft,aright : presobject) : presobject; inline;
+Function NewUnaryOp(const aop : ansistring; aright : presobject) : presobject; inline;
+Function NewBinaryOp(const aop : ansistring; aleft,aright : presobject) : presobject; inline;
 Function NewVoid : presobject; inline;
 Function NewVoid : presobject; inline;
-Function NewID(aID : string) : presobject; inline;
+Function NewID(const aID : ansistring) : presobject; inline;
 Function NewType1(aType : ttyp; aID : presobject) : presobject; inline;
 Function NewType1(aType : ttyp; aID : presobject) : presobject; inline;
 Function NewType2(aType : ttyp; aID,aID2 : presobject) : presobject; inline;
 Function NewType2(aType : ttyp; aID,aID2 : presobject) : presobject; inline;
 Function NewType3(aType : ttyp; aID,aID2,aID3 : presobject) : presobject; inline;
 Function NewType3(aType : ttyp; aID,aID2,aID3 : presobject) : presobject; inline;
-Function NewIntID(aIntID : string) : presobject; inline;
+Function NewIntID(const aPascalType : ansistring) : presobject; inline;
 function strpnew(const s : ansistring) : pansichar; inline;
 function strpnew(const s : ansistring) : pansichar; inline;
 
 
 implementation
 implementation
 
 
-uses strings;
+uses h2poptions, strings;
 
 
 
 
 Function NewVoid : presobject;
 Function NewVoid : presobject;
@@ -189,29 +189,32 @@ begin
   Result:=new(presobject,init_no(t_void));
   Result:=new(presobject,init_no(t_void));
 end;
 end;
 
 
-Function NewBinaryOp(aop : string; aleft,aright : presobject) : presobject;
+Function NewBinaryOp(const aop : ansistring; aleft,aright : presobject) : presobject;
 
 
 begin
 begin
   Result:=new(presobject,init_bop(aop,aleft,aright));
   Result:=new(presobject,init_bop(aop,aleft,aright));
 end;
 end;
 
 
-Function NewUnaryOp(aop : string; aright : presobject) : presobject; inline;
+Function NewUnaryOp(const aop : ansistring; aright : presobject) : presobject; inline;
 
 
 begin
 begin
   Result:=new(presobject,init_preop(aop,aright));
   Result:=new(presobject,init_preop(aop,aright));
 end;
 end;
 
 
 
 
-Function NewID(aID : string) : presobject;
+Function NewID(const aID : ansistring) : presobject;
 
 
 begin
 begin
-  Result:=new(presobject,init_id(aID));
+  if useansichar and (aId='char') then
+    Result:=new(presobject,init_id('AnsiChar'))
+  else
+    Result:=new(presobject,init_id(aID));
 end;
 end;
 
 
-Function NewIntID(aIntID : string) : presobject;
+Function NewIntID(const aPascalType : ansistring) : presobject;
 
 
 begin
 begin
-  Result:=new(presobject,init_intid(aIntID));
+  Result:=new(presobject,init_intid(aPascalType));
 end;
 end;
 
 
 Function NewType1(aType : ttyp; aID : presobject) : presobject; inline;
 Function NewType1(aType : ttyp; aID : presobject) : presobject; inline;
@@ -250,7 +253,7 @@ constructor tresobject.init_preop(const s : string;_p1 : presobject);
      p2:=nil;
      p2:=nil;
      p3:=nil;
      p3:=nil;
      next:=nil;
      next:=nil;
-     intname:=false;
+     skiptprefix:=false;
   end;
   end;
 
 
 constructor tresobject.init_bop(const s : string;_p1,_p2 : presobject);
 constructor tresobject.init_bop(const s : string;_p1,_p2 : presobject);
@@ -261,7 +264,7 @@ constructor tresobject.init_bop(const s : string;_p1,_p2 : presobject);
      p2:=_p2;
      p2:=_p2;
      p3:=nil;
      p3:=nil;
      next:=nil;
      next:=nil;
-     intname:=false;
+     skiptprefix:=false;
   end;
   end;
 
 
 constructor tresobject.init_id(const s : string);
 constructor tresobject.init_id(const s : string);
@@ -272,18 +275,21 @@ constructor tresobject.init_id(const s : string);
      p2:=nil;
      p2:=nil;
      p3:=nil;
      p3:=nil;
      next:=nil;
      next:=nil;
-     intname:=false;
+     skiptprefix:=false;
   end;
   end;
 
 
 constructor tresobject.init_intid(const s : string);
 constructor tresobject.init_intid(const s : string);
   begin
   begin
      typ:=t_id;
      typ:=t_id;
-     p:=strpnew(s);
+     if useansichar and (s='char') then
+       p:=strpnew('ansichar')
+     else
+       p:=strpnew(s);
      p1:=nil;
      p1:=nil;
      p2:=nil;
      p2:=nil;
      p3:=nil;
      p3:=nil;
      next:=nil;
      next:=nil;
-     intname:=true;
+     skiptprefix:=true;
   end;
   end;
 
 
 constructor tresobject.init_two(t : ttyp;_p1,_p2 : presobject);
 constructor tresobject.init_two(t : ttyp;_p1,_p2 : presobject);
@@ -294,7 +300,7 @@ constructor tresobject.init_two(t : ttyp;_p1,_p2 : presobject);
      p3:=nil;
      p3:=nil;
      p:=nil;
      p:=nil;
      next:=nil;
      next:=nil;
-     intname:=false;
+     skiptprefix:=false;
   end;
   end;
 
 
 constructor tresobject.init_three(t : ttyp;_p1,_p2,_p3 : presobject);
 constructor tresobject.init_three(t : ttyp;_p1,_p2,_p3 : presobject);
@@ -305,7 +311,7 @@ constructor tresobject.init_three(t : ttyp;_p1,_p2,_p3 : presobject);
      p3:=_p3;
      p3:=_p3;
      p:=nil;
      p:=nil;
      next:=nil;
      next:=nil;
-     intname:=false;
+     skiptprefix:=false;
   end;
   end;
 
 
 constructor tresobject.init_one(t : ttyp;_p1 : presobject);
 constructor tresobject.init_one(t : ttyp;_p1 : presobject);
@@ -316,7 +322,7 @@ constructor tresobject.init_one(t : ttyp;_p1 : presobject);
      p3:=nil;
      p3:=nil;
      next:=nil;
      next:=nil;
      p:=nil;
      p:=nil;
-     intname:=false;
+     skiptprefix:=false;
   end;
   end;
 
 
 constructor tresobject.init_no(t : ttyp);
 constructor tresobject.init_no(t : ttyp);
@@ -327,7 +333,7 @@ constructor tresobject.init_no(t : ttyp);
      p2:=nil;
      p2:=nil;
      p3:=nil;
      p3:=nil;
      next:=nil;
      next:=nil;
-     intname:=false;
+     skiptprefix:=false;
   end;
   end;
 
 
 procedure tresobject.setstr(const s : string);
 procedure tresobject.setstr(const s : string);
@@ -370,7 +376,7 @@ function tresobject.get_copy : presobject;
      newres : presobject;
      newres : presobject;
   begin
   begin
      newres:=new(presobject,init_no(typ));
      newres:=new(presobject,init_no(typ));
-     newres^.intname:=intname;
+     newres^.skiptprefix:=skiptprefix;
      if assigned(p) then
      if assigned(p) then
        newres^.p:=strnew(p);
        newres^.p:=strnew(p);
      if assigned(p1) then
      if assigned(p1) then