Initial implementation of IPC docs

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}
+

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) $*

docs/ipcex/foot.tex

@@ -0,0 +1,2 @@
+\end{verbatim}
+\end{FPCList}

docs/ipcex/head.tex

@@ -0,0 +1,3 @@
+\begin{FPCList}
+\item[Example]
+\begin{verbatim}

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

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

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.