mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-13 11:09:13 +02:00
+ added -P:
allows to generate headers which load proc. dyn. from libs
This commit is contained in:
florian
parent
bfbc3c0a8f
commit
cbfda37a26
@ -54,6 +54,9 @@ program h2pas;
|
||||
No_pop : boolean;
|
||||
s,TN,PN : String;
|
||||
pointerprefix: boolean;
|
||||
freedynlibproc,
|
||||
loaddynlibproc : tstringlist;
|
||||
|
||||
|
||||
(* $ define yydebug
|
||||
compile with -dYYDEBUG to get debugging info *)
|
||||
@ -1314,10 +1317,25 @@ begin
|
||||
else
|
||||
IsExtern:=assigned(yyv[yysp-5])and(yyv[yysp-5]^.str='extern');
|
||||
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;
|
||||
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
|
||||
begin
|
||||
write(outfile,aktspace);
|
||||
@ -1328,11 +1346,23 @@ begin
|
||||
if assigned(yyv[yysp-4]) then
|
||||
if (yyv[yysp-4]^.typ=t_void) and (yyv[yysp-2]^.p1^.p1^.p1=nil) then
|
||||
begin
|
||||
if createdynlib then
|
||||
begin
|
||||
write(outfile,yyv[yysp-2]^.p1^.p2^.p,' : procedure');
|
||||
end
|
||||
else
|
||||
begin
|
||||
shift(10);
|
||||
write(outfile,'procedure ',yyv[yysp-2]^.p1^.p2^.p);
|
||||
end;
|
||||
if assigned(yyv[yysp-2]^.p1^.p1^.p2) then
|
||||
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
|
||||
write(implemfile,'procedure ',yyv[yysp-2]^.p1^.p2^.p);
|
||||
if assigned(yyv[yysp-2]^.p1^.p1^.p2) then
|
||||
@ -1341,13 +1371,26 @@ begin
|
||||
end
|
||||
else
|
||||
begin
|
||||
if createdynlib then
|
||||
begin
|
||||
write(outfile,yyv[yysp-2]^.p1^.p2^.p,' : function');
|
||||
end
|
||||
else
|
||||
begin
|
||||
shift(9);
|
||||
write(outfile,'function ',yyv[yysp-2]^.p1^.p2^.p);
|
||||
end;
|
||||
|
||||
if assigned(yyv[yysp-2]^.p1^.p1^.p2) then
|
||||
write_args(outfile,yyv[yysp-2]^.p1^.p1^.p2);
|
||||
write(outfile,':');
|
||||
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
|
||||
write(implemfile,'function ',yyv[yysp-2]^.p1^.p2^.p);
|
||||
if assigned(yyv[yysp-2]^.p1^.p1^.p2) then
|
||||
@ -1362,7 +1405,11 @@ begin
|
||||
if IsExtern and (not no_pop) then
|
||||
write(outfile,';cdecl');
|
||||
popshift;
|
||||
if UseLib then
|
||||
if createdynlib then
|
||||
begin
|
||||
writeln(outfile,';');
|
||||
end
|
||||
else if UseLib then
|
||||
begin
|
||||
if IsExtern then
|
||||
begin
|
||||
@ -1384,7 +1431,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
IsExtern:=false;
|
||||
if not compactmode then
|
||||
if not(compactmode) and not(createdynlib) then
|
||||
writeln(outfile);
|
||||
until not NeedEllipsisOverload;
|
||||
end
|
||||
@ -7848,6 +7895,8 @@ begin
|
||||
{ write unit header }
|
||||
if not includefile then
|
||||
begin
|
||||
if createdynlib then
|
||||
writeln(headerfile,'{$mode objfpc}');
|
||||
writeln(headerfile,'unit ',unitname,';');
|
||||
writeln(headerfile,'interface');
|
||||
writeln(headerfile);
|
||||
@ -7905,6 +7954,8 @@ begin
|
||||
PTypeList:=TStringList.Create;
|
||||
PTypeList.Sorted := true;
|
||||
PTypeList.Duplicates := dupIgnore;
|
||||
freedynlibproc:=TStringList.Create;
|
||||
loaddynlibproc:=TStringList.Create;
|
||||
yydebug:=true;
|
||||
aktspace:='';
|
||||
block_type:=bt_no;
|
||||
@ -7956,6 +8007,51 @@ begin
|
||||
readln(implemfile,SS);
|
||||
writeln(outfile,SS);
|
||||
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 }
|
||||
writeln(outfile);
|
||||
if not(includefile) then
|
||||
@ -8013,15 +8109,15 @@ begin
|
||||
erase(headerfile);
|
||||
|
||||
PTypeList.Free;
|
||||
freedynlibproc.free;
|
||||
loaddynlibproc.free;
|
||||
end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.15 2005-02-14 17:13:39 peter
|
||||
* truncate log
|
||||
|
||||
Revision 1.14 2004/11/02 23:53:19 peter
|
||||
* fixed crashes with ide and 1.9.x
|
||||
Revision 1.16 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
|
||||
|
||||
@ -50,6 +50,9 @@ program h2pas;
|
||||
No_pop : boolean;
|
||||
s,TN,PN : String;
|
||||
pointerprefix: boolean;
|
||||
freedynlibproc,
|
||||
loaddynlibproc : tstringlist;
|
||||
|
||||
|
||||
(* $ define yydebug
|
||||
compile with -dYYDEBUG to get debugging info *)
|
||||
@ -1245,10 +1248,25 @@ declaration :
|
||||
else
|
||||
IsExtern:=assigned($1)and($1^.str='extern');
|
||||
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;
|
||||
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
|
||||
begin
|
||||
write(outfile,aktspace);
|
||||
@ -1258,27 +1276,52 @@ declaration :
|
||||
(* distinguish between procedure and function *)
|
||||
if assigned($2) 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
|
||||
shift(10);
|
||||
write(outfile,'procedure ',$4^.p1^.p2^.p);
|
||||
end;
|
||||
if assigned($4^.p1^.p1^.p2) then
|
||||
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
|
||||
write(implemfile,'procedure ',$4^.p1^.p2^.p);
|
||||
if assigned($4^.p1^.p1^.p2) then
|
||||
write_args(implemfile,$4^.p1^.p1^.p2);
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
if createdynlib then
|
||||
begin
|
||||
write(outfile,$4^.p1^.p2^.p,' : function');
|
||||
end
|
||||
else
|
||||
begin
|
||||
shift(9);
|
||||
write(outfile,'function ',$4^.p1^.p2^.p);
|
||||
end;
|
||||
|
||||
if assigned($4^.p1^.p1^.p2) then
|
||||
write_args(outfile,$4^.p1^.p1^.p2);
|
||||
write(outfile,':');
|
||||
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
|
||||
write(implemfile,'function ',$4^.p1^.p2^.p);
|
||||
if assigned($4^.p1^.p1^.p2) then
|
||||
@ -1293,7 +1336,11 @@ declaration :
|
||||
if IsExtern and (not no_pop) then
|
||||
write(outfile,';cdecl');
|
||||
popshift;
|
||||
if UseLib then
|
||||
if createdynlib then
|
||||
begin
|
||||
writeln(outfile,';');
|
||||
end
|
||||
else if UseLib then
|
||||
begin
|
||||
if IsExtern then
|
||||
begin
|
||||
@ -1315,7 +1362,7 @@ declaration :
|
||||
end;
|
||||
end;
|
||||
IsExtern:=false;
|
||||
if not compactmode then
|
||||
if not(compactmode) and not(createdynlib) then
|
||||
writeln(outfile);
|
||||
until not NeedEllipsisOverload;
|
||||
end
|
||||
@ -2432,6 +2479,8 @@ begin
|
||||
{ write unit header }
|
||||
if not includefile then
|
||||
begin
|
||||
if createdynlib then
|
||||
writeln(headerfile,'{$mode objfpc}');
|
||||
writeln(headerfile,'unit ',unitname,';');
|
||||
writeln(headerfile,'interface');
|
||||
writeln(headerfile);
|
||||
@ -2489,6 +2538,8 @@ begin
|
||||
PTypeList:=TStringList.Create;
|
||||
PTypeList.Sorted := true;
|
||||
PTypeList.Duplicates := dupIgnore;
|
||||
freedynlibproc:=TStringList.Create;
|
||||
loaddynlibproc:=TStringList.Create;
|
||||
yydebug:=true;
|
||||
aktspace:='';
|
||||
block_type:=bt_no;
|
||||
@ -2540,6 +2591,51 @@ begin
|
||||
readln(implemfile,SS);
|
||||
writeln(outfile,SS);
|
||||
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 }
|
||||
writeln(outfile);
|
||||
if not(includefile) then
|
||||
@ -2597,11 +2693,17 @@ begin
|
||||
erase(headerfile);
|
||||
|
||||
PTypeList.Free;
|
||||
freedynlibproc.free;
|
||||
loaddynlibproc.free;
|
||||
end.
|
||||
|
||||
{
|
||||
$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
|
||||
* var parameter bugfixes
|
||||
|
||||
|
||||
@ -35,6 +35,7 @@ var
|
||||
Win32headers, { allows dec_specifier }
|
||||
stripcomment, { strip comments from inputfile }
|
||||
PrependTypes, { Print T in front of type names ? }
|
||||
createdynlib, { creates a unit which loads dynamically the imports to proc vars }
|
||||
RemoveUnderscore : Boolean;
|
||||
usevarparas : boolean; { generate var parameters, when a pointer }
|
||||
{ is passed }
|
||||
@ -109,6 +110,7 @@ begin
|
||||
writeln (' -o outputfilename Specify the outputfilename');
|
||||
writeln (' -p Use "P" instead of "^" for pointers');
|
||||
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 and don''t write info to outputfile.');
|
||||
writeln (' -t Prepend typedef type names with T');
|
||||
@ -159,6 +161,7 @@ begin
|
||||
palmpilot:=false;
|
||||
includefile:=false;
|
||||
packrecords:=false;
|
||||
createdynlib:=false;
|
||||
i:=1;
|
||||
while i<=paramcount do
|
||||
begin
|
||||
@ -176,6 +179,7 @@ begin
|
||||
'i' : includefile:=true;
|
||||
'l' : LibFileName:=GetNextParam ('l','libname');
|
||||
'o' : outputfilename:=GetNextParam('o','outputfilename');
|
||||
'P' : createdynlib:=true;
|
||||
'p' : begin
|
||||
if (cp[3] = 'r') then
|
||||
begin
|
||||
@ -236,7 +240,11 @@ end;
|
||||
end.
|
||||
{
|
||||
$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
|
||||
|
||||
Revision 1.4 2004/09/08 22:21:41 carl
|
||||
|
||||
Loading…
Reference in New Issue
Block a user