diff --git a/docs/ipc.tex b/docs/ipc.tex new file mode 100644 index 0000000000..11d60724ce --- /dev/null +++ b/docs/ipc.tex @@ -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} + diff --git a/docs/ipcex/Makefile b/docs/ipcex/Makefile new file mode 100644 index 0000000000..95794c17e7 --- /dev/null +++ b/docs/ipcex/Makefile @@ -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) $* diff --git a/docs/ipcex/foot.tex b/docs/ipcex/foot.tex new file mode 100644 index 0000000000..4b6c233a40 --- /dev/null +++ b/docs/ipcex/foot.tex @@ -0,0 +1,2 @@ +\end{verbatim} +\end{FPCList} \ No newline at end of file diff --git a/docs/ipcex/head.tex b/docs/ipcex/head.tex new file mode 100644 index 0000000000..2699f37d16 --- /dev/null +++ b/docs/ipcex/head.tex @@ -0,0 +1,3 @@ +\begin{FPCList} +\item[Example] +\begin{verbatim} diff --git a/docs/ipcex/msgtool.pp b/docs/ipcex/msgtool.pp new file mode 100644 index 0000000000..4123d8030d --- /dev/null +++ b/docs/ipcex/msgtool.pp @@ -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) (max 255 characters)'); + Writeln (' r(eceive) '); + Writeln (' d(elete)'); + Writeln (' m(ode) '); + 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. \ No newline at end of file diff --git a/docs/ipcex/semtool.pp b/docs/ipcex/semtool.pp new file mode 100644 index 0000000000..996f0b8122 --- /dev/null +++ b/docs/ipcex/semtool.pp @@ -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) '); + Writeln (' l(ock) '); + Writeln (' u(nlock) '); + Writeln (' d(elete)'); + Writeln (' m(ode) '); + 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. \ No newline at end of file diff --git a/docs/ipcex/shmtool.pp b/docs/ipcex/shmtool.pp new file mode 100644 index 0000000000..4a1e626aca --- /dev/null +++ b/docs/ipcex/shmtool.pp @@ -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. \ No newline at end of file