mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-11 18:06:12 +02:00
+ Initial implementation, implemented shm and msg
This commit is contained in:
michael
parent
1ace0dc9b8
commit
8ee50fd02a
284
rtl/linux/ipc.pp
Normal file
284
rtl/linux/ipc.pp
Normal file
@ -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.
|
||||
Loading…
Reference in New Issue
Block a user