[p5sagit/p5-mst-13.2.git] / doop.c

/*    doop.c
 *
 *    Copyright (c) 1991-1997, 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.
 *
 */

/*
 * "'So that was the job I felt I had to do when I started,' thought Sam."
 */

#include "EXTERN.h"
#include "perl.h"

#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
#include <signal.h>
#endif

I32
do_trans(SV *sv, OP *arg)
{
    dTHR;
    register U8 *s;
    register U8 *send;
    register U8 *d;
    register I32 matches = 0;
    register I32 squash = PL_op->op_private & OPpTRANS_SQUASH;
    STRLEN len;

    if (SvREADONLY(sv) && !(PL_op->op_private & OPpTRANS_COUNTONLY))
	croak(no_modify);

    if (PL_op->op_private & (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF)) {
	SV* rv = (SV*)cSVOP->op_sv;
	HV* hv = (HV*)SvRV(rv);
	SV** svp = hv_fetch(hv, "NONE", 4, FALSE);
	UV none = svp ? SvUV(*svp) : 0x7fffffff;
	UV extra = none + 1;
	I32 del = PL_op->op_private & OPpTRANS_DELETE;
	UV final;
	register UV uv;
	UV puv;
	register I32 from_utf = PL_op->op_private & OPpTRANS_FROM_UTF;
	register I32 to_utf = PL_op->op_private & OPpTRANS_TO_UTF;

	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;
	DEBUG_t( deb("2.TBL\n"));
	if (PL_op->op_private == (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF)) {	/* no other flags */
	    svp = hv_fetch(hv, "FINAL", 5, FALSE);
	    if (svp)
		final = SvUV(*svp);

	    d = s;
	    while (s < send) {
		if ((uv = swash_fetch(rv, s)) < none) {
		    s += UTF8SKIP(s);
		    matches++;
		    d = uv_to_utf8(d, uv);
		}
		else if (uv == none) {
		    int i;
		    for (i = UTF8SKIP(s); i; i--)
			*d++ = *s++;
		}
		else if (uv == extra) {
		    s += UTF8SKIP(s);
		    matches++;
		    d = uv_to_utf8(d, final);
		}
		else
		    s += UTF8SKIP(s);
	    }
	    *d = '\0';
	    SvCUR_set(sv, d - (U8*)SvPVX(sv));
	    SvSETMAGIC(sv);
	}
	else if (PL_op->op_private == OPpTRANS_FROM_UTF) {	/* no other flags */
	    svp = hv_fetch(hv, "FINAL", 5, FALSE);
	    if (svp)
		final = SvUV(*svp);

	    d = s;
	    while (s < send) {
		if ((uv = swash_fetch(rv, s)) < none) {
		    s += UTF8SKIP(s);
		    matches++;
		    *d++ = (U8)uv;
		}
		else if (uv == none) {
		    I32 ulen;
		    uv = utf8_to_uv(s, &ulen);
		    s += ulen;
		    *d++ = (U8)uv;
		}
		else if (uv == extra) {
		    s += UTF8SKIP(s);
		    matches++;
		    *d++ = (U8)final;
		}
		else
		    s += UTF8SKIP(s);
	    }
	    *d = '\0';
	    SvCUR_set(sv, d - (U8*)SvPVX(sv));
	    SvSETMAGIC(sv);
	}
	else if (PL_op->op_private == OPpTRANS_TO_UTF) {	/* no other flags */
	    svp = hv_fetch(hv, "FINAL", 5, FALSE);
	    if (svp)
		final = SvUV(*svp);

	    d = s;
	    while (s < send) {
		U8 tmpbuf[10];
		uv_to_utf8(tmpbuf, *s);		/* XXX suboptimal */
		if ((uv = swash_fetch(rv, tmpbuf)) < none) {
		    s += UTF8SKIP(s);
		    matches++;
		    d = uv_to_utf8(d, uv);
		}
		else if (uv == none) {
		    I32 ulen;
		    uv = utf8_to_uv(s, &ulen);
		    s += ulen;
		    d = uv_to_utf8(d, uv);
		}
		else if (uv == extra) {
		    s += UTF8SKIP(s);
		    matches++;
		    d = uv_to_utf8(d, final);
		}
		else
		    s += UTF8SKIP(s);
	    }
	    *d = '\0';
	    SvCUR_set(sv, d - (U8*)SvPVX(sv));
	    SvSETMAGIC(sv);
	}
	else if (PL_op->op_private & OPpTRANS_COUNTONLY) {
	    if (from_utf) {
		while (s < send) {
		    if (swash_fetch(rv, s) < none)
			matches++;
		    s += UTF8SKIP(s);
		}
	    }
	    else {
		while (s < send) {
		    U8 tmpbuf[10];
		    uv_to_utf8(tmpbuf, *s);	/* XXX suboptimal */
		    if (swash_fetch(rv, tmpbuf) < none)
			matches++;
		    s += UTF8SKIP(s);
		}
	    }
	}
	else {
	    I32 bits = 16;
	    U8 *dst;

	    svp = hv_fetch(hv, "BITS", 4, FALSE);
	    if (svp)
		bits = (I32)SvIV(*svp);

	    svp = hv_fetch(hv, "FINAL", 5, FALSE);
	    if (svp)
		final = SvUV(*svp);

	    Newz(801, d, len * (bits >> 3) + 1, U8);
	    dst = d;

	    puv = 0xfeedface;
	    if (squash) {
		while (s < send) {
		    if (from_utf)
			uv = swash_fetch(rv, s);
		    else {
			U8 tmpbuf[10];
			uv_to_utf8(tmpbuf, *s);	/* XXX suboptimal */
			uv = swash_fetch(rv, tmpbuf);
		    }
		    if (uv < none) {
			matches++;
			if (uv != puv) {
			    if (to_utf)
				d = uv_to_utf8(d, uv);
			    else
				*d++ = (U8)uv;
			}
			puv = uv;
			s += UTF8SKIP(s);
			continue;
		    }
		    else if (uv == none) {	/* "none" is unmapped character */
			int i;
			if (to_utf) {
			    for (i = UTF8SKIP(s); i; --i)
				*d++ = *s++;
			}
			else {
			    I32 ulen;
			    *d++ = (U8)utf8_to_uv(s, &ulen);
			    s += ulen;
			}
			puv = 0xfeedface;
			continue;
		    }
		    else if (uv == extra && !del) {
			matches++;
			if (to_utf)
			    d = uv_to_utf8(d, final);
			else
			    *d++ = (U8)final;
			s += UTF8SKIP(s);
			puv = 0xfeedface;
			continue;
		    }
		    matches++;		/* "none+1" is delete character */
		    s += UTF8SKIP(s);
		}
	    }
	    else {
		while (s < send) {
		    if (from_utf)
			uv = swash_fetch(rv, s);
		    else {
			U8 tmpbuf[10];
			uv_to_utf8(tmpbuf, *s);	/* XXX suboptimal */
			uv = swash_fetch(rv, tmpbuf);
		    }
		    if (uv < none) {
			if (to_utf)
			    d = uv_to_utf8(d, uv);
			else
			    *d++ = (U8)uv;
			matches++;
			s += UTF8SKIP(s);
			continue;
		    }
		    else if (uv == none) {	/* "none" is unmapped character */
			int i;
			if (to_utf) {
			    for (i = UTF8SKIP(s); i; --i)
				*d++ = *s++;
			}
			else {
			    I32 ulen;
			    *d++ = (U8)utf8_to_uv(s, &ulen);
			    s += ulen;
			}
			continue;
		    }
		    else if (uv == extra && !del) {
			matches++;
			if (to_utf)
			    d = uv_to_utf8(d, final);
			else
			    *d++ = (U8)final;
			s += UTF8SKIP(s);
			continue;
		    }
		    matches++;		/* "none+1" is delete character */
		    s += UTF8SKIP(s);
		}
	    }
	    sv_usepvn_mg(sv, (char*)dst, d - dst);
	}
	return matches;
    }
    else {
	register short *tbl;
	register I32 ch;
	register U8 *p;

	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)
	    croak("panic: do_trans");
	DEBUG_t( deb("2.TBL\n"));
	if (!PL_op->op_private) {
	    while (s < send) {
		if ((ch = tbl[*s]) >= 0) {
		    matches++;
		    *s = ch;
		}
		s++;
	    }
	    SvSETMAGIC(sv);
	}
	else if (PL_op->op_private & OPpTRANS_COUNTONLY) {
	    while (s < send) {
		if (tbl[*s] >= 0)
		    matches++;
		s++;
	    }
	}
	else {
	    d = s;
	    p = send;
	    while (s < send) {
		if ((ch = tbl[*s]) >= 0) {
		    *d = ch;
		    matches++;
		    if (squash) {
			if (p == d - 1 && *p == *d)
			    matches--;
			else
			    p = d++;
		    }
		    else
			d++;
		}
		else if (ch == -1)		/* -1 is unmapped character */
		    *d++ = *s;		/* -2 is delete character */
		s++;
	    }
	    matches += send - d;	/* account for disappeared chars */
	    *d = '\0';
	    SvCUR_set(sv, d - (U8*)SvPVX(sv));
	    SvSETMAGIC(sv);
	}
	return matches;
    }
}

