Subsections

10. The IPC unit.

This chapter describes the IPC unit for Free Pascal. It was written for LINUX by Michaël Van Canneyt. It gives all the functionality of system V Inter-Process Communication: shared memory, semaphores and messages. It works only on the LINUX operating system.

The chapter is divided in 2 sections:

10.1 Types, Constants and variables :

10.1.1 Variables

Var
  IPCerror : longint;
The IPCerror variable is used to report errors, by all calls.

10.1.2 Constants

Many constants here are provided for completeness only, and should under normal circumstances not be used by the programmer.
Const 
  IPC_CREAT  =  1 shl 9;  { create if key is nonexistent }
  IPC_EXCL   =  2 shl 9;  { fail if key exists }
  IPC_NOWAIT =  4 shl 9;  { return error on wait }
These constants are used in the various xxxget calls.
  IPC_RMID = 0;     { remove resource }
  IPC_SET  = 1;     { set ipc_perm options }
  IPC_STAT = 2;     { get ipc_perm options }
  IPC_INFO = 3;     { see ipcs }
These constants can be passed to the various xxxctl calls.
const
  MSG_NOERROR = 1 shl 12;
  MSG_EXCEPT  = 2 shl 12;
  MSGMNI = 128;
  MSGMAX = 4056;
  MSGMNB = 16384;
These constants are used in the messaging system, they are not for use by the programmer.
const
  SEM_UNDO = $1000;
  GETPID = 11;
  GETVAL = 12;
  GETALL = 13;
  GETNCNT = 14;
  GETZCNT = 15;
  SETVAL = 16;
  SETALL = 17;
These constants call be specified in the semop call.
  SEMMNI = 128;
  SEMMSL = 32;
  SEMMNS = (SEMMNI * SEMMSL);
  SEMOPM = 32;
  SEMVMX = 32767;
These constanst are used internally by the semaphore system, they should not be used by the programmer.
const
  SHM_R      = 4 shl 6;
  SHM_W      = 2 shl 6;
  SHM_RDONLY = 1 shl 12;
  SHM_RND    = 2 shl 12;
  SHM_REMAP  = 4 shl 12;
  SHM_LOCK   = 11;
  SHM_UNLOCK = 12;
These constants are used in the shmctl call.

10.1.3 Types

The following two types are provided because they are needed. One they they should be defined in the system unit, however.
Type
  PULong = ^Cardinal;
  PWord  = ^Word;

Type 
   TKey   = Longint;
TKey is the type returned by the ftok key generating function.
type
  PIPC_Perm = ^TIPC_Perm;
  TIPC_Perm = record
    key : TKey;
    uid, 
    gid,
    cuid,
    cgid,
    mode,
    seq : Word;   
  end;
The TIPC_Perm structure is used in all IPC systems to specify the permissions.
Type  
  PSHMid_DS = ^TSHMid_ds; 
  TSHMid_ds = record
    shm_perm  : TIPC_Perm;
    shm_segsz : longint;
    shm_atime : longint;
    shm_dtime : longint;
    shm_ctime : longint;
    shm_cpid  : word;
    shm_lpid  : word;
    shm_nattch : integer;
    shm_npages : word;
    shm_pages  : Pointer;
    attaches   : pointer;
  end;
The TSHMid_ds strucure is used in the shmctl call to set or retrieve settings concerning shared memory.
type
  PSHMinfo = ^TSHMinfo;
  TSHMinfo = record
    shmmax : longint;
    shmmin : longint;
    shmmni : longint;
    shmseg : longint;
    shmall : longint;
  end;
The TSHMinfo record is used by the shared memory system, and should not be accessed by the programer directly.
type
  PMSG = ^TMSG;
  TMSG = record
    msg_next  : PMSG;
    msg_type  : Longint;
    msg_spot  : PChar;
    msg_stime : Longint;
    msg_ts    : Integer;
  end;
The TMSG record is used in the handling of message queues. There should be few cases where the programmer needs to access this data.
type
  PMSQid_ds = ^TMSQid_ds;
  TMSQid_ds = record
    msg_perm   : TIPC_perm;
    msg_first  : PMsg;
    msg_last   : PMsg;
    msg_stime  : Longint;
    msg_rtime  : Longint;
    msg_ctime  : Longint;
    wwait      : Pointer;
    rwait      : pointer;
    msg_cbytes : word;
    msg_qnum   : word;
    msg_qbytes : word;
    msg_lspid  : word;
    msg_lrpid  : word;
  end;
