Update IPC SysV test from blead (hopefully is more graceful under duress)
[perl.git] / doop.c
1 /*    doop.c
2  *
3  *    Copyright (c) 1991-1999, Larry Wall
4  *
5  *    You may distribute under the terms of either the GNU General Public
6  *    License or the Artistic License, as specified in the README file.
7  *
8  */
9
10 /*
11  * "'So that was the job I felt I had to do when I started,' thought Sam."
12  */
13
14 #include "EXTERN.h"
15 #include "perl.h"
16
17 #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
18 #include <signal.h>
19 #endif
20
21 I32
22 do_trans(SV *sv, OP *arg)
23 {
24     dTHR;
25     register short *tbl;
26     register U8 *s;
27     register U8 *send;
28     register U8 *d;
29     register I32 ch;
30     register I32 matches = 0;
31     register I32 squash = PL_op->op_private & OPpTRANS_SQUASH;
32     register U8 *p;
33     STRLEN len;
34
35     if (SvREADONLY(sv) && !(PL_op->op_private & OPpTRANS_COUNTONLY))
36         croak(no_modify);
37     tbl = (short*)cPVOP->op_pv;
38     s = (U8*)SvPV(sv, len);
39     if (!len)
40         return 0;
41     if (!SvPOKp(sv))
42         s = (U8*)SvPV_force(sv, len);
43     (void)SvPOK_only(sv);
44     send = s + len;
45     if (!tbl || !s)
46         croak("panic: do_trans");
47     DEBUG_t( deb("2.TBL\n"));
48     if (!PL_op->op_private) {
49         while (s < send) {
50             if ((ch = tbl[*s]) >= 0) {
51                 matches++;
52                 *s = ch;
53             }
54             s++;
55         }
56         SvSETMAGIC(sv);
57     }
58     else if (PL_op->op_private & OPpTRANS_COUNTONLY) {
59         while (s < send) {
60             if (tbl[*s] >= 0)
61                 matches++;
62             s++;
63         }
64     }
65     else {
66         d = s;
67         p = send;
68         while (s < send) {
69             if ((ch = tbl[*s]) >= 0) {
70                 *d = ch;
71                 matches++;
72                 if (squash) {
73                     if (p == d - 1 && *p == *d)
74                         matches--;
75                     else
76                         p = d++;
77                 }
78                 else
79                     d++;
80             }
81             else if (ch == -1)          /* -1 is unmapped character */
82                 *d++ = *s;              /* -2 is delete character */
83             s++;
84         }
85         matches += send - d;    /* account for disappeared chars */
86         *d = '\0';
87         SvCUR_set(sv, d - (U8*)SvPVX(sv));
88         SvSETMAGIC(sv);
89     }
90     return matches;
91 }
92
93 void
94 do_join(register SV *sv, SV *del, register SV **mark, register SV **sp)
95 {
96     SV **oldmark = mark;
97     register I32 items = sp - mark;
98     register STRLEN len;
99     STRLEN delimlen;
100     register char *delim = SvPV(del, delimlen);
101     STRLEN tmplen;
102
103     mark++;
104     len = (items > 0 ? (delimlen * (items - 1) ) : 0);
105     if (SvTYPE(sv) < SVt_PV)
106         sv_upgrade(sv, SVt_PV);
107     if (SvLEN(sv) < len + items) {      /* current length is way too short */
108         while (items-- > 0) {
109             if (*mark && !SvGMAGICAL(*mark) && SvOK(*mark)) {
110                 SvPV(*mark, tmplen);
111                 len += tmplen;
112             }
113             mark++;
114         }
115         SvGROW(sv, len + 1);            /* so try to pre-extend */
116
117         mark = oldmark;
118         items = sp - mark;;
119         ++mark;
120     }
121
122     if (items-- > 0) {
123         char *s;
124
125         if (*mark) {
126             s = SvPV(*mark, tmplen);
127             sv_setpvn(sv, s, tmplen);
128         }
129         else
130             sv_setpv(sv, "");
131         mark++;
132     }
133     else
134         sv_setpv(sv,"");
135     len = delimlen;
136     if (len) {
137         for (; items > 0; items--,mark++) {
138             sv_catpvn(sv,delim,len);
139             sv_catsv(sv,*mark);
140         }
141     }
142     else {
143         for (; items > 0; items--,mark++)
144             sv_catsv(sv,*mark);
145     }
146     SvSETMAGIC(sv);
147 }
148
149 void
150 do_sprintf(SV *sv, I32 len, SV **sarg)
151 {
152     STRLEN patlen;
153     char *pat = SvPV(*sarg, patlen);
154     bool do_taint = FALSE;
155
156     sv_vsetpvfn(sv, pat, patlen, Null(va_list*), sarg + 1, len - 1, &do_taint);
157     SvSETMAGIC(sv);
158     if (do_taint)
159         SvTAINTED_on(sv);
160 }
161
162 void
163 do_vecset(SV *sv)
164 {
165     SV *targ = LvTARG(sv);
166     register I32 offset;
167     register I32 size;
168     register unsigned char *s;
169     register unsigned long lval;
170     I32 mask;
171     STRLEN targlen;
172     STRLEN len;
173
174     if (!targ)
175         return;
176     s = (unsigned char*)SvPV_force(targ, targlen);
177     lval = U_L(SvNV(sv));
178     offset = LvTARGOFF(sv);
179     size = LvTARGLEN(sv);
180     
181     len = (offset + size + 7) / 8;
182     if (len > targlen) {
183         s = (unsigned char*)SvGROW(targ, len + 1);
184         (void)memzero(s + targlen, len - targlen + 1);
185         SvCUR_set(targ, len);
186     }
187     
188     if (size < 8) {
189         mask = (1 << size) - 1;
190         size = offset & 7;
191         lval &= mask;
192         offset >>= 3;
193         s[offset] &= ~(mask << size);
194         s[offset] |= lval << size;
195     }
196     else {
197         offset >>= 3;
198         if (size == 8)
199             s[offset] = lval & 255;
200         else if (size == 16) {
201             s[offset] = (lval >> 8) & 255;
202             s[offset+1] = lval & 255;
203         }
204         else if (size == 32) {
205             s[offset] = (lval >> 24) & 255;
206             s[offset+1] = (lval >> 16) & 255;
207             s[offset+2] = (lval >> 8) & 255;
208             s[offset+3] = lval & 255;
209         }
210     }
211 }
212
213 void
214 do_chop(register SV *astr, register SV *sv)
215 {
216     STRLEN len;
217     char *s;
218     
219     if (SvTYPE(sv) == SVt_PVAV) {
220         register I32 i;
221         I32 max;
222         AV* av = (AV*)sv;
223         max = AvFILL(av);
224         for (i = 0; i <= max; i++) {
225             sv = (SV*)av_fetch(av, i, FALSE);
226             if (sv && ((sv = *(SV**)sv), sv != &PL_sv_undef))
227                 do_chop(astr, sv);
228         }
229         return;
230     }
231     if (SvTYPE(sv) == SVt_PVHV) {
232         HV* hv = (HV*)sv;
233         HE* entry;
234         (void)hv_iterinit(hv);
235         /*SUPPRESS 560*/
236         while (entry = hv_iternext(hv))
237             do_chop(astr,hv_iterval(hv,entry));
238         return;
239     }
240     s = SvPV(sv, len);
241     if (len && !SvPOK(sv))
242         s = SvPV_force(sv, len);
243     if (s && len) {
244         s += --len;
245         sv_setpvn(astr, s, 1);
246         *s = '\0';
247         SvCUR_set(sv, len);
248         SvNIOK_off(sv);
249     }
250     else
251         sv_setpvn(astr, "", 0);
252     SvSETMAGIC(sv);
253
254
255 I32
256 do_chomp(register SV *sv)
257 {
258     dTHR;
259     register I32 count;
260     STRLEN len;
261     char *s;
262
263     if (RsSNARF(PL_rs))
264         return 0;
265     count = 0;
266     if (SvTYPE(sv) == SVt_PVAV) {
267         register I32 i;
268         I32 max;
269         AV* av = (AV*)sv;
270         max = AvFILL(av);
271         for (i = 0; i <= max; i++) {
272             sv = (SV*)av_fetch(av, i, FALSE);
273             if (sv && ((sv = *(SV**)sv), sv != &PL_sv_undef))
274                 count += do_chomp(sv);
275         }
276         return count;
277     }
278     if (SvTYPE(sv) == SVt_PVHV) {
279         HV* hv = (HV*)sv;
280         HE* entry;
281         (void)hv_iterinit(hv);
282         /*SUPPRESS 560*/
283         while (entry = hv_iternext(hv))
284             count += do_chomp(hv_iterval(hv,entry));
285         return count;
286     }
287     s = SvPV(sv, len);
288     if (len && !SvPOKp(sv))
289         s = SvPV_force(sv, len);
290     if (s && len) {
291         s += --len;
292         if (RsPARA(PL_rs)) {
293             if (*s != '\n')
294                 goto nope;
295             ++count;
296             while (len && s[-1] == '\n') {
297                 --len;
298                 --s;
299                 ++count;
300             }
301         }
302         else {
303             STRLEN rslen;
304             char *rsptr = SvPV(PL_rs, rslen);
305             if (rslen == 1) {
306                 if (*s != *rsptr)
307                     goto nope;
308                 ++count;
309             }
310             else {
311                 if (len < rslen - 1)
312                     goto nope;
313                 len -= rslen - 1;
314                 s -= rslen - 1;
315                 if (memNE(s, rsptr, rslen))
316                     goto nope;
317                 count += rslen;
318             }
319         }
320         *s = '\0';
321         SvCUR_set(sv, len);
322         SvNIOK_off(sv);
323     }
324   nope:
325     SvSETMAGIC(sv);
326     return count;
327
328
329 void
330 do_vop(I32 optype, SV *sv, SV *left, SV *right)
331 {
332     dTHR;       /* just for taint */
333 #ifdef LIBERAL
334     register long *dl;
335     register long *ll;
336     register long *rl;
337 #endif
338     register char *dc;
339     STRLEN leftlen;
340     STRLEN rightlen;
341     register char *lc;
342     register char *rc;
343     register I32 len;
344     I32 lensave;
345     char *lsave;
346     char *rsave;
347
348     if (sv != left || (optype != OP_BIT_AND && !SvOK(sv) && !SvGMAGICAL(sv)))
349         sv_setpvn(sv, "", 0);   /* avoid undef warning on |= and ^= */
350     lsave = lc = SvPV(left, leftlen);
351     rsave = rc = SvPV(right, rightlen);
352     len = leftlen < rightlen ? leftlen : rightlen;
353     lensave = len;
354     if (SvOK(sv) || SvTYPE(sv) > SVt_PVMG) {
355         STRLEN n_a;
356         dc = SvPV_force(sv, n_a);
357         if (SvCUR(sv) < len) {
358             dc = SvGROW(sv, len + 1);
359             (void)memzero(dc + SvCUR(sv), len - SvCUR(sv) + 1);
360         }
361     }
362     else {
363         I32 needlen = ((optype == OP_BIT_AND)
364                         ? len : (leftlen > rightlen ? leftlen : rightlen));
365         Newz(801, dc, needlen + 1, char);
366         (void)sv_usepvn(sv, dc, needlen);
367         dc = SvPVX(sv);         /* sv_usepvn() calls Renew() */
368     }
369     SvCUR_set(sv, len);
370     (void)SvPOK_only(sv);
371 #ifdef LIBERAL
372     if (len >= sizeof(long)*4 &&
373         !((long)dc % sizeof(long)) &&
374         !((long)lc % sizeof(long)) &&
375         !((long)rc % sizeof(long)))     /* It's almost always aligned... */
376     {
377         I32 remainder = len % (sizeof(long)*4);
378         len /= (sizeof(long)*4);
379
380         dl = (long*)dc;
381         ll = (long*)lc;
382         rl = (long*)rc;
383
384         switch (optype) {
385         case OP_BIT_AND:
386             while (len--) {
387                 *dl++ = *ll++ & *rl++;
388                 *dl++ = *ll++ & *rl++;
389                 *dl++ = *ll++ & *rl++;
390                 *dl++ = *ll++ & *rl++;
391             }
392             break;
393         case OP_BIT_XOR:
394             while (len--) {
395                 *dl++ = *ll++ ^ *rl++;
396                 *dl++ = *ll++ ^ *rl++;
397                 *dl++ = *ll++ ^ *rl++;
398                 *dl++ = *ll++ ^ *rl++;
399             }
400             break;
401         case OP_BIT_OR:
402             while (len--) {
403                 *dl++ = *ll++ | *rl++;
404                 *dl++ = *ll++ | *rl++;
405                 *dl++ = *ll++ | *rl++;
406                 *dl++ = *ll++ | *rl++;
407             }
408         }
409
410         dc = (char*)dl;
411         lc = (char*)ll;
412         rc = (char*)rl;
413
414         len = remainder;
415     }
416 #endif
417     {
418         switch (optype) {
419         case OP_BIT_AND:
420             while (len--)
421                 *dc++ = *lc++ & *rc++;
422             break;
423         case OP_BIT_XOR:
424             while (len--)
425                 *dc++ = *lc++ ^ *rc++;
426             goto mop_up;
427         case OP_BIT_OR:
428             while (len--)
429                 *dc++ = *lc++ | *rc++;
430           mop_up:
431             len = lensave;
432             if (rightlen > len)
433                 sv_catpvn(sv, rsave + len, rightlen - len);
434             else if (leftlen > len)
435                 sv_catpvn(sv, lsave + len, leftlen - len);
436             else
437                 *SvEND(sv) = '\0';
438             break;
439         }
440     }
441     SvTAINT(sv);
442 }
443
444 OP *
445 do_kv(ARGSproto)
446 {
447     djSP;
448     HV *hv = (HV*)POPs;
449     HV *keys;
450     register HE *entry;
451     SV *tmpstr;
452     I32 gimme = GIMME_V;
453     I32 dokeys =   (PL_op->op_type == OP_KEYS);
454     I32 dovalues = (PL_op->op_type == OP_VALUES);
455     I32 realhv = (SvTYPE(hv) == SVt_PVHV);
456     
457     if (PL_op->op_type == OP_RV2HV || PL_op->op_type == OP_PADHV) 
458         dokeys = dovalues = TRUE;
459
460     if (!hv) {
461         if (PL_op->op_flags & OPf_MOD) {        /* lvalue */
462             dTARGET;            /* make sure to clear its target here */
463             if (SvTYPE(TARG) == SVt_PVLV)
464                 LvTARG(TARG) = Nullsv;
465             PUSHs(TARG);
466         }
467         RETURN;
468     }
469
470     keys = realhv ? hv : avhv_keys((AV*)hv);
471     (void)hv_iterinit(keys);    /* always reset iterator regardless */
472
473     if (gimme == G_VOID)
474         RETURN;
475
476     if (gimme == G_SCALAR) {
477         IV i;
478         dTARGET;
479
480         if (PL_op->op_flags & OPf_MOD) {        /* lvalue */
481             if (SvTYPE(TARG) < SVt_PVLV) {
482                 sv_upgrade(TARG, SVt_PVLV);
483                 sv_magic(TARG, Nullsv, 'k', Nullch, 0);
484             }
485             LvTYPE(TARG) = 'k';
486             if (LvTARG(TARG) != (SV*)keys) {
487                 if (LvTARG(TARG))
488                     SvREFCNT_dec(LvTARG(TARG));
489                 LvTARG(TARG) = SvREFCNT_inc(keys);
490             }
491             PUSHs(TARG);
492             RETURN;
493         }
494
495         if (! SvTIED_mg((SV*)keys, 'P'))
496             i = HvKEYS(keys);
497         else {
498             i = 0;
499             /*SUPPRESS 560*/
500             while (hv_iternext(keys)) i++;
501         }
502         PUSHi( i );
503         RETURN;
504     }
505
506     EXTEND(SP, HvKEYS(keys) * (dokeys + dovalues));
507
508     PUTBACK;    /* hv_iternext and hv_iterval might clobber stack_sp */
509     while (entry = hv_iternext(keys)) {
510         SPAGAIN;
511         if (dokeys)
512             XPUSHs(hv_iterkeysv(entry));        /* won't clobber stack_sp */
513         if (dovalues) {
514             tmpstr = sv_newmortal();
515             PUTBACK;
516             sv_setsv(tmpstr,realhv ?
517                      hv_iterval(hv,entry) : avhv_iterval((AV*)hv,entry));
518             DEBUG_H(sv_setpvf(tmpstr, "%lu%%%d=%lu",
519                             (unsigned long)HeHASH(entry),
520                             HvMAX(keys)+1,
521                             (unsigned long)(HeHASH(entry) & HvMAX(keys))));
522             SPAGAIN;
523             XPUSHs(tmpstr);
524         }
525         PUTBACK;
526     }
527     return NORMAL;
528 }
529