/* $RCSfile: doarg.c,v $$Revision: 4.1 $$Date: 92/08/07 17:19:37 $
 *
 *    Copyright (c) 1991, 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.
 * 
 */

#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 */

static void doencodes();

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

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

    tbl = (short*) cPVOP->op_pv;
    s = SvPV(sv);
    send = s + sv->sv_cur;
    if (!tbl || !s)
	fatal("panic: do_trans");
#ifdef DEBUGGING
    if (debug & 8) {
	deb("2.TBL\n");
    }
#endif
    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';
	sv->sv_cur = d - sv->sv_ptr;
    }
    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 int items = sp - mark;
    register char *delim = SvPV(del);
    register STRLEN len;
    int delimlen = del->sv_cur;

    mark++;
    len = (items > 0 ? (delimlen * (items - 1) ) : 0);
    if (sv->sv_len < len + items) {	/* current length is way too short */
	while (items-- > 0) {
	    if (*mark)
		len += (*mark)->sv_cur;
	    mark++;
	}
	SvGROW(sv, len + 1);		/* so try to pre-extend */

	mark = oldmark;
	items = sp - mark;;
	++mark;
    }

    if (items-- > 0)
	sv_setsv(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,numargs,firstarg)
register SV *sv;
int numargs;
SV **firstarg;
{
    register char *s;
    register char *t;
    register char *f;
    register int argix = 0;
    register SV **sarg = firstarg;
    bool dolong;
#ifdef QUAD
    bool doquad;
#endif /* QUAD */
    char ch;
    register char *send;
    register SV *arg;
    char *xs;
    int xlen;
    int pre;
    int post;
    double value;

    sv_setpv(sv,"");
    len--;			/* don't count pattern string */
    t = s = SvPV(*sarg);
    send = s + (*sarg)->sv_cur;
    sarg++;
    for ( ; ; argix++) {

	/*SUPPRESS 530*/
	for ( ; t < send && *t != '%'; t++) ;
	if (t >= send)
	    break;		/* end of run_format string, ignore extra args */
	f = t;
	if (t[2] == '$' && isDIGIT(t[1])) {
	    ch = *(++t);
	    *t = '\0';
	    (void)sprintf(xs,t);
	    sv_catpvn(sv, xs, xlen);
	    argix = atoi(t+1);
	    sarg = firstarg + argix;
	    t[2] = '%';
	    f += 2;

	}
	/*SUPPRESS 560*/
	if (argix > numargs || !(arg = *sarg++))
	    arg = &sv_no;

	*buf = '\0';
	xs = buf;
#ifdef QUAD
	doquad =
#endif /* QUAD */
	dolong = FALSE;
	pre = post = 0;
	for (t++; t < send; t++) {
	    switch (*t) {
	    default:
		ch = *(++t);
		*t = '\0';
		(void)sprintf(xs,f);
		argix--, sarg--;
		xlen = strlen(xs);
		break;
	    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 QUAD
		if (dolong) {
		    dolong = FALSE;
		    doquad = TRUE;
		} else
#endif
		dolong = TRUE;
		continue;
	    case 'c':
		ch = *(++t);
		*t = '\0';
		xlen = (int)SvNV(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 QUAD
		if (doquad)
		    (void)sprintf(buf,s,(quad)SvNV(arg));
		else
#endif
		if (dolong)
		    (void)sprintf(xs,f,(long)SvNV(arg));
		else
		    (void)sprintf(xs,f,(int)SvNV(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 QUAD
		if (doquad)
		    (void)sprintf(buf,s,(unsigned quad)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);
		xlen = arg->sv_cur;
		if (*xs == 'S' && xs[1] == 't' && xs[2] == 'B' && xs[3] == '\0'
		  && xlen == sizeof(GP)) {
		    SV *tmpstr = NEWSV(24,0);

		    gv_efullname(tmpstr, ((GV*)arg)); /* a gv value! */
		    sprintf(tokenbuf,"*%s",tmpstr->sv_ptr);
					/* reformat to non-binary */
		    xs = tokenbuf;
		    xlen = strlen(tokenbuf);
		    sv_free(tmpstr);
		}
		if (strEQ(f,"%s")) {	/* some printfs fail on >128 chars */
		    break;		/* so handle simple cases */
		}
		else if (f[1] == '-') {
		    char *mp = index(f, '.');
		    int min = atoi(f+2);

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

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

		    if (mp) {
			int 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, sv->sv_cur + (f - s) + xlen + 1 + pre + post);
	    sv_catpvn(sv, s, f - s);
	    if (pre) {
		repeatcpy(sv->sv_ptr + sv->sv_cur, " ", 1, pre);
		sv->sv_cur += pre;
	    }
	    sv_catpvn(sv, xs, xlen);
	    if (post) {
		repeatcpy(sv->sv_ptr + sv->sv_cur, " ", 1, post);
		sv->sv_cur += post;
	    }
	    s = t;
	    break;		/* break from for loop */
	}
    }
    sv_catpvn(sv, s, t - s);
    SvSETMAGIC(sv);
}

void
do_vecset(mstr,sv)
SV *mstr;
SV *sv;
{
    struct lstring *lstr = (struct lstring*)sv;
    register int offset;
    register int size;
    register unsigned char *s = (unsigned char*)mstr->sv_ptr;
    register unsigned long lval = U_L(SvNV(sv));
    int mask;

    mstr->sv_rare = 0;
    sv->sv_magic = Nullsv;
    offset = lstr->lstr_offset;
    size = lstr->lstr_len;
    if (size < 8) {
	mask = (1 << size) - 1;
	size = offset & 7;
	lval &= mask;
	offset >>= 3;
	s[offset] &= ~(mask << size);
	s[offset] |= lval << size;
    }
    else {
	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;
{
    register char *tmps;
    register int i;
    AV *ary;
    HV *hash;
    HE *entry;

    if (!sv)
	return;
    if (sv->sv_state == SVs_AV) {
	ary = (AV*)sv;
	for (i = 0; i <= ary->av_fill; i++)
	    do_chop(astr,ary->av_array[i]);
	return;
    }
    if (sv->sv_state == SVs_HV) {
	hash = (HV*)sv;
	(void)hv_iterinit(hash);
	/*SUPPRESS 560*/
	while (entry = hv_iternext(hash))
	    do_chop(astr,hv_iterval(hash,entry));
	return;
    }
    tmps = SvPV(sv);
    if (tmps && sv->sv_cur) {
	tmps += sv->sv_cur - 1;
	sv_setpvn(astr,tmps,1);	/* remember last char */
	*tmps = '\0';				/* wipe it out */
	sv->sv_cur = tmps - sv->sv_ptr;
	sv->sv_nok = 0;
	SvSETMAGIC(sv);
    }
    else
	sv_setpvn(astr,"",0);
}

void
do_vop(optype,sv,left,right)
int optype;
SV *sv;
SV *left;
SV *right;
{
#ifdef LIBERAL
    register long *dl;
    register long *ll;
    register long *rl;
#endif
    register char *dc;
    register char *lc = SvPV(left);
    register char *rc = SvPV(right);
    register int len;

    len = left->sv_cur;
    if (len > right->sv_cur)
	len = right->sv_cur;
    if (sv->sv_cur > len)
	sv->sv_cur = len;
    else if (sv->sv_cur < len) {
	SvGROW(sv,len);
	(void)memzero(sv->sv_ptr + sv->sv_cur, len - sv->sv_cur);
	sv->sv_cur = len;
    }
    sv->sv_pok = 1;
    sv->sv_nok = 0;
    dc = sv->sv_ptr;
    if (!dc) {
	sv_setpvn(sv,"",0);
	dc = sv->sv_ptr;
    }
#ifdef LIBERAL
    if (len >= sizeof(long)*4 &&
	!((long)dc % sizeof(long)) &&
	!((long)lc % sizeof(long)) &&
	!((long)rc % sizeof(long)))	/* It's almost always aligned... */
    {
	int 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_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_XOR:
	while (len--)
	    *dc++ = *lc++ ^ *rc++;
	goto mop_up;
    case OP_BIT_OR:
	while (len--)
	    *dc++ = *lc++ | *rc++;
      mop_up:
	len = sv->sv_cur;
	if (right->sv_cur > len)
	    sv_catpvn(sv,right->sv_ptr+len,right->sv_cur - len);
	else if (left->sv_cur > len)
	    sv_catpvn(sv,left->sv_ptr+len,left->sv_cur - len);
	break;
    }
}