The TMSQid_ds record is returned by the msgctl call, and contains all data about a message queue.
  PMSGbuf = ^TMSGbuf;
  TMSGbuf = record
    mtype : longint;
    mtext : array[0..0] of char;
  end;
The TMSGbuf record is a record containing the data of a record. you should never use this record directly, instead you should make your own record that follows the structure of the TMSGbuf record, but that has a size that is big enough to accomodate your messages. The mtype field should always be present, and should always be filled.
Type
  PMSGinfo = ^TMSGinfo;
  TMSGinfo = record
    msgpool : Longint;
    msgmap  : Longint;
    msgmax  : Longint;
    msgmnb  : Longint;
    msgmni  : Longint;
    msgssz  : Longint;
    msgtql  : Longint;
    msgseg  : Word;
  end;
The TMSGinfo record is used internally by the message queue system, and should not be used by the programmer directly.
Type
  PSEMid_ds = ^PSEMid_ds;
  TSEMid_ds = record
    sem_perm : tipc_perm;
    sem_otime : longint;
    sem_ctime : longint;
    sem_base         : pointer;
    sem_pending      : pointer;
    sem_pending_last : pointer;
    undo             : pointer;
    sem_nsems : word;
  end;
The TSEMid_ds structure is returned by the semctl call, and contains all data concerning a semahore.
Type
  PSEMbuf = ^TSEMbuf;
  TSEMbuf = record
    sem_num : word;
    sem_op  : integer;
    sem_flg : integer;
  end;
The TSEMbuf record us use in the semop call, and is used to specify which operations you want to do.
Type
  PSEMinfo = ^TSEMinfo;
  TSEMinfo = record
    semmap : longint;
    semmni : longint;
    semmns : longint;
    semmnu : longint;
    semmsl : longint;
    semopm : longint;
    semume : longint;
    semusz : longint;
    semvmx : longint;
    semaem : longint;
  end;
The TSEMinfo record is used internally by the semaphore system, and should not be used directly.
Type
  PSEMun = ^TSEMun;
  TSEMun = record
   case longint of
      0 : ( val : longint );
      1 : ( buf : PSEMid_ds );
      2 : ( arr : PWord );
      3 : ( padbuf : PSeminfo );
      4 : ( padpad : pointer );
   end;
The TSEMun variant record (actually a C union) is used in the semctl call.

10.2 Functions and procedures


10.2.1 ftok

Declaration
Function ftok (Path : String; ID : char) : TKey;
Description
ftok returns a key that can be used in a semget,shmget or msgget call to access a new or existing IPC resource.

Path is the name of a file in the file system, ID is a character of your choice. The ftok call does the same as it's C couterpart, so a pascal program and a C program will access the same resource if they use the same Path and ID

Errors
ftok returns -1 if the file in Path doesn't exist.
See also
semget,shmget,msgget

For an example, see msgctl, semctl, shmctl.


10.2.2 msgget

Declaration
Function msgget(key: TKey; msgflg:longint):longint;
Description
msgget returns the ID of the message queue described by key. Depending on the flags in msgflg, a new queue is created.

msgflg can have one or more of the following values (combined by ORs):

IPC_CREAT
The queue is created if it doesn't already exist.
IPC_EXCL
If used in combination with IPC_CREAT, causes the call to fail if the queue already exists. It cannot be used by itself.
Optionally, the flags can be ORed with a permission mode, which is the same mode that can be used in the file system.
Errors
On error, -1 is returned, and IPCError is set.
See also
ftok,msgsnd, msgrcv, msgctl, semget (2)

For an example, see msgctl.


10.2.3 msgsnd

Declaration
Function msgsnd(msqid:longint; msgp: PMSGBuf; msgsz: longint; msgflg:longint): Boolean;
Description
msgsend sends a message to a message queue with ID msqid. msgp is a pointer to a message buffer, that should be based on the TMsgBuf type. msgsiz is the size of the message (NOT of the message buffer record !)

The msgflg can have a combination of the following values (ORed together):

0
No special meaning. The message will be written to the queue. If the queue is full, then the process is blocked.
IPC_NOWAIT
If the queue is full, then no message is written, and the call returns immediatly.

