Полищук, Семериков. Системное программирование в UNIX средствами Free Pascal / examples / 7 / unnamed5

(* рТЙНЕТ ЙУРПМШЪПЧБОЙС ЖМБЗБ Open_NONBLOCK *)
uses linux,stdio;

const
MSGSIZE=6;
msg1:array [0..MSGSIZE-1] of char = 'hello';
msg2:array [0..MSGSIZE-1] of char = 'bye!!';


function fatal(s:pchar):integer;
begin
perror (s);
halt (1);
end;


function parent(fdin,fdout:integer):integer; (* ЛПД ТПДЙФЕМШУЛПЗП РТПГЕУУБ *)
var
nread:longint;
buf:array [0..MSGSIZE-1] of char;
begin
fdclose (fdout);
while true do
begin
nread := fdread (fdin, buf, MSGSIZE);
case nread of
-1:
begin
(* рТПЧЕТЙФШ, ЕУФШ МЙ ДБООЩЕ Ч ЛБОБМЕ. *)
if linuxerror = Sys_EAGAIN then
begin
writeln('(ЛБОБМ РХУФ)');
sleep (1);
end
else
fatal ('пЫЙВЛБ ЧЩЪПЧБ read');
end;
0:
begin
(* лБОБМ ВЩМ ЪБЛТЩФ. *)
writeln('лПОЕГ УЧСЪЙ');
halt (0);
end;
else
writeln('MSG=', buf);
end;
end;
end;


function child (fdin,fdout:integer):integer;
var
count:longint;
begin
fdclose (fdin);
for count := 1 to 3 do
begin
fdwrite (fdout, msg1, MSGSIZE);
sleep (3);
end;
(* рПУМБФШ РПУМЕДОЕЕ УППВЭЕОЙЕ *)
fdwrite (fdout, msg2, MSGSIZE);
halt (0);
end;


var
fdin,fdout:longint;
begin
(* пФЛТЩФШ ЛБОБМ *)
if not assignpipe (fdin,fdout) then
fatal ('пЫЙВЛБ ЧЩЪПЧБ pipe ');
(* хУФБОПЧЙФШ ЖМБЗ Open_NONBLOCK ДМС ДЕУЛТЙРФПТБ fdin *)
fcntl (fdin, F_SETFL, Open_NONBLOCK);
if (linuxerror=sys_eagain) or (linuxerror=sys_eacces) then
fatal ('ПЫЙВЛБ ЧЩЪПЧБ fcntl');
case fork of
-1: (* ПЫЙВЛБ *)
fatal ('ПЫЙВЛБ ЧЩЪПЧБ fork');
0: (* ДПЮЕТОЙК РТПГЕУУ *)
child (fdin,fdout);
else (* ТПДЙФЕМШУЛЙК РТПГЕУУ *)
parent (fdin,fdout);
end;
end.