void
do_join(register SV *sv, SV *del, register SV **mark, register SV **sp)
{
    SV **oldmark = mark;
    register I32 items = sp - mark;
    register STRLEN len;
    STRLEN delimlen;
    register char *delim = SvPV(del, delimlen);
    STRLEN tmplen;

    mark++;
    len = (items > 0 ? (delimlen * (items - 1) ) : 0);
    if (SvTYPE(sv) < SVt_PV)
	sv_upgrade(sv, SVt_PV);
    if (SvLEN(sv) < len + items) {	/* current length is way too short */
	while (items-- > 0) {
	    if (*mark && !SvGMAGICAL(*mark) && SvOK(*mark)) {
		SvPV(*mark, tmplen);
		len += tmplen;
	    }
	    mark++;
	}
	SvGROW(sv, len + 1);		/* so try to pre-extend */

	mark = oldmark;
	items = sp - mark;;
	++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;
    if (len) {
	for (; items > 0; items--,mark++) {
	    sv_catpvn(sv,delim,len);
	    sv_catsv(sv,*mark);
	}
    }
    else {
	for (; items > 0; items--,mark++)
	    sv_catsv(sv,*mark);
    }
    SvSETMAGIC(sv);
}

void
do_sprintf(SV *sv, I32 len, SV **sarg)
{
    STRLEN patlen;
    char *pat = SvPV(*sarg, patlen);
    bool do_taint = FALSE;

    sv_vsetpvfn(sv, pat, patlen, Null(va_list*), sarg + 1, len - 1, &do_taint);
    SvSETMAGIC(sv);
    if (do_taint)
	SvTAINTED_on(sv);
}

void
do_vecset(SV *sv)
{
    SV *targ = LvTARG(sv);
    register I32 offset;
    register I32 size;
    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;
	lval &= mask;
	offset >>= 3;
	s[offset] &= ~(mask << size);
	s[offset] |= lval << size;
    }
    else {
	offset >>= 3;
	if (size == 8)
	    s[offset] = lval & 255;
	else if (size == 16) {
	    s[offset] = (lval >> 8) & 255;
	    s[offset+1] = lval & 255;
	}
	else if (size == 32) {
	    s[offset] = (lval >> 24) & 255;
	    s[offset+1] = (lval >> 16) & 255;
	    s[offset+2] = (lval >> 8) & 255;
	    s[offset+3] = lval & 255;
	}
    }
}

void
do_chop(register SV *astr, register SV *sv)
{
    STRLEN len;
    char *s;
    dTHR;
    
    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 != &PL_sv_undef))
		do_chop(astr, sv);
	}
        return;
    }
    if (SvTYPE(sv) == SVt_PVHV) {
        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;
    }
    s = SvPV(sv, len);
    if (len && !SvPOK(sv))
	s = SvPV_force(sv, len);
    if (IN_UTF8) {
	if (s && len) {
	    char *send = s + len;
	    char *start = s;
	    s = send - 1;
	    while ((*s & 0xc0) == 0x80)
		--s;
	    if (UTF8SKIP(s) != send - s)
		warn("Malformed UTF-8 character");
	    sv_setpvn(astr, s, send - s);
	    *s = '\0';
	    SvCUR_set(sv, s - start);
	    SvNIOK_off(sv);
	}
	else
	    sv_setpvn(astr, "", 0);
    }
    else
    if (s && len) {
	s += --len;
	sv_setpvn(astr, s, 1);
	*s = '\0';
	SvCUR_set(sv, len);
	SvNIOK_off(sv);
    }
    else
	sv_setpvn(astr, "", 0);
    SvSETMAGIC(sv);
} 

