{ $Id$ This file is part of the Free Pascal run time library. Copyright (c) 1999-2000 by the Free Pascal development team This file implements IPC calls calls for Linux See the file COPYING.FPC, included in this distribution, for details about the copyright. This program 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. **********************************************************************} Unit ipc; interface { ---------------------------------------------------------------------- General IPC stuff ----------------------------------------------------------------------} Var IPCError : longint; Type TKey = Longint; PULong = ^Cardinal; PWord = ^Word; Const { IPC flags for get calls } 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 } { Actions for ctl 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 } type PIPC_Perm = ^TIPC_Perm; TIPC_Perm = record key : TKey; uid, gid, cuid, cgid, mode, seq : Word; end; { Function to generate a IPC key. } Function ftok (Path : String; ID : char) : TKey; { ---------------------------------------------------------------------- Shared memory stuff ----------------------------------------------------------------------} 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; 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; type PSHMinfo = ^TSHMinfo; TSHMinfo = record shmmax : longint; shmmin : longint; shmmni : longint; shmseg : longint; shmall : longint; end; Function shmget(key: Tkey; size:longint; flag:longint):longint; Function shmat (shmid:longint; shmaddr:pchar; shmflg:longint):pchar; Function shmdt (shmaddr:pchar):boolean; Function shmctl(shmid:longint; cmd:longint; buf: pshmid_ds): Boolean; { ---------------------------------------------------------------------- Message queue stuff ----------------------------------------------------------------------} const MSG_NOERROR = 1 shl 12; MSG_EXCEPT = 2 shl 12; MSGMNI = 128; MSGMAX = 4056; MSGMNB = 16384; 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; Function msgget(key: TKey; msgflg:longint):longint; Function msgsnd(msqid:longint; msgp: PMSGBuf; msgsz: longint; msgflg:longint): Boolean; Function msgrcv(msqid:longint; msgp: PMSGBuf; msgsz: longint; msgtyp:longint; msgflg:longint): Boolean; Function msgctl(msqid:longint; cmd: longint; buf: PMSQid_ds): Boolean; { ---------------------------------------------------------------------- Semaphores stuff ----------------------------------------------------------------------} const SEM_UNDO = $1000; GETPID = 11; GETVAL = 12; GETALL = 13; GETNCNT = 14; GETZCNT = 15; SETVAL = 16; SETALL = 17; SEMMNI = 128; SEMMSL = 32; SEMMNS = (SEMMNI * SEMMSL); SEMOPM = 32; SEMVMX = 32767; type PSEMid_ds = ^TSEMid_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 : PWord ); 3 : ( padbuf : PSeminfo ); 4 : ( padpad : pointer ); end; Function semget(key:Tkey; nsems:longint; semflg:longint): longint; Function semop(semid:longint; sops: pointer; nsops: cardinal): Boolean; Function semctl(semid:longint; semnum:longint; cmd:longint; var arg: tsemun): longint; implementation uses Linux; { The following definitions come from linux/ipc.h } Const CALL_SEMOP = 1; CALL_SEMGET = 2; CALL_SEMCTL = 3; CALL_MSGSND = 11; CALL_MSGRCV = 12; CALL_MSGGET = 13; CALL_MSGCTL = 14; CALL_SHMAT = 21; CALL_SHMDT = 22; CALL_SHMGET = 23; CALL_SHMCTL = 24; { generic call that handles all IPC calls } function ipccall(Call,First,Second,Third : Longint; P : Pointer) : longint; {$ifndef bsd} Var SR : SysCallRegs; {$endif} begin {$IFNDEF bsd} SR.Reg2:=Call; SR.reg3:=first; SR.reg4:=second; SR.Reg5:=third; SR.Reg6:=Longint(P); ipccall:=syscall(syscall_nr_ipc,sr); {$Endif} ipcerror:=Errno; end; Function ftok (Path : String; ID : char) : TKey; Var Info : Stat; begin If not fstat(path,info) then ftok:=-1 else begin ftok:= (info.ino and $FFFF) or ((info.dev and $ff) shl 16) or (byte(ID) shl 24) end; end; function shmget(key: Tkey; size:longint; flag:longint):longint; begin shmget:=ipccall (CALL_SHMGET,key,size,flag,nil); end; function shmat (shmid:longint; shmaddr:pchar; shmflg:longint): pchar; Var raddr : pchar; error : longint; begin error:=ipccall(CALL_SHMAT,shmid,shmflg,longint(@raddr),shmaddr); If Error<0 then shmat:=pchar(error) else shmat:=raddr; end; function shmdt (shmaddr:pchar): boolean; begin shmdt:=ipccall(CALL_SHMDT,0,0,0,shmaddr)<>-1; end; function shmctl(shmid:longint; cmd:longint; buf: pshmid_ds): Boolean; begin shmctl:=ipccall(CALL_SHMCTL,shmid,cmd,0,buf)=0; end; Function msgget(key:Tkey; msgflg:longint):longint; begin msgget:=ipccall(CALL_MSGGET,key,msgflg,0,Nil); end; Function msgsnd(msqid:longint; msgp: PMSGBuf; msgsz: longint; msgflg:longint):Boolean; begin msgsnd:=ipccall(Call_MSGSND,msqid,msgsz,msgflg,msgp)=0; end; Function msgrcv(msqid:longint; msgp: PMSGBuf; msgsz: longint; msgtyp:longint; msgflg:longint):Boolean; Type TIPC_Kludge = Record msgp : pmsgbuf; msgtyp : longint; end; Var tmp : TIPC_Kludge; begin tmp.msgp := msgp; tmp.msgtyp := msgtyp; msgrcv:=ipccall(CALL_MSGRCV,msqid,msgsz,msgflg,@tmp)>=0; end; Function msgctl(msqid:longint; cmd: longint; buf: PMSQid_ds): Boolean; begin msgctl:=ipccall(CALL_MSGCTL,msqid,cmd,0,buf)=0; end; Function semget(key:Tkey; nsems:longint; semflg:longint): longint; begin semget:=ipccall (CALL_SEMGET,key,nsems,semflg,Nil); end; Function semop(semid:longint; sops: pointer; nsops:cardinal): Boolean; begin semop:=ipccall (CALL_SEMOP,semid,Longint(nsops),0,Pointer(sops))=0; end; Function semctl(semid:longint; semnum:longint; cmd:longint; var arg: tsemun): longint; begin semctl:=ipccall(CALL_SEMCTL,semid,semnum,cmd,@arg); end; end. { $Log$ Revision 1.2 2000-09-18 13:14:50 marco * Global Linux +bsd to (rtl/freebsd rtl/unix rtl/linux structure) Revision 1.3 2000/09/12 08:51:43 marco * fixed some small problems left from merging. (waitpid has now last param longint) Revision 1.2 2000/07/13 11:33:48 michael + removed logs }