[perl5.git] / doop.c

/*    doop.c
 *
 *    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.
 *
 */

/*
 * "'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

#ifdef BUGGY_MSC
 #pragma function(memcmp)
#endif /* BUGGY_MSC */

#ifdef BUGGY_MSC
 #pragma intrinsic(memcmp)
#endif /* BUGGY_MSC */

I32
do_trans(sv,arg)
SV *sv;
OP *arg;
{
    register short *tbl;
    register char *s;
    register I32 matches = 0;
    register I32 ch;
    register char *send;
    register char *d;
    register I32 squash = op->op_private & OPpTRANS_SQUASH;
    STRLEN len;

    if (SvREADONLY(sv))
	croak(no_modify);
    tbl = (short*) cPVOP->op_pv;
    s = SvPV(sv, len);
    if (!len)
	return 0;
    if (!SvPOKp(sv))
	s = 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 (!op->op_private) {
	while (s < send) {
	    if ((ch = tbl[*s & 0377]) >= 0) {
		matches++;
		*s = ch;
	    }
	    s++;
	}
    }
    else {
	d = s;
	while (s < send) {
	    if ((ch = tbl[*s & 0377]) >= 0) {
		*d = ch;
		if (matches++ && squash) {
		    if (d[-1] == *d)
			matches--;
		    else
			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 - SvPVX(sv));
    }
    SvSETMAGIC(sv);
    return matches;
}

void
do_join(sv,del,mark,sp)
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) {
		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,len,sarg)
register SV *sv;
register I32 len;
register SV **sarg;
{
    register char *s;
    register char *t;
    register char *f;
    bool dolong;
#ifdef HAS_QUAD
    bool doquad;
#endif /* HAS_QUAD */
    char ch;
    register char *send;
    register SV *arg;
    char *xs;
    I32 xlen;
    I32 pre;
    I32 post;
    double value;
    STRLEN arglen;

    sv_setpv(sv,"");
    len--;			/* don't count pattern string */
    t = s = SvPV(*sarg, arglen);	/* XXX Don't know t is writeable */
    send = s + arglen;
    sarg++;
    for ( ; ; len--) {

	/*SUPPRESS 560*/
	if (len <= 0 || !(arg = *sarg++))
	    arg = &sv_no;

	/*SUPPRESS 530*/
	for ( ; t < send && *t != '%'; t++) ;
	if (t >= send)
	    break;		/* end of run_format string, ignore extra args */
	f = t;
	*buf = '\0';
	xs = buf;
#ifdef HAS_QUAD
	doquad =
#endif /* HAS_QUAD */
	dolong = FALSE;
	pre = post = 0;
	for (t++; t < send; t++) {
	    switch (*t) {
	    default:
		ch = *(++t);
		*t = '\0';
		(void)sprintf(xs,f);
		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 'l':
#ifdef HAS_QUAD
		if (dolong) {
		    dolong = FALSE;
		    doquad = TRUE;
		} else
#endif
		dolong = TRUE;
		continue;
	    case 'c':
		ch = *(++t);
		*t = '\0';
		xlen = SvIV(arg);
		if (strEQ(f,"%c")) { /* some printfs fail on null chars */
		    *xs = xlen;
		    xs[1] = '\0';
		    xlen = 1;
		}
		else {
		    (void)sprintf(xs,f,xlen);
		    xlen = strlen(xs);
		}
		break;
	    case 'D':
		dolong = TRUE;
		/* FALL THROUGH */
	    case 'd':
		ch = *(++t);
		*t = '\0';
#ifdef HAS_QUAD
		if (doquad)
		    (void)sprintf(buf,s,(Quad_t)SvNV(arg));
		else
#endif
		if (dolong)
		    (void)sprintf(xs,f,(long)SvNV(arg));
		else
		    (void)sprintf(xs,f,SvIV(arg));
		xlen = strlen(xs);
		break;
	    case 'X': case 'O':
		dolong = TRUE;
		/* FALL THROUGH */
	    case 'x': case 'o': case 'u':
		ch = *(++t);
		*t = '\0';
		value = SvNV(arg);
#ifdef HAS_QUAD
		if (doquad)
		    (void)sprintf(buf,s,(unsigned Quad_t)value);
		else
#endif
		if (dolong)
		    (void)sprintf(xs,f,U_L(value));
		else
		    (void)sprintf(xs,f,U_I(value));
		xlen = strlen(xs);
		break;
	    case 'E': case 'e': case 'f': case 'G': case 'g':
		ch = *(++t);
		*t = '\0';
		(void)sprintf(xs,f,SvNV(arg));
		xlen = strlen(xs);
		break;
	    case 's':
		ch = *(++t);
		*t = '\0';
		xs = SvPV(arg, arglen);
		xlen = (I32)arglen;
		if (strEQ(f,"%s")) {	/* some printfs fail on >128 chars */
		    break;		/* so handle simple cases */
		}
		else if (f[1] == '-') {
		    char *mp = strchr(f, '.');
		    I32 min = atoi(f+2);

		    if (mp) {
			I32 max = atoi(mp+1);

			if (xlen > max)
			    xlen = max;
		    }
		    if (xlen < min)
			post = min - xlen;
		    break;
		}
		else if (isDIGIT(f[1])) {
		    char *mp = strchr(f, '.');
		    I32 min = atoi(f+1);

		    if (mp) {
			I32 max = atoi(mp+1);

			if (xlen > max)
			    xlen = max;
		    }
		    if (xlen < min)
			pre = min - xlen;
		    break;
		}
		strcpy(tokenbuf+64,f);	/* sprintf($s,...$s...) */
		*t = ch;
		(void)sprintf(buf,tokenbuf+64,xs);
		xs = buf;
		xlen = strlen(xs);
		break;
	    }
	    /* end of switch, copy results */
	    *t = ch;
	    SvGROW(sv, SvCUR(sv) + (f - s) + xlen + 1 + pre + post);
	    sv_catpvn(sv, s, f - s);
	    if (pre) {
		repeatcpy(SvPVX(sv) + SvCUR(sv), " ", 1, pre);
		SvCUR(sv) += pre;
	    }
	    sv_catpvn(sv, xs, xlen);
	    if (post) {
		repeatcpy(SvPVX(sv) + SvCUR(sv), " ", 1, post);
		SvCUR(sv) += post;
	    }
	    s = t;
	    break;		/* break from for loop */
	}
    }
    sv_catpvn(sv, s, t - s);
    SvSETMAGIC(sv);
}

void
do_vecset(sv)
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(astr,sv)
register SV *astr;
register SV *sv;
{
    STRLEN len;
    char *s;
    
    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))
		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 (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(sv)
register SV *sv;
{
    register I32 count = 0;
    STRLEN len;
    char *s;
    
    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) {
	    if (*s != '\n')
		goto nope;
	    ++count;
	    while (len && s[-1] == '\n') {
		--len;
		--s;
		++count;
	    }
	}
	else if (rslen == 1) {
	    if (*s != rschar)
		goto nope;
	    ++count;
	} 
	else {
	    if (len < rslen - 1)
		goto nope;
	    len -= rslen - 1;
	    s -= rslen - 1;
	    if (bcmp(s, rs, 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)
I32 optype;
SV *sv;
SV *left;
SV *right;
{
#ifdef LIBERAL
    register long *dl;
    register long *ll;
    register long *rl;
#endif
    register char *dc;
    STRLEN leftlen;
    STRLEN rightlen;
    register char *lc = SvPV(left, leftlen);
    register char *rc = SvPV(right, rightlen);
    register I32 len;
    I32 lensave;

    dc = SvPV_force(sv,na);
    len = leftlen < rightlen ? leftlen : rightlen;
    lensave = len;
    if (SvCUR(sv) < len) {
	dc = SvGROW(sv,len + 1);
	(void)memzero(dc + SvCUR(sv), len - SvCUR(sv) + 1);
    }
    SvCUR_set(sv, len);
    *SvEND(sv) = '\0';
    (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
    {
	char *lsave = lc;
	char *rsave = rc;
	
	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);
	    break;
	}
    }
}

OP *
do_kv(ARGS)
dARGS
{
    dSP;
    HV *hv = (HV*)POPs;
    I32 i;
    register HE *entry;
    char *tmps;
    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) {
	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) {
	    tmps = hv_iterkey(entry,&i);	/* won't clobber stack_sp */
	    if (!i)
		tmps = "";
	    XPUSHs(sv_2mortal(newSVpv(tmps,i)));
	}
	if (dovalues) {
	    tmpstr = NEWSV(45,0);
	    PUTBACK;
	    sv_setsv(tmpstr,hv_iterval(hv,entry));
	    SPAGAIN;
	    DEBUG_H( {
		sprintf(buf,"%d%%%d=%d\n",entry->hent_hash,
		    HvMAX(hv)+1,entry->hent_hash & HvMAX(hv));
		sv_setpv(tmpstr,buf);
	    } )
	    XPUSHs(sv_2mortal(tmpstr));
	}
	PUTBACK;
    }
    return NORMAL;
}
Commit	Line	Data
a0d0e21e	1	/* doop.c
79072805	2	*
a0d0e21e	3	* Copyright (c) 1991-1994, Larry Wall
79072805 LW	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 LW	8	*/
	9
	10	/*
	11	* "'So that was the job I felt I had to do when I started,' thought Sam."
79072805 LW	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	#ifdef BUGGY_MSC
	22	#pragma function(memcmp)
	23	#endif /* BUGGY_MSC */
	24