I32
do_chomp(register SV *sv)
{
    dTHR;
    register I32 count;
    STRLEN len;
    char *s;

    if (RsSNARF(PL_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 != &PL_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(PL_rs)) {
	    if (*s != '\n')
		goto nope;
	    ++count;
	    while (len && s[-1] == '\n') {
		--len;
		--s;
		++count;
	    }
	}
	else {
	    STRLEN rslen;
	    char *rsptr = SvPV(PL_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 (memNE(s, rsptr, rslen))
		    goto nope;
		count += rslen;
	    }
	}
	*s = '\0';
	SvCUR_set(sv, len);
	SvNIOK_off(sv);
    }
  nope:
    SvSETMAGIC(sv);
    return count;
} 

void
do_vop(I32 optype, SV *sv, SV *left, SV *right)
{
    dTHR;	/* just for taint */
#ifdef LIBERAL
    register long *dl;
    register long *ll;
    register long *rl;
#endif
    register char *dc;
    STRLEN leftlen;
    STRLEN rightlen;
    register char *lc;
    register char *rc;
    register I32 len;
    I32 lensave;
    char *lsave;
    char *rsave;

    if (sv != left || (optype != OP_BIT_AND && !SvOK(sv) && !SvGMAGICAL(sv)))
	sv_setpvn(sv, "", 0);	/* avoid undef warning on |= and ^= */
    lsave = lc = SvPV(left, leftlen);
    rsave = rc = SvPV(right, rightlen);
    len = leftlen < rightlen ? leftlen : rightlen;
    lensave = len;
    if (SvOK(sv) || SvTYPE(sv) > SVt_PVMG) {
	dc = SvPV_force(sv, PL_na);
	if (SvCUR(sv) < len) {
	    dc = SvGROW(sv, len + 1);
	    (void)memzero(dc + SvCUR(sv), len - SvCUR(sv) + 1);
	}
    }
    else {
	I32 needlen = ((optype == OP_BIT_AND)
			? len : (leftlen > rightlen ? leftlen : rightlen));
	Newz(801, dc, needlen + 1, char);
	(void)sv_usepvn(sv, dc, needlen);
	dc = SvPVX(sv);		/* sv_usepvn() calls Renew() */
    }
    SvCUR_set(sv, len);
    (void)SvPOK_only(sv);
#ifdef LIBERAL
    if (len >= sizeof(long)*4 &&
	!((long)dc % sizeof(long)) &&
	!((long)lc % sizeof(long)) &&
	!((long)rc % sizeof(long)))	/* It's almost always aligned... */
    {
	I32 remainder = len % (sizeof(long)*4);
	len /= (sizeof(long)*4);

	dl = (long*)dc;
	ll = (long*)lc;
	rl = (long*)rc;

	switch (optype) {
	case OP_BIT_AND:
	    while (len--) {
		*dl++ = *ll++ & *rl++;
		*dl++ = *ll++ & *rl++;
		*dl++ = *ll++ & *rl++;
		*dl++ = *ll++ & *rl++;
	    }
	    break;
	case OP_BIT_XOR:
	    while (len--) {
		*dl++ = *ll++ ^ *rl++;
		*dl++ = *ll++ ^ *rl++;
		*dl++ = *ll++ ^ *rl++;
		*dl++ = *ll++ ^ *rl++;
	    }
	    break;
	case OP_BIT_OR:
	    while (len--) {
		*dl++ = *ll++ | *rl++;
		*dl++ = *ll++ | *rl++;
		*dl++ = *ll++ | *rl++;
		*dl++ = *ll++ | *rl++;
	    }
	}

	dc = (char*)dl;
	lc = (char*)ll;
	rc = (char*)rl;

	len = remainder;
    }
#endif
    {
	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;
	}
    }
    SvTAINT(sv);
}

