DPtoLP needs to round the result.
[wine] / tools / ipcl
1 #!/usr/bin/perl
2
3 #
4 # Copyright 1995. Michael Veksler.
5 #
6
7 $IPC_RMID=0;
8 $USER=$ENV{USER};
9
10 open(IPCS,"ipcs|");
11
12 #
13 # The following part is OS dependant, it works under linux only.
14 # To make it work under other OS 
15 # You should fill in @shm, @sem, @msq lists, with the relevent IPC
16 # keys.
17
18 #
19 # This code was written to be as much as possible generic, but...
20 # It works for Linux and ALPHA. I had no BSD machine to test it.
21 # (As I remember, AIX will work also).
22
23 while(<IPCS>) {
24     split;
25
26     # try to find out the IPC-ID, assume it is the first number.
27     foreach (@_) {
28         $_ ne int($_) && next;  # not a decimal number
29         $num=$_;
30         last;
31     }
32     if (/mem/i .. /^\s*$/ ) {
33         index($_,$USER)>=0 || next;
34         push(@shm,$num);
35     }
36     if (/sem/i .. /^\s*$/ ) {
37         index($_,$USER)>=0 || next;
38         push(@sem,$num);
39     }
40     if (/mes/i .. /^\s*$/ ) {
41         index($_,$USER)>=0 || next;
42         push(@msq,$num);
43     }
44 }
45
46
47 #
48 # This is the end of OS dependant code.
49 #
50
51 @shm && print "shmid ", join(":",@shm),"\n";
52 @sem && print "semid ", join(":",@sem),"\n";
53 @msq && print "msqid ", join(":",@msq),"\n";
54 foreach (@shm) {
55     shmctl($_, $IPC_RMID,0);
56 }
57 foreach (@sem) {
58     semctl($_, 0, $IPC_RMID,0);
59 }
60 foreach (@msq) {
61     msgctl($_, $IPC_RMID,0);
62 }