paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-13 12:49:20 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ added -P:

Browse Source 
allows to generate headers which load proc. dyn. from libs
This commit is contained in:
florian 2005-02-20 11:09:41 +00:00
parent bfbc3c0a8f
commit cbfda37a26
3 changed files with 486 additions and 280 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

118
utils/h2pas/h2pas.pas
View File

@ -54,6 +54,9 @@ program h2pas;
No_pop : boolean; No_pop : boolean;
s,TN,PN : String; s,TN,PN : String;
pointerprefix: boolean; pointerprefix: boolean;
freedynlibproc,
loaddynlibproc : tstringlist;
(* $ define yydebug (* $ define yydebug
compile with -dYYDEBUG to get debugging info *) compile with -dYYDEBUG to get debugging info *)
@ -1314,10 +1317,25 @@ begin
else else
IsExtern:=assigned(yyv[yysp-5])and(yyv[yysp-5]^.str='extern'); IsExtern:=assigned(yyv[yysp-5])and(yyv[yysp-5]^.str='extern');
no_pop:=assigned(yyv[yysp-3]) and (yyv[yysp-3]^.str='no_pop'); no_pop:=assigned(yyv[yysp-3]) and (yyv[yysp-3]^.str='no_pop');
if block_type<>bt_func then
writeln(outfile);
if (block_type<>bt_func) and not(createdynlib) then
begin
writeln(outfile);
block_type:=bt_func; block_type:=bt_func;
end;
(* dyn. procedures must be put into a var block *)
if createdynlib then
begin
if (block_type<>bt_var) then
begin
if not(compactmode) then
writeln(outfile);
writeln(outfile,aktspace,'var');
block_type:=bt_var;
end;
shift(2);
end;
if not CompactMode then if not CompactMode then
begin begin
write(outfile,aktspace); write(outfile,aktspace);
@ -1328,11 +1346,23 @@ begin
if assigned(yyv[yysp-4]) then if assigned(yyv[yysp-4]) then
if (yyv[yysp-4]^.typ=t_void) and (yyv[yysp-2]^.p1^.p1^.p1=nil) then if (yyv[yysp-4]^.typ=t_void) and (yyv[yysp-2]^.p1^.p1^.p1=nil) then
begin begin
if createdynlib then
begin
write(outfile,yyv[yysp-2]^.p1^.p2^.p,' : procedure');
end
else
begin
shift(10); shift(10);
write(outfile,'procedure ',yyv[yysp-2]^.p1^.p2^.p); write(outfile,'procedure ',yyv[yysp-2]^.p1^.p2^.p);
end;
if assigned(yyv[yysp-2]^.p1^.p1^.p2) then if assigned(yyv[yysp-2]^.p1^.p1^.p2) then
write_args(outfile,yyv[yysp-2]^.p1^.p1^.p2); write_args(outfile,yyv[yysp-2]^.p1^.p1^.p2);
if not IsExtern then if createdynlib then
begin
loaddynlibproc.add('pointer('+yyv[yysp-2]^.p1^.p2^.p+'):=GetProcAddress(hlib,'''+yyv[yysp-2]^.p1^.p2^.p+''');');
freedynlibproc.add(yyv[yysp-2]^.p1^.p2^.p+':=nil;');
end
else if not IsExtern then
begin begin
write(implemfile,'procedure ',yyv[yysp-2]^.p1^.p2^.p); write(implemfile,'procedure ',yyv[yysp-2]^.p1^.p2^.p);
if assigned(yyv[yysp-2]^.p1^.p1^.p2) then if assigned(yyv[yysp-2]^.p1^.p1^.p2) then
@ -1341,13 +1371,26 @@ begin
end end
else else
begin begin
if createdynlib then
begin
write(outfile,yyv[yysp-2]^.p1^.p2^.p,' : function');
end
else
begin
shift(9); shift(9);
write(outfile,'function ',yyv[yysp-2]^.p1^.p2^.p); write(outfile,'function ',yyv[yysp-2]^.p1^.p2^.p);
end;
if assigned(yyv[yysp-2]^.p1^.p1^.p2) then if assigned(yyv[yysp-2]^.p1^.p1^.p2) then
write_args(outfile,yyv[yysp-2]^.p1^.p1^.p2); write_args(outfile,yyv[yysp-2]^.p1^.p1^.p2);
write(outfile,':'); write(outfile,':');
write_p_a_def(outfile,yyv[yysp-2]^.p1^.p1^.p1,yyv[yysp-4]); write_p_a_def(outfile,yyv[yysp-2]^.p1^.p1^.p1,yyv[yysp-4]);
if not IsExtern then if createdynlib then
begin
loaddynlibproc.add('pointer('+yyv[yysp-2]^.p1^.p2^.p+'):=GetProcAddress(hlib,'''+yyv[yysp-2]^.p1^.p2^.p+''');');
freedynlibproc.add(yyv[yysp-2]^.p1^.p2^.p+':=nil;');
end
else if not IsExtern then
begin begin
write(implemfile,'function ',yyv[yysp-2]^.p1^.p2^.p); write(implemfile,'function ',yyv[yysp-2]^.p1^.p2^.p);
if assigned(yyv[yysp-2]^.p1^.p1^.p2) then if assigned(yyv[yysp-2]^.p1^.p1^.p2) then
@ -1362,7 +1405,11 @@ begin
if IsExtern and (not no_pop) then if IsExtern and (not no_pop) then
write(outfile,';cdecl'); write(outfile,';cdecl');
popshift; popshift;
if UseLib then if createdynlib then
begin
writeln(outfile,';');
end
else if UseLib then
begin begin
if IsExtern then if IsExtern then
begin begin
@ -1384,7 +1431,7 @@ begin
end; end;
end; end;
IsExtern:=false; IsExtern:=false;
if not compactmode then if not(compactmode) and not(createdynlib) then
writeln(outfile); writeln(outfile);
until not NeedEllipsisOverload; until not NeedEllipsisOverload;
end end
@ -7848,6 +7895,8 @@ begin
{ write unit header } { write unit header }
if not includefile then if not includefile then
begin begin
if createdynlib then
writeln(headerfile,'{$mode objfpc}');
writeln(headerfile,'unit ',unitname,';'); writeln(headerfile,'unit ',unitname,';');
writeln(headerfile,'interface'); writeln(headerfile,'interface');
writeln(headerfile); writeln(headerfile);
@ -7905,6 +7954,8 @@ begin
PTypeList:=TStringList.Create; PTypeList:=TStringList.Create;
PTypeList.Sorted := true; PTypeList.Sorted := true;
PTypeList.Duplicates := dupIgnore; PTypeList.Duplicates := dupIgnore;
freedynlibproc:=TStringList.Create;
loaddynlibproc:=TStringList.Create;
yydebug:=true; yydebug:=true;
aktspace:=''; aktspace:='';
block_type:=bt_no; block_type:=bt_no;
@ -7956,6 +8007,51 @@ begin
readln(implemfile,SS); readln(implemfile,SS);
writeln(outfile,SS); writeln(outfile,SS);
end; end;
if createdynlib then
begin
writeln(outfile,' uses');
writeln(outfile,' SysUtils,');
writeln(outfile,'{$ifdef Win32}');
writeln(outfile,' Windows;');
writeln(outfile,'{$else}');
writeln(outfile,' DLLFuncs;');
writeln(outfile,'{$endif win32}');
writeln(outfile);
writeln(outfile,' var');
writeln(outfile,' hlib : thandle;');
writeln(outfile);
writeln(outfile);
writeln(outfile,' procedure Free',unitname,';');
writeln(outfile,' begin');
writeln(outfile,' FreeLibrary(hlib);');
for i:=0 to (freedynlibproc.Count-1) do
Writeln(outfile,' ',freedynlibproc[i]);
writeln(outfile,' end;');
writeln(outfile);
writeln(outfile);
writeln(outfile,' procedure Load',unitname,'(lib : pchar);');
writeln(outfile,' begin');
writeln(outfile,' Free',unitname,';');
writeln(outfile,' hlib:=LoadLibrary(lib);');
writeln(outfile,' if hlib=0 then');
writeln(outfile,' raise Exception.Create(format(''Could not load library: %s'',[lib]));');
writeln(outfile);
for i:=0 to (loaddynlibproc.Count-1) do
Writeln(outfile,' ',loaddynlibproc[i]);
writeln(outfile,' end;');
writeln(outfile);
writeln(outfile);
writeln(outfile,'initialization');
writeln(outfile,' Load',unitname,'(''',unitname,''');');
writeln(outfile,'finalization');
writeln(outfile,' Free',unitname,';');
end;
{ write end of file } { write end of file }
writeln(outfile); writeln(outfile);
if not(includefile) then if not(includefile) then
@ -8013,15 +8109,15 @@ begin
erase(headerfile); erase(headerfile);
PTypeList.Free; PTypeList.Free;
freedynlibproc.free;
loaddynlibproc.free;
end. end.
{ {
$Log$ $Log$
Revision 1.15 2005-02-14 17:13:39 peter Revision 1.16 2005-02-20 11:09:41 florian
* truncate log + added -P:
allows to generate headers which load proc. dyn. from libs
Revision 1.14 2004/11/02 23:53:19 peter
* fixed crashes with ide and 1.9.x
Revision 1.9 2004/09/08 22:21:41 carl Revision 1.9 2004/09/08 22:21:41 carl
+ support for creating packed records + support for creating packed records

116
utils/h2pas/h2pas.y
View File

@ -50,6 +50,9 @@ program h2pas;
No_pop : boolean; No_pop : boolean;
s,TN,PN : String; s,TN,PN : String;
pointerprefix: boolean; pointerprefix: boolean;
freedynlibproc,
loaddynlibproc : tstringlist;
(* $ define yydebug (* $ define yydebug
compile with -dYYDEBUG to get debugging info *) compile with -dYYDEBUG to get debugging info *)
@ -1245,10 +1248,25 @@ declaration :
else else
IsExtern:=assigned($1)and($1^.str='extern'); IsExtern:=assigned($1)and($1^.str='extern');
no_pop:=assigned($3) and ($3^.str='no_pop'); no_pop:=assigned($3) and ($3^.str='no_pop');
if block_type<>bt_func then
writeln(outfile);
if (block_type<>bt_func) and not(createdynlib) then
begin
writeln(outfile);
block_type:=bt_func; block_type:=bt_func;
end;
(* dyn. procedures must be put into a var block *)
if createdynlib then
begin
if (block_type<>bt_var) then
begin
if not(compactmode) then
writeln(outfile);
writeln(outfile,aktspace,'var');
block_type:=bt_var;
end;
shift(2);
end;
if not CompactMode then if not CompactMode then
begin begin
write(outfile,aktspace); write(outfile,aktspace);
@ -1258,27 +1276,52 @@ declaration :
(* distinguish between procedure and function *) (* distinguish between procedure and function *)
if assigned($2) then if assigned($2) then
if ($2^.typ=t_void) and ($4^.p1^.p1^.p1=nil) then if ($2^.typ=t_void) and ($4^.p1^.p1^.p1=nil) then
begin
if createdynlib then
begin
write(outfile,$4^.p1^.p2^.p,' : procedure');
end
else
begin begin
shift(10); shift(10);
write(outfile,'procedure ',$4^.p1^.p2^.p); write(outfile,'procedure ',$4^.p1^.p2^.p);
end;
if assigned($4^.p1^.p1^.p2) then if assigned($4^.p1^.p1^.p2) then
write_args(outfile,$4^.p1^.p1^.p2); write_args(outfile,$4^.p1^.p1^.p2);
if not IsExtern then if createdynlib then
begin
loaddynlibproc.add('pointer('+$4^.p1^.p2^.p+'):=GetProcAddress(hlib,'''+$4^.p1^.p2^.p+''');');
freedynlibproc.add($4^.p1^.p2^.p+':=nil;');
end
else if not IsExtern then
begin begin
write(implemfile,'procedure ',$4^.p1^.p2^.p); write(implemfile,'procedure ',$4^.p1^.p2^.p);
if assigned($4^.p1^.p1^.p2) then if assigned($4^.p1^.p1^.p2) then
write_args(implemfile,$4^.p1^.p1^.p2); write_args(implemfile,$4^.p1^.p1^.p2);
end; end;
end end
else
begin
if createdynlib then
begin
write(outfile,$4^.p1^.p2^.p,' : function');
end
else else
begin begin
shift(9); shift(9);
write(outfile,'function ',$4^.p1^.p2^.p); write(outfile,'function ',$4^.p1^.p2^.p);
end;
if assigned($4^.p1^.p1^.p2) then if assigned($4^.p1^.p1^.p2) then
write_args(outfile,$4^.p1^.p1^.p2); write_args(outfile,$4^.p1^.p1^.p2);
write(outfile,':'); write(outfile,':');
write_p_a_def(outfile,$4^.p1^.p1^.p1,$2); write_p_a_def(outfile,$4^.p1^.p1^.p1,$2);
if not IsExtern then if createdynlib then
begin
loaddynlibproc.add('pointer('+$4^.p1^.p2^.p+'):=GetProcAddress(hlib,'''+$4^.p1^.p2^.p+''');');
freedynlibproc.add($4^.p1^.p2^.p+':=nil;');
end
else if not IsExtern then
begin begin
write(implemfile,'function ',$4^.p1^.p2^.p); write(implemfile,'function ',$4^.p1^.p2^.p);
if assigned($4^.p1^.p1^.p2) then if assigned($4^.p1^.p1^.p2) then
@ -1293,7 +1336,11 @@ declaration :
if IsExtern and (not no_pop) then if IsExtern and (not no_pop) then
write(outfile,';cdecl'); write(outfile,';cdecl');
popshift; popshift;
if UseLib then if createdynlib then
begin
writeln(outfile,';');
end
else if UseLib then
begin begin
if IsExtern then if IsExtern then
begin begin
@ -1315,7 +1362,7 @@ declaration :
end; end;
end; end;
IsExtern:=false; IsExtern:=false;
if not compactmode then if not(compactmode) and not(createdynlib) then
writeln(outfile); writeln(outfile);
until not NeedEllipsisOverload; until not NeedEllipsisOverload;
end end
@ -2432,6 +2479,8 @@ begin
{ write unit header } { write unit header }
if not includefile then if not includefile then
begin begin
if createdynlib then
writeln(headerfile,'{$mode objfpc}');
writeln(headerfile,'unit ',unitname,';'); writeln(headerfile,'unit ',unitname,';');
writeln(headerfile,'interface'); writeln(headerfile,'interface');
writeln(headerfile); writeln(headerfile);
@ -2489,6 +2538,8 @@ begin
PTypeList:=TStringList.Create; PTypeList:=TStringList.Create;
PTypeList.Sorted := true; PTypeList.Sorted := true;
PTypeList.Duplicates := dupIgnore; PTypeList.Duplicates := dupIgnore;
freedynlibproc:=TStringList.Create;
loaddynlibproc:=TStringList.Create;
yydebug:=true; yydebug:=true;
aktspace:=''; aktspace:='';
block_type:=bt_no; block_type:=bt_no;
@ -2540,6 +2591,51 @@ begin
readln(implemfile,SS); readln(implemfile,SS);
writeln(outfile,SS); writeln(outfile,SS);
end; end;
if createdynlib then
begin
writeln(outfile,' uses');
writeln(outfile,' SysUtils,');
writeln(outfile,'{$ifdef Win32}');
writeln(outfile,' Windows;');
writeln(outfile,'{$else}');
writeln(outfile,' DLLFuncs;');
writeln(outfile,'{$endif win32}');
writeln(outfile);
writeln(outfile,' var');
writeln(outfile,' hlib : thandle;');
writeln(outfile);
writeln(outfile);
writeln(outfile,' procedure Free',unitname,';');
writeln(outfile,' begin');
writeln(outfile,' FreeLibrary(hlib);');
for i:=0 to (freedynlibproc.Count-1) do
Writeln(outfile,' ',freedynlibproc[i]);
writeln(outfile,' end;');
writeln(outfile);
writeln(outfile);
writeln(outfile,' procedure Load',unitname,'(lib : pchar);');
writeln(outfile,' begin');
writeln(outfile,' Free',unitname,';');
writeln(outfile,' hlib:=LoadLibrary(lib);');
writeln(outfile,' if hlib=0 then');
writeln(outfile,' raise Exception.Create(format(''Could not load library: %s'',[lib]));');
writeln(outfile);
for i:=0 to (loaddynlibproc.Count-1) do
Writeln(outfile,' ',loaddynlibproc[i]);
writeln(outfile,' end;');
writeln(outfile);
writeln(outfile);
writeln(outfile,'initialization');
writeln(outfile,' Load',unitname,'(''',unitname,''');');
writeln(outfile,'finalization');
writeln(outfile,' Free',unitname,';');
end;
{ write end of file } { write end of file }
writeln(outfile); writeln(outfile);
if not(includefile) then if not(includefile) then
@ -2597,11 +2693,17 @@ begin
erase(headerfile); erase(headerfile);
PTypeList.Free; PTypeList.Free;
freedynlibproc.free;
loaddynlibproc.free;
end. end.
{ {
$Log$ $Log$
Revision 1.9 2004-09-08 22:21:41 carl Revision 1.10 2005-02-20 11:09:41 florian
+ added -P:
allows to generate headers which load proc. dyn. from libs
Revision 1.9 2004/09/08 22:21:41 carl
+ support for creating packed records + support for creating packed records
* var parameter bugfixes * var parameter bugfixes

10
utils/h2pas/options.pas
View File

@ -35,6 +35,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 ? }
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 }
{ is passed } { is passed }
@ -109,6 +110,7 @@ begin
writeln (' -o outputfilename Specify the outputfilename'); writeln (' -o outputfilename Specify the outputfilename');
writeln (' -p Use "P" instead of "^" for pointers'); writeln (' -p Use "P" instead of "^" for pointers');
writeln (' -pr Pack all records (1 byte alignment)'); writeln (' -pr Pack all records (1 byte alignment)');
writeln (' -P use proc. vars for imports');
writeln (' -s strip comments from inputfile'); writeln (' -s strip comments from inputfile');
writeln (' -S strip comments and don''t write info to outputfile.'); writeln (' -S strip comments and don''t write info to outputfile.');
writeln (' -t Prepend typedef type names with T'); writeln (' -t Prepend typedef type names with T');
@ -159,6 +161,7 @@ begin
palmpilot:=false; palmpilot:=false;
includefile:=false; includefile:=false;
packrecords:=false; packrecords:=false;
createdynlib:=false;
i:=1; i:=1;
while i<=paramcount do while i<=paramcount do
begin begin
@ -176,6 +179,7 @@ begin
'i' : includefile:=true; 'i' : includefile:=true;
'l' : LibFileName:=GetNextParam ('l','libname'); 'l' : LibFileName:=GetNextParam ('l','libname');
'o' : outputfilename:=GetNextParam('o','outputfilename'); 'o' : outputfilename:=GetNextParam('o','outputfilename');
'P' : createdynlib:=true;
'p' : begin 'p' : begin
if (cp[3] = 'r') then if (cp[3] = 'r') then
begin begin
@ -236,7 +240,11 @@ end;
end. end.
{ {
$Log$ $Log$
Revision 1.5 2005-02-14 17:13:39 peter Revision 1.6 2005-02-20 11:09:41 florian
+ added -P:
allows to generate headers which load proc. dyn. from libs
Revision 1.5 2005/02/14 17:13:39 peter
* truncate log * truncate log
Revision 1.4 2004/09/08 22:21:41 carl Revision 1.4 2004/09/08 22:21:41 carl