From 8ee50fd02ab9713f4c98dfdf5f6bcec0891a1a23 Mon Sep 17 00:00:00 2001 From: michael Date: Mon, 11 Jan 1999 16:53:31 +0000 Subject: [PATCH] + Initial implementation, implemented shm and msg --- rtl/linux/ipc.pp | 284 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 284 insertions(+) create mode 100644 rtl/linux/ipc.pp diff --git a/rtl/linux/ipc.pp b/rtl/linux/ipc.pp new file mode 100644 index 0000000000..b5b8869367 --- /dev/null +++ b/rtl/linux/ipc.pp @@ -0,0 +1,284 @@ +{ + $Id$ + This file is part of the Free Pascal run time library. + Copyright (c) 1998 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; + +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; + + +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; + +Var SR : SysCallRegs; + +begin + SR.Reg2:=Call; + SR.reg3:=first; + SR.reg4:=second; + SR.Reg5:=third; + SR.Reg6:=Longint(P); + ipccall:=syscall(syscall_nr_ipc,sr); + 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; + +end.