b7107684ac060218199c1f26bf3a0ba49f1629bc
[perl.git] / do / shmio
1 int
2 do_shmio(optype, arglast)
3 int optype;
4 int *arglast;
5 {
6 #ifdef HAS_SHM
7     register STR **st = stack->ary_array;
8     register int sp = arglast[0];
9     STR *mstr;
10     char *mbuf, *shm;
11     int id, mpos, msize;
12     struct shmid_ds shmds;
13 #ifndef VOIDSHMAT
14     extern char *shmat();
15 #endif
16
17     id = (int)str_gnum(st[++sp]);
18     mstr = st[++sp];
19     mpos = (int)str_gnum(st[++sp]);
20     msize = (int)str_gnum(st[++sp]);
21     errno = 0;
22     if (shmctl(id, IPC_STAT, &shmds) == -1)
23         return -1;
24     if (mpos < 0 || msize < 0 || mpos + msize > shmds.shm_segsz) {
25         errno = EFAULT;         /* can't do as caller requested */
26         return -1;
27     }
28     shm = (char*)shmat(id, (char*)NULL, (optype == O_SHMREAD) ? SHM_RDONLY : 0);
29     if (shm == (char *)-1)      /* I hate System V IPC, I really do */
30         return -1;
31     mbuf = str_get(mstr);
32     if (optype == O_SHMREAD) {
33         if (mstr->str_cur < msize) {
34             STR_GROW(mstr, msize+1);
35             mbuf = str_get(mstr);
36         }
37         Copy(shm + mpos, mbuf, msize, char);
38         mstr->str_cur = msize;
39         mstr->str_ptr[msize] = '\0';
40     }
41     else {
42         int n;
43
44         if ((n = mstr->str_cur) > msize)
45             n = msize;
46         Copy(mbuf, shm + mpos, n, char);
47         if (n < msize)
48             memzero(shm + mpos + n, msize - n);
49     }
50     return shmdt(shm);
51 #else
52     fatal("shm I/O not implemented");
53 #endif
54 }
55