mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-05-30 23:22:33 +02:00
Initial implementation of IPC docs
This commit is contained in:
michael
parent
29e8608a19
commit
cf2a88a773
340
docs/ipc.tex
Normal file
340
docs/ipc.tex
Normal file
@ -0,0 +1,340 @@
|
||||
%
|
||||
% $Id$
|
||||
% This file is part of the FPC documentation.
|
||||
% Copyright (C) 1998, by Michael Van Canneyt
|
||||
%
|
||||
% The FPC documentation is free text; you can redistribute it and/or
|
||||
% modify it under the terms of the GNU Library General Public License as
|
||||
% published by the Free Software Foundation; either version 2 of the
|
||||
% License, or (at your option) any later version.
|
||||
%
|
||||
% The FPC Documentation is distributed in the hope that it will be useful,
|
||||
% but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
% Library General Public License for more details.
|
||||
%
|
||||
% You should have received a copy of the GNU Library General Public
|
||||
% License along with the FPC documentation; see the file COPYING.LIB. If not,
|
||||
% write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
||||
% Boston, MA 02111-1307, USA.
|
||||
%
|
||||
\chapter{The IPC unit.}
|
||||
This chapter describes the IPC unit for Free Pascal. It was written for
|
||||
\linux by Micha\"el Van Canneyt. It gives all the functionality of system V
|
||||
Inter-Process Communication: shared memory, semaphores and messages.
|
||||
|
||||
The chapter is divided in 2 sections:
|
||||
\begin{itemize}
|
||||
\item The first section lists types, constants and variables from the
|
||||
interface part of the unit.
|
||||
\item The second section describes the functions defined in the unit.
|
||||
\end{itemize}
|
||||
\section {Types, Constants and variables : }
|
||||
\subsection{Variables}
|
||||
|
||||
\begin{verbatim}
|
||||
Var
|
||||
IPCerror : longint;
|
||||
\end{verbatim}
|
||||
The \var{IPCerror} variable is used to report errors, by all calls.
|
||||
\subsection{Constants}
|
||||
|
||||
\begin{verbatim}
|
||||
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 }
|
||||
\end{verbatim}
|
||||
These constants are used in the various \var{xxxget} calls.
|
||||
\begin{verbatim}
|
||||
IPC_RMID = 0; { remove resource }
|
||||
IPC_SET = 1; { set ipc_perm options }
|
||||
IPC_STAT = 2; { get ipc_perm options }
|
||||
IPC_INFO = 3; { see ipcs }
|
||||
\end{verbatim}
|
||||
These constants can be passed to the various \var{xxxctl} calls.
|
||||
\begin{verbatim}
|
||||
const
|
||||
MSG_NOERROR = 1 shl 12;
|
||||
MSG_EXCEPT = 2 shl 12;
|
||||
MSGMNI = 128;
|
||||
MSGMAX = 4056;
|
||||
MSGMNB = 16384;
|
||||
\end{verbatim}
|
||||
These constants are used in the messaging system, they are not for use by
|
||||
the programmer.
|
||||
\begin{verbatim}
|
||||
const
|
||||
SEM_UNDO = $1000;
|
||||
GETPID = 11;
|
||||
GETVAL = 12;
|
||||
GETALL = 13;
|
||||
GETNCNT = 14;
|
||||
GETZCNT = 15;
|
||||
SETVAL = 16;
|
||||
SETALL = 17;
|
||||
\end{verbatim}
|
||||
These constants call be specified in the \seef{semop} call.
|
||||
\begin{verbatim}
|
||||
SEMMNI = 128;
|
||||
SEMMSL = 32;
|
||||
SEMMNS = (SEMMNI * SEMMSL);
|
||||
SEMOPM = 32;
|
||||
SEMVMX = 32767;
|
||||
\end{verbatim}
|
||||
These constanst are used internally by the semaphore system, they should not
|
||||
be used by the programmer.
|
||||
\begin{verbatim}
|
||||
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;
|
||||
\end{verbatim}
|
||||
These constants are used in the \seef{shmctl} call.
|
||||
|
||||
\subsection{Types}
|
||||
|
||||
\begin{verbatim}
|
||||
Type
|
||||
TKey = Longint;
|
||||
\end{verbatim}
|
||||
\var{TKey} is the type returned by the \seef{ftok} key generating function.
|
||||
\begin{verbatim}
|
||||
type
|
||||
PIPC_Perm = ^TIPC_Perm;
|
||||
TIPC_Perm = record
|
||||
key : TKey;
|
||||
uid,
|
||||
gid,
|
||||
cuid,
|
||||
cgid,
|
||||
mode,
|
||||
seq : Word;
|
||||
end;
|
||||
\end{verbatim}
|
||||
The \var{TIPC\_Perm} structure is used in all IPC systems to specify the
|
||||
permissions.
|
||||
|
||||
\begin{verbatim}
|
||||
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;
|
||||
|
||||
|
||||
type
|
||||
PSHMinfo = ^TSHMinfo;
|
||||
TSHMinfo = record
|
||||
shmmax : longint;
|
||||
shmmin : longint;
|
||||
shmmni : longint;
|
||||
shmseg : longint;
|
||||
shmall : longint;
|
||||
end;
|
||||
|
||||
type
|
||||
PMSG = ^TMSG;
|
||||
TMSG = record
|
||||
msg_next : PMSG;
|
||||
msg_type : Longint;
|
||||
msg_spot : PChar;
|
||||
msg_stime : Longint;
|
||||
msg_ts : Integer;
|
||||
end;
|
||||
|
||||
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;
|
||||
|
||||
PMSGbuf = ^TMSGbuf;
|
||||
TMSGbuf = record
|
||||
mtype : longint;
|
||||
mtext : array[0..0] of char;
|
||||
end;
|
||||
|
||||
PMSGinfo = ^TMSGinfo;
|
||||
TMSGinfo = record
|
||||
msgpool : Longint;
|
||||
msgmap : Longint;
|
||||
msgmax : Longint;
|
||||
msgmnb : Longint;
|
||||
msgmni : Longint;
|
||||
msgssz : Longint;
|
||||
msgtql : Longint;
|
||||
msgseg : Word;
|
||||
end;
|
||||
|
||||
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;
|
||||
|
||||
PSEMbuf = ^TSEMbuf;
|
||||
TSEMbuf = record
|
||||
sem_num : word;
|
||||
sem_op : integer;
|
||||
sem_flg : integer;
|
||||
end;
|
||||
|
||||
|
||||
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;
|
||||
|
||||
PSEMun = ^TSEMun;
|
||||
TSEMun = record
|
||||
case longint of
|
||||
0 : ( val : longint );
|
||||
1 : ( buf : PSEMid_ds );
|
||||
2 : ( arr : Pointer );
|
||||
3 : ( padbuf : PSeminfo );
|
||||
4 : ( padpad : pointer );
|
||||
end;
|
||||
\end{verbatim}
|
||||
|
||||
\section{Functions and procedures}
|
||||
|
||||
\begin{function}{ftok}
|
||||
\Declaration
|
||||
Function ftok (Path : String; ID : char) : TKey;
|
||||
\Description
|
||||
\Errors
|
||||
\SeeAlso
|
||||
\end{function}
|
||||
|
||||
\begin{function}{msgget}
|
||||
\Declaration
|
||||
Function msgget(key: TKey; msgflg:longint):longint;
|
||||
\Description
|
||||
\Errors
|
||||
\SeeAlso
|
||||
\end{function}
|
||||
|
||||
\begin{function}{msgsnd}
|
||||
\Declaration
|
||||
Function msgsnd(msqid:longint; msgp: PMSGBuf; msgsz: longint; msgflg:longint): Boolean;
|
||||
\Description
|
||||
\Errors
|
||||
\SeeAlso
|
||||
\end{function}
|
||||
|
||||
\begin{function}{msgrcv}
|
||||
\Declaration
|
||||
Function msgrcv(msqid:longint; msgp: PMSGBuf; msgsz: longint; msgtyp:longint; msgflg:longint): Boolean;
|
||||
\Description
|
||||
\Errors
|
||||
\SeeAlso
|
||||
\end{function}
|
||||
|
||||
\begin{function}{msgctl}
|
||||
\Declaration
|
||||
Function msgctl(msqid:longint; cmd: longint; buf: PMSQid\_ds): Boolean;
|
||||
\Description
|
||||
\Errors
|
||||
\SeeAlso
|
||||
\end{function}
|
||||
|
||||
\begin{function}{semget}
|
||||
\Declaration
|
||||
Function semget(key:Tkey; nsems:longint; semflg:longint): longint;
|
||||
\Description
|
||||
\Errors
|
||||
\SeeAlso
|
||||
\end{function}
|
||||
|
||||
\begin{function}{semop}
|
||||
\Declaration
|
||||
Function semop(semid:longint; sops: pointer; nsops: cardinal): Boolean;
|
||||
\Description
|
||||
\Errors
|
||||
\SeeAlso
|
||||
\end{function}
|
||||
|
||||
\begin{function}{semctl}
|
||||
\Declaration
|
||||
Function semctl(semid:longint; semnum:longint; cmd:longint; var arg: tsemun): longint;
|
||||
\Description
|
||||
\Errors
|
||||
\SeeAlso
|
||||
\end{function}
|
||||
|
||||
\begin{function}{shmget}
|
||||
\Declaration
|
||||
Function shmget(key: Tkey; size:longint; flag:longint):longint;
|
||||
\Description
|
||||
\Errors
|
||||
\SeeAlso
|
||||
\end{function}
|
||||
|
||||
\begin{function}{shmat}
|
||||
\Declaration
|
||||
Function shmat (shmid:longint; shmaddr:pchar; shmflg:longint):pchar;
|
||||
\Description
|
||||
\Errors
|
||||
\SeeAlso
|
||||
\end{function}
|
||||
|
||||
\begin{function}{shmdt}
|
||||
\Declaration
|
||||
Function shmdt (shmaddr:pchar):boolean;
|
||||
\Description
|
||||
\Errors
|
||||
\SeeAlso
|
||||
\end{function}
|
||||
|
||||
\begin{function}{shmctl}
|
||||
\Declaration
|
||||
Function shmctl(shmid:longint; cmd:longint; buf: pshmid\_ds): Boolean;
|
||||
\Description
|
||||
\Errors
|
||||
\SeeAlso
|
||||
\end{function}
|
||||
|
||||
53
docs/ipcex/Makefile
Normal file
53
docs/ipcex/Makefile
Normal file
@ -0,0 +1,53 @@
|
||||
#######################################################################
|
||||
#
|
||||
# Makefile to compile all examples and convert them to LaTeX
|
||||
#
|
||||
#######################################################################
|
||||
|
||||
# Compiler
|
||||
PP=ppc386
|
||||
|
||||
# Unit directory
|
||||
# UNITDIR=/usr/lib/ppc/0.99.0/linuxunits
|
||||
|
||||
|
||||
# Any options you wish to pass.
|
||||
PPOPTS=
|
||||
|
||||
# Script to convert the programs to LaTeX examples which can be included.
|
||||
PP2TEX=../pp2tex
|
||||
|
||||
# Script to collect all examples in 1 file.
|
||||
MAKETEX=make1tex
|
||||
|
||||
#######################################################################
|
||||
# No need to edit after this line.
|
||||
#######################################################################
|
||||
|
||||
ifdef UNITDIR
|
||||
PPOPTS:=$(PPOPTS) -Up$(UNITDIR);
|
||||
endif
|
||||
|
||||
.SUFFIXES: .pp .tex
|
||||
|
||||
.PHONY: all tex clean
|
||||
|
||||
OBJECTS=shmtool semtool msgtool
|
||||
|
||||
TEXOBJECTS=$(addsuffix .tex, $(OBJECTS))
|
||||
|
||||
all : $(OBJECTS)
|
||||
|
||||
tex : $(TEXOBJECTS)
|
||||
|
||||
onetex : tex
|
||||
$(MAKETEX) $(TEXOBJECTS)
|
||||
|
||||
clean :
|
||||
rm -f *.o *.s $(OBJECTS) $(TEXOBJECTS)
|
||||
|
||||
$(OBJECTS): %: %.pp
|
||||
$(PP) $(PPOPTS) $*
|
||||
|
||||
$(TEXOBJECTS): %.tex: %.pp head.tex foot.tex
|
||||
$(PP2TEX) $*
|
||||
2
docs/ipcex/foot.tex
Normal file
2
docs/ipcex/foot.tex
Normal file
@ -0,0 +1,2 @@
|
||||
\end{verbatim}
|
||||
\end{FPCList}
|
||||
3
docs/ipcex/head.tex
Normal file
3
docs/ipcex/head.tex
Normal file
@ -0,0 +1,3 @@
|
||||
\begin{FPCList}
|
||||
\item[Example]
|
||||
\begin{verbatim}
|
||||
118
docs/ipcex/msgtool.pp
Normal file
118
docs/ipcex/msgtool.pp
Normal file
@ -0,0 +1,118 @@
|
||||
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.
|
||||
216
docs/ipcex/semtool.pp
Normal file
216
docs/ipcex/semtool.pp
Normal file
@ -0,0 +1,216 @@
|
||||
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.
|
||||
98
docs/ipcex/shmtool.pp
Normal file
98
docs/ipcex/shmtool.pp
Normal file
@ -0,0 +1,98 @@
|
||||
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.
|
||||
Loading…
Reference in New Issue
Block a user