OP *
do_kv(ARGSproto)
{
    djSP;
    HV *hv = (HV*)POPs;
    HV *keys;
    register HE *entry;
    SV *tmpstr;
    I32 gimme = GIMME_V;
    I32 dokeys =   (PL_op->op_type == OP_KEYS);
    I32 dovalues = (PL_op->op_type == OP_VALUES);
    I32 realhv = (SvTYPE(hv) == SVt_PVHV);
    
    if (PL_op->op_type == OP_RV2HV || PL_op->op_type == OP_PADHV) 
	dokeys = dovalues = TRUE;

    if (!hv) {
	if (PL_op->op_flags & OPf_MOD) {	/* lvalue */
	    dTARGET;		/* make sure to clear its target here */
	    if (SvTYPE(TARG) == SVt_PVLV)
		LvTARG(TARG) = Nullsv;
	    PUSHs(TARG);
	}
	RETURN;
    }

    keys = realhv ? hv : avhv_keys((AV*)hv);
    (void)hv_iterinit(keys);	/* always reset iterator regardless */

    if (gimme == G_VOID)
	RETURN;

    if (gimme == G_SCALAR) {
	IV i;
	dTARGET;

	if (PL_op->op_flags & OPf_MOD) {	/* lvalue */
	    if (SvTYPE(TARG) < SVt_PVLV) {
		sv_upgrade(TARG, SVt_PVLV);
		sv_magic(TARG, Nullsv, 'k', Nullch, 0);
	    }
	    LvTYPE(TARG) = 'k';
	    if (LvTARG(TARG) != (SV*)keys) {
		if (LvTARG(TARG))
		    SvREFCNT_dec(LvTARG(TARG));
		LvTARG(TARG) = SvREFCNT_inc(keys);
	    }
	    PUSHs(TARG);
	    RETURN;
	}

	if (!SvRMAGICAL(keys) || !mg_find((SV*)keys,'P'))
	    i = HvKEYS(keys);
	else {
	    i = 0;
	    /*SUPPRESS 560*/
	    while (hv_iternext(keys)) i++;
	}
	PUSHi( i );
	RETURN;
    }

    EXTEND(SP, HvKEYS(keys) * (dokeys + dovalues));

    PUTBACK;	/* hv_iternext and hv_iterval might clobber stack_sp */
    while (entry = hv_iternext(keys)) {
	SPAGAIN;
	if (dokeys)
	    XPUSHs(hv_iterkeysv(entry));	/* won't clobber stack_sp */
	if (dovalues) {
	    tmpstr = sv_newmortal();
	    PUTBACK;
	    sv_setsv(tmpstr,realhv ?
		     hv_iterval(hv,entry) : avhv_iterval((AV*)hv,entry));
	    DEBUG_H(sv_setpvf(tmpstr, "%lu%%%d=%lu",
			    (unsigned long)HeHASH(entry),
			    HvMAX(keys)+1,
			    (unsigned long)(HeHASH(entry) & HvMAX(keys))));
	    SPAGAIN;
	    XPUSHs(tmpstr);
	}
	PUTBACK;
    }
    return NORMAL;
}
Commit	Line	Data
a0d0e21e	1	/* doop.c
79072805	2	*
9607fc9c	3	* Copyright (c) 1991-1997, Larry Wall
79072805	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	*
a0d0e21e	8	*/
	9
	10	/*
	11	* "'So that was the job I felt I had to do when I started,' thought Sam."
79072805	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
79072805	21	I32
8ac85365	22	do_trans(SV sv, OP arg)
79072805	23	{
11343788	24	dTHR;
1476d272	25	register U8 *s;
	26	register U8 *send;
	27	register U8 *d;
1476d272	28	register I32 matches = 0;
533c011a	29	register I32 squash = PL_op->op_private & OPpTRANS_SQUASH;
463ee0b2	30	STRLEN len;
79072805	31
533c011a	32	if (SvREADONLY(sv) && !(PL_op->op_private & OPpTRANS_COUNTONLY))
a0d0e21e	33	croak(no_modify);
a0ed51b3	34
	35	if (PL_op->op_private & (OPpTRANS_FROM_UTF\|OPpTRANS_TO_UTF)) {
	36	SV* rv = (SV*)cSVOP->op_sv;
	37	HV* hv = (HV*)SvRV(rv);
	38	SV** svp = hv_fetch(hv, "NONE", 4, FALSE);
	39	UV none = svp ? SvUV(*svp) : 0x7fffffff;
	40	UV extra = none + 1;
	41	I32 del = PL_op->op_private & OPpTRANS_DELETE;
	42	UV final;
	43	register UV uv;
	44	UV puv;
a0ed51b3	45	register I32 from_utf = PL_op->op_private & OPpTRANS_FROM_UTF;
	46	register I32 to_utf = PL_op->op_private & OPpTRANS_TO_UTF;
	47
	48	s = (U8*)SvPV(sv, len);
	49	if (!len)
	50	return 0;
	51	if (!SvPOKp(sv))
	52	s = (U8*)SvPV_force(sv, len);
	53	(void)SvPOK_only(sv);
	54	send = s + len;
	55	DEBUG_t( deb("2.TBL\n"));
	56	if (PL_op->op_private == (OPpTRANS_FROM_UTF\|OPpTRANS_TO_UTF)) { /* no other flags */
	57	svp = hv_fetch(hv, "FINAL", 5, FALSE);
	58	if (svp)
	59	final = SvUV(*svp);
	60
	61	d = s;
	62	while (s < send) {
	63	if ((uv = swash_fetch(rv, s)) < none) {
	64	s += UTF8SKIP(s);
	65	matches++;
	66	d = uv_to_utf8(d, uv);
	67	}
	68	else if (uv == none) {
	69	int i;
	70	for (i = UTF8SKIP(s); i; i--)
	71	d++ = s++;
	72	}
	73	else if (uv == extra) {
	74	s += UTF8SKIP(s);
	75	matches++;
	76	d = uv_to_utf8(d, final);
	77	}
	78	else
	79	s += UTF8SKIP(s);
79072805	80	}
a0ed51b3	81	*d = '\0';
	82	SvCUR_set(sv, d - (U8*)SvPVX(sv));
	83	SvSETMAGIC(sv);
