X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=doop.c;h=470ec064dc38e172863343d32bdb4f6d13658433;hb=95146c060d4701c16367f59345531d4eb7a2d283;hp=d4cb84aa0f4c1e21eab0ff618b60783fd111db2d;hpb=93a17b20b6d176db3f04f51a63b0a781e5ffd11c;p=p5sagit%2Fp5-mst-13.2.git diff --git a/doop.c b/doop.c index d4cb84a..470ec06 100644 --- a/doop.c +++ b/doop.c @@ -1,60 +1,14 @@ -/* $RCSfile: doarg.c,v $$Revision: 4.1 $$Date: 92/08/07 17:19:37 $ +/* doop.c * - * Copyright (c) 1991, Larry Wall + * Copyright (c) 1991-1994, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. * - * $Log: doarg.c,v $ - * Revision 4.1 92/08/07 17:19:37 lwall - * Stage 6 Snapshot - * - * Revision 4.0.1.7 92/06/11 21:07:11 lwall - * patch34: join with null list attempted negative allocation - * patch34: sprintf("%6.4s", "abcdefg") didn't print "abcd " - * - * Revision 4.0.1.6 92/06/08 12:34:30 lwall - * patch20: removed implicit int declarations on funcions - * patch20: pattern modifiers i and o didn't interact right - * patch20: join() now pre-extends target string to avoid excessive copying - * patch20: fixed confusion between a *var's real name and its effective name - * patch20: subroutines didn't localize $`, $&, $', $1 et al correctly - * patch20: usersub routines didn't reclaim temp values soon enough - * patch20: ($<,$>) = ... didn't work on some architectures - * patch20: added Atari ST portability - * - * Revision 4.0.1.5 91/11/11 16:31:58 lwall - * patch19: added little-endian pack/unpack options - * - * Revision 4.0.1.4 91/11/05 16:35:06 lwall - * patch11: /$foo/o optimizer could access deallocated data - * patch11: minimum match length calculation in regexp is now cumulative - * patch11: added some support for 64-bit integers - * patch11: prepared for ctype implementations that don't define isascii() - * patch11: sprintf() now supports any length of s field - * patch11: indirect subroutine calls through magic vars (e.g. &$1) didn't work - * patch11: defined(&$foo) and undef(&$foo) didn't work - * - * Revision 4.0.1.3 91/06/10 01:18:41 lwall - * patch10: pack(hh,1) dumped core - * - * Revision 4.0.1.2 91/06/07 10:42:17 lwall - * patch4: new copyright notice - * patch4: // wouldn't use previous pattern if it started with a null character - * patch4: //o and s///o now optimize themselves fully at runtime - * patch4: added global modifier for pattern matches - * patch4: undef @array disabled "@array" interpolation - * patch4: chop("") was returning "\0" rather than "" - * patch4: vector logical operations &, | and ^ sometimes returned null string - * patch4: syscall couldn't pass numbers with most significant bit set on sparcs - * - * Revision 4.0.1.1 91/04/11 17:40:14 lwall - * patch1: fixed undefined environ problem - * patch1: fixed debugger coredump on subroutines - * - * Revision 4.0 91/03/20 01:06:42 lwall - * 4.0 baseline. - * + */ + +/* + * "'So that was the job I felt I had to do when I started,' thought Sam." */ #include "EXTERN.h" @@ -68,8 +22,6 @@ #pragma function(memcmp) #endif /* BUGGY_MSC */ -static void doencodes(); - #ifdef BUGGY_MSC #pragma intrinsic(memcmp) #endif /* BUGGY_MSC */ @@ -80,22 +32,30 @@ SV *sv; OP *arg; { register short *tbl; - register char *s; - register I32 matches = 0; + register U8 *s; + register U8 *send; + register U8 *d; register I32 ch; - register char *send; - register char *d; + register I32 matches = 0; register I32 squash = op->op_private & OPpTRANS_SQUASH; + STRLEN len; - tbl = (short*) cPVOP->op_pv; - s = SvPVn(sv); - send = s + SvCUROK(sv); + if (SvREADONLY(sv)) + croak(no_modify); + tbl = (short*)cPVOP->op_pv; + s = (U8*)SvPV(sv, len); + if (!len) + return 0; + if (!SvPOKp(sv)) + s = (U8*)SvPV_force(sv, len); + (void)SvPOK_only(sv); + send = s + len; if (!tbl || !s) - fatal("panic: do_trans"); + croak("panic: do_trans"); DEBUG_t( deb("2.TBL\n")); if (!op->op_private) { while (s < send) { - if ((ch = tbl[*s & 0377]) >= 0) { + if ((ch = tbl[*s]) >= 0) { matches++; *s = ch; } @@ -105,7 +65,7 @@ OP *arg; else { d = s; while (s < send) { - if ((ch = tbl[*s & 0377]) >= 0) { + if ((ch = tbl[*s]) >= 0) { *d = ch; if (matches++ && squash) { if (d[-1] == *d) @@ -122,7 +82,7 @@ OP *arg; } matches += send - d; /* account for disappeared chars */ *d = '\0'; - SvCUR_set(sv, d - SvPV(sv)); + SvCUR_set(sv, d - (U8*)SvPVX(sv)); } SvSETMAGIC(sv); return matches; @@ -137,9 +97,10 @@ register SV **sp; { SV **oldmark = mark; register I32 items = sp - mark; - register char *delim = SvPVn(del); register STRLEN len; - I32 delimlen = SvCUROK(del); + STRLEN delimlen; + register char *delim = SvPV(del, delimlen); + STRLEN tmplen; mark++; len = (items > 0 ? (delimlen * (items - 1) ) : 0); @@ -148,12 +109,8 @@ register SV **sp; if (SvLEN(sv) < len + items) { /* current length is way too short */ while (items-- > 0) { if (*mark) { - if (!SvPOK(*mark)) { - sv_2pv(*mark); - if (!SvPOK(*mark)) - *mark = &sv_no; - } - len += SvCUR((*mark)); + SvPV(*mark, tmplen); + len += tmplen; } mark++; } @@ -164,8 +121,17 @@ register SV **sp; ++mark; } - if (items-- > 0) - sv_setsv(sv, *mark++); + if (items-- > 0) { + char *s; + + if (*mark) { + s = SvPV(*mark, tmplen); + sv_setpvn(sv, s, tmplen); + } + else + sv_setpv(sv, ""); + mark++; + } else sv_setpv(sv,""); len = delimlen; @@ -192,9 +158,9 @@ register SV **sarg; register char *t; register char *f; bool dolong; -#ifdef QUAD +#ifdef HAS_QUAD bool doquad; -#endif /* QUAD */ +#endif /* HAS_QUAD */ char ch; register char *send; register SV *arg; @@ -203,11 +169,12 @@ register SV **sarg; I32 pre; I32 post; double value; + STRLEN arglen; sv_setpv(sv,""); len--; /* don't count pattern string */ - t = s = SvPVn(*sarg); - send = s + SvCUROK(*sarg); + t = s = SvPV(*sarg, arglen); /* XXX Don't know t is writeable */ + send = s + arglen; sarg++; for ( ; ; len--) { @@ -222,9 +189,9 @@ register SV **sarg; f = t; *buf = '\0'; xs = buf; -#ifdef QUAD +#ifdef HAS_QUAD doquad = -#endif /* QUAD */ +#endif /* HAS_QUAD */ dolong = FALSE; pre = post = 0; for (t++; t < send; t++) { @@ -236,12 +203,15 @@ register SV **sarg; len++, sarg--; xlen = strlen(xs); break; + case 'n': case '*': + croak("Use of %c in printf format not supported", *t); + case '0': case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': case '.': case '#': case '-': case '+': case ' ': continue; - case 'lXXX': -#ifdef QUAD + case 'l': +#ifdef HAS_QUAD if (dolong) { dolong = FALSE; doquad = TRUE; @@ -252,7 +222,7 @@ register SV **sarg; case 'c': ch = *(++t); *t = '\0'; - xlen = SvIVn(arg); + xlen = SvIV(arg); if (strEQ(f,"%c")) { /* some printfs fail on null chars */ *xs = xlen; xs[1] = '\0'; @@ -269,15 +239,15 @@ register SV **sarg; case 'd': ch = *(++t); *t = '\0'; -#ifdef QUAD +#ifdef HAS_QUAD if (doquad) - (void)sprintf(buf,s,(quad)SvNVn(arg)); + (void)sprintf(buf,s,(Quad_t)SvNV(arg)); else #endif if (dolong) - (void)sprintf(xs,f,(long)SvNVn(arg)); + (void)sprintf(xs,f,(long)SvNV(arg)); else - (void)sprintf(xs,f,SvIVn(arg)); + (void)sprintf(xs,f,SvIV(arg)); xlen = strlen(xs); break; case 'X': case 'O': @@ -286,10 +256,10 @@ register SV **sarg; case 'x': case 'o': case 'u': ch = *(++t); *t = '\0'; - value = SvNVn(arg); -#ifdef QUAD + value = SvNV(arg); +#ifdef HAS_QUAD if (doquad) - (void)sprintf(buf,s,(unsigned quad)value); + (void)sprintf(buf,s,(unsigned Quad_t)value); else #endif if (dolong) @@ -301,17 +271,14 @@ register SV **sarg; case 'E': case 'e': case 'f': case 'G': case 'g': ch = *(++t); *t = '\0'; - (void)sprintf(xs,f,SvNVn(arg)); + (void)sprintf(xs,f,SvNV(arg)); xlen = strlen(xs); break; case 's': ch = *(++t); *t = '\0'; - xs = SvPVn(arg); - if (SvPOK(arg)) - xlen = SvCUR(arg); - else - xlen = strlen(xs); + xs = SvPV(arg, arglen); + xlen = (I32)arglen; if (strEQ(f,"%s")) { /* some printfs fail on >128 chars */ break; /* so handle simple cases */ } @@ -352,15 +319,19 @@ register SV **sarg; } /* end of switch, copy results */ *t = ch; + if (xs == buf && xlen >= sizeof(buf)) { /* Ooops! */ + PerlIO_puts(PerlIO_stderr(),"panic: sprintf overflow - memory corrupted!\n"); + my_exit(1); + } SvGROW(sv, SvCUR(sv) + (f - s) + xlen + 1 + pre + post); sv_catpvn(sv, s, f - s); if (pre) { - repeatcpy(SvPV(sv) + SvCUR(sv), " ", 1, pre); + repeatcpy(SvPVX(sv) + SvCUR(sv), " ", 1, pre); SvCUR(sv) += pre; } sv_catpvn(sv, xs, xlen); if (post) { - repeatcpy(SvPV(sv) + SvCUR(sv), " ", 1, post); + repeatcpy(SvPVX(sv) + SvCUR(sv), " ", 1, post); SvCUR(sv) += post; } s = t; @@ -378,12 +349,26 @@ SV *sv; SV *targ = LvTARG(sv); register I32 offset; register I32 size; - register unsigned char *s = (unsigned char*)SvPV(targ); - register unsigned long lval = U_L(SvNVn(sv)); + register unsigned char *s; + register unsigned long lval; I32 mask; + STRLEN targlen; + STRLEN len; + if (!targ) + return; + s = (unsigned char*)SvPV_force(targ, targlen); + lval = U_L(SvNV(sv)); offset = LvTARGOFF(sv); size = LvTARGLEN(sv); + + len = (offset + size + 7) / 8; + if (len > targlen) { + s = (unsigned char*)SvGROW(targ, len + 1); + (void)memzero(s + targlen, len - targlen + 1); + SvCUR_set(targ, len); + } + if (size < 8) { mask = (1 << size) - 1; size = offset & 7; @@ -393,6 +378,7 @@ SV *sv; s[offset] |= lval << size; } else { + offset >>= 3; if (size == 8) s[offset] = lval & 255; else if (size == 16) { @@ -413,42 +399,118 @@ do_chop(astr,sv) register SV *astr; register SV *sv; { - register char *tmps; - register I32 i; - AV *ary; - HV *hash; - HE *entry; - - if (!sv) - return; + STRLEN len; + char *s; + if (SvTYPE(sv) == SVt_PVAV) { - I32 max; - SV **array = AvARRAY(sv); - max = AvFILL(sv); - for (i = 0; i <= max; i++) - do_chop(astr,array[i]); - return; + register I32 i; + I32 max; + AV* av = (AV*)sv; + max = AvFILL(av); + for (i = 0; i <= max; i++) { + sv = (SV*)av_fetch(av, i, FALSE); + if (sv && ((sv = *(SV**)sv), sv != &sv_undef)) + do_chop(astr, sv); + } + return; } if (SvTYPE(sv) == SVt_PVHV) { - hash = (HV*)sv; - (void)hv_iterinit(hash); - /*SUPPRESS 560*/ - while (entry = hv_iternext(hash)) - do_chop(astr,hv_iterval(hash,entry)); - return; + HV* hv = (HV*)sv; + HE* entry; + (void)hv_iterinit(hv); + /*SUPPRESS 560*/ + while (entry = hv_iternext(hv)) + do_chop(astr,hv_iterval(hv,entry)); + return; } - tmps = SvPVn(sv); - if (tmps && SvCUROK(sv)) { - tmps += SvCUR(sv) - 1; - sv_setpvn(astr,tmps,1); /* remember last char */ - *tmps = '\0'; /* wipe it out */ - SvCUR_set(sv, tmps - SvPV(sv)); - SvNOK_off(sv); - SvSETMAGIC(sv); + s = SvPV(sv, len); + if (len && !SvPOK(sv)) + s = SvPV_force(sv, len); + if (s && len) { + s += --len; + sv_setpvn(astr, s, 1); + *s = '\0'; + SvCUR_set(sv, len); + SvNIOK_off(sv); } else - sv_setpvn(astr,"",0); -} + sv_setpvn(astr, "", 0); + SvSETMAGIC(sv); +} + +I32 +do_chomp(sv) +register SV *sv; +{ + register I32 count; + STRLEN len; + char *s; + + if (RsSNARF(rs)) + return 0; + count = 0; + if (SvTYPE(sv) == SVt_PVAV) { + register I32 i; + I32 max; + AV* av = (AV*)sv; + max = AvFILL(av); + for (i = 0; i <= max; i++) { + sv = (SV*)av_fetch(av, i, FALSE); + if (sv && ((sv = *(SV**)sv), sv != &sv_undef)) + count += do_chomp(sv); + } + return count; + } + if (SvTYPE(sv) == SVt_PVHV) { + HV* hv = (HV*)sv; + HE* entry; + (void)hv_iterinit(hv); + /*SUPPRESS 560*/ + while (entry = hv_iternext(hv)) + count += do_chomp(hv_iterval(hv,entry)); + return count; + } + s = SvPV(sv, len); + if (len && !SvPOKp(sv)) + s = SvPV_force(sv, len); + if (s && len) { + s += --len; + if (RsPARA(rs)) { + if (*s != '\n') + goto nope; + ++count; + while (len && s[-1] == '\n') { + --len; + --s; + ++count; + } + } + else { + STRLEN rslen; + char *rsptr = SvPV(rs, rslen); + if (rslen == 1) { + if (*s != *rsptr) + goto nope; + ++count; + } + else { + if (len < rslen - 1) + goto nope; + len -= rslen - 1; + s -= rslen - 1; + if (memcmp(s, rsptr, rslen)) + goto nope; + count += rslen; + } + } + *s = '\0'; + SvCUR_set(sv, len); + SvNIOK_off(sv); + } + nope: + SvSETMAGIC(sv); + return count; +} void do_vop(optype,sv,left,right) @@ -463,28 +525,24 @@ SV *right; register long *rl; #endif register char *dc; - register char *lc = SvPVn(left); - register char *rc = SvPVn(right); + STRLEN leftlen; + STRLEN rightlen; + register char *lc = SvPV(left, leftlen); + register char *rc = SvPV(right, rightlen); register I32 len; - I32 leftlen = SvCUROK(left); - I32 rightlen = SvCUROK(right); + I32 lensave; + char *lsave = lc; + char *rsave = rc; + dc = SvPV_force(sv,na); len = leftlen < rightlen ? leftlen : rightlen; - if (SvTYPE(sv) < SVt_PV) - sv_upgrade(sv, SVt_PV); - if (SvCUR(sv) > len) - SvCUR_set(sv, len); - else if (SvCUR(sv) < len) { - SvGROW(sv,len); - (void)memzero(SvPV(sv) + SvCUR(sv), len - SvCUR(sv)); - SvCUR_set(sv, len); - } - SvPOK_only(sv); - dc = SvPV(sv); - if (!dc) { - sv_setpvn(sv,"",0); - dc = SvPV(sv); + lensave = len; + if (SvCUR(sv) < len) { + dc = SvGROW(sv,len + 1); + (void)memzero(dc + SvCUR(sv), len - SvCUR(sv) + 1); } + SvCUR_set(sv, len); + (void)SvPOK_only(sv); #ifdef LIBERAL if (len >= sizeof(long)*4 && !((long)dc % sizeof(long)) && @@ -507,7 +565,7 @@ SV *right; *dl++ = *ll++ & *rl++; } break; - case OP_XOR: + case OP_BIT_XOR: while (len--) { *dl++ = *ll++ ^ *rl++; *dl++ = *ll++ ^ *rl++; @@ -531,24 +589,90 @@ SV *right; len = remainder; } #endif - switch (optype) { - case OP_BIT_AND: - while (len--) - *dc++ = *lc++ & *rc++; - break; - case OP_XOR: - while (len--) - *dc++ = *lc++ ^ *rc++; - goto mop_up; - case OP_BIT_OR: - while (len--) - *dc++ = *lc++ | *rc++; - mop_up: - len = SvCUR(sv); - if (rightlen > len) - sv_catpvn(sv, SvPV(right) + len, rightlen - len); - else if (leftlen > len) - sv_catpvn(sv, SvPV(left) + len, leftlen - len); - break; + { + switch (optype) { + case OP_BIT_AND: + while (len--) + *dc++ = *lc++ & *rc++; + break; + case OP_BIT_XOR: + while (len--) + *dc++ = *lc++ ^ *rc++; + goto mop_up; + case OP_BIT_OR: + while (len--) + *dc++ = *lc++ | *rc++; + mop_up: + len = lensave; + if (rightlen > len) + sv_catpvn(sv, rsave + len, rightlen - len); + else if (leftlen > len) + sv_catpvn(sv, lsave + len, leftlen - len); + else + *SvEND(sv) = '\0'; + break; + } + } +} + +OP * +do_kv(ARGS) +dARGS +{ + dSP; + HV *hv = (HV*)POPs; + register HE *entry; + SV *tmpstr; + I32 dokeys = (op->op_type == OP_KEYS); + I32 dovalues = (op->op_type == OP_VALUES); + + if (op->op_type == OP_RV2HV || op->op_type == OP_PADHV) + dokeys = dovalues = TRUE; + + if (!hv) + RETURN; + + (void)hv_iterinit(hv); /* always reset iterator regardless */ + + if (GIMME != G_ARRAY) { + I32 i; + dTARGET; + + if (!SvRMAGICAL(hv) || !mg_find((SV*)hv,'P')) + i = HvKEYS(hv); + else { + i = 0; + /*SUPPRESS 560*/ + while (entry = hv_iternext(hv)) { + i++; + } + } + PUSHi( i ); + RETURN; } + + /* Guess how much room we need. hv_max may be a few too many. Oh well. */ + EXTEND(sp, HvMAX(hv) * (dokeys + dovalues)); + + PUTBACK; /* hv_iternext and hv_iterval might clobber stack_sp */ + while (entry = hv_iternext(hv)) { + SPAGAIN; + if (dokeys) + XPUSHs(hv_iterkeysv(entry)); /* won't clobber stack_sp */ + if (dovalues) { + tmpstr = NEWSV(45,0); + PUTBACK; + sv_setsv(tmpstr,hv_iterval(hv,entry)); + SPAGAIN; + DEBUG_H( { + sprintf(buf,"%d%%%d=%d\n", HeHASH(entry), + HvMAX(hv)+1, HeHASH(entry) & HvMAX(hv)); + sv_setpv(tmpstr,buf); + } ) + XPUSHs(sv_2mortal(tmpstr)); + } + PUTBACK; + } + return NORMAL; } +