79072805 LW	25	#ifdef BUGGY_MSC
	26	#pragma intrinsic(memcmp)
	27	#endif /* BUGGY_MSC */
	28
	29	I32
	30	do_trans(sv,arg)
	31	SV *sv;
	32	OP *arg;
	33	{
	34	register short *tbl;
	35	register char *s;
	36	register I32 matches = 0;
	37	register I32 ch;
	38	register char *send;
	39	register char *d;
	40	register I32 squash = op->op_private & OPpTRANS_SQUASH;
463ee0b2	41	STRLEN len;
79072805	42
a0d0e21e LW	43	if (SvREADONLY(sv))
a0d0e21e LW	44	croak(no_modify);
79072805	45	tbl = (short*) cPVOP->op_pv;
463ee0b2	46	s = SvPV(sv, len);
a0d0e21e LW	47	if (!len)
	48	return 0;
	49	if (!SvPOKp(sv))
	50	s = SvPV_force(sv, len);
	51	(void)SvPOK_only(sv);
463ee0b2	52	send = s + len;
79072805	53	if (!tbl \|\| !s)
463ee0b2	54	croak("panic: do_trans");
79072805 LW	55	DEBUG_t( deb("2.TBL\n"));
	56	if (!op->op_private) {
	57	while (s < send) {
	58	if ((ch = tbl[*s & 0377]) >= 0) {
	59	matches++;
	60	*s = ch;
	61	}
	62	s++;
	63	}
	64	}
	65	else {
	66	d = s;
	67	while (s < send) {
	68	if ((ch = tbl[*s & 0377]) >= 0) {
	69	*d = ch;
	70	if (matches++ && squash) {
	71	if (d[-1] == *d)
	72	matches--;
	73	else
	74	d++;
	75	}
	76	else
	77	d++;
	78	}
	79	else if (ch == -1) /* -1 is unmapped character */
	80	d++ = s; /* -2 is delete character */
	81	s++;
	82	}
	83	matches += send - d; /* account for disappeared chars */
	84	*d = '\0';
463ee0b2	85	SvCUR_set(sv, d - SvPVX(sv));
79072805 LW	86	}
	87	SvSETMAGIC(sv);
	88	return matches;
	89	}
	90
	91	void
	92	do_join(sv,del,mark,sp)
	93	register SV *sv;
	94	SV *del;
	95	register SV **mark;
	96	register SV **sp;
	97	{
	98	SV **oldmark = mark;
	99	register I32 items = sp - mark;
79072805	100	register STRLEN len;
463ee0b2 LW	101	STRLEN delimlen;
	102	register char *delim = SvPV(del, delimlen);
	103	STRLEN tmplen;
79072805 LW	104
	105	mark++;
	106	len = (items > 0 ? (delimlen * (items - 1) ) : 0);
	107	if (SvTYPE(sv) < SVt_PV)
	108	sv_upgrade(sv, SVt_PV);
	109	if (SvLEN(sv) < len + items) { /* current length is way too short */
	110	while (items-- > 0) {
	111	if (*mark) {
463ee0b2 LW	112	SvPV(*mark, tmplen);
463ee0b2 LW	113	len += tmplen;
79072805 LW	114	}
	115	mark++;
	116	}
	117	SvGROW(sv, len + 1); /* so try to pre-extend */
	118
	119	mark = oldmark;
	120	items = sp - mark;;
	121	++mark;
	122	}
	123
463ee0b2	124	if (items-- > 0) {
8990e307 LW	125	char *s;
	126
	127	if (*mark) {
	128	s = SvPV(*mark, tmplen);
	129	sv_setpvn(sv, s, tmplen);
	130	}
	131	else
	132	sv_setpv(sv, "");
463ee0b2 LW	133	mark++;
463ee0b2 LW	134	}
79072805 LW	135	else
	136	sv_setpv(sv,"");
	137	len = delimlen;
	138	if (len) {
	139	for (; items > 0; items--,mark++) {
	140	sv_catpvn(sv,delim,len);
	141	sv_catsv(sv,*mark);
	142	}
	143	}
	144	else {
	145	for (; items > 0; items--,mark++)
	146	sv_catsv(sv,*mark);
	147	}
	148	SvSETMAGIC(sv);
	149	}
	150
	151	void
	152	do_sprintf(sv,len,sarg)
	153	register SV *sv;
	154	register I32 len;
	155	register SV **sarg;
	156	{
	157	register char *s;
	158	register char *t;
	159	register char *f;
	160	bool dolong;
ecfc5424	161	#ifdef HAS_QUAD
79072805	162	bool doquad;
ecfc5424	163	#endif /* HAS_QUAD */
79072805 LW	164	char ch;
	165	register char *send;
	166	register SV *arg;
	167	char *xs;
	168	I32 xlen;
	169	I32 pre;
	170	I32 post;
	171	double value;
463ee0b2	172	STRLEN arglen;
79072805 LW	173
	174	sv_setpv(sv,"");
	175	len--; /* don't count pattern string */
a0d0e21e	176	t = s = SvPV(sarg, arglen); / XXX Don't know t is writeable */
463ee0b2	177	send = s + arglen;
79072805 LW	178	sarg++;
	179	for ( ; ; len--) {
	180
	181	/SUPPRESS 560/
	182	if (len <= 0 \|\| !(arg = *sarg++))
	183	arg = &sv_no;
	184
	185	/SUPPRESS 530/
	186	for ( ; t < send && *t != '%'; t++) ;
	187	if (t >= send)
	188	break; /* end of run_format string, ignore extra args */
	189	f = t;
	190	*buf = '\0';
	191	xs = buf;
ecfc5424	192	#ifdef HAS_QUAD
79072805	193	doquad =
ecfc5424	194	#endif /* HAS_QUAD */
79072805 LW	195	dolong = FALSE;
	196	pre = post = 0;
	197	for (t++; t < send; t++) {
	198	switch (*t) {
	199	default:
	200	ch = *(++t);
	201	*t = '\0';
	202	(void)sprintf(xs,f);
	203	len++, sarg--;
	204	xlen = strlen(xs);
	205	break;
748a9306 LW	206	case 'n': case '*':
	207	croak("Use of %c in printf format not supported", *t);
	208
79072805 LW	209	case '0': case '1': case '2': case '3': case '4':
	210	case '5': case '6': case '7': case '8': case '9':
	211	case '.': case '#': case '-': case '+': case ' ':
	212	continue;
463ee0b2	213	case 'l':
ecfc5424	214	#ifdef HAS_QUAD
79072805 LW	215	if (dolong) {
	216	dolong = FALSE;
	217	doquad = TRUE;
	218	} else
	219	#endif
	220	dolong = TRUE;
	221	continue;
	222	case 'c':
	223	ch = *(++t);
	224	*t = '\0';
463ee0b2	225	xlen = SvIV(arg);
79072805 LW	226	if (strEQ(f,"%c")) { /* some printfs fail on null chars */
	227	*xs = xlen;
	228	xs[1] = '\0';
	229	xlen = 1;
	230	}
	231	else {
	232	(void)sprintf(xs,f,xlen);
	233	xlen = strlen(xs);
	234	}
	235	break;
	236	case 'D':
	237	dolong = TRUE;
	238	/* FALL THROUGH */
	239	case 'd':
	240	ch = *(++t);
	241	*t = '\0';
ecfc5424	242	#ifdef HAS_QUAD
79072805	243	if (doquad)
ecfc5424	244	(void)sprintf(buf,s,(Quad_t)SvNV(arg));
79072805 LW	245	else
	246	#endif
	247	if (dolong)
463ee0b2	248	(void)sprintf(xs,f,(long)SvNV(arg));
79072805	249	else
463ee0b2	250	(void)sprintf(xs,f,SvIV(arg));
79072805 LW	251	xlen = strlen(xs);
	252	break;
	253	case 'X': case 'O':
	254	dolong = TRUE;
	255	/* FALL THROUGH */
	256	case 'x': case 'o': case 'u':
	257	ch = *(++t);
	258	*t = '\0';
463ee0b2	259	value = SvNV(arg);
ecfc5424	260	#ifdef HAS_QUAD
79072805	261	if (doquad)
ecfc5424	262	(void)sprintf(buf,s,(unsigned Quad_t)value);
79072805 LW	263	else
	264	#endif
	265	if (dolong)
	266	(void)sprintf(xs,f,U_L(value));
	267	else
	268	(void)sprintf(xs,f,U_I(value));
	269	xlen = strlen(xs);
	270	break;
	271	case 'E': case 'e': case 'f': case 'G': case 'g':
	272	ch = *(++t);
	273	*t = '\0';
463ee0b2	274	(void)sprintf(xs,f,SvNV(arg));
79072805 LW	275	xlen = strlen(xs);
	276	break;
	277	case 's':
	278	ch = *(++t);
	279	*t = '\0';
463ee0b2 LW	280	xs = SvPV(arg, arglen);
463ee0b2 LW	281	xlen = (I32)arglen;
79072805 LW	282	if (strEQ(f,"%s")) { /* some printfs fail on >128 chars */
	283	break; /* so handle simple cases */
	284	}
	285	else if (f[1] == '-') {
93a17b20	286	char *mp = strchr(f, '.');
79072805 LW	287	I32 min = atoi(f+2);
	288
	289	if (mp) {
	290	I32 max = atoi(mp+1);
	291
	292	if (xlen > max)
	293	xlen = max;
	294	}
	295	if (xlen < min)
	296	post = min - xlen;
	297	break;
	298	}
	299	else if (isDIGIT(f[1])) {
93a17b20	300	char *mp = strchr(f, '.');
79072805 LW	301	I32 min = atoi(f+1);
	302
	303	if (mp) {
	304	I32 max = atoi(mp+1);
	305
	306	if (xlen > max)
	307	xlen = max;
	308	}
	309	if (xlen < min)
	310	pre = min - xlen;
	311	break;
	312	}
	313	strcpy(tokenbuf+64,f); /* sprintf($s,...$s...) */
	314	*t = ch;
	315	(void)sprintf(buf,tokenbuf+64,xs);
	316	xs = buf;
	317	xlen = strlen(xs);
	318	break;
	319	}
	320	/* end of switch, copy results */
	321	*t = ch;
	322	SvGROW(sv, SvCUR(sv) + (f - s) + xlen + 1 + pre + post);
	323	sv_catpvn(sv, s, f - s);
	324	if (pre) {
463ee0b2	325	repeatcpy(SvPVX(sv) + SvCUR(sv), " ", 1, pre);
79072805 LW	326	SvCUR(sv) += pre;
	327	}
	328	sv_catpvn(sv, xs, xlen);
	329	if (post) {
463ee0b2	330	repeatcpy(SvPVX(sv) + SvCUR(sv), " ", 1, post);
79072805 LW	331	SvCUR(sv) += post;
	332	}
	333	s = t;
	334	break; /* break from for loop */
	335	}
	336	}
	337	sv_catpvn(sv, s, t - s);
	338	SvSETMAGIC(sv);
	339	}
	340
	341	void
	342	do_vecset(sv)
	343	SV *sv;
	344	{
	345	SV *targ = LvTARG(sv);
	346	register I32 offset;
	347	register I32 size;
8990e307 LW	348	register unsigned char *s;
8990e307 LW	349	register unsigned long lval;
79072805	350	I32 mask;
a0d0e21e LW	351	STRLEN targlen;
a0d0e21e LW	352	STRLEN len;
79072805	353
8990e307 LW	354	if (!targ)
8990e307 LW	355	return;
a0d0e21e	356	s = (unsigned char*)SvPV_force(targ, targlen);
8990e307	357	lval = U_L(SvNV(sv));
79072805 LW	358	offset = LvTARGOFF(sv);
79072805 LW	359	size = LvTARGLEN(sv);
a0d0e21e LW	360
	361	len = (offset + size + 7) / 8;
	362	if (len > targlen) {
	363	s = (unsigned char*)SvGROW(targ, len + 1);
	364	(void)memzero(s + targlen, len - targlen + 1);
	365	SvCUR_set(targ, len);
	366	}
	367
79072805 LW	368	if (size < 8) {
	369	mask = (1 << size) - 1;
	370	size = offset & 7;
	371	lval &= mask;
	372	offset >>= 3;
	373	s[offset] &= ~(mask << size);
	374	s[offset] \|= lval << size;
	375	}
	376	else {
a0d0e21e	377	offset >>= 3;
79072805 LW	378	if (size == 8)
	379	s[offset] = lval & 255;
	380	else if (size == 16) {
	381	s[offset] = (lval >> 8) & 255;
	382	s[offset+1] = lval & 255;
	383	}
	384	else if (size == 32) {
	385	s[offset] = (lval >> 24) & 255;
	386	s[offset+1] = (lval >> 16) & 255;
	387	s[offset+2] = (lval >> 8) & 255;
	388	s[offset+3] = lval & 255;
	389	}
	390	}
	391	}
	392
	393	void
	394	do_chop(astr,sv)
	395	register SV *astr;
	396	register SV *sv;
	397	{
463ee0b2	398	STRLEN len;
a0d0e21e LW	399	char *s;
a0d0e21e LW	400
79072805	401	if (SvTYPE(sv) == SVt_PVAV) {
a0d0e21e LW	402	register I32 i;
	403	I32 max;
	404	AV* av = (AV*)sv;
	405	max = AvFILL(av);
	406	for (i = 0; i <= max; i++) {
	407	sv = (SV*)av_fetch(av, i, FALSE);
	408	if (sv && ((sv = (SV*)sv), sv != &sv_undef))
	409	do_chop(astr, sv);
	410	}
	411	return;
79072805 LW	412	}
79072805 LW	413	if (SvTYPE(sv) == SVt_PVHV) {
a0d0e21e LW	414	HV* hv = (HV*)sv;
	415	HE* entry;
	416	(void)hv_iterinit(hv);
	417	/SUPPRESS 560/
	418	while (entry = hv_iternext(hv))
	419	do_chop(astr,hv_iterval(hv,entry));
	420	return;
79072805	421	}
a0d0e21e	422	s = SvPV(sv, len);
748a9306	423	if (len && !SvPOK(sv))
a0d0e21e LW	424	s = SvPV_force(sv, len);
	425	if (s && len) {
	426	s += --len;
	427	sv_setpvn(astr, s, 1);
	428	*s = '\0';
	429	SvCUR_set(sv, len);
	430	SvNIOK_off(sv);
79072805 LW	431	}
79072805 LW	432	else
a0d0e21e LW	433	sv_setpvn(astr, "", 0);
	434	SvSETMAGIC(sv);
	435	}
	436
	437	I32
	438	do_chomp(sv)
	439	register SV *sv;
	440	{
	441	register I32 count = 0;
	442	STRLEN len;
	443	char *s;
	444
	445	if (SvTYPE(sv) == SVt_PVAV) {
	446	register I32 i;
	447	I32 max;
	448	AV* av = (AV*)sv;
	449	max = AvFILL(av);
	450	for (i = 0; i <= max; i++) {
	451	sv = (SV*)av_fetch(av, i, FALSE);
	452	if (sv && ((sv = (SV*)sv), sv != &sv_undef))
	453	count += do_chomp(sv);
	454	}
	455	return count;
	456	}
	457	if (SvTYPE(sv) == SVt_PVHV) {
	458	HV* hv = (HV*)sv;
	459	HE* entry;
	460	(void)hv_iterinit(hv);
	461	/SUPPRESS 560/
	462	while (entry = hv_iternext(hv))
	463	count += do_chomp(hv_iterval(hv,entry));
	464	return count;
	465	}
	466	s = SvPV(sv, len);
	467	if (len && !SvPOKp(sv))
	468	s = SvPV_force(sv, len);
	469	if (s && len) {
	470	s += --len;
	471	if (rspara) {
	472	if (*s != '\n')
	473	goto nope;
	474	++count;
	475	while (len && s[-1] == '\n') {
	476	--len;
	477	--s;
	478	++count;
	479	}
	480	}
	481	else if (rslen == 1) {
	482	if (*s != rschar)
	483	goto nope;
	484	++count;
	485	}
	486	else {
	487	if (len < rslen - 1)
	488	goto nope;
	489	len -= rslen - 1;
	490	s -= rslen - 1;
	491	if (bcmp(s, rs, rslen))
	492	goto nope;
	493	count += rslen;
	494	}
	495
	496	*s = '\0';
497	SvCUR_set(sv, len);
498	SvNIOK_off(sv);
499	}
500	nope:
501	SvSETMAGIC(sv);
502	return count;
503	}
79072805 LW	504
	505	void
	506	do_vop(optype,sv,left,right)
	507	I32 optype;
	508	SV *sv;
	509	SV *left;
	510	SV *right;
	511	{
	512	#ifdef LIBERAL
	513	register long *dl;
	514	register long *ll;
	515	register long *rl;
	516	#endif
	517	register char *dc;
463ee0b2 LW	518	STRLEN leftlen;
	519	STRLEN rightlen;
	520	register char *lc = SvPV(left, leftlen);
	521	register char *rc = SvPV(right, rightlen);
79072805	522	register I32 len;
a0d0e21e	523	I32 lensave;
79072805	524
a0d0e21e	525	dc = SvPV_force(sv,na);
93a17b20	526	len = leftlen < rightlen ? leftlen : rightlen;
a0d0e21e LW	527	lensave = len;
	528	if (SvCUR(sv) < len) {
	529	dc = SvGROW(sv,len + 1);
	530	(void)memzero(dc + SvCUR(sv), len - SvCUR(sv) + 1);
79072805	531	}
a0d0e21e	532	SvCUR_set(sv, len);
748a9306	533	*SvEND(sv) = '\0';
a0d0e21e	534	(void)SvPOK_only(sv);
79072805 LW	535	#ifdef LIBERAL
	536	if (len >= sizeof(long)*4 &&
	537	!((long)dc % sizeof(long)) &&
	538	!((long)lc % sizeof(long)) &&
	539	!((long)rc % sizeof(long))) /* It's almost always aligned... */
	540	{
	541	I32 remainder = len % (sizeof(long)*4);
	542	len /= (sizeof(long)*4);
	543
	544	dl = (long*)dc;
	545	ll = (long*)lc;
	546	rl = (long*)rc;
	547
	548	switch (optype) {
	549	case OP_BIT_AND:
	550	while (len--) {
	551	dl++ = ll++ & *rl++;
	552	dl++ = ll++ & *rl++;
	553	dl++ = ll++ & *rl++;
	554	dl++ = ll++ & *rl++;
	555	}
	556	break;
a0d0e21e	557	case OP_BIT_XOR:
79072805 LW	558	while (len--) {
	559	dl++ = ll++ ^ *rl++;
	560	dl++ = ll++ ^ *rl++;
	561	dl++ = ll++ ^ *rl++;
	562	dl++ = ll++ ^ *rl++;
	563	}
	564	break;
	565	case OP_BIT_OR:
	566	while (len--) {
	567	dl++ = ll++ \| *rl++;
	568	dl++ = ll++ \| *rl++;
	569	dl++ = ll++ \| *rl++;
	570	dl++ = ll++ \| *rl++;
	571	}
	572	}
	573
	574	dc = (char*)dl;
	575	lc = (char*)ll;
	576	rc = (char*)rl;
	577
	578	len = remainder;
	579	}
	580	#endif
a0d0e21e LW	581	{
	582	char *lsave = lc;
	583	char *rsave = rc;
	584
	585	switch (optype) {
	586	case OP_BIT_AND:
	587	while (len--)
	588	dc++ = lc++ & *rc++;
	589	break;
	590	case OP_BIT_XOR:
	591	while (len--)
	592	dc++ = lc++ ^ *rc++;
	593	goto mop_up;
	594	case OP_BIT_OR:
	595	while (len--)
	596	dc++ = lc++ \| *rc++;
	597	mop_up:
	598	len = lensave;
	599	if (rightlen > len)
	600	sv_catpvn(sv, rsave + len, rightlen - len);
	601	else if (leftlen > len)
	602	sv_catpvn(sv, lsave + len, leftlen - len);
	603	break;
	604	}
79072805 LW	605	}
79072805 LW	606	}
463ee0b2 LW	607
	608	OP *
	609	do_kv(ARGS)
	610	dARGS
	611	{
	612	dSP;
	613	HV hv = (HV)POPs;
463ee0b2 LW	614	I32 i;
	615	register HE *entry;
	616	char *tmps;
	617	SV *tmpstr;
a0d0e21e LW	618	I32 dokeys = (op->op_type == OP_KEYS);
	619	I32 dovalues = (op->op_type == OP_VALUES);
	620
	621	if (op->op_type == OP_RV2HV \|\| op->op_type == OP_PADHV)
	622	dokeys = dovalues = TRUE;
463ee0b2 LW	623
	624	if (!hv)
	625	RETURN;
748a9306 LW	626
	627	(void)hv_iterinit(hv); /* always reset iterator regardless */
	628
463ee0b2 LW	629	if (GIMME != G_ARRAY) {
	630	dTARGET;
	631
8990e307	632	if (!SvRMAGICAL(hv) \|\| !mg_find((SV*)hv,'P'))
463ee0b2 LW	633	i = HvKEYS(hv);
	634	else {
	635	i = 0;
463ee0b2 LW	636	/SUPPRESS 560/
	637	while (entry = hv_iternext(hv)) {
	638	i++;
	639	}
	640	}
	641	PUSHi( i );
	642	RETURN;
	643	}
	644
	645	/* Guess how much room we need. hv_max may be a few too many. Oh well. */
	646	EXTEND(sp, HvMAX(hv) * (dokeys + dovalues));
	647
463ee0b2 LW	648	PUTBACK; /* hv_iternext and hv_iterval might clobber stack_sp */
	649	while (entry = hv_iternext(hv)) {
	650	SPAGAIN;
	651	if (dokeys) {
	652	tmps = hv_iterkey(entry,&i); /* won't clobber stack_sp */
	653	if (!i)
	654	tmps = "";
	655	XPUSHs(sv_2mortal(newSVpv(tmps,i)));
	656	}
	657	if (dovalues) {
	658	tmpstr = NEWSV(45,0);
	659	PUTBACK;
	660	sv_setsv(tmpstr,hv_iterval(hv,entry));
	661	SPAGAIN;
	662	DEBUG_H( {
	663	sprintf(buf,"%d%%%d=%d\n",entry->hent_hash,
	664	HvMAX(hv)+1,entry->hent_hash & HvMAX(hv));
	665	sv_setpv(tmpstr,buf);
	666	} )
	667	XPUSHs(sv_2mortal(tmpstr));
	668	}
	669	PUTBACK;
	670	}
	671	return NORMAL;
	672	}
	673