79072805	84	}
a0ed51b3	85	else if (PL_op->op_private == OPpTRANS_FROM_UTF) { /* no other flags */
	86	svp = hv_fetch(hv, "FINAL", 5, FALSE);
	87	if (svp)
	88	final = SvUV(*svp);
	89
	90	d = s;
	91	while (s < send) {
	92	if ((uv = swash_fetch(rv, s)) < none) {
	93	s += UTF8SKIP(s);
	94	matches++;
	95	*d++ = (U8)uv;
	96	}
	97	else if (uv == none) {
	98	I32 ulen;
	99	uv = utf8_to_uv(s, &ulen);
	100	s += ulen;
	101	*d++ = (U8)uv;
	102	}
	103	else if (uv == extra) {
	104	s += UTF8SKIP(s);
	105	matches++;
	106	*d++ = (U8)final;
	107	}
	108	else
	109	s += UTF8SKIP(s);
	110	}
	111	*d = '\0';
	112	SvCUR_set(sv, d - (U8*)SvPVX(sv));
	113	SvSETMAGIC(sv);
	114	}
	115	else if (PL_op->op_private == OPpTRANS_TO_UTF) { /* no other flags */
	116	svp = hv_fetch(hv, "FINAL", 5, FALSE);
	117	if (svp)
	118	final = SvUV(*svp);
	119
	120	d = s;
	121	while (s < send) {
	122	U8 tmpbuf[10];
	123	uv_to_utf8(tmpbuf, s); / XXX suboptimal */
	124	if ((uv = swash_fetch(rv, tmpbuf)) < none) {
	125	s += UTF8SKIP(s);
	126	matches++;
	127	d = uv_to_utf8(d, uv);
	128	}
	129	else if (uv == none) {
	130	I32 ulen;
	131	uv = utf8_to_uv(s, &ulen);
	132	s += ulen;
	133	d = uv_to_utf8(d, uv);
	134	}
	135	else if (uv == extra) {
	136	s += UTF8SKIP(s);
	137	matches++;
	138	d = uv_to_utf8(d, final);
	139	}
	140	else
	141	s += UTF8SKIP(s);
	142	}
	143	*d = '\0';
	144	SvCUR_set(sv, d - (U8*)SvPVX(sv));
	145	SvSETMAGIC(sv);
5d06d08e	146	}
a0ed51b3	147	else if (PL_op->op_private & OPpTRANS_COUNTONLY) {
	148	if (from_utf) {
	149	while (s < send) {
	150	if (swash_fetch(rv, s) < none)
	151	matches++;
	152	s += UTF8SKIP(s);
	153	}
	154	}
	155	else {
	156	while (s < send) {
dfe13c55	157	U8 tmpbuf[10];
a0ed51b3	158	uv_to_utf8(tmpbuf, s); / XXX suboptimal */
	159	if (swash_fetch(rv, tmpbuf) < none)
	160	matches++;
	161	s += UTF8SKIP(s);
	162	}
	163	}
	164	}
	165	else {
	166	I32 bits = 16;
	167	U8 *dst;
	168
	169	svp = hv_fetch(hv, "BITS", 4, FALSE);
	170	if (svp)
	171	bits = (I32)SvIV(*svp);
	172
	173	svp = hv_fetch(hv, "FINAL", 5, FALSE);
	174	if (svp)
	175	final = SvUV(*svp);
	176
dfe13c55	177	Newz(801, d, len * (bits >> 3) + 1, U8);
a0ed51b3	178	dst = d;
	179
	180	puv = 0xfeedface;
	181	if (squash) {
	182	while (s < send) {
	183	if (from_utf)
	184	uv = swash_fetch(rv, s);
	185	else {
dfe13c55	186	U8 tmpbuf[10];
a0ed51b3	187	uv_to_utf8(tmpbuf, s); / XXX suboptimal */
	188	uv = swash_fetch(rv, tmpbuf);
	189	}
	190	if (uv < none) {
	191	matches++;
	192	if (uv != puv) {
	193	if (to_utf)
	194	d = uv_to_utf8(d, uv);
	195	else
	196	*d++ = (U8)uv;
	197	}
	198	puv = uv;
	199	s += UTF8SKIP(s);
	200	continue;
	201	}
	202	else if (uv == none) { /* "none" is unmapped character */
	203	int i;
	204	if (to_utf) {
	205	for (i = UTF8SKIP(s); i; --i)
	206	d++ = s++;
	207	}
	208	else {
	209	I32 ulen;
	210	*d++ = (U8)utf8_to_uv(s, &ulen);
	211	s += ulen;
	212	}
	213	puv = 0xfeedface;
	214	continue;
	215	}
	216	else if (uv == extra && !del) {
	217	matches++;
	218	if (to_utf)
	219	d = uv_to_utf8(d, final);
	220	else
	221	*d++ = (U8)final;
	222	s += UTF8SKIP(s);
	223	puv = 0xfeedface;
	224	continue;
	225	}
	226	matches++; /* "none+1" is delete character */
	227	s += UTF8SKIP(s);
	228	}
	229	}
	230	else {
	231	while (s < send) {
	232	if (from_utf)
	233	uv = swash_fetch(rv, s);
	234	else {
dfe13c55	235	U8 tmpbuf[10];
a0ed51b3	236	uv_to_utf8(tmpbuf, s); / XXX suboptimal */
	237	uv = swash_fetch(rv, tmpbuf);
	238	}
	239	if (uv < none) {
	240	if (to_utf)
	241	d = uv_to_utf8(d, uv);
	242	else
	243	*d++ = (U8)uv;
	244	matches++;
	245	s += UTF8SKIP(s);
	246	continue;
	247	}
	248	else if (uv == none) { /* "none" is unmapped character */
	249	int i;
	250	if (to_utf) {
	251	for (i = UTF8SKIP(s); i; --i)
	252	d++ = s++;
	253	}
	254	else {
	255	I32 ulen;
	256	*d++ = (U8)utf8_to_uv(s, &ulen);
	257	s += ulen;
	258	}
	259	continue;
	260	}
	261	else if (uv == extra && !del) {
	262	matches++;
	263	if (to_utf)
	264	d = uv_to_utf8(d, final);
	265	else
	266	*d++ = (U8)final;
	267	s += UTF8SKIP(s);
	268	continue;
	269	}
	270	matches++; /* "none+1" is delete character */
	271	s += UTF8SKIP(s);
	272	}
	273	}
dfe13c55	274	sv_usepvn_mg(sv, (char*)dst, d - dst);
a0ed51b3	275	}
a0ed51b3	276	return matches;
79072805	277	}
79072805	278	else {
a0ed51b3	279	register short *tbl;
	280	register I32 ch;
	281	register U8 *p;
	282
	283	tbl = (short*)cPVOP->op_pv;
	284	s = (U8*)SvPV(sv, len);
	285	if (!len)
	286	return 0;
	287	if (!SvPOKp(sv))
	288	s = (U8*)SvPV_force(sv, len);
	289	(void)SvPOK_only(sv);
	290	send = s + len;
	291	if (!tbl \|\| !s)
	292	croak("panic: do_trans");
	293	DEBUG_t( deb("2.TBL\n"));
	294	if (!PL_op->op_private) {
	295	while (s < send) {
	296	if ((ch = tbl[*s]) >= 0) {
	297	matches++;
	298	*s = ch;
	299	}
	300	s++;
	301	}
	302	SvSETMAGIC(sv);
	303	}
	304	else if (PL_op->op_private & OPpTRANS_COUNTONLY) {
	305	while (s < send) {
	306	if (tbl[*s] >= 0)
	307	matches++;
	308	s++;
	309	}
	310	}
	311	else {
	312	d = s;
	313	p = send;
	314	while (s < send) {
	315	if ((ch = tbl[*s]) >= 0) {
	316	*d = ch;
	317	matches++;
	318	if (squash) {
	319	if (p == d - 1 && p == d)
	320	matches--;
	321	else
	322	p = d++;
	323	}
79072805	324	else
a0ed51b3	325	d++;
79072805	326	}
a0ed51b3	327	else if (ch == -1) /* -1 is unmapped character */
	328	d++ = s; /* -2 is delete character */
	329	s++;
79072805	330	}
a0ed51b3	331	matches += send - d; /* account for disappeared chars */
	332	*d = '\0';
	333	SvCUR_set(sv, d - (U8*)SvPVX(sv));
	334	SvSETMAGIC(sv);
79072805	335	}
a0ed51b3	336	return matches;
79072805	337	}
79072805	338	}
	339
	340	void
