paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-06-06 07:18:23 +02:00
Code Issues Packages Projects Releases Wiki Activity

use the ctypes unit in h2pas (from jpetermugaas)

Browse Source 
git-svn-id: trunk@4687 -
This commit is contained in:
micha 2006-09-22 21:12:07 +00:00
parent 48ac2cb379
commit 08c3d44cea
3 changed files with 3258 additions and 2960 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

168
utils/h2pas/h2pas.pas
View File

@ -44,6 +44,62 @@ program h2pas;
REAL_STR = 'double'; REAL_STR = 'double';
WCHAR_STR = 'widechar'; WCHAR_STR = 'widechar';
{ctypes strings}
const
cint8_STR = 'cint8';
cuint8_STR = 'cuint8';
cchar_STR = 'cchar';
cschar_STR = 'cschar';
cuchar_STR = 'cuchar';
cint16_STR = 'cint16';
cuint16_STR = 'cuint16';
cshort_STR = 'cshort';
csshort_STR = 'csshort';
cushort_STR = 'cushort';
cint32_STR = 'cint32';
cuint32_STR = 'cuint32';
cint_STR = 'cint';
csint_STR = 'csint';
cuint_STR = 'cuint';
csigned_STR = 'csigned';
cunsigned_STR = 'cunsigned';
cint64_STR = 'cint64';
cuint64_STR = 'cuint64';
clonglong_STR = 'clonglong';
cslonglong_STR = 'cslonglong';
culonglong_STR = 'culonglong';
cbool_STR = 'cbool';
clong_STR = 'clong';
cslong_STR = 'cslong';
culong_STR = 'culong';
cfloat_STR = 'cfloat';
cdouble_STR = 'cdouble';
clongdouble_STR = 'clongdouble';
const
MAX_CTYPESARRAY = 25;
CTypesArray : array [0..MAX_CTYPESARRAY] of string =
(cint8_STR, cuint8_STR,
cchar_STR, cschar_STR, cuchar_STR,
cint16_STR, cuint16_STR,
cshort_STR, csshort_STR, cushort_STR,
csigned_STR, cunsigned_STR,
cint32_STR, cuint32_STR, cint_STR,
csint_STR, cuint_STR,
cint64_STR, cuint64_STR,
clonglong_STR, cslonglong_STR, culonglong_STR,
cbool_STR,
clong_STR, cslong_STR, culong_STR);
var var
hp,ph : presobject; hp,ph : presobject;
implemfile : text; (* file for implementation headers extern procs *) implemfile : text; (* file for implementation headers extern procs *)
@ -201,11 +257,34 @@ program h2pas;
TypeName:=Copy(s,i,255); TypeName:=Copy(s,i,255);
end; end;
function IsACType(const s : String) : Boolean;
var i : Integer;
begin
IsACType := True;
WriteLn('IsACType '+s);
for i := 0 to MAX_CTYPESARRAY do
begin
if s = CTypesArray[i] then
begin
WriteLn('IsACType True');
Exit;
end;
end;
IsACType := False;
end;
function PointerName(const s:string):string; function PointerName(const s:string):string;
var var
i : longint; i : longint;
begin begin
if UseCTypesUnit then
begin
if IsACType(s) then
begin
PointerName := 'p'+s;
exit;
end;
end;
i:=1; i:=1;
if RemoveUnderScore and (length(s)>1) and (s[1]='_') then if RemoveUnderScore and (length(s)>1) and (s[1]='_') then
i:=2; i:=2;
@ -220,7 +299,6 @@ program h2pas;
PTypeList.Add('P'+s); PTypeList.Add('P'+s);
end; end;
procedure write_packed_fields_info(var outfile:text; p : presobject; ph : string); procedure write_packed_fields_info(var outfile:text; p : presobject; ph : string);
var var
hp1,hp2,hp3 : presobject; hp1,hp2,hp3 : presobject;
@ -727,7 +805,7 @@ program h2pas;
begin begin
pointerwritten:=false; pointerwritten:=false;
if (p^.p1=nil) and UsePPointers then if (p^.p1=nil) and UsePPointers then
begin begin
if (simple_type^.typ=t_id) then if (simple_type^.typ=t_id) then
begin begin
write(outfile,PointerName(simple_type^.p)); write(outfile,PointerName(simple_type^.p));
@ -844,13 +922,14 @@ program h2pas;
end; end;
if not pointerwritten then if not pointerwritten then
begin begin
if in_args then
begin if in_args then
write(outfile,'P'); begin
pointerprefix:=true; write(outfile,'P');
end pointerprefix:=true;
else end
write(outfile,'^'); else
write(outfile,'^');
write_type_specifier(outfile,p^.p1); write_type_specifier(outfile,p^.p1);
pointerprefix:=false; pointerprefix:=false;
end; end;
@ -2265,6 +2344,23 @@ begin
if assigned(hp) then if assigned(hp) then
begin begin
s:=strpas(hp^.p); s:=strpas(hp^.p);
if UseCTypesUnit then
begin
if s=cint_STR then
s:=csint_STR
else if s=cshort_STR then
s:=csshort_STR
else if s=cchar_STR then
s:=cschar_STR
else if s=clong_STR then
s:=cslong_STR
else if s=clonglong_STR then
s:=cslonglong_STR
else
s:='';
end
else
begin
if s=UINT_STR then if s=UINT_STR then
s:=INT_STR s:=INT_STR
else if s=USHORT_STR then else if s=USHORT_STR then
@ -2274,7 +2370,8 @@ begin
else if s=QWORD_STR then else if s=QWORD_STR then
s:=INT64_STR s:=INT64_STR
else else
s:=''; s:='';
end;
if s<>'' then if s<>'' then
hp^.setstr(s); hp^.setstr(s);
end; end;
@ -2287,6 +2384,23 @@ begin
if assigned(hp) then if assigned(hp) then
begin begin
s:=strpas(hp^.p); s:=strpas(hp^.p);
if UseCTypesUnit then
begin
if s=cint_STR then
s:=cuint_STR
else if s=cshort_STR then
s:=cushort_STR
else if s=cchar_STR then
s:=cuchar_STR
else if s=clong_STR then
s:=culong_STR
else if s=clonglong_STR then
s:=culonglong_STR
else
s:='';
end
else
begin
if s=INT_STR then if s=INT_STR then
s:=UINT_STR s:=UINT_STR
else if s=SHORT_STR then else if s=SHORT_STR then
@ -2297,6 +2411,7 @@ begin
s:=QWORD_STR s:=QWORD_STR
else else
s:=''; s:='';
end;
if s<>'' then if s<>'' then
hp^.setstr(s); hp^.setstr(s);
end; end;
@ -2304,36 +2419,57 @@ begin
end; end;
67 : begin 67 : begin
if UseCTypesUnit then
yyval:=new(presobject,init_id(cint_STR))
else
yyval:=new(presobject,init_intid(INT_STR)); yyval:=new(presobject,init_intid(INT_STR));
end; end;
68 : begin 68 : begin
if UseCTypesUnit then
yyval:=new(presobject,init_id(clong_STR))
else
yyval:=new(presobject,init_intid(INT_STR)); yyval:=new(presobject,init_intid(INT_STR));
end; end;
69 : begin 69 : begin
if UseCTypesUnit then
yyval:=new(presobject,init_id(clong_STR))
else
yyval:=new(presobject,init_intid(INT_STR)); yyval:=new(presobject,init_intid(INT_STR));
end; end;
70 : begin 70 : begin
if UseCTypesUnit then
yyval:=new(presobject,init_id(clonglong_STR))
else
yyval:=new(presobject,init_intid(INT64_STR)); yyval:=new(presobject,init_intid(INT64_STR));
end; end;
71 : begin 71 : begin
if UseCTypesUnit then
yyval:=new(presobject,init_id(clonglong_STR))
else
yyval:=new(presobject,init_intid(INT64_STR)); yyval:=new(presobject,init_intid(INT64_STR));
end; end;
72 : begin 72 : begin
if UseCTypesUnit then
yyval:=new(presobject,init_id(cshort_STR))
else
yyval:=new(presobject,init_intid(SHORT_STR)); yyval:=new(presobject,init_intid(SHORT_STR));
end; end;
73 : begin 73 : begin
if UseCTypesUnit then
yyval:=new(presobject,init_id(csint_STR))
else
yyval:=new(presobject,init_intid(SHORT_STR)); yyval:=new(presobject,init_intid(SHORT_STR));
end; end;
@ -2349,11 +2485,17 @@ begin
end; end;
76 : begin 76 : begin
if UseCTypesUnit then
yyval:=new(presobject,init_id(cchar_STR))
else
yyval:=new(presobject,init_intid(CHAR_STR)); yyval:=new(presobject,init_intid(CHAR_STR));
end; end;
77 : begin 77 : begin
if UseCTypesUnit then
yyval:=new(presobject,init_id(cunsigned_STR))
else
yyval:=new(presobject,init_intid(UINT_STR)); yyval:=new(presobject,init_intid(UINT_STR));
end; end;
@ -8548,6 +8690,12 @@ begin
writeln(headerfile,'unit ',unitname,';'); writeln(headerfile,'unit ',unitname,';');
writeln(headerfile,'interface'); writeln(headerfile,'interface');
writeln(headerfile); writeln(headerfile);
if UseCTypesUnit then
begin
writeln(headerfile,'uses');
writeln(headerfile,' ctypes;');
writeln(headerfile);
end;
writeln(headerfile,'{'); writeln(headerfile,'{');
writeln(headerfile,' Automatically converted by H2Pas ',version,' from ',inputfilename); writeln(headerfile,' Automatically converted by H2Pas ',version,' from ',inputfilename);
writeln(headerfile,' The following command line parameters were used:'); writeln(headerfile,' The following command line parameters were used:');

