[prev] [prev-tail] [tail] [up]

### 10.2 Functions and procedures

#### ftok

Declaration:
  Function ftok (Path : String; ID : char) : TKey;
Description:
  ftok returns a key that can be used in a semget (270),shmget (278) or msgget (266) 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 (270),shmget (278),msgget (266)

For an example, see msgctl (268), semctl (272), shmctl (279).

#### 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 (266),msgsnd (267), msgrcv (267), msgctl (268), semget (2)

For an example, see msgctl (268).

#### 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 (266), msgrcv (267), seefmsgctl

For an example, see msgctl (268).

#### 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 (266), msgsnd (267), msgctl (268)

For an example, see msgctl (268).

#### 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 (266), msgsnd (267), msgrcv (267)

Listing: ipcex/msgtool.pp

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.

#### 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 (266), semop (271), semctl (272)

#### 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 (270), semctl (272)

#### 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 (271) 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 (270), semop (271)

Listing: ipcex/semtool.pp

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.

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

#### 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 (278), shmdt (279), shmctl (279)

For an example, see shmctl (279).

#### 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 (278).

  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 (278), shmat (278), shmctl (279)

#### 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 (278), shmat (278), shmdt (279)

Listing: ipcex/shmtool.pp

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.

[prev] [prev-tail] [front] [up]