8ac85365	341	do_join(register SV sv, SV del, register SV mark, register SV sp)
79072805	342	{
	343	SV **oldmark = mark;
	344	register I32 items = sp - mark;
79072805	345	register STRLEN len;
463ee0b2	346	STRLEN delimlen;
	347	register char *delim = SvPV(del, delimlen);
	348	STRLEN tmplen;
79072805	349
	350	mark++;
	351	len = (items > 0 ? (delimlen * (items - 1) ) : 0);
	352	if (SvTYPE(sv) < SVt_PV)
	353	sv_upgrade(sv, SVt_PV);
	354	if (SvLEN(sv) < len + items) { /* current length is way too short */
	355	while (items-- > 0) {
48c036b1	356	if (mark && !SvGMAGICAL(mark) && SvOK(*mark)) {
463ee0b2	357	SvPV(*mark, tmplen);
463ee0b2	358	len += tmplen;
79072805	359	}
	360	mark++;
	361	}
	362	SvGROW(sv, len + 1); /* so try to pre-extend */
	363
	364	mark = oldmark;
	365	items = sp - mark;;
	366	++mark;
	367	}
	368
463ee0b2	369	if (items-- > 0) {
8990e307	370	char *s;
	371
	372	if (*mark) {
	373	s = SvPV(*mark, tmplen);
	374	sv_setpvn(sv, s, tmplen);
	375	}
	376	else
	377	sv_setpv(sv, "");
463ee0b2	378	mark++;
463ee0b2	379	}
79072805	380	else
	381	sv_setpv(sv,"");
	382	len = delimlen;
	383	if (len) {
	384	for (; items > 0; items--,mark++) {
	385	sv_catpvn(sv,delim,len);
	386	sv_catsv(sv,*mark);
	387	}
	388	}
	389	else {
	390	for (; items > 0; items--,mark++)
	391	sv_catsv(sv,*mark);
	392	}
	393	SvSETMAGIC(sv);
	394	}
	395
	396	void
8ac85365	397	do_sprintf(SV sv, I32 len, SV *sarg)
79072805	398	{
46fc3d4c	399	STRLEN patlen;
	400	char pat = SvPV(sarg, patlen);
	401	bool do_taint = FALSE;
	402
	403	sv_vsetpvfn(sv, pat, patlen, Null(va_list*), sarg + 1, len - 1, &do_taint);
79072805	404	SvSETMAGIC(sv);
46fc3d4c	405	if (do_taint)
46fc3d4c	406	SvTAINTED_on(sv);
79072805	407	}
	408
	409	void
8ac85365	410	do_vecset(SV *sv)
79072805	411	{
	412	SV *targ = LvTARG(sv);
	413	register I32 offset;
	414	register I32 size;
8990e307	415	register unsigned char *s;
8990e307	416	register unsigned long lval;
79072805	417	I32 mask;
a0d0e21e	418	STRLEN targlen;
a0d0e21e	419	STRLEN len;
79072805	420
8990e307	421	if (!targ)
8990e307	422	return;
a0d0e21e	423	s = (unsigned char*)SvPV_force(targ, targlen);
8990e307	424	lval = U_L(SvNV(sv));
79072805	425	offset = LvTARGOFF(sv);
79072805	426	size = LvTARGLEN(sv);
a0d0e21e	427
	428	len = (offset + size + 7) / 8;
	429	if (len > targlen) {
	430	s = (unsigned char*)SvGROW(targ, len + 1);
	431	(void)memzero(s + targlen, len - targlen + 1);
	432	SvCUR_set(targ, len);
	433	}
	434
79072805	435	if (size < 8) {
	436	mask = (1 << size) - 1;
	437	size = offset & 7;
	438	lval &= mask;
	439	offset >>= 3;
	440	s[offset] &= ~(mask << size);
	441	s[offset] \|= lval << size;
	442	}
	443	else {
a0d0e21e	444	offset >>= 3;
79072805	445	if (size == 8)
	446	s[offset] = lval & 255;
	447	else if (size == 16) {
	448	s[offset] = (lval >> 8) & 255;
	449	s[offset+1] = lval & 255;
	450	}
	451	else if (size == 32) {
	452	s[offset] = (lval >> 24) & 255;
	453	s[offset+1] = (lval >> 16) & 255;
	454	s[offset+2] = (lval >> 8) & 255;
	455	s[offset+3] = lval & 255;
	456	}
	457	}
	458	}
	459
	460	void
8ac85365	461	do_chop(register SV astr, register SV sv)
79072805	462	{
463ee0b2	463	STRLEN len;
a0d0e21e	464	char *s;
c485e607	465	dTHR;
a0d0e21e	466
79072805	467	if (SvTYPE(sv) == SVt_PVAV) {
a0d0e21e	468	register I32 i;
	469	I32 max;
	470	AV* av = (AV*)sv;
	471	max = AvFILL(av);
	472	for (i = 0; i <= max; i++) {
	473	sv = (SV*)av_fetch(av, i, FALSE);
3280af22	474	if (sv && ((sv = (SV*)sv), sv != &PL_sv_undef))
a0d0e21e	475	do_chop(astr, sv);
	476	}
	477	return;
79072805	478	}
79072805	479	if (SvTYPE(sv) == SVt_PVHV) {
a0d0e21e	480	HV* hv = (HV*)sv;
	481	HE* entry;
	482	(void)hv_iterinit(hv);
	483	/SUPPRESS 560/
	484	while (entry = hv_iternext(hv))
	485	do_chop(astr,hv_iterval(hv,entry));
	486	return;
79072805	487	}
a0d0e21e	488	s = SvPV(sv, len);
748a9306	489	if (len && !SvPOK(sv))
a0d0e21e	490	s = SvPV_force(sv, len);
a0ed51b3	491	if (IN_UTF8) {
	492	if (s && len) {
	493	char *send = s + len;
	494	char *start = s;
	495	s = send - 1;
	496	while ((*s & 0xc0) == 0x80)
	497	--s;
	498	if (UTF8SKIP(s) != send - s)
	499	warn("Malformed UTF-8 character");
	500	sv_setpvn(astr, s, send - s);
	501	*s = '\0';
	502	SvCUR_set(sv, s - start);
	503	SvNIOK_off(sv);
	504	}
	505	else
	506	sv_setpvn(astr, "", 0);
	507	}
	508	else
a0d0e21e	509	if (s && len) {
	510	s += --len;
	511	sv_setpvn(astr, s, 1);
	512	*s = '\0';
	513	SvCUR_set(sv, len);
	514	SvNIOK_off(sv);
79072805	515	}
79072805	516	else
a0d0e21e	517	sv_setpvn(astr, "", 0);
	518	SvSETMAGIC(sv);
	519	}
	520
	521	I32
