semctl

Perform various control operations on a semaphore set

Declaration

Source position: ipc.pp line 874

  function semctl(semid: cint; semnum: cint; cmd: cint; var arg: TSEMun)
                  : cint;

Description

semctl performs various operations on the semaphore semnum w ith semaphore set id ID.

The arg parameter supplies the data needed for each call. This is a variant record that should be filled differently, according to the command:

Type
  TSEMun = record
   case longint of
      0 : ( val : longint );
      1 : ( buf : PSEMid_ds );
      2 : ( arr : PWord );
      3 : ( padbuf : PSeminfo );
      4 : ( padpad : pointer );
   end;

Which operation is performed, depends on the cmd parameter, which can have one of the following values:

IPC_STAT: In this case, the arg record should have it's buf field set to the address of a TSEMid_ds record. The semctl call fills this TSEMid_ds structure with information about the semaphore set.
IPC_SET: In this case, the arg record should have it's buf field set to the address of a TSEMid_ds record. The semctl call sets the permissions of the queue as specified in the ipc_perm record.
IPC_RMID: If this is specified, the semaphore set is removed from from the system.
GETALL: In this case, the arr field of arg should point to a memory area where the values of the semaphores will be stored. The size of this memory area is SizeOf(Word) * Number of semaphores in the set. This call will then fill the memory array with all the values of the semaphores.
GETNCNT: This will fill the val field of the arg union with the number of processes waiting for resources.
GETPID: semctl returns the process ID of the process that performed the last semop call.
GETVAL: semctl returns the value of the semaphore with number semnum.
GETZCNT: semctl returns the number of processes waiting for semaphores that reach value zero.
SETALL: In this case, the arr field of arg should point to a memory area where the values of the semaphores will be retrieved from. The size of this memory area is SizeOf(Word) * Number of semaphores in the set. This call will then set the values of the semaphores from the memory array.
SETVAL: This will set the value of semaphore semnum to the value in the val field of the arg parameter.

The function returns -1 on error.

Errors

The function returns -1 on error, and IPCerror is set accordingly.

Example

Program semtool;
{ Program to demonstrate the use of semaphores }
Uses ipc,baseunix;
Const MaxSemValue = 5;
Procedure DoError (Const Msg : String);
var
  error: cint;
begin
  error:=fpgeterrno;
  Writeln ('Error : ',msg,' Code : ',error);
  Halt(1);
end;
Function getsemval (ID,Member : longint) : longint;
Var S : TSEMun;
begin
  GetSemVal:=SemCtl(id,member,SEM_GETVAL,S);
end;
Procedure DispVal (ID,member : longint);
begin
  writeln ('Value for member ',member,' is ',GetSemVal(ID,Member));
end;
Function GetMemberCount (ID : Longint) : longint;
Var opts : TSEMun;
    semds : TSEMid_ds;
begin
  opts.buf:=@semds;
  If semctl(Id,0,IPC_STAT,opts)<>-1 then
    GetMemberCount:=semds.sem_nsems
  else
    GetMemberCount:=-1;
end;
Function OpenSem (Key : TKey) : Longint;
begin
  OpenSem:=semget(Key,0,438);
  If OpenSem=-1 then
    DoError ('OpenSem');
end;
Function CreateSem (Key : TKey; Members : Longint) : Longint;
Var Count : Longint;
    Semopts : TSemun;
begin
// the semmsl constant seems kernel specific
{  If members>semmsl then
    DoError ('Sorry, maximum number of semaphores in set exceeded');
}
  Writeln ('Trying to create a new semaphore set with ',members,' members.');
  CreateSem:=semget(key,members,IPC_CREAT or IPC_Excl or 438);
  If CreateSem=-1 then
    DoError ('Semaphore set already exists.');
  Semopts.val:=MaxSemValue; { Initial value of semaphores }
  For Count:=0 to Members-1 do
    semctl(CreateSem,count,SEM_SETVAL,semopts);
