(* Программа 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.