8ac85365	522	do_chomp(register SV *sv)
a0d0e21e	523	{
aeea060c	524	dTHR;
c07a80fd	525	register I32 count;
a0d0e21e	526	STRLEN len;
a0d0e21e	527	char *s;
c07a80fd	528
3280af22	529	if (RsSNARF(PL_rs))
c07a80fd	530	return 0;
c07a80fd	531	count = 0;
a0d0e21e	532	if (SvTYPE(sv) == SVt_PVAV) {
	533	register I32 i;
	534	I32 max;
	535	AV* av = (AV*)sv;
	536	max = AvFILL(av);
	537	for (i = 0; i <= max; i++) {
	538	sv = (SV*)av_fetch(av, i, FALSE);
3280af22	539	if (sv && ((sv = (SV*)sv), sv != &PL_sv_undef))
a0d0e21e	540	count += do_chomp(sv);
	541	}
	542	return count;
	543	}
	544	if (SvTYPE(sv) == SVt_PVHV) {
	545	HV* hv = (HV*)sv;
	546	HE* entry;
	547	(void)hv_iterinit(hv);
	548	/SUPPRESS 560/
	549	while (entry = hv_iternext(hv))
	550	count += do_chomp(hv_iterval(hv,entry));
	551	return count;
	552	}
	553	s = SvPV(sv, len);
	554	if (len && !SvPOKp(sv))
	555	s = SvPV_force(sv, len);
	556	if (s && len) {
	557	s += --len;
3280af22	558	if (RsPARA(PL_rs)) {
a0d0e21e	559	if (*s != '\n')
	560	goto nope;
	561	++count;
	562	while (len && s[-1] == '\n') {
	563	--len;
	564	--s;
	565	++count;
	566	}
	567	}
a0d0e21e	568	else {
c07a80fd	569	STRLEN rslen;
3280af22	570	char *rsptr = SvPV(PL_rs, rslen);
c07a80fd	571	if (rslen == 1) {
	572	if (s != rsptr)
	573	goto nope;
	574	++count;
	575	}
	576	else {
8c2cee6f	577	if (len < rslen - 1)
c07a80fd	578	goto nope;
	579	len -= rslen - 1;
	580	s -= rslen - 1;
36477c24	581	if (memNE(s, rsptr, rslen))
c07a80fd	582	goto nope;
	583	count += rslen;
	584	}
a0d0e21e	585	}
a0d0e21e	586	*s = '\0';
	587	SvCUR_set(sv, len);
	588	SvNIOK_off(sv);
	589	}
	590	nope:
	591	SvSETMAGIC(sv);
	592	return count;
	593	}
