This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
hv_max may be a few too many
[perl5.git] / doop.c
1 /*    doop.c
2  *
3  *    Copyright (c) 1991-1997, 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 = op->op_private & OPpTRANS_SQUASH;
32     register U8 *p;
33     STRLEN len;
34
35     if (SvREADONLY(sv) && !(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 (!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 (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 != &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(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 != &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(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(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         dc = SvPV_force(sv, na);
356         if (SvCUR(sv) < len) {
357             dc = SvGROW(sv, len + 1);
358             (void)memzero(dc + SvCUR(sv), len - SvCUR(sv) + 1);
359         }
360     }
361     else {
362         I32 needlen = ((optype == OP_BIT_AND)
363                         ? len : (leftlen > rightlen ? leftlen : rightlen));
364         Newz(801, dc, needlen + 1, char);
365         (void)sv_usepvn(sv, dc, needlen);
366         dc = SvPVX(sv);         /* sv_usepvn() calls Renew() */
367     }
368     SvCUR_set(sv, len);
369     (void)SvPOK_only(sv);
370 #ifdef LIBERAL
371     if (len >= sizeof(long)*4 &&
372         !((long)dc % sizeof(long)) &&
373         !((long)lc % sizeof(long)) &&
374         !((long)rc % sizeof(long)))     /* It's almost always aligned... */
375     {
376         I32 remainder = len % (sizeof(long)*4);
377         len /= (sizeof(long)*4);
378
379         dl = (long*)dc;
380         ll = (long*)lc;
381         rl = (long*)rc;
382
383         switch (optype) {
384         case OP_BIT_AND:
385             while (len--) {
386                 *dl++ = *ll++ & *rl++;
387                 *dl++ = *ll++ & *rl++;
388                 *dl++ = *ll++ & *rl++;
389                 *dl++ = *ll++ & *rl++;
390             }
391             break;
392         case OP_BIT_XOR:
393             while (len--) {
394                 *dl++ = *ll++ ^ *rl++;
395                 *dl++ = *ll++ ^ *rl++;
396                 *dl++ = *ll++ ^ *rl++;
397                 *dl++ = *ll++ ^ *rl++;
398             }
399             break;
400         case OP_BIT_OR:
401             while (len--) {
402                 *dl++ = *ll++ | *rl++;
403                 *dl++ = *ll++ | *rl++;
404                 *dl++ = *ll++ | *rl++;
405                 *dl++ = *ll++ | *rl++;
406             }
407         }
408
409         dc = (char*)dl;
410         lc = (char*)ll;
411         rc = (char*)rl;
412
413         len = remainder;
414     }
415 #endif
416     {
417         switch (optype) {
418         case OP_BIT_AND:
419             while (len--)
420                 *dc++ = *lc++ & *rc++;
421             break;
422         case OP_BIT_XOR:
423             while (len--)
424                 *dc++ = *lc++ ^ *rc++;
425             goto mop_up;
426         case OP_BIT_OR:
427             while (len--)
428                 *dc++ = *lc++ | *rc++;
429           mop_up:
430             len = lensave;
431             if (rightlen > len)
432                 sv_catpvn(sv, rsave + len, rightlen - len);
433             else if (leftlen > len)
434                 sv_catpvn(sv, lsave + len, leftlen - len);
435             else
436                 *SvEND(sv) = '\0';
437             break;
438         }
439     }
440     SvTAINT(sv);
441 }
442
443 OP *
444 do_kv(ARGSproto)
445 {
446     djSP;
447     HV *hv = (HV*)POPs;
448     HV *keys;
449     register HE *entry;
450     SV *tmpstr;
451     I32 gimme = GIMME_V;
452     I32 dokeys =   (op->op_type == OP_KEYS);
453     I32 dovalues = (op->op_type == OP_VALUES);
454     I32 realhv = (SvTYPE(hv) == SVt_PVHV);
455     
456     if (op->op_type == OP_RV2HV || op->op_type == OP_PADHV) 
457         dokeys = dovalues = TRUE;
458
459     if (!hv) {
460         if (op->op_flags & OPf_MOD) {   /* lvalue */
461             dTARGET;            /* make sure to clear its target here */
462             if (SvTYPE(TARG) == SVt_PVLV)
463                 LvTARG(TARG) = Nullsv;
464             PUSHs(TARG);
465         }
466         RETURN;
467     }
468
469     keys = realhv ? hv : avhv_keys((AV*)hv);
470     (void)hv_iterinit(keys);    /* always reset iterator regardless */
471
472     if (gimme == G_VOID)
473         RETURN;
474
475     if (gimme == G_SCALAR) {
476         IV i;
477         dTARGET;
478
479         if (op->op_flags & OPf_MOD) {   /* lvalue */
480             if (SvTYPE(TARG) < SVt_PVLV) {
481                 sv_upgrade(TARG, SVt_PVLV);
482                 sv_magic(TARG, Nullsv, 'k', Nullch, 0);
483             }
484             LvTYPE(TARG) = 'k';
485             if (LvTARG(TARG) != (SV*)keys) {
486                 if (LvTARG(TARG))
487                     SvREFCNT_dec(LvTARG(TARG));
488                 LvTARG(TARG) = SvREFCNT_inc(keys);
489             }
490             PUSHs(TARG);
491             RETURN;
492         }
493
494         if (!SvRMAGICAL(keys) || !mg_find((SV*)keys,'P'))
495             i = HvKEYS(keys);
496         else {
497             i = 0;
498             /*SUPPRESS 560*/
499             while (hv_iternext(keys)) i++;
500         }
501         PUSHi( i );
502         RETURN;
503     }
504
505     EXTEND(SP, HvKEYS(keys) * (dokeys + dovalues));
506
507     PUTBACK;    /* hv_iternext and hv_iterval might clobber stack_sp */
508     while (entry = hv_iternext(keys)) {
509         SPAGAIN;
510         if (dokeys)
511             XPUSHs(hv_iterkeysv(entry));        /* won't clobber stack_sp */
512         if (dovalues) {
513             tmpstr = sv_newmortal();
514             PUTBACK;
515             sv_setsv(tmpstr,realhv ?
516                      hv_iterval(hv,entry) : avhv_iterval((AV*)hv,entry));
517             DEBUG_H(sv_setpvf(tmpstr, "%lu%%%d=%lu",
518                             (unsigned long)HeHASH(entry),
519                             HvMAX(keys)+1,
520                             (unsigned long)(HeHASH(entry) & HvMAX(keys))));
521             SPAGAIN;
522             XPUSHs(tmpstr);
523         }
524         PUTBACK;
525     }
526     return NORMAL;
527 }
528