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