source: trunk/third/perl/doop.c @ 10724

Revision 10724, 10.2 KB checked in by ghudson, 27 years ago (diff)
This commit was generated by cvs2svn to compensate for changes in r10723, which included commits to RCS files with non-trunk default branches.
Line 
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
21I32
22do_trans(sv,arg)
23SV *sv;
24OP *arg;
25{
26    register short *tbl;
27    register U8 *s;
28    register U8 *send;
29    register U8 *d;
30    register I32 ch;
31    register I32 matches = 0;
32    register I32 squash = op->op_private & OPpTRANS_SQUASH;
33    STRLEN len;
34
35    if (SvREADONLY(sv))
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    }
57    else {
58        d = s;
59        while (s < send) {
60            if ((ch = tbl[*s]) >= 0) {
61                *d = ch;
62                if (matches++ && squash) {
63                    if (d[-1] == *d)
64                        matches--;
65                    else
66                        d++;
67                }
68                else
69                    d++;
70            }
71            else if (ch == -1)          /* -1 is unmapped character */
72                *d++ = *s;              /* -2 is delete character */
73            s++;
74        }
75        matches += send - d;    /* account for disappeared chars */
76        *d = '\0';
77        SvCUR_set(sv, d - (U8*)SvPVX(sv));
78    }
79    SvSETMAGIC(sv);
80    return matches;
81}
82
83void
84do_join(sv,del,mark,sp)
85register SV *sv;
86SV *del;
87register SV **mark;
88register SV **sp;
89{
90    SV **oldmark = mark;
91    register I32 items = sp - mark;
92    register STRLEN len;
93    STRLEN delimlen;
94    register char *delim = SvPV(del, delimlen);
95    STRLEN tmplen;
96
97    mark++;
98    len = (items > 0 ? (delimlen * (items - 1) ) : 0);
99    if (SvTYPE(sv) < SVt_PV)
100        sv_upgrade(sv, SVt_PV);
101    if (SvLEN(sv) < len + items) {      /* current length is way too short */
102        while (items-- > 0) {
103            if (*mark) {
104                SvPV(*mark, tmplen);
105                len += tmplen;
106            }
107            mark++;
108        }
109        SvGROW(sv, len + 1);            /* so try to pre-extend */
110
111        mark = oldmark;
112        items = sp - mark;;
113        ++mark;
114    }
115
116    if (items-- > 0) {
117        char *s;
118
119        if (*mark) {
120            s = SvPV(*mark, tmplen);
121            sv_setpvn(sv, s, tmplen);
122        }
123        else
124            sv_setpv(sv, "");
125        mark++;
126    }
127    else
128        sv_setpv(sv,"");
129    len = delimlen;
130    if (len) {
131        for (; items > 0; items--,mark++) {
132            sv_catpvn(sv,delim,len);
133            sv_catsv(sv,*mark);
134        }
135    }
136    else {
137        for (; items > 0; items--,mark++)
138            sv_catsv(sv,*mark);
139    }
140    SvSETMAGIC(sv);
141}
142
143void
144do_sprintf(sv,len,sarg)
145SV *sv;
146I32 len;
147SV **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
159void
160do_vecset(sv)
161SV *sv;
162{
163    SV *targ = LvTARG(sv);
164    register I32 offset;
165    register I32 size;
166    register unsigned char *s;
167    register unsigned long lval;
168    I32 mask;
169    STRLEN targlen;
170    STRLEN len;
171
172    if (!targ)
173        return;
174    s = (unsigned char*)SvPV_force(targ, targlen);
175    lval = U_L(SvNV(sv));
176    offset = LvTARGOFF(sv);
177    size = LvTARGLEN(sv);
178   
179    len = (offset + size + 7) / 8;
180    if (len > targlen) {
181        s = (unsigned char*)SvGROW(targ, len + 1);
182        (void)memzero(s + targlen, len - targlen + 1);
183        SvCUR_set(targ, len);
184    }
185   
186    if (size < 8) {
187        mask = (1 << size) - 1;
188        size = offset & 7;
189        lval &= mask;
190        offset >>= 3;
191        s[offset] &= ~(mask << size);
192        s[offset] |= lval << size;
193    }
194    else {
195        offset >>= 3;
196        if (size == 8)
197            s[offset] = lval & 255;
198        else if (size == 16) {
199            s[offset] = (lval >> 8) & 255;
200            s[offset+1] = lval & 255;
201        }
202        else if (size == 32) {
203            s[offset] = (lval >> 24) & 255;
204            s[offset+1] = (lval >> 16) & 255;
205            s[offset+2] = (lval >> 8) & 255;
206            s[offset+3] = lval & 255;
207        }
208    }
209}
210
211void
212do_chop(astr,sv)
213register SV *astr;
214register 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
255I32
256do_chomp(sv)
257register SV *sv;
258{
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
329void
330do_vop(optype,sv,left,right)
331I32 optype;
332SV *sv;
333SV *left;
334SV *right;
335{
336#ifdef LIBERAL
337    register long *dl;
338    register long *ll;
339    register long *rl;
340#endif
341    register char *dc;
342    STRLEN leftlen;
343    STRLEN rightlen;
344    register char *lc;
345    register char *rc;
346    register I32 len;
347    I32 lensave;
348    char *lsave;
349    char *rsave;
350
351    if (sv != left || (optype != OP_BIT_AND && !SvOK(sv) && !SvGMAGICAL(sv)))
352        sv_setpvn(sv, "", 0);   /* avoid undef warning on |= and ^= */
353    lsave = lc = SvPV(left, leftlen);
354    rsave = rc = SvPV(right, rightlen);
355    len = leftlen < rightlen ? leftlen : rightlen;
356    lensave = len;
357    if (SvOK(sv) || SvTYPE(sv) > SVt_PVMG) {
358        dc = SvPV_force(sv, na);
359        if (SvCUR(sv) < len) {
360            dc = SvGROW(sv, len + 1);
361            (void)memzero(dc + SvCUR(sv), len - SvCUR(sv) + 1);
362        }
363    }
364    else {
365        I32 needlen = ((optype == OP_BIT_AND)
366                        ? len : (leftlen > rightlen ? leftlen : rightlen));
367        Newz(801, dc, needlen + 1, char);
368        (void)sv_usepvn(sv, dc, needlen);
369        dc = SvPVX(sv);         /* sv_usepvn() calls Renew() */
370    }
371    SvCUR_set(sv, len);
372    (void)SvPOK_only(sv);
373#ifdef LIBERAL
374    if (len >= sizeof(long)*4 &&
375        !((long)dc % sizeof(long)) &&
376        !((long)lc % sizeof(long)) &&
377        !((long)rc % sizeof(long)))     /* It's almost always aligned... */
378    {
379        I32 remainder = len % (sizeof(long)*4);
380        len /= (sizeof(long)*4);
381
382        dl = (long*)dc;
383        ll = (long*)lc;
384        rl = (long*)rc;
385
386        switch (optype) {
387        case OP_BIT_AND:
388            while (len--) {
389                *dl++ = *ll++ & *rl++;
390                *dl++ = *ll++ & *rl++;
391                *dl++ = *ll++ & *rl++;
392                *dl++ = *ll++ & *rl++;
393            }
394            break;
395        case OP_BIT_XOR:
396            while (len--) {
397                *dl++ = *ll++ ^ *rl++;
398                *dl++ = *ll++ ^ *rl++;
399                *dl++ = *ll++ ^ *rl++;
400                *dl++ = *ll++ ^ *rl++;
401            }
402            break;
403        case OP_BIT_OR:
404            while (len--) {
405                *dl++ = *ll++ | *rl++;
406                *dl++ = *ll++ | *rl++;
407                *dl++ = *ll++ | *rl++;
408                *dl++ = *ll++ | *rl++;
409            }
410        }
411
412        dc = (char*)dl;
413        lc = (char*)ll;
414        rc = (char*)rl;
415
416        len = remainder;
417    }
418#endif
419    {
420        switch (optype) {
421        case OP_BIT_AND:
422            while (len--)
423                *dc++ = *lc++ & *rc++;
424            break;
425        case OP_BIT_XOR:
426            while (len--)
427                *dc++ = *lc++ ^ *rc++;
428            goto mop_up;
429        case OP_BIT_OR:
430            while (len--)
431                *dc++ = *lc++ | *rc++;
432          mop_up:
433            len = lensave;
434            if (rightlen > len)
435                sv_catpvn(sv, rsave + len, rightlen - len);
436            else if (leftlen > len)
437                sv_catpvn(sv, lsave + len, leftlen - len);
438            else
439                *SvEND(sv) = '\0';
440            break;
441        }
442    }
443    SvTAINT(sv);
444}
445
446OP *
447do_kv(ARGS)
448dARGS
449{
450    dSP;
451    HV *hv = (HV*)POPs;
452    register HE *entry;
453    SV *tmpstr;
454    I32 gimme = GIMME_V;
455    I32 dokeys =   (op->op_type == OP_KEYS);
456    I32 dovalues = (op->op_type == OP_VALUES);
457
458    if (op->op_type == OP_RV2HV || op->op_type == OP_PADHV)
459        dokeys = dovalues = TRUE;
460
461    if (!hv) {
462        if (op->op_flags & OPf_MOD) {   /* lvalue */
463            dTARGET;            /* make sure to clear its target here */
464            if (SvTYPE(TARG) == SVt_PVLV)
465                LvTARG(TARG) = Nullsv;
466            PUSHs(TARG);
467        }
468        RETURN;
469    }
470
471    (void)hv_iterinit(hv);      /* always reset iterator regardless */
472
473    if (gimme == G_VOID)
474        RETURN;
475
476    if (gimme == G_SCALAR) {
477        I32 i;
478        dTARGET;
479
480        if (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            LvTARG(TARG) = (SV*)hv;
487            PUSHs(TARG);
488            RETURN;
489        }
490
491        if (!SvRMAGICAL(hv) || !mg_find((SV*)hv,'P'))
492            i = HvKEYS(hv);
493        else {
494            i = 0;
495            /*SUPPRESS 560*/
496            while (entry = hv_iternext(hv)) {
497                i++;
498            }
499        }
500        PUSHi( i );
501        RETURN;
502    }
503
504    /* Guess how much room we need.  hv_max may be a few too many.  Oh well. */
505    EXTEND(sp, HvMAX(hv) * (dokeys + dovalues));
506
507    PUTBACK;    /* hv_iternext and hv_iterval might clobber stack_sp */
508    while (entry = hv_iternext(hv)) {
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,hv_iterval(hv,entry));
516            DEBUG_H(sv_setpvf(tmpstr, "%lu%%%d=%lu",
517                            (unsigned long)HeHASH(entry),
518                            HvMAX(hv)+1,
519                            (unsigned long)(HeHASH(entry) & HvMAX(hv))));
520            SPAGAIN;
521            XPUSHs(tmpstr);
522        }
523        PUTBACK;
524    }
525    return NORMAL;
526}
527
Note: See TracBrowser for help on using the repository browser.