paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-15 19:59:26 +01:00
Code Issues Packages Projects Releases Wiki Activity

* use vfork instead of fork for popen and one variant of executeprocess

Browse Source 
if USE_VFORK is defined (currently only if both BSD and FPC_USE_LIBC
    are defined). Speeds up the compilation of the compiler under Darwin
    by 20-25% (the larger the project, the bigger the speedup).

git-svn-id: trunk@2317 -
This commit is contained in:
Jonas Maebe 2006-01-21 20:19:19 +00:00
parent f5d790f9b6
commit 5e694a801e
3 changed files with 120 additions and 51 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
rtl/unix/oscdeclh.inc
View File

@ -33,6 +33,7 @@ Type TGrpArr = Array [0..0] of TGid; { C style array workarounds}
function FpDup2 (oldd:cint;newd:cint):cint; cdecl; external clib name 'dup2'; function FpDup2 (oldd:cint;newd:cint):cint; cdecl; external clib name 'dup2';
function FpExecve (path : pchar; argv : ppchar; envp: ppchar): cint; cdecl; external clib name 'execve'; function FpExecve (path : pchar; argv : ppchar; envp: ppchar): cint; cdecl; external clib name 'execve';
function FpFork : TPid; cdecl; external clib name 'fork'; function FpFork : TPid; cdecl; external clib name 'fork';
function FpvFork : TPid; cdecl; external clib name 'vfork';
function FpFtruncate(fd : cint; flength : TOff): cint; cdecl; external clib name 'ftruncate'; function FpFtruncate(fd : cint; flength : TOff): cint; cdecl; external clib name 'ftruncate';
function FpLseek (fd : cint; offset : TOff; whence : cint): TOff; cdecl; external clib name 'lseek'; function FpLseek (fd : cint; offset : TOff; whence : cint): TOff; cdecl; external clib name 'lseek';
function FpMkdir (path : pchar; mode: TMode):cint; cdecl; external clib name 'mkdir'; function FpMkdir (path : pchar; mode: TMode):cint; cdecl; external clib name 'mkdir';

8
rtl/unix/sysutils.pp
View File

@ -20,6 +20,10 @@ interface
{ force ansistrings } { force ansistrings }
{$H+} {$H+}
{$if defined(BSD) and defined(FPC_USE_LIBC)}
{$define USE_VFORK}
{$endif}
{$DEFINE OS_FILESETDATEBYNAME} {$DEFINE OS_FILESETDATEBYNAME}
{$DEFINE HAS_SLEEP} {$DEFINE HAS_SLEEP}
{$DEFINE HAS_OSERROR} {$DEFINE HAS_OSERROR}
@ -984,7 +988,11 @@ Begin
if ComLine <> '' then if ComLine <> '' then
CommandLine := Commandline + ' ' + ComLine; CommandLine := Commandline + ' ' + ComLine;
{$endif} {$endif}
{$ifdef USE_VFORK}
pid:=fpvFork;
{$else USE_VFORK}
pid:=fpFork; pid:=fpFork;
{$endif USE_VFORK}
if pid=0 then if pid=0 then
begin begin
{The child does the actual exec, and then exits} {The child does the actual exec, and then exits}

150
rtl/unix/unix.pp
View File