The function returns True if the message was sent successfully, False otherwise.

Errors
In case of error, the call returns False, and IPCerror is set.
See also
msgget, msgrcv, seefmsgctl

For an example, see msgctl.


10.2.4 msgrcv

Declaration
Function msgrcv(msqid:longint; msgp: PMSGBuf; msgsz: longint; msgtyp:longint; msgflg:longint): Boolean;
Description
msgrcv retrieves a message of type msgtyp from the message queue with ID msqid. msgtyp corresponds to the mtype field of the TMSGbuf record. The message is stored in the MSGbuf structure pointed to by msgp.

The msgflg parameter can be used to control the behaviour of the msgrcv call. It consists of an ORed combination of the following flags:

0
No special meaning.
IPC_NOWAIT
if no messages are available, then the call returns immediatly, with the ENOMSG error.
MSG_NOERROR
If the message size is wrong (too large), no error is generated, instead the message is truncated. Normally, in such cases, the call returns an error (E2BIG)

The function returns True if the message was received correctly, False otherwise.

Errors
In case of error, False is returned, and IPCerror is set.
See also
msgget, msgsnd, msgctl

For an example, see msgctl.


10.2.5 msgctl

Declaration
Function msgctl(msqid:longint; cmd: longint; buf: PMSQid_ds): Boolean;
Description
msgctl performs various operations on the message queue with id ID. Which operation is performed, depends on the cmd parameter, which can have one of the following values:
IPC_STAT
In this case, the msgctl call fills the TMSQid_ds structure with information about the message queue.
IPC_SET
in this case, the msgctl call sets the permissions of the queue as specified in the ipc_perm record inside buf.
IPC_RMID
If this is specified, the message queue will be removed from the system.

buf contains the data that are needed by the call. It can be Nil in case the message queue should be removed.

The function returns True if successfull, False otherwise.

Errors
On error, False is returned, and IPCerror is set accordingly.
See also
msgget, msgsnd, msgrcv

Example
program msgtool;

Uses ipc;

Type
  PMyMsgBuf = ^TMyMsgBuf;
  TMyMsgBuf = record
    mtype : Longint;
    mtext : string[255];
  end; 

Procedure DoError (Const Msg : string);

begin
  Writeln (msg,'returned an error : ',ipcerror);
  halt(1);
end;

Procedure SendMessage (Id : Longint; 
                       Var Buf : TMyMsgBuf; 
                       MType : Longint; 
                       Const MText : String);

begin
  Writeln ('Sending message.');
  Buf.mtype:=mtype;
  Buf.Mtext:=mtext;
  If not msgsnd(Id,PMsgBuf(@Buf),256,0) then
    DoError('msgsnd');
end;

Procedure ReadMessage (ID : Longint;
                       Var Buf : TMyMsgBuf;
                       MType : longint);

begin
  Writeln ('Reading message.');
  Buf.MType:=MType;
  If msgrcv(ID,PMSGBuf(@Buf),256,mtype,0) then
    Writeln ('Type : ',buf.mtype,' Text : ',buf.mtext)
  else 
    DoError ('msgrcv');
end;

Procedure RemoveQueue ( ID : Longint);

begin
  If msgctl (id,IPC_RMID,Nil) then
    Writeln ('Removed Queue with id',Id);
end;

Procedure ChangeQueueMode (ID,mode : longint);

Var QueueDS : TMSQid_ds;

begin
  If Not msgctl (Id,IPC_STAT,@QueueDS) then
    DoError ('msgctl : stat');
  Writeln ('Old permissions : ',QueueDS.msg_perm.mode);
  QueueDS.msg_perm.mode:=Mode;
  if msgctl (ID,IPC_SET,@QueueDS) then
    Writeln ('New permissions : ',QueueDS.msg_perm.mode)
  else
   DoError ('msgctl : IPC_SET');
end;

procedure usage;

begin
  Writeln ('Usage : msgtool s(end)    <type> <text> (max 255 characters)');
  Writeln ('                r(eceive) <type>');
  Writeln ('                d(elete)');
  Writeln ('                m(ode) <decimal mode>');
  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;
  Buf : TMyMsgBuf;

