1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
|
{
This file is part of the Free Pascal run time library.
Copyright (c) 2001 by Free Pascal development team
Linux IPC implemented with ipccall
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.
***********************************************************************}
{ The following definitions come from linux/ipc.h }
Function ftok (Path : pchar; ID : cint) : TKey;
Var Info : TStat;
begin
If fpstat(path,info)<0 then
ftok:=-1
else
begin
ftok:= (info.st_ino and $FFFF) or ((info.st_dev and $ff) shl 16) or (byte(ID) shl 24)
end;
end;
{$ifdef linux_ipc32}
const
ipc_api_select = 0; // 16-bit gid/pid types and old structs
{$else}
const
ipc_api_select = $100; // 32-bit gid/pid types and newer structs
{$endif}
Const
CALL_SEMOP = 1 +ipc_api_select;
CALL_SEMGET = 2 +ipc_api_select;
CALL_SEMCTL = 3 +ipc_api_select;
CALL_SEMTIMEDOP = 4 +ipc_api_select;
CALL_MSGSND = 11+ipc_api_select;
CALL_MSGRCV = 12+ipc_api_select;
CALL_MSGGET = 13+ipc_api_select;
CALL_MSGCTL = 14+ipc_api_select;
CALL_SHMAT = 21+ipc_api_select;
CALL_SHMDT = 22+ipc_api_select;
CALL_SHMGET = 23+ipc_api_select;
CALL_SHMCTL = 24+ipc_api_select;
{ generic call that handles all IPC calls }
function ipccall(Call: cuint; First: cint; Second,Third : culong; P: pointer; Fifth: clong) : ptrint;
begin
ipccall:=do_syscall(syscall_nr_ipc,TSysParam(call),TSysParam(first),TSysParam(second),TSysParam(third),TSysParam(P),TSysParam(Fifth));
end;
function shmget(key: Tkey; size:size_t; flag:cint):cint;
begin
shmget:=ipccall (CALL_SHMGET,key,size,flag,nil,0);
end;
Function shmat (shmid:cint; shmaddr:pointer; shmflg:cint):pointer;
Var raddr : pchar;
error : ptrint;
begin
error:=ipccall(CALL_SHMAT,shmid,shmflg,cint(@raddr),shmaddr,0);
If Error<0 then
shmat:=pchar(error)
else
shmat:=raddr;
end;
function shmdt (shmaddr:pointer): cint;
begin
shmdt:=ipccall(CALL_SHMDT,0,0,0,shmaddr,0);
end;
function shmctl(shmid:cint; cmd:cint; buf: pshmid_ds): cint;
begin
shmctl:=ipccall(CALL_SHMCTL,shmid,cmd,0,buf,0);
end;
function msgget(key:Tkey; msgflg:cint):cint;
begin
msgget:=ipccall(CALL_MSGGET,key,msgflg,0,Nil,0);
end;
function msgsnd(msqid:cint; msgp: PMSGBuf; msgsz: size_t; msgflg:cint):cint;
begin
msgsnd:=ipccall(Call_MSGSND,msqid,msgsz,msgflg,msgp,0);
end;
function msgrcv(msqid:cint; msgp: PMSGBuf; msgsz: size_t; msgtyp:clong; msgflg:cint):cint;
Type
TIPC_Kludge = Record
msgp : pmsgbuf;
msgtyp : clong;
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:cint; cmd: cint; buf: PMSQid_ds): cint;
begin
msgctl:=ipccall(CALL_MSGCTL,msqid,cmd,0,buf,0);
end;
Function semget(key:Tkey; nsems:cint; semflg:cint): cint;
begin
semget:=ipccall (CALL_SEMGET,key,nsems,semflg,Nil,0);
end;
Function semop(semid:cint; sops: psembuf; nsops:cuint): cint;
begin
semop:=ipccall (CALL_SEMOP,semid,cint(nsops),0,Pointer(sops),0);
end;
Function semctl(semid:cint; semnum:cint; cmd:cint; var arg: tsemun): cint;
begin
semctl:=ipccall(CALL_SEMCTL,semid,semnum,cmd,@arg,0);
end;
Function semtimedop(semid:cint; sops: psembuf; nsops: cuint; timeOut: ptimespec): cint;
begin
semtimedop:=ipccall(CALL_SEMTIMEDOP,semid,culong(nsops),culong(0),Pointer(sops),clong(timeOut));
end;
|