79072805	594
79072805	595	void
8ac85365	596	do_vop(I32 optype, SV sv, SV left, SV *right)
79072805	597	{
aeea060c	598	dTHR; /* just for taint */
79072805	599	#ifdef LIBERAL
	600	register long *dl;
	601	register long *ll;
	602	register long *rl;
	603	#endif
	604	register char *dc;
463ee0b2	605	STRLEN leftlen;
463ee0b2	606	STRLEN rightlen;
7a4c00b4	607	register char *lc;
7a4c00b4	608	register char *rc;
79072805	609	register I32 len;
a0d0e21e	610	I32 lensave;
7a4c00b4	611	char *lsave;
7a4c00b4	612	char *rsave;
79072805	613
1fbd88dc	614	if (sv != left \|\| (optype != OP_BIT_AND && !SvOK(sv) && !SvGMAGICAL(sv)))
1fbd88dc	615	sv_setpvn(sv, "", 0); /* avoid undef warning on \|= and ^= */
7a4c00b4	616	lsave = lc = SvPV(left, leftlen);
7a4c00b4	617	rsave = rc = SvPV(right, rightlen);
93a17b20	618	len = leftlen < rightlen ? leftlen : rightlen;
a0d0e21e	619	lensave = len;
7a4c00b4	620	if (SvOK(sv) \|\| SvTYPE(sv) > SVt_PVMG) {
3280af22	621	dc = SvPV_force(sv, PL_na);
ff68c719	622	if (SvCUR(sv) < len) {
	623	dc = SvGROW(sv, len + 1);
	624	(void)memzero(dc + SvCUR(sv), len - SvCUR(sv) + 1);
	625	}
	626	}
	627	else {
	628	I32 needlen = ((optype == OP_BIT_AND)
	629	? len : (leftlen > rightlen ? leftlen : rightlen));
	630	Newz(801, dc, needlen + 1, char);
	631	(void)sv_usepvn(sv, dc, needlen);
	632	dc = SvPVX(sv); /* sv_usepvn() calls Renew() */
79072805	633	}
a0d0e21e	634	SvCUR_set(sv, len);
a0d0e21e	635	(void)SvPOK_only(sv);
79072805	636	#ifdef LIBERAL
	637	if (len >= sizeof(long)*4 &&
	638	!((long)dc % sizeof(long)) &&
	639	!((long)lc % sizeof(long)) &&
	640	!((long)rc % sizeof(long))) /* It's almost always aligned... */
	641	{
	642	I32 remainder = len % (sizeof(long)*4);
	643	len /= (sizeof(long)*4);
	644
	645	dl = (long*)dc;
	646	ll = (long*)lc;
	647	rl = (long*)rc;
	648
	649	switch (optype) {
	650	case OP_BIT_AND:
	651	while (len--) {
	652	dl++ = ll++ & *rl++;
	653	dl++ = ll++ & *rl++;
	654	dl++ = ll++ & *rl++;
	655	dl++ = ll++ & *rl++;
	656	}
	657	break;
a0d0e21e	658	case OP_BIT_XOR:
79072805	659	while (len--) {
	660	dl++ = ll++ ^ *rl++;
	661	dl++ = ll++ ^ *rl++;
	662	dl++ = ll++ ^ *rl++;
	663	dl++ = ll++ ^ *rl++;
	664	}
	665	break;
	666	case OP_BIT_OR:
	667	while (len--) {
	668	dl++ = ll++ \| *rl++;
	669	dl++ = ll++ \| *rl++;
	670	dl++ = ll++ \| *rl++;
	671	dl++ = ll++ \| *rl++;
	672	}
	673	}
	674
	675	dc = (char*)dl;
	676	lc = (char*)ll;
	677	rc = (char*)rl;
	678
	679	len = remainder;
	680	}
	681	#endif
a0d0e21e	682	{
a0d0e21e	683	switch (optype) {
	684	case OP_BIT_AND:
	685	while (len--)
	686	dc++ = lc++ & *rc++;
	687	break;
	688	case OP_BIT_XOR:
	689	while (len--)
	690	dc++ = lc++ ^ *rc++;
	691	goto mop_up;
	692	case OP_BIT_OR:
	693	while (len--)
	694	dc++ = lc++ \| *rc++;
	695	mop_up:
	696	len = lensave;
	697	if (rightlen > len)
	698	sv_catpvn(sv, rsave + len, rightlen - len);
	699	else if (leftlen > len)
	700	sv_catpvn(sv, lsave + len, leftlen - len);
4633a7c4	701	else
4633a7c4	702	*SvEND(sv) = '\0';
a0d0e21e	703	break;
a0d0e21e	704	}
79072805	705	}
fb73857a	706	SvTAINT(sv);
79072805	707	}
463ee0b2	708
463ee0b2	709	OP *
8ac85365	710	do_kv(ARGSproto)
463ee0b2	711	{
4e35701f	712	djSP;
463ee0b2	713	HV hv = (HV)POPs;
800e9ae0	714	HV *keys;
463ee0b2	715	register HE *entry;
463ee0b2	716	SV *tmpstr;
54310121	717	I32 gimme = GIMME_V;
533c011a	718	I32 dokeys = (PL_op->op_type == OP_KEYS);
533c011a	719	I32 dovalues = (PL_op->op_type == OP_VALUES);
c750a3ec	720	I32 realhv = (SvTYPE(hv) == SVt_PVHV);
c750a3ec	721
533c011a	722	if (PL_op->op_type == OP_RV2HV \|\| PL_op->op_type == OP_PADHV)
a0d0e21e	723	dokeys = dovalues = TRUE;
463ee0b2	724
85581909	725	if (!hv) {
533c011a	726	if (PL_op->op_flags & OPf_MOD) { /* lvalue */
85581909	727	dTARGET; /* make sure to clear its target here */
	728	if (SvTYPE(TARG) == SVt_PVLV)
	729	LvTARG(TARG) = Nullsv;
	730	PUSHs(TARG);
	731	}
463ee0b2	732	RETURN;
85581909	733	}
748a9306	734
800e9ae0	735	keys = realhv ? hv : avhv_keys((AV*)hv);
800e9ae0	736	(void)hv_iterinit(keys); /* always reset iterator regardless */
748a9306	737
54310121	738	if (gimme == G_VOID)
aa689395	739	RETURN;
aa689395	740
54310121	741	if (gimme == G_SCALAR) {
6ee623d5	742	IV i;
463ee0b2	743	dTARGET;
463ee0b2	744
533c011a	745	if (PL_op->op_flags & OPf_MOD) { /* lvalue */
85581909	746	if (SvTYPE(TARG) < SVt_PVLV) {
	747	sv_upgrade(TARG, SVt_PVLV);
	748	sv_magic(TARG, Nullsv, 'k', Nullch, 0);
	749	}
	750	LvTYPE(TARG) = 'k';
800e9ae0	751	if (LvTARG(TARG) != (SV*)keys) {
6ff81951	752	if (LvTARG(TARG))
6ff81951	753	SvREFCNT_dec(LvTARG(TARG));
800e9ae0	754	LvTARG(TARG) = SvREFCNT_inc(keys);
6ff81951	755	}
85581909	756	PUSHs(TARG);
	757	RETURN;
	758	}
	759
800e9ae0	760	if (!SvRMAGICAL(keys) \|\| !mg_find((SV*)keys,'P'))
800e9ae0	761	i = HvKEYS(keys);
463ee0b2	762	else {
463ee0b2	763	i = 0;
463ee0b2	764	/SUPPRESS 560/
800e9ae0	765	while (hv_iternext(keys)) i++;
463ee0b2	766	}
	767	PUSHi( i );
	768	RETURN;
	769	}
	770
8ed4b672	771	EXTEND(SP, HvKEYS(keys) * (dokeys + dovalues));
463ee0b2	772
463ee0b2	773	PUTBACK; /* hv_iternext and hv_iterval might clobber stack_sp */
800e9ae0	774	while (entry = hv_iternext(keys)) {
463ee0b2	775	SPAGAIN;
8c2cee6f	776	if (dokeys)
8c2cee6f	777	XPUSHs(hv_iterkeysv(entry)); /* won't clobber stack_sp */
463ee0b2	778	if (dovalues) {
46fc3d4c	779	tmpstr = sv_newmortal();
463ee0b2	780	PUTBACK;
c750a3ec	781	sv_setsv(tmpstr,realhv ?
c750a3ec	782	hv_iterval(hv,entry) : avhv_iterval((AV*)hv,entry));
46fc3d4c	783	DEBUG_H(sv_setpvf(tmpstr, "%lu%%%d=%lu",
46fc3d4c	784	(unsigned long)HeHASH(entry),
800e9ae0	785	HvMAX(keys)+1,
800e9ae0	786	(unsigned long)(HeHASH(entry) & HvMAX(keys))));
463ee0b2	787	SPAGAIN;
46fc3d4c	788	XPUSHs(tmpstr);
463ee0b2	789	}
	790	PUTBACK;
	791	}
	792	return NORMAL;
	793	}
4e35701f	794