begin
  If Paramcount<1 then Usage;
  key :=Ftok('.','M');
  ID:=msgget(key,IPC_CREAT or 438);
  If ID<0 then DoError ('MsgGet');
  Case upCase(Paramstr(1)[1]) of 
   'S' : If ParamCount<>3 then 
           Usage
         else
           SendMessage (id,Buf,StrToInt(Paramstr(2)),paramstr(3));
   'R' : If ParamCount<>2 then
           Usage
         else
           ReadMessage (id,buf,strtoint(Paramstr(2)));
   'D' : If ParamCount<>1 then
           Usage 
         else
           RemoveQueue (ID);
   'M' : If ParamCount<>2 then
           Usage
         else
           ChangeQueueMode (id,strtoint(paramstr(2)));
   else
     Usage
   end;
end.


10.2.6 semget

Declaration
Function semget(key:Tkey; nsems:longint; semflg:longint): longint;
Description
msgget returns the ID of the semaphore set described by key. Depending on the flags in semflg, a new queue is created.

semflg can have one or more of the following values (combined by ORs):

IPC_CREAT
The queue is created if it doesn't already exist.
IPC_EXCL
If used in combination with IPC_CREAT, causes the call to fail if the set already exists. It cannot be used by itself.
Optionally, the flags can be ORed with a permission mode, which is the same mode that can be used in the file system.

if a new set of semaphores is created, then there will be nsems semaphores in it.

Errors
On error, -1 is returned, and IPCError is set.
See also
ftok, semop, semctl


10.2.7 semop

Declaration
Function semop(semid:longint; sops: pointer; nsops: cardinal): Boolean;
Description
semop performs a set of operations on a message queue. sops points to an array of type TSEMbuf. The array should contain nsops elements.

The fields of the TSEMbuf structure

  TSEMbuf = record
    sem_num : word;
    sem_op  : integer;
    sem_flg : integer;

should be filled as follows:

sem_num
The number of the semaphore in the set on which the operation must be performed.
sem_op
The operation to be performed. The operation depends on the sign of sem_op
  1. A positive number is simply added to the current value of the semaphore.
  2. If 0 (zero) is specified, then the process is suspended until the specified semaphore reaches zero.
  3. If a negative number is specified, it is substracted from the current value of the semaphore. If the value would become negative then the process is suspended until the value becomes big enough, unless IPC_NOWAIT is specified in the sem_flg.
sem_flg
Optional flags: if IPC_NOWAIT is specified, then the calling process will never be suspended.

The function returns True if the operations were successful, False otherwise.

Errors
In case of error, False is returned, and IPCerror is set.
See also
semget, semctl


10.2.8 semctl

Declaration
Function semctl(semid:longint; semnum:longint; cmd:longint; var arg: tsemun): longint;
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 bumber 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, semop

Example
Program semtool;

{ Program to demonstrat the use of semaphores }

Uses ipc;

Const MaxSemValue = 5;

Procedure DoError (Const Msg : String);

begin
  Writeln ('Error : ',msg,' Code : ',IPCerror);
  Halt(1);
end;

Function getsemval (ID,Member : longint) : longint;

Var S : TSEMun;