@ -17,6 +17,10 @@ Interface
Uses BaseUnix,UnixType; Uses BaseUnix,UnixType;
{$if defined(BSD) and defined(FPC_USE_LIBC)}
{$define USE_VFORK}
{$endif}
{$i aliasptp.inc} {$i aliasptp.inc}
{ Get Types and Constants only exported in this unit } { Get Types and Constants only exported in this unit }
@ -128,8 +132,8 @@ Function AssignPipe (var pipe_in,pipe_out:text):cint;
Function AssignPipe (var pipe_in,pipe_out:file):cint; Function AssignPipe (var pipe_in,pipe_out:file):cint;
//Function PClose (Var F:text) : cint; //Function PClose (Var F:text) : cint;
//Function PClose (Var F:file) : cint; //Function PClose (Var F:file) : cint;
Function POpen (var F:text;const Prog:String;rw:char):cint; Function POpen (var F:text;const Prog:Ansistring;rw:char):cint;
Function POpen (var F:file;const Prog:String;rw:char):cint; Function POpen (var F:file;const Prog:Ansistring;rw:char):cint;
Function AssignStream(Var StreamIn,Streamout:text;Const Prog:ansiString;const args : array of ansistring) : cint; Function AssignStream(Var StreamIn,Streamout:text;Const Prog:ansiString;const args : array of ansistring) : cint;
Function AssignStream(Var StreamIn,Streamout,streamerr:text;Const Prog:ansiString;const args : array of ansistring) : cint; Function AssignStream(Var StreamIn,Streamout,streamerr:text;Const Prog:ansiString;const args : array of ansistring) : cint;
@ -736,7 +740,7 @@ begin
end; end;
function POpen(var F:text;const Prog:String;rw:char):cint; Function POpen(var F:text;const Prog:Ansistring;rw:char):cint;
{ {
Starts the program in 'Prog' and makes it's input or out put the Starts the program in 'Prog' and makes it's input or out put the
other end of a pipe. If rw is 'w' or 'W', then whatever is written to other end of a pipe. If rw is 'w' or 'W', then whatever is written to
@ -747,11 +751,12 @@ function POpen(var F:text;const Prog:String;rw:char):cint;
var var
pipi, pipi,
pipo : text; pipo : text;
pid : pid_t; pid : cint;
pl : ^cint; pl : ^cint;
{$ifndef FPC_USE_FPEXEC} {$if not defined(FPC_USE_FPEXEC) or defined(USE_VFORK)}
pp : ppchar; pp : array[0..3] of pchar;
{$endif not FPC_USE_FPEXEC} temp : string[255];
{$endif not FPC_USE_FPEXEC or USE_VFORK}
ret : cint; ret : cint;
begin begin
rw:=upcase(rw); rw:=upcase(rw);
@ -760,9 +765,14 @@ begin
FpSetErrno(ESysEnoent); FpSetErrno(ESysEnoent);
exit(-1); exit(-1);
end; end;
if AssignPipe(pipi,pipo)=-1 Then ret:=AssignPipe(pipi,pipo);
Exit(-1); if ret=-1 then
pid:=fpfork; // vfork in FreeBSD. exit(-1);
{$ifdef USE_VFORK}
pid:=fpvfork;
{$else USE_VFORK}
pid:=fpfork;
{$endif USE_VFORK}
if pid=-1 then if pid=-1 then
begin begin
close(pipi); close(pipi);
@ -774,27 +784,53 @@ begin
{ We're in the child } { We're in the child }
if rw='W' then if rw='W' then
begin begin
close(pipo); if (textrec(pipi).handle <> stdinputhandle) then
begin
ret:=fpdup2(pipi,input); ret:=fpdup2(pipi,input);
{$ifdef USE_VFORK}
fpclose(textrec(pipi).handle);
{$else USE_VFORK}
close(pipi); close(pipi);
{$endif USE_VFORK}
end;
{$ifdef USE_VFORK}
fpclose(textrec(pipo).handle);
{$else USE_VFORK}
close(pipo);
{$endif USE_VFORK}
if ret=-1 then if ret=-1 then
halt(127); fpexit(127);
end end
else else
begin begin
{$ifdef USE_VFORK}
fpclose(textrec(pipi).handle);
{$else USE_VFORK}
close(pipi); close(pipi);
{$endif USE_VFORK}
if (textrec(pipo).handle <> stdoutputhandle) then
begin
ret:=fpdup2(pipo,output); ret:=fpdup2(pipo,output);
{$ifdef USE_VFORK}
fpclose(textrec(pipo).handle);
{$else USE_VFORK}
close(pipo); close(pipo);
if ret=-1 then {$endif USE_VFORK}
halt(127);
end; end;
{$ifdef FPC_USE_FPEXEC} if ret=1 then
fpexecl('/bin/sh',['-c',Prog]); fpexit(127);
end;
{$if defined(FPC_USE_FPEXEC) and not defined(USE_VFORK)}
fpexecl(pchar('/bin/sh'),['-c',Prog]);
{$else} {$else}
pp:=createshellargv(prog); temp:='/bin/sh'#0'-c'#0;
fpExecve(pp^,pp,envp); pp[0]:=@temp[1];
pp[1]:=@temp[9];
pp[2]:=@prog[1];
pp[3]:=Nil;
fpExecve('/bin/sh',@pp,envp);
{$endif} {$endif}
halt(127); fpexit(127);
end end
else else
begin begin
@ -803,23 +839,22 @@ begin
begin begin
close(pipi); close(pipi);
f:=pipo; f:=pipo;
textrec(f).bufptr:=@textrec(f).buffer;
end end
else else
begin begin
close(pipo); close(pipo);
f:=pipi; f:=pipi;
textrec(f).bufptr:=@textrec(f).buffer;
end; end;
textrec(f).bufptr:=@textrec(f).buffer;
{Save the process ID - needed when closing } {Save the process ID - needed when closing }
pl:=@(textrec(f).userdata[2]); pl:=@(textrec(f).userdata[2]);
pl^:=pid; pl^:=pid;
textrec(f).closefunc:=@PCloseText; textrec(f).closefunc:=@PCloseText;
end; end;
ret:=0; POpen:=0;
end; end;
Function POpen(var F:file;const Prog:String;rw:char):cint; Function POpen(var F:file;const Prog:Ansistring;rw:char):cint;
{ {
Starts the program in 'Prog' and makes it's input or out put the Starts the program in 'Prog' and makes it's input or out put the
other end of a pipe. If rw is 'w' or 'W', then whatever is written to other end of a pipe. If rw is 'w' or 'W', then whatever is written to
@ -832,10 +867,10 @@ var
pipo : file; pipo : file;
pid : cint; pid : cint;
pl : ^cint; pl : ^cint;
{$ifndef FPC_USE_FPEXEC} {$if not defined(FPC_USE_FPEXEC) or defined(USE_VFORK)}
p,pp : ppchar; pp : array[0..3] of pchar;
temp : string[255]; temp : string[255];
{$endif not FPC_USE_FPEXEC} {$endif not FPC_USE_FPEXEC or USE_VFORK}
ret : cint; ret : cint;
begin begin
rw:=upcase(rw); rw:=upcase(rw);
@ -847,7 +882,11 @@ begin
ret:=AssignPipe(pipi,pipo); ret:=AssignPipe(pipi,pipo);
if ret=-1 then if ret=-1 then
exit(-1); exit(-1);
{$ifdef USE_VFORK}
pid:=fpvfork;
{$else USE_VFORK}
pid:=fpfork; pid:=fpfork;
{$endif USE_VFORK}
if pid=-1 then if pid=-1 then
begin begin
close(pipi); close(pipi);
@ -859,36 +898,53 @@ begin
{ We're in the child } { We're in the child }
if rw='W' then if rw='W' then
begin begin
close(pipo); if (filerec(pipi).handle <> stdinputhandle) then
begin
ret:=fpdup2(filerec(pipi).handle,stdinputhandle); ret:=fpdup2(filerec(pipi).handle,stdinputhandle);
{$ifdef USE_VFORK}
fpclose(filerec(pipi).handle);
{$else USE_VFORK}
close(pipi); close(pipi);
{$endif USE_VFORK}
end;
{$ifdef USE_VFORK}
fpclose(filerec(pipo).handle);
{$else USE_VFORK}
close(pipo);
{$endif USE_VFORK}
if ret=-1 then if ret=-1 then
halt(127); fpexit(127);
end end
else else
begin begin
{$ifdef USE_VFORK}
fpclose(filerec(pipi).handle);
{$else USE_VFORK}
close(pipi); close(pipi);
{$endif USE_VFORK}
if (filerec(pipo).handle <> stdoutputhandle) then
begin
ret:=fpdup2(filerec(pipo).handle,stdoutputhandle); ret:=fpdup2(filerec(pipo).handle,stdoutputhandle);
{$ifdef USE_VFORK}
fpclose(filerec(pipo).handle);
{$else USE_VFORK}
close(pipo); close(pipo);
if ret=1 then {$endif USE_VFORK}
halt(127);
end; end;
{$ifdef FPC_USE_FPEXEC} if ret=1 then
fpexecl('/bin/sh',['-c',Prog]); fpexit(127);
end;
{$if defined(FPC_USE_FPEXEC) and not defined(USE_VFORK)}
fpexecl(pchar('/bin/sh'),['-c',Prog]);
{$else} {$else}
getmem(pp,sizeof(pchar)*4); temp:='/bin/sh'#0'-c'#0;
temp:='/bin/sh'#0'-c'#0+prog+#0; pp[0]:=@temp[1];
p:=pp; pp[1]:=@temp[9];
p^:=@temp[1]; pp[2]:=@prog[1];
inc(p); pp[3]:=Nil;
p^:=@temp[9]; fpExecve('/bin/sh',@pp,envp);
inc(p);
p^:=@temp[12];
inc(p);
p^:=Nil;
fpExecve(ansistring('/bin/sh'),pp,envp);
{$endif} {$endif}
halt(127); fpexit(127);
end end
else else
begin begin
@ -931,8 +987,12 @@ begin
AssignStream:=-1; AssignStream:=-1;
if AssignPipe(streamin,pipo)=-1 Then if AssignPipe(streamin,pipo)=-1 Then
exit(-1); exit(-1);
if AssignPipe(pipi,streamout)=-1 Then // shouldn't this close streamin and pipo? if AssignPipe(pipi,streamout)=-1 Then
begin
close(streamin);
close(pipo);
exit(-1); exit(-1);
end;
pid:=fpfork; pid:=fpfork;
if pid=-1 then if pid=-1 then
begin begin