end;
Procedure lockSem (ID,Member: Longint);
Var lock : TSEMbuf;
begin
  With lock do
    begin
    sem_num:=0;
    sem_op:=-1;
    sem_flg:=IPC_NOWAIT;
    end;
   if (member<0) or (member>GetMemberCount(ID)-1) then
     DoError ('semaphore member out of range');
   if getsemval(ID,member)=0 then
     DoError ('Semaphore resources exhausted (no lock)');
   lock.sem_num:=member;
   Writeln ('Attempting to lock member ',member, ' of semaphore ',ID);
   if semop(Id,@lock,1)=-1 then
     DoError ('Lock failed')
   else
     Writeln ('Semaphore resources decremented by one');
   dispval(ID,Member);
end;
Procedure UnlockSem (ID,Member: Longint);
Var Unlock : TSEMbuf;
begin
  With Unlock do
    begin
    sem_num:=0;
    sem_op:=1;
    sem_flg:=IPC_NOWAIT;
    end;
   if (member<0) or (member>GetMemberCount(ID)-1) then
     DoError ('semaphore member out of range');
   if getsemval(ID,member)=MaxSemValue then
     DoError ('Semaphore not locked');
   Unlock.sem_num:=member;
   Writeln ('Attempting to unlock member ',member, ' of semaphore ',ID);
   if semop(Id,@unlock,1)=-1 then
     DoError ('Unlock failed')
   else
     Writeln ('Semaphore resources incremented by one');
   dispval(ID,Member);
end;
Procedure RemoveSem (ID : longint);
var S : TSemun;
begin
  If semctl(Id,0,IPC_RMID,s)<>-1 then
    Writeln ('Semaphore removed')
  else
    DoError ('Couldn''t remove semaphore');
end;
Procedure ChangeMode (ID,Mode : longint);
Var rc : longint;
    opts : TSEMun;
    semds : TSEMid_ds;
begin
  opts.buf:=@semds;
  If not semctl (Id,0,IPC_STAT,opts)<>-1 then
    DoError ('Couldn''t stat semaphore');
  Writeln ('Old permissions were : ',semds.sem_perm.mode);
  semds.sem_perm.mode:=mode;
  If semctl(id,0,IPC_SET,opts)<>-1 then
    Writeln ('Set permissions to ',mode)
  else
    DoError ('Couldn''t set permissions');
end;
Procedure PrintSem (ID : longint);
Var I,cnt : longint;
begin
  cnt:=getmembercount(ID);
  Writeln ('Semaphore ',ID,' has ',cnt,' Members');
  For I:=0 to cnt-1 Do
    DispVal(id,i);
end;
Procedure USage;
begin
  Writeln ('Usage : semtool c(reate) <count>');
  Writeln ('                l(ock) <member>');
  Writeln ('                u(nlock) <member>');
  Writeln ('                d(elete)');
  Writeln ('                m(ode) <mode>');
  Writeln ('                p(rint)');
  halt(1);
end;
Function StrToInt (S : String): longint;
Var M : longint;
    C : Integer;
begin
  val (S,M,C);
  If C<>0 Then DoError ('StrToInt : '+S);
  StrToInt:=M;
end;
Var Key : TKey;
    ID : Longint;
const ipckey='.'#0;  
begin
  If ParamCount<1 then USage;
  key:=ftok(@ipckey[1],ORD('s'));
  Case UpCase(Paramstr(1)[1]) of
   'C' : begin
         if paramcount<>2 then usage;
         CreateSem (key,strtoint(paramstr(2)));
         end;
   'L' : begin
         if paramcount<>2 then usage;
         ID:=OpenSem (key);
         LockSem (ID,strtoint(paramstr(2)));
         end;
   'U' : begin
         if paramcount<>2 then usage;
         ID:=OpenSem (key);
         UnLockSem (ID,strtoint(paramstr(2)));
         end;
   'M' : begin
         if paramcount<>2 then usage;
         ID:=OpenSem (key);
         ChangeMode (ID,strtoint(paramstr(2)));
         end;
   'D' : Begin
         ID:=OpenSem(Key);
         RemoveSem(Id);
         end;
   'P' : begin
         ID:=OpenSem(Key);
         PrintSem(Id);
         end;
  else
    Usage
  end;
end.

Name	Description
semget	Return the ID of a semaphore set, possibly creating the set
semop	Perform semaphore operation.

semctl

Declaration

Description

Errors

See also

Example