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

(* рТПЗТБННБ shmcopy -- ЖХОЛГЙС main *)
uses ipc,stdio,linux;
{$i share_ex.inc}

const
IFLAGS=IPC_CREAT or IPC_EXCL;
ERR:pdatabuf=pdatabuf(-1);

var
shmid1, shmid2, semid : longint;

(* пРТЕДЕМЕОЙС РТПГЕДХТ p() Й v() ДМС ДЧХИ УЕНБЖПТПЧ *)
const
p1:tsembuf=(sem_num:0;sem_op:-1;sem_flg:0);
p2:tsembuf=(sem_num:1;sem_op:-1;sem_flg:0);
v1:tsembuf=(sem_num:0;sem_op:1;sem_flg:0);
v2:tsembuf=(sem_num:1;sem_op:1;sem_flg:0);

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

(* рТПГЕДХТБ writer -- ЧЩРПМОСЕФ ЪБРЙУШ *)
procedure writer(semid:longint;buf1,buf2:pdatabuf);
begin
while true do
begin
semop (semid, @p1, 1);
semop (semid, @v2, 1);

if buf1^.d_nread <= 0 then
exit;

fdwrite (1, buf1^.d_buf, buf1^.d_nread);
semop (semid, @p2, 1);
semop (semid, @v1, 1);

if buf2^.d_nread <= 0 then
exit;

fdwrite (1, buf2^.d_buf, buf2^.d_nread);
end;
end;

(* рТПГЕДХТБ reader -- ЧЩРПМОСЕФ ЮФЕОЙЕ ЙЪ ЖБКМБ *)
procedure reader(semid:longint;buf1,buf2:pdatabuf);
begin
while true do
begin
(* уЮЙФБФШ Ч ВХЖЕТ buf1 *)
buf1^.d_nread := fdread (0, buf1^.d_buf, SIZ);

(* фПЮЛБ УЙОИТПОЙЪБГЙЙ *)
semop (semid, @v1, 1);
semop (semid, @p2, 1);

(* юФПВЩ РТПГЕДХТБ writer ОЕ ВЩМБ РТЙПУФБОПЧМЕОБ. *)
if buf1^.d_nread <= 0 then
exit;

buf2^.d_nread := fdread (0, buf2^.d_buf, SIZ);

semop (semid, @v2, 1);
semop (semid, @p1, 1);

if buf2^.d_nread <= 0 then
exit;
end;
end;


procedure getseg (var p1,p2:pdatabuf);
begin
(* уПЪДБФШ ХЮБУФПЛ ТБЪДЕМСЕНПК РБНСФЙ *)
shmid1 := shmget (SHMKEY1, sizeof (databuf), octal(0600) or IFLAGS);
if shmid1 = -1 then
fatal ('shmget');

shmid2 := shmget (SHMKEY2, sizeof (databuf), octal(0600) or IFLAGS);
if shmid2 = -1 then
fatal ('shmget');

(* рПДЛМАЮЙФШ ХЮБУФЛЙ ТБЪДЕМСЕНПК РБНСФЙ. *)
p1 := pdatabuf( shmat (shmid1, 0, 0));
if p1 = ERR then
fatal ('shmat');

p2 := pdatabuf( shmat (shmid2, 0, 0));
if p2 = ERR then
fatal ('shmat');
end;


function getsem:longint; (* рПМХЮЙФШ ОБВПТ УЕНБЖПТПЧ *)
var
x:tsemun;
begin
x.val := 0;

(* уПЪДБФШ ДЧБ ОБВПТБ УЕНБЖПТПЧ *)
semid := semget (SEMKEY, 2, octal(0600) or IFLAGS);
if semid = -1 then
fatal ('semget');

(* ъБДБФШ ОБЮБМШОЩЕ ЪОБЮЕОЙС *)

if semctl (semid, 0, SETVAL, x) = -1 then
fatal ('semctl');

if semctl (semid, 1, SETVAL, x) = -1 then
fatal ('semctl');

getsem:=semid;
end;

(* хДБМСЕФ ЙДЕОФЙЖЙЛБФПТЩ ТБЪДЕМСЕНПК РБНСФЙ
* Й ЙДЕОФЙЖЙЛБФПТ ОБВПТБ УЕНБЖПТПЧ
*)
procedure remobj;
var
x:tsemun;
begin
if not shmctl (shmid1, IPC_RMID, nil) then
fatal ('shmctl');

if not shmctl (shmid2, IPC_RMID, nil) then
fatal ('shmctl');

if semctl (semid, 0, IPC_RMID, x) = -1 then
fatal ('semctl');
end;


var
pid : longint;
buf1, buf2 : pdatabuf;
begin
(* йОЙГЙБМЙЪБГЙС ОБВПТБ УЕНБЖПТПЧ. *)
semid := getsem;

(* уПЪДБФШ Й РПДЛМАЮЙФШ ХЮБУФЛЙ ТБЪДЕМСЕНПК РБНСФЙ. *)
getseg (buf1, buf2);

pid := fork;
case pid of
-1:
fatal ('fork');
0: (* ДПЮЕТОЙК РТПГЕУУ *)
begin
writer (semid, buf1, buf2);
remobj;
end;
else (* ТПДЙФЕМШУЛЙК РТПГЕУУ *)
reader (semid, buf1, buf2);
end;

halt (0);
end.