begin
  GetSemVal:=SemCtl(id,member,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
  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,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 not semop(Id,@lock,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 not semop(Id,@unlock,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>');
  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;

begin
  If ParamCount<1 then USage;
  key:=ftok('.','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.


10.2.9 shmget

Declaration
Function shmget(key: Tkey; Size:longint; flag:longint):longint;
Description
shmget returns the ID of a shared memory block, described by key. Depending on the flags in flag, a new memory block is created.

flag can have one or more of the following values (combined by ORs):

IPC_CREAT
The queue is created if it doesn't already exist.
IPC_EXCL
If used in combination with IPC_CREAT, causes the call to fail if the queue already exists. It cannot be used by itself.
Optionally, the flags can be ORed with a permission mode, which is the same mode that can be used in the file system.

if a new memory block is created, then it will have size Size semaphores in it.

Errors
On error, -1 is returned, and IPCError is set.
See also


10.2.10 shmat

Declaration
Function shmat (shmid:longint; shmaddr:pchar; shmflg:longint):pchar;
Description
shmat attaches a shared memory block with identified shmid to the current process. The function returns a pointer to the shared memory block.

If shmaddr is Nil, then the system chooses a free unmapped memory region, as high up in memory space as possible.

If shmaddr is non-nil, and SHM_RND is in shmflg, then the returned address is shmaddr, rounded down to SHMLBA. If SHM_RND is not specified, then shmaddr must be a page-aligned address.

The parameter shmflg can be used to control the behaviour of the shmat call. It consists of a ORed combination of the following costants:

SHM_RND
The suggested address in shmaddr is rounded down to SHMLBA.
SHM_RDONLY
the shared memory is attached for read access only. Otherwise the memory is attached for read-write. The process then needs read-write permissions to access the shared memory.
Errors
If an error occurs, -1 is returned, and IPCerror is set.
See also
shmget, shmdt, shmctl

For an example, see shmctl.


10.2.11 shmdt

Declaration
Function shmdt (shmaddr:pchar):boolean;
Description
shmdt detaches the shared memory at address shmaddr. This shared memory block is unavailable to the current process, until it is attached again by a call to shmat.

The function returns True if the memory block was detached successfully, False otherwise.

Errors
On error, False is returned, and IPCerror is set.
See also
shmget, shmat, shmctl


10.2.12 shmctl

Declaration
Function shmctl(shmid:longint; cmd:longint; buf: pshmid_ds): Boolean;
Description
shmctl performs various operations on the shared memory block identified by identifier shmid.

The buf parameter points to a TSHMid_ds record. The cmd parameter is used to pass which operation is to be performed. It can have one of the following values :

IPC_STAT
shmctl fills the TSHMid_ds record that buf points to with the available information about the shared memory block.
IPC_SET
applies the values in the ipc_perm record that buf points to, to the shared memory block.
IPC_RMID
the shared memory block is destroyed (after all processes to which the block is attached, have detached from it).

If successful, the function returns True, False otherwise.

Errors
If an error occurs, the function returns False, and IPCerror is set.
See also
shmget, shmat, shmdt

Example
Program shmtool;

uses ipc,strings;

Const SegSize = 100;

var key : Tkey;
    shmid,cntr : longint;
    segptr : pchar;

Procedure USage;

begin
 Writeln ('Usage : shmtool w(rite) text');
 writeln ('                r(ead)');
 writeln ('                d(elete)');
 writeln ('                m(ode change) mode');
 halt(1);
end;

Procedure Writeshm (ID : Longint; ptr : pchar; S : string);

begin
  strpcopy (ptr,s);
end;

Procedure Readshm(ID : longint; ptr : pchar);

begin
  Writeln ('Read : ',ptr);
end;

Procedure removeshm (ID : Longint);

begin
  shmctl (ID,IPC_RMID,Nil);
  writeln ('Shared memory marked for deletion');
end;

Procedure CHangeMode (ID : longint; mode : String);

Var m : word;
    code : integer; 
    data : TSHMid_ds;
    
begin
  val (mode,m,code);
  if code<>0 then
    usage;
  If Not shmctl (shmid,IPC_STAT,@data) then 
    begin
    writeln ('Error : shmctl :',ipcerror);
    halt(1);
    end;
  writeln ('Old permissions : ',data.shm_perm.mode);
  data.shm_perm.mode:=m;
  If Not shmctl (shmid,IPC_SET,@data) then 
    begin
    writeln ('Error : shmctl :',ipcerror);
    halt(1);
    end;
  writeln ('New permissions : ',data.shm_perm.mode);
end;

begin
  if paramcount<1 then usage;
  key := ftok ('.','S');
  shmid := shmget(key,segsize,IPC_CREAT or IPC_EXCL or 438);
  If shmid=-1 then
    begin
    Writeln ('Shared memory exists. Opening as client');
    shmid := shmget(key,segsize,0);
    If shmid = -1 then 
      begin
      Writeln ('shmget : Error !',ipcerror);
      halt(1);
      end
    end
  else
    Writeln ('Creating new shared memory segment.');
  segptr:=shmat(shmid,nil,0);
  if longint(segptr)=-1 then
    begin
    Writeln ('Shmat : error !',ipcerror);
    halt(1);
    end;
  case upcase(paramstr(1)[1]) of
    'W' : writeshm (shmid,segptr,paramstr(2));
    'R' : readshm (shmid,segptr);
    'D' : removeshm(shmid);
    'M' : changemode (shmid,paramstr(2));
  else
    begin
    writeln (paramstr(1));
    usage;
    end;
  end;
end.


root
2000-12-20