[Overview][Constants][Types][Procedures and functions][Index] | Reference for unit 'ipc' (#rtl)

# 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.

## See also

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

## 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.