(* Программа testsem - проверка процедур работы с семафорами *)
uses ipc,stdio,linux;
{$i pv.inc}


(* Функция initsem - инициализация семафора *)
function initsem(semkey:tkey):longint;
var
  status, semid:longint;
  arg:tsemun;
begin
  status := 0;
  semid := semget (semkey, 1,
		       SEMPERM or IPC_CREAT or IPC_EXCL);
  if semid = -1 then
  begin
    if ipcerror = Sys_EEXIST then
      semid := semget (semkey, 1, 0);
  end
  else
    (* если семафор создается ... *)
  begin
    arg.val := 1;
    status := semctl (semid, 0, SETVAL, arg);
  end;
  if (semid = -1) or (status = -1) then
  begin
    perror ('ошибка вызова initsem');
    initsem:=-1;
    exit;
  end;
  (* Все в порядке *)
  initsem:=semid;
end;

(* Процедура p.pas - операция p для семафора *)
function p (semid:longint):longint;
var
  p_buf:tsembuf;
begin
  p_buf.sem_num := 0;
  p_buf.sem_op := -1;
  p_buf.sem_flg := SEM_UNDO;
  if not semop (semid, @p_buf, 1) then
  begin
    perror ('ошибка операции p(semid)');
    halt (1);
  end;
  p:=0;
end;

(* Процедура v.pas - операция v для семафора *)
function v (semid:longint):longint;
var
  v_buf:tsembuf;
begin
  v_buf.sem_num := 0;
  v_buf.sem_op := 1;
  v_buf.sem_flg := SEM_UNDO;
  if not semop (semid, @v_buf, 1) then
  begin
    perror ('Ошибка операции v(semid)');
    halt (1);
  end;
  v:=0;
end;


procedure handlesem (skey:tkey);
var
  semid, pid:longint;
begin
  pid := getpid;

  semid := initsem (skey);
  if semid < 0 then
    halt (1);

  writeln (#$a'Процесс ',pid,' перед критическим участком');
  p (semid);
  writeln ('Процесс ',pid,' выполняет критический участок');

  (* В реальной программе здесь выполняется нечто осмысленное *)
  sleep (10);

  writeln ('Процесс ',pid,' покинул критический участок');
  v (semid);
  writeln ('Процесс ',pid,' завершает работу');

  halt (0);
end;

const
  semkey:tkey = $200;
var
  i:integer;
begin
  for i := 1 to 3 do
    if fork = 0 then
      handlesem (semkey);
end.