6046
utils/h2pas/h2pas.y
View File

File diff suppressed because it is too large Load Diff

4
utils/h2pas/options.pas
View File

@ -34,6 +34,7 @@ var
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}
createdynlib, { creates a unit which loads dynamically the imports to proc vars } createdynlib, { creates a unit which loads dynamically the imports to proc vars }
RemoveUnderscore : Boolean; RemoveUnderscore : Boolean;
usevarparas : boolean; { generate var parameters, when a pointer } usevarparas : boolean; { generate var parameters, when a pointer }
@ -104,6 +105,7 @@ begin
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');
writeln (' -c Compact outputmode, less spaces and empty lines'); writeln (' -c Compact outputmode, less spaces and empty lines');
WriteLn (' -C Use types in ctypes unit');
writeln (' -i create include files (no unit header)'); writeln (' -i create include files (no unit header)');
writeln (' -l libname Specify the library name for external'); writeln (' -l libname Specify the library name for external');
writeln (' -o outputfilename Specify the outputfilename'); writeln (' -o outputfilename Specify the outputfilename');
@ -155,6 +157,7 @@ begin
StripComment:=false; StripComment:=false;
StripInfo:=false; StripInfo:=false;
UsePPointers:=false; UsePPointers:=false;
UseCTypesUnit := false;
EnumToCOnst:=false; EnumToCOnst:=false;
usevarparas:=false; usevarparas:=false;
palmpilot:=false; palmpilot:=false;
@ -169,6 +172,7 @@ begin
begin begin
case cp[2] of case cp[2] of
'c' : CompactMode:=true; 'c' : CompactMode:=true;
'C' : UseCTypesUnit := true;
'e' : EnumToConst :=true; 'e' : EnumToConst :=true;
'd' : UseLib :=true; 'd' : UseLib :=true;
'D' : begin 'D' : begin