paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-10-23 13:14:24 +02:00
Code Issues Packages Projects Releases Wiki Activity

* now compiles again

Browse Source
This commit is contained in:
marco 2005-05-04 13:22:17 +00:00
parent 7df51de3d6
commit 4fff9fb131
1 changed files with 11 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
docs/ipcex/shmtool.pp
View File

@ -1,6 +1,6 @@
Program shmtool; Program shmtool;
uses ipc,strings; uses ipc,strings,Baseunix;
Const SegSize = 100; Const SegSize = 100;
@ -47,24 +47,26 @@ begin
val (mode,m,code); val (mode,m,code);
if code<>0 then if code<>0 then
usage; usage;
If Not shmctl (shmid,IPC_STAT,@data) then If shmctl (shmid,IPC_STAT,@data)=-1 then
begin begin
writeln ('Error : shmctl :',ipcerror); writeln ('Error : shmctl :',fpgeterrno);
halt(1); halt(1);
end; end;
writeln ('Old permissions : ',data.shm_perm.mode); writeln ('Old permissions : ',data.shm_perm.mode);
data.shm_perm.mode:=m; data.shm_perm.mode:=m;
If Not shmctl (shmid,IPC_SET,@data) then If shmctl (shmid,IPC_SET,@data)=-1 then
begin begin
writeln ('Error : shmctl :',ipcerror); writeln ('Error : shmctl :',fpgeterrno);
halt(1); halt(1);
end; end;
writeln ('New permissions : ',data.shm_perm.mode); writeln ('New permissions : ',data.shm_perm.mode);
end; end;
const ftokpath = '.'#0;
begin begin
if paramcount<1 then usage; if paramcount<1 then usage;
key := ftok ('.','S'); key := ftok (pchar(@ftokpath[1]),ord('S'));
shmid := shmget(key,segsize,IPC_CREAT or IPC_EXCL or 438); shmid := shmget(key,segsize,IPC_CREAT or IPC_EXCL or 438);
If shmid=-1 then If shmid=-1 then
begin begin
@ -72,7 +74,7 @@ begin
shmid := shmget(key,segsize,0); shmid := shmget(key,segsize,0);
If shmid = -1 then If shmid = -1 then
begin begin
Writeln ('shmget : Error !',ipcerror); Writeln ('shmget : Error !',fpgeterrno);
halt(1); halt(1);
end end
end end
@ -81,7 +83,7 @@ begin
segptr:=shmat(shmid,nil,0); segptr:=shmat(shmid,nil,0);
if longint(segptr)=-1 then if longint(segptr)=-1 then
begin begin
Writeln ('Shmat : error !',ipcerror); Writeln ('Shmat : error !',fpgeterrno);
halt(1); halt(1);
end; end;
case upcase(paramstr(1)[1]) of case upcase(paramstr(1)[1]) of