-/* $Header: doarg.c,v 3.0.1.1 89/11/11 04:17:20 lwall Locked $
+/* $RCSfile: doarg.c,v $$Revision: 4.0.1.4 $$Date: 91/11/05 16:35:06 $
*
- * Copyright (c) 1989, Larry Wall
+ * Copyright (c) 1991, Larry Wall
*
- * You may distribute under the terms of the GNU General Public License
- * as specified in the README file that comes with the perl 3.0 kit.
+ * 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 3.0.1.1 89/11/11 04:17:20 lwall
- * patch2: printf %c, %D, %X and %O didn't work right
- * patch2: printf of unsigned vs signed needed separate casts on some machines
+ * 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 3.0 89/10/18 15:10:41 lwall
- * 3.0 baseline
+ * 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
extern unsigned char fold[];
-int wantarray;
+#ifdef BUGGY_MSC
+ #pragma function(memcmp)
+#endif /* BUGGY_MSC */
int
do_subst(str,arg,sp)
register char *d;
int clen;
int iters = 0;
+ int maxiters = (strend - s) + 10;
register int i;
bool once;
char *orig;
(void)eval(spat->spat_runtime,G_SCALAR,sp);
m = str_get(dstr = stack->ary_array[sp+1]);
nointrp = "";
- if (spat->spat_regexp)
+ if (spat->spat_regexp) {
regfree(spat->spat_regexp);
+ spat->spat_regexp = Null(REGEXP*); /* required if regcomp pukes */
+ }
spat->spat_regexp = regcomp(m,m+dstr->str_cur,
- spat->spat_flags & SPAT_FOLD,1);
+ spat->spat_flags & SPAT_FOLD);
if (spat->spat_flags & SPAT_KEEP) {
+ scanconst(spat, m, dstr->str_cur);
arg_free(spat->spat_runtime); /* it won't change, so */
spat->spat_runtime = Nullarg; /* no point compiling again */
+ hoistmust(spat);
+ if (curcmd->c_expr && (curcmd->c_flags & CF_OPTIMIZE) == CFT_EVAL) {
+ curcmd->c_flags &= ~CF_OPTIMIZE;
+ opt_arg(curcmd, 1, curcmd->c_type == C_EXPR);
+ }
}
}
#ifdef DEBUGGING
#endif
safebase = ((!spat->spat_regexp || !spat->spat_regexp->nparens) &&
!sawampersand);
- if (!*spat->spat_regexp->precomp && lastspat)
+ if (!spat->spat_regexp->prelen && lastspat)
spat = lastspat;
orig = m = s;
if (hint) {
spat->spat_short = Nullstr; /* opt is being useless */
}
}
- once = ((rspat->spat_flags & SPAT_ONCE) != 0);
+ once = !(rspat->spat_flags & SPAT_GLOBAL);
if (rspat->spat_flags & SPAT_CONST) { /* known replacement string? */
if ((rspat->spat_repl[1].arg_type & A_MASK) == A_SINGLE)
dstr = rspat->spat_repl[1].arg_ptr.arg_str;
}
c = str_get(dstr);
clen = dstr->str_cur;
- if (clen <= spat->spat_slen + spat->spat_regexp->regback) {
+ if (clen <= spat->spat_regexp->minlen) {
/* can do inplace substitution */
- if (regexec(spat->spat_regexp, s, strend, orig, 1,
+ if (regexec(spat->spat_regexp, s, strend, orig, 0,
str->str_pok & SP_STUDIED ? str : Nullstr, safebase)) {
if (spat->spat_regexp->subbase) /* oops, no we can't */
goto long_way;
stack->ary_array[++sp] = arg->arg_ptr.arg_str;
return sp;
}
+ /*SUPPRESS 560*/
else if (i = m - s) { /* faster from front */
d -= clen;
m = d;
/* NOTREACHED */
}
do {
- if (iters++ > 10000)
+ if (iters++ > maxiters)
fatal("Substitution loop");
m = spat->spat_regexp->startp[0];
+ /*SUPPRESS 560*/
if (i = m - s) {
if (s != d)
(void)bcopy(s,d,i);
d += clen;
}
s = spat->spat_regexp->endp[0];
- } while (regexec(spat->spat_regexp, s, strend, orig, 1, Nullstr,
- TRUE));
+ } while (regexec(spat->spat_regexp, s, strend, orig, s == m,
+ Nullstr, TRUE)); /* (don't match same null twice) */
if (s != d) {
i = strend - s;
str->str_cur = d - str->str_ptr + i;
}
else
c = Nullch;
- if (regexec(spat->spat_regexp, s, strend, orig, 1,
+ if (regexec(spat->spat_regexp, s, strend, orig, 0,
str->str_pok & SP_STUDIED ? str : Nullstr, safebase)) {
long_way:
dstr = Str_new(25,str_len(str));
curspat = spat;
lastspat = spat;
do {
- if (iters++ > 10000)
+ if (iters++ > maxiters)
fatal("Substitution loop");
if (spat->spat_regexp->subbase
&& spat->spat_regexp->subbase != orig) {
str_ncat(dstr,c,clen);
}
else {
+ char *mysubbase = spat->spat_regexp->subbase;
+
+ spat->spat_regexp->subbase = Nullch; /* so recursion works */
(void)eval(rspat->spat_repl,G_SCALAR,sp);
str_scat(dstr,stack->ary_array[sp+1]);
+ if (spat->spat_regexp->subbase)
+ Safefree(spat->spat_regexp->subbase);
+ spat->spat_regexp->subbase = mysubbase;
}
if (once)
break;
- } while (regexec(spat->spat_regexp, s, strend, orig, 1, Nullstr,
+ } while (regexec(spat->spat_regexp, s, strend, orig, s == m, Nullstr,
safebase));
str_ncat(dstr,s,strend - s);
str_replace(str,dstr);
stack->ary_array[++sp] = arg->arg_ptr.arg_str;
return sp;
}
+#ifdef BUGGY_MSC
+ #pragma intrinsic(memcmp)
+#endif /* BUGGY_MSC */
int
do_trans(str,arg)
STR *str;
-register ARG *arg;
+ARG *arg;
{
- register char *tbl;
+ register short *tbl;
register char *s;
register int matches = 0;
register int ch;
register char *send;
+ register char *d;
+ register int squash = arg[2].arg_len & 1;
- tbl = arg[2].arg_ptr.arg_cval;
+ tbl = (short*) arg[2].arg_ptr.arg_cval;
s = str_get(str);
send = s + str->str_cur;
if (!tbl || !s)
deb("2.TBL\n");
}
#endif
- while (s < send) {
- if (ch = tbl[*s & 0377]) {
- matches++;
- *s = ch;
+ if (!arg[2].arg_len) {
+ while (s < send) {
+ if ((ch = tbl[*s & 0377]) >= 0) {
+ matches++;
+ *s = ch;
+ }
+ s++;
}
- 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';
+ str->str_cur = d - str->str_ptr;
}
STABSET(str);
return matches;
st += ++sp;
if (items-- > 0)
- str_sset(str,*st++);
+ str_sset(str, *st++);
else
str_set(str,"");
- for (; items > 0; items--,st++) {
- str_ncat(str,delim,delimlen);
- str_scat(str,*st);
+ if (delimlen) {
+ for (; items > 0; items--,st++) {
+ str_ncat(str,delim,delimlen);
+ str_scat(str,*st);
+ }
+ }
+ else {
+ for (; items > 0; items--,st++)
+ str_scat(str,*st);
}
STABSET(str);
}
register int len;
int datumtype;
STR *fromstr;
+ /*SUPPRESS 442*/
static char *null10 = "\0\0\0\0\0\0\0\0\0\0";
static char *space10 = " ";
char achar;
short ashort;
int aint;
+ unsigned int auint;
long along;
+ unsigned long aulong;
+#ifdef QUAD
+ quad aquad;
+ unsigned quad auquad;
+#endif
char *aptr;
+ float afloat;
+ double adouble;
items = arglast[2] - sp;
st += ++sp;
while (pat < patend) {
#define NEXTFROM (items-- > 0 ? *st++ : &str_no)
datumtype = *pat++;
- if (isdigit(*pat)) {
- len = atoi(pat);
- while (isdigit(*pat))
- pat++;
+ if (*pat == '*') {
+ len = index("@Xxu",datumtype) ? 0 : items;
+ pat++;
+ }
+ else if (isDIGIT(*pat)) {
+ len = *pat++ - '0';
+ while (isDIGIT(*pat))
+ len = (len * 10) + (*pat++ - '0');
}
else
len = 1;
switch(datumtype) {
default:
break;
+ case '%':
+ fatal("% may only be used in unpack");
+ case '@':
+ len -= str->str_cur;
+ if (len > 0)
+ goto grow;
+ len = -len;
+ if (len > 0)
+ goto shrink;
+ break;
+ case 'X':
+ shrink:
+ if (str->str_cur < len)
+ fatal("X outside of string");
+ str->str_cur -= len;
+ str->str_ptr[str->str_cur] = '\0';
+ break;
case 'x':
+ grow:
while (len >= 10) {
str_ncat(str,null10,10);
len -= 10;
case 'a':
fromstr = NEXTFROM;
aptr = str_get(fromstr);
+ if (pat[-1] == '*')
+ len = fromstr->str_cur;
if (fromstr->str_cur > len)
str_ncat(str,aptr,len);
- else
+ else {
str_ncat(str,aptr,fromstr->str_cur);
- len -= fromstr->str_cur;
- if (datumtype == 'A') {
- while (len >= 10) {
- str_ncat(str,space10,10);
- len -= 10;
+ len -= fromstr->str_cur;
+ if (datumtype == 'A') {
+ while (len >= 10) {
+ str_ncat(str,space10,10);
+ len -= 10;
+ }
+ str_ncat(str,space10,len);
+ }
+ else {
+ while (len >= 10) {
+ str_ncat(str,null10,10);
+ len -= 10;
+ }
+ str_ncat(str,null10,len);
}
- str_ncat(str,space10,len);
}
- else {
- while (len >= 10) {
- str_ncat(str,null10,10);
- len -= 10;
+ break;
+ case 'B':
+ case 'b':
+ {
+ char *savepat = pat;
+ int saveitems;
+
+ fromstr = NEXTFROM;
+ saveitems = items;
+ aptr = str_get(fromstr);
+ if (pat[-1] == '*')
+ len = fromstr->str_cur;
+ pat = aptr;
+ aint = str->str_cur;
+ str->str_cur += (len+7)/8;
+ STR_GROW(str, str->str_cur + 1);
+ aptr = str->str_ptr + aint;
+ if (len > fromstr->str_cur)
+ len = fromstr->str_cur;
+ aint = len;
+ items = 0;
+ if (datumtype == 'B') {
+ for (len = 0; len++ < aint;) {
+ items |= *pat++ & 1;
+ if (len & 7)
+ items <<= 1;
+ else {
+ *aptr++ = items & 0xff;
+ items = 0;
+ }
+ }
+ }
+ else {
+ for (len = 0; len++ < aint;) {
+ if (*pat++ & 1)
+ items |= 128;
+ if (len & 7)
+ items >>= 1;
+ else {
+ *aptr++ = items & 0xff;
+ items = 0;
+ }
+ }
}
- str_ncat(str,null10,len);
+ if (aint & 7) {
+ if (datumtype == 'B')
+ items <<= 7 - (aint & 7);
+ else
+ items >>= 7 - (aint & 7);
+ *aptr++ = items & 0xff;
+ }
+ pat = str->str_ptr + str->str_cur;
+ while (aptr <= pat)
+ *aptr++ = '\0';
+
+ pat = savepat;
+ items = saveitems;
+ }
+ break;
+ case 'H':
+ case 'h':
+ {
+ char *savepat = pat;
+ int saveitems;
+
+ fromstr = NEXTFROM;
+ saveitems = items;
+ aptr = str_get(fromstr);
+ if (pat[-1] == '*')
+ len = fromstr->str_cur;
+ pat = aptr;
+ aint = str->str_cur;
+ str->str_cur += (len+1)/2;
+ STR_GROW(str, str->str_cur + 1);
+ aptr = str->str_ptr + aint;
+ if (len > fromstr->str_cur)
+ len = fromstr->str_cur;
+ aint = len;
+ items = 0;
+ if (datumtype == 'H') {
+ for (len = 0; len++ < aint;) {
+ if (isALPHA(*pat))
+ items |= ((*pat++ & 15) + 9) & 15;
+ else
+ items |= *pat++ & 15;
+ if (len & 1)
+ items <<= 4;
+ else {
+ *aptr++ = items & 0xff;
+ items = 0;
+ }
+ }
+ }
+ else {
+ for (len = 0; len++ < aint;) {
+ if (isALPHA(*pat))
+ items |= (((*pat++ & 15) + 9) & 15) << 4;
+ else
+ items |= (*pat++ & 15) << 4;
+ if (len & 1)
+ items >>= 4;
+ else {
+ *aptr++ = items & 0xff;
+ items = 0;
+ }
+ }
+ }
+ if (aint & 1)
+ *aptr++ = items & 0xff;
+ pat = str->str_ptr + str->str_cur;
+ while (aptr <= pat)
+ *aptr++ = '\0';
+
+ pat = savepat;
+ items = saveitems;
}
break;
case 'C':
str_ncat(str,&achar,sizeof(char));
}
break;
+ /* Float and double added by gnb@melba.bby.oz.au 22/11/89 */
+ case 'f':
+ case 'F':
+ while (len-- > 0) {
+ fromstr = NEXTFROM;
+ afloat = (float)str_gnum(fromstr);
+ str_ncat(str, (char *)&afloat, sizeof (float));
+ }
+ break;
+ case 'd':
+ case 'D':
+ while (len-- > 0) {
+ fromstr = NEXTFROM;
+ adouble = (double)str_gnum(fromstr);
+ str_ncat(str, (char *)&adouble, sizeof (double));
+ }
+ break;
case 'n':
while (len-- > 0) {
fromstr = NEXTFROM;
ashort = (short)str_gnum(fromstr);
-#ifdef HTONS
+#ifdef HAS_HTONS
ashort = htons(ashort);
#endif
str_ncat(str,(char*)&ashort,sizeof(short));
}
break;
case 'I':
+ while (len-- > 0) {
+ fromstr = NEXTFROM;
+ auint = U_I(str_gnum(fromstr));
+ str_ncat(str,(char*)&auint,sizeof(unsigned int));
+ }
+ break;
case 'i':
while (len-- > 0) {
fromstr = NEXTFROM;
case 'N':
while (len-- > 0) {
fromstr = NEXTFROM;
- along = (long)str_gnum(fromstr);
-#ifdef HTONL
- along = htonl(along);
+ aulong = U_L(str_gnum(fromstr));
+#ifdef HAS_HTONL
+ aulong = htonl(aulong);
#endif
- str_ncat(str,(char*)&along,sizeof(long));
+ str_ncat(str,(char*)&aulong,sizeof(unsigned long));
}
break;
case 'L':
+ while (len-- > 0) {
+ fromstr = NEXTFROM;
+ aulong = U_L(str_gnum(fromstr));
+ str_ncat(str,(char*)&aulong,sizeof(unsigned long));
+ }
+ break;
case 'l':
while (len-- > 0) {
fromstr = NEXTFROM;
str_ncat(str,(char*)&along,sizeof(long));
}
break;
+#ifdef QUAD
+ case 'Q':
+ while (len-- > 0) {
+ fromstr = NEXTFROM;
+ auquad = (unsigned quad)str_gnum(fromstr);
+ str_ncat(str,(char*)&auquad,sizeof(unsigned quad));
+ }
+ break;
+ case 'q':
+ while (len-- > 0) {
+ fromstr = NEXTFROM;
+ aquad = (quad)str_gnum(fromstr);
+ str_ncat(str,(char*)&aquad,sizeof(quad));
+ }
+ break;
+#endif /* QUAD */
case 'p':
while (len-- > 0) {
fromstr = NEXTFROM;
str_ncat(str,(char*)&aptr,sizeof(char*));
}
break;
+ case 'u':
+ fromstr = NEXTFROM;
+ aptr = str_get(fromstr);
+ aint = fromstr->str_cur;
+ STR_GROW(str,aint * 4 / 3);
+ if (len <= 1)
+ len = 45;
+ else
+ len = len / 3 * 3;
+ while (aint > 0) {
+ int todo;
+
+ if (aint > len)
+ todo = len;
+ else
+ todo = aint;
+ doencodes(str, aptr, todo);
+ aint -= todo;
+ aptr += todo;
+ }
+ break;
}
}
STABSET(str);
}
#undef NEXTFROM
+doencodes(str, s, len)
+register STR *str;
+register char *s;
+register int len;
+{
+ char hunk[5];
+
+ *hunk = len + ' ';
+ str_ncat(str, hunk, 1);
+ hunk[4] = '\0';
+ while (len > 0) {
+ hunk[0] = ' ' + (077 & (*s >> 2));
+ hunk[1] = ' ' + (077 & ((*s << 4) & 060 | (s[1] >> 4) & 017));
+ hunk[2] = ' ' + (077 & ((s[1] << 2) & 074 | (s[2] >> 6) & 03));
+ hunk[3] = ' ' + (077 & (s[2] & 077));
+ str_ncat(str, hunk, 4);
+ s += 3;
+ len -= 3;
+ }
+ for (s = str->str_ptr; *s; s++) {
+ if (*s == ' ')
+ *s = '`';
+ }
+ str_ncat(str, "\n", 1);
+}
+
void
do_sprintf(str,len,sarg)
register STR *str;
{
register char *s;
register char *t;
+ register char *f;
bool dolong;
+#ifdef QUAD
+ bool doquad;
+#endif /* QUAD */
char ch;
static STR *sargnull = &str_no;
register char *send;
+ register STR *arg;
char *xs;
int xlen;
+ int pre;
+ int post;
+ double value;
str_set(str,"");
len--; /* don't count pattern string */
- s = str_get(*sarg);
+ t = s = str_get(*sarg);
send = s + (*sarg)->str_cur;
sarg++;
- for ( ; s < send; len--) {
- if (len <= 0 || !*sarg) {
- sarg = &sargnull;
- len = 0;
- }
- dolong = FALSE;
- for (t = s; t < send && *t != '%'; t++) ;
+ for ( ; ; len--) {
+
+ /*SUPPRESS 560*/
+ if (len <= 0 || !(arg = *sarg++))
+ arg = sargnull;
+
+ /*SUPPRESS 530*/
+ for ( ; t < send && *t != '%'; t++) ;
if (t >= send)
- break; /* not enough % patterns, oh well */
- for (t++; *sarg && t < send && t != s; t++) {
+ break; /* end of format string, ignore extra args */
+ f = t;
+ *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(buf,s);
- s = t;
- *(t--) = ch;
- len++;
+ (void)sprintf(xs,f);
+ len++, 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 '+':
- break;
+ case '.': case '#': case '-': case '+': case ' ':
+ continue;
case 'l':
+#ifdef QUAD
+ if (dolong) {
+ dolong = FALSE;
+ doquad = TRUE;
+ } else
+#endif
dolong = TRUE;
- break;
+ continue;
case 'c':
ch = *(++t);
*t = '\0';
- xlen = (int)str_gnum(*(sarg++));
- if (strEQ(t-2,"%c")) { /* some printfs fail on null chars */
- *buf = xlen;
- str_ncat(str,s,t - s - 2);
- str_ncat(str,buf,1); /* so handle simple case */
- *buf = '\0';
+ xlen = (int)str_gnum(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);
}
- else
- (void)sprintf(buf,s,xlen);
- s = t;
- *(t--) = ch;
break;
case 'D':
dolong = TRUE;
case 'd':
ch = *(++t);
*t = '\0';
+#ifdef QUAD
+ if (doquad)
+ (void)sprintf(buf,s,(quad)str_gnum(arg));
+ else
+#endif
if (dolong)
- (void)sprintf(buf,s,(long)str_gnum(*(sarg++)));
+ (void)sprintf(xs,f,(long)str_gnum(arg));
else
- (void)sprintf(buf,s,(int)str_gnum(*(sarg++)));
- s = t;
- *(t--) = ch;
+ (void)sprintf(xs,f,(int)str_gnum(arg));
+ xlen = strlen(xs);
break;
case 'X': case 'O':
dolong = TRUE;
case 'x': case 'o': case 'u':
ch = *(++t);
*t = '\0';
+ value = str_gnum(arg);
+#ifdef QUAD
+ if (doquad)
+ (void)sprintf(buf,s,(unsigned quad)value);
+ else
+#endif
if (dolong)
- (void)sprintf(buf,s,(unsigned long)str_gnum(*(sarg++)));
+ (void)sprintf(xs,f,U_L(value));
else
- (void)sprintf(buf,s,(unsigned int)str_gnum(*(sarg++)));
- s = t;
- *(t--) = ch;
+ (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(buf,s,str_gnum(*(sarg++)));
- s = t;
- *(t--) = ch;
+ (void)sprintf(xs,f,str_gnum(arg));
+ xlen = strlen(xs);
break;
case 's':
ch = *(++t);
*t = '\0';
- xs = str_get(*sarg);
- xlen = (*sarg)->str_cur;
- if (*xs == 'S' && xs[1] == 't' && xs[2] == 'a' && xs[3] == 'b'
- && xlen == sizeof(STBP) && strlen(xs) < xlen) {
- xs = stab_name(((STAB*)(*sarg))); /* a stab value! */
- sprintf(tokenbuf,"*%s",xs); /* reformat to non-binary */
+ xs = str_get(arg);
+ xlen = arg->str_cur;
+ if (*xs == 'S' && xs[1] == 't' && xs[2] == 'B' && xs[3] == '\0'
+ && xlen == sizeof(STBP)) {
+ STR *tmpstr = Str_new(24,0);
+
+ stab_fullname(tmpstr, ((STAB*)arg)); /* a stab value! */
+ sprintf(tokenbuf,"*%s",tmpstr->str_ptr);
+ /* reformat to non-binary */
xs = tokenbuf;
xlen = strlen(tokenbuf);
+ str_free(tmpstr);
}
- if (strEQ(t-2,"%s")) { /* some printfs fail on >128 chars */
- *buf = '\0';
- str_ncat(str,s,t - s - 2);
- str_ncat(str,xs,xlen); /* so handle simple case */
+ if (strEQ(f,"%s")) { /* some printfs fail on >128 chars */
+ break; /* so handle simple cases */
}
- else
- (void)sprintf(buf,s,xs);
- sarg++;
- s = t;
- *(t--) = ch;
+ else if (f[1] == '-') {
+ char *mp = index(f, '.');
+ int min = atoi(f+2);
+
+ if (xlen < min)
+ post = min - xlen;
+ else if (mp) {
+ int max = atoi(mp+1);
+
+ if (xlen > max)
+ xlen = max;
+ }
+ break;
+ }
+ else if (isDIGIT(f[1])) {
+ char *mp = index(f, '.');
+ int min = atoi(f+1);
+
+ if (xlen < min)
+ pre = min - xlen;
+ else if (mp) {
+ int max = atoi(mp+1);
+
+ if (xlen > max)
+ xlen = max;
+ }
+ break;
+ }
+ strcpy(tokenbuf+64,f); /* sprintf($s,...$s...) */
+ *t = ch;
+ (void)sprintf(buf,tokenbuf+64,xs);
+ xs = buf;
+ xlen = strlen(xs);
break;
}
- }
- if (s < t && t >= send) {
- str_cat(str,s);
+ /* end of switch, copy results */
+ *t = ch;
+ STR_GROW(str, str->str_cur + (f - s) + xlen + 1 + pre + post);
+ str_ncat(str, s, f - s);
+ if (pre) {
+ repeatcpy(str->str_ptr + str->str_cur, " ", 1, pre);
+ str->str_cur += pre;
+ }
+ str_ncat(str, xs, xlen);
+ if (post) {
+ repeatcpy(str->str_ptr + str->str_cur, " ", 1, post);
+ str->str_cur += post;
+ }
s = t;
- break;
+ break; /* break from for loop */
}
- str_cat(str,buf);
- }
- if (*s) {
- (void)sprintf(buf,s,0,0,0,0);
- str_cat(str,buf);
}
+ str_ncat(str, s, t - s);
STABSET(str);
}
return str;
}
-int
+void
do_unshift(ary,arglast)
register ARRAY *ary;
int *arglast;
register int sp = arglast[1];
register int items = arglast[2] - sp;
register SUBR *sub;
- ARRAY *savearray;
+ STR *str;
STAB *stab;
- char *oldfile = filename;
int oldsave = savestack->ary_fill;
int oldtmps_base = tmps_base;
+ int hasargs = ((arg[2].arg_type & A_MASK) != A_NULL);
+ register CSV *csv;
if ((arg[1].arg_type & A_MASK) == A_WORD)
stab = arg[1].arg_ptr.arg_stab;
else {
- STR *tmpstr = stab_val(arg[1].arg_ptr.arg_stab);
+ STR *tmpstr = STAB_STR(arg[1].arg_ptr.arg_stab);
if (tmpstr)
stab = stabent(str_get(tmpstr),TRUE);
}
if (!stab)
fatal("Undefined subroutine called");
- sub = stab_sub(stab);
- if (!sub)
- fatal("Undefined subroutine \"%s\" called", stab_name(stab));
- if ((arg[2].arg_type & A_MASK) != A_NULL) {
- savearray = stab_xarray(defstab);
- stab_xarray(defstab) = afake(defstab, items, &st[sp+1]);
- }
- savelong(&sub->depth);
- sub->depth++;
- saveint(&wantarray);
- wantarray = gimme;
- if (sub->depth >= 2) { /* save temporaries on recursion? */
- if (sub->depth == 100 && dowarn)
- warn("Deep recursion on subroutine \"%s\"",stab_name(stab));
- savelist(sub->tosave->ary_array,sub->tosave->ary_fill);
- }
- filename = sub->filename;
- tmps_base = tmps_max;
- sp = cmd_exec(sub->cmd,gimme,--sp); /* so do it already */
- st = stack->ary_array;
+ if (!(sub = stab_sub(stab))) {
+ STR *tmpstr = arg[0].arg_ptr.arg_str;
- if ((arg[2].arg_type & A_MASK) != A_NULL) {
- afree(stab_xarray(defstab)); /* put back old $_[] */
- stab_xarray(defstab) = savearray;
+ stab_fullname(tmpstr, stab);
+ fatal("Undefined subroutine \"%s\" called",tmpstr->str_ptr);
}
- filename = oldfile;
- tmps_base = oldtmps_base;
- if (savestack->ary_fill > oldsave) {
- for (items = arglast[0] + 1; items <= sp; items++)
- st[items] = str_static(st[items]);
- /* in case restore wipes old str */
- restorelist(oldsave);
+ if (arg->arg_type == O_DBSUBR && !sub->usersub) {
+ str = stab_val(DBsub);
+ saveitem(str);
+ stab_fullname(str,stab);
+ sub = stab_sub(DBsub);
+ if (!sub)
+ fatal("No DBsub routine");
}
- return sp;
-}
-
-int
-do_dbsubr(arg,gimme,arglast)
-register ARG *arg;
-int gimme;
-int *arglast;
-{
- register STR **st = stack->ary_array;
- register int sp = arglast[1];
- register int items = arglast[2] - sp;
- register SUBR *sub;
- ARRAY *savearray;
- STR *str;
- STAB *stab;
- char *oldfile = filename;
- int oldsave = savestack->ary_fill;
- int oldtmps_base = tmps_base;
-
- if ((arg[1].arg_type & A_MASK) == A_WORD)
- stab = arg[1].arg_ptr.arg_stab;
- else {
- STR *tmpstr = stab_val(arg[1].arg_ptr.arg_stab);
-
- if (tmpstr)
- stab = stabent(str_get(tmpstr),TRUE);
- else
- stab = Nullstab;
+ str = Str_new(15, sizeof(CSV));
+ str->str_state = SS_SCSV;
+ (void)apush(savestack,str);
+ csv = (CSV*)str->str_ptr;
+ csv->sub = sub;
+ csv->stab = stab;
+ csv->curcsv = curcsv;
+ csv->curcmd = curcmd;
+ csv->depth = sub->depth;
+ csv->wantarray = gimme;
+ csv->hasargs = hasargs;
+ curcsv = csv;
+ if (sub->usersub) {
+ csv->hasargs = 0;
+ csv->savearray = Null(ARRAY*);;
+ csv->argarray = Null(ARRAY*);
+ st[sp] = arg->arg_ptr.arg_str;
+ if (!hasargs)
+ items = 0;
+ return (*sub->usersub)(sub->userindex,sp,items);
}
- if (!stab)
- fatal("Undefined subroutine called");
- sub = stab_sub(stab);
- if (!sub)
- fatal("Undefined subroutine \"%s\" called", stab_name(stab));
-/* begin differences */
- str = stab_val(DBsub);
- saveitem(str);
- str_set(str,stab_name(stab));
- sub = stab_sub(DBsub);
- if (!sub)
- fatal("No DBsub routine");
-/* end differences */
- if ((arg[2].arg_type & A_MASK) != A_NULL) {
- savearray = stab_xarray(defstab);
- stab_xarray(defstab) = afake(defstab, items, &st[sp+1]);
+ if (hasargs) {
+ csv->savearray = stab_xarray(defstab);
+ csv->argarray = afake(defstab, items, &st[sp+1]);
+ stab_xarray(defstab) = csv->argarray;
}
- savelong(&sub->depth);
sub->depth++;
- saveint(&wantarray);
- wantarray = gimme;
if (sub->depth >= 2) { /* save temporaries on recursion? */
if (sub->depth == 100 && dowarn)
warn("Deep recursion on subroutine \"%s\"",stab_name(stab));
savelist(sub->tosave->ary_array,sub->tosave->ary_fill);
}
- filename = sub->filename;
tmps_base = tmps_max;
sp = cmd_exec(sub->cmd,gimme, --sp); /* so do it already */
st = stack->ary_array;
- if ((arg[2].arg_type & A_MASK) != A_NULL) {
- afree(stab_xarray(defstab)); /* put back old $_[] */
- stab_xarray(defstab) = savearray;
- }
- filename = oldfile;
tmps_base = oldtmps_base;
- if (savestack->ary_fill > oldsave) {
- for (items = arglast[0] + 1; items <= sp; items++)
- st[items] = str_static(st[items]);
- /* in case restore wipes old str */
- restorelist(oldsave);
- }
+ for (items = arglast[0] + 1; items <= sp; items++)
+ st[items] = str_mortal(st[items]);
+ /* in case restore wipes old str */
+ restorelist(oldsave);
return sp;
}
HASH *hash;
int i;
- makelocal = (arg->arg_flags & AF_LOCAL);
+ makelocal = (arg->arg_flags & AF_LOCAL) != 0;
+ localizing = makelocal;
delaymagic = DM_DELAY; /* catch simultaneous items */
/* If there's a common identifier on both sides we have to take
*/
if (arg->arg_flags & AF_COMMON) {
for (relem = firstrelem; relem <= lastrelem; relem++) {
+ /*SUPPRESS 560*/
if (str = *relem)
- *relem = str_static(str);
+ *relem = str_mortal(str);
}
}
relem = firstrelem;
while (relem <= lastrelem) { /* gobble up all the rest */
str = Str_new(28,0);
if (*relem)
- str_sset(str,*(relem++));
- else
- relem++;
+ str_sset(str,*relem);
+ *(relem++) = str;
(void)astore(ary,i++,str);
}
}
else if (str->str_state == SS_HASH) {
char *tmps;
STR *tmpstr;
+ int magic = 0;
+ STAB *tmpstab = str->str_u.str_stab;
if (makelocal)
hash = savehash(str->str_u.str_stab);
else {
hash = stab_hash(str->str_u.str_stab);
- hclear(hash);
+ if (tmpstab == envstab) {
+ magic = 'E';
+ environ[0] = Nullch;
+ }
+ else if (tmpstab == sigstab) {
+ magic = 'S';
+#ifndef NSIG
+#define NSIG 32
+#endif
+ for (i = 1; i < NSIG; i++)
+ signal(i, SIG_DFL); /* crunch, crunch, crunch */
+ }
+#ifdef SOME_DBM
+ else if (hash->tbl_dbm)
+ magic = 'D';
+#endif
+ hclear(hash, magic == 'D'); /* wipe any dbm file too */
+
}
while (relem < lastrelem) { /* gobble up all the rest */
if (*relem)
tmps = str_get(str);
tmpstr = Str_new(29,0);
if (*relem)
- str_sset(tmpstr,*(relem++)); /* value */
- else
- relem++;
+ str_sset(tmpstr,*relem); /* value */
+ *(relem++) = tmpstr;
(void)hstore(hash,tmps,str->str_cur,tmpstr,0);
+ if (magic) {
+ str_magic(tmpstr, tmpstab, magic, tmps, str->str_cur);
+ stabset(tmpstr->str_magic, tmpstr);
+ }
}
}
else
else {
if (makelocal)
saveitem(str);
- if (relem <= lastrelem)
- str_sset(str, *(relem++));
- else
- str_nset(str, "", 0);
+ if (relem <= lastrelem) {
+ str_sset(str, *relem);
+ *(relem++) = str;
+ }
+ else {
+ str_sset(str, &str_undef);
+ if (gimme == G_ARRAY) {
+ i = ++lastrelem - firstrelem;
+ relem++; /* tacky, I suppose */
+ astore(stack,i,str);
+ if (st != stack->ary_array) {
+ st = stack->ary_array;
+ firstrelem = st + arglast[1] + 1;
+ firstlelem = st + arglast[0] + 1;
+ lastlelem = st + arglast[1];
+ lastrelem = st + i;
+ relem = lastrelem + 1;
+ }
+ }
+ }
STABSET(str);
}
}
if (delaymagic > 1) {
-#ifdef SETREUID
- if (delaymagic & DM_REUID)
+ if (delaymagic & DM_REUID) {
+#ifdef HAS_SETREUID
setreuid(uid,euid);
+#else
+ if (uid != euid || setuid(uid) < 0)
+ fatal("No setreuid available");
#endif
-#ifdef SETREGID
- if (delaymagic & DM_REGID)
+ }
+ if (delaymagic & DM_REGID) {
+#ifdef HAS_SETREGID
setregid(gid,egid);
+#else
+ if (gid != egid || setgid(gid) < 0)
+ fatal("No setregid available");
#endif
+ }
}
delaymagic = 0;
+ localizing = FALSE;
if (gimme == G_ARRAY) {
i = lastrelem - firstrelem + 1;
if (ary || hash)
}
}
-int
+int /*SUPPRESS 590*/
do_study(str,arg,gimme,arglast)
STR *str;
ARG *arg;
return retarg;
}
-int
+int /*SUPPRESS 590*/
do_defined(str,arg,gimme,arglast)
STR *str;
register ARG *arg;
register int type;
register int retarg = arglast[0] + 1;
int retval;
+ ARRAY *ary;
+ HASH *hash;
if ((arg[1].arg_type & A_MASK) != A_LEXPR)
fatal("Illegal argument to defined()");
arg = arg[1].arg_ptr.arg_arg;
type = arg->arg_type;
- if (type == O_ARRAY || type == O_LARRAY)
- retval = stab_xarray(arg[1].arg_ptr.arg_stab) != 0;
- else if (type == O_HASH || type == O_LHASH)
- retval = stab_xhash(arg[1].arg_ptr.arg_stab) != 0;
- else if (type == O_SUBR || type == O_DBSUBR)
- retval = stab_sub(arg[1].arg_ptr.arg_stab) != 0;
- else if (type == O_ASLICE || type == O_LASLICE)
- retval = stab_xarray(arg[1].arg_ptr.arg_stab) != 0;
- else if (type == O_HSLICE || type == O_LHSLICE)
- retval = stab_xhash(arg[1].arg_ptr.arg_stab) != 0;
+ if (type == O_SUBR || type == O_DBSUBR) {
+ if ((arg[1].arg_type & A_MASK) == A_WORD)
+ retval = stab_sub(arg[1].arg_ptr.arg_stab) != 0;
+ else {
+ STR *tmpstr = STAB_STR(arg[1].arg_ptr.arg_stab);
+
+ retval = tmpstr && stab_sub(stabent(str_get(tmpstr),TRUE)) != 0;
+ }
+ }
+ else if (type == O_ARRAY || type == O_LARRAY ||
+ type == O_ASLICE || type == O_LASLICE )
+ retval = ((ary = stab_xarray(arg[1].arg_ptr.arg_stab)) != 0
+ && ary->ary_max >= 0 );
+ else if (type == O_HASH || type == O_LHASH ||
+ type == O_HSLICE || type == O_LHSLICE )
+ retval = ((hash = stab_xhash(arg[1].arg_ptr.arg_stab)) != 0
+ && hash->tbl_array);
else
retval = FALSE;
str_numset(str,(double)retval);
return retarg;
}
-int
+int /*SUPPRESS 590*/
do_undef(str,arg,gimme,arglast)
STR *str;
register ARG *arg;
if (type == O_ARRAY || type == O_LARRAY) {
stab = arg[1].arg_ptr.arg_stab;
afree(stab_xarray(stab));
- stab_xarray(stab) = Null(ARRAY*);
+ stab_xarray(stab) = anew(stab); /* so "@array" still works */
}
else if (type == O_HASH || type == O_LHASH) {
stab = arg[1].arg_ptr.arg_stab;
- (void)hfree(stab_xhash(stab));
+ if (stab == envstab)
+ environ[0] = Nullch;
+ else if (stab == sigstab) {
+ int i;
+
+ for (i = 1; i < NSIG; i++)
+ signal(i, SIG_DFL); /* munch, munch, munch */
+ }
+ (void)hfree(stab_xhash(stab), TRUE);
stab_xhash(stab) = Null(HASH*);
}
else if (type == O_SUBR || type == O_DBSUBR) {
stab = arg[1].arg_ptr.arg_stab;
- cmd_free(stab_sub(stab)->cmd);
- afree(stab_sub(stab)->tosave);
- Safefree(stab_sub(stab));
- stab_sub(stab) = Null(SUBR*);
+ if ((arg[1].arg_type & A_MASK) != A_WORD) {
+ STR *tmpstr = STAB_STR(arg[1].arg_ptr.arg_stab);
+
+ if (tmpstr)
+ stab = stabent(str_get(tmpstr),TRUE);
+ else
+ stab = Nullstab;
+ }
+ if (stab && stab_sub(stab)) {
+ cmd_free(stab_sub(stab)->cmd);
+ stab_sub(stab)->cmd = Nullcmd;
+ afree(stab_sub(stab)->tosave);
+ Safefree(stab_sub(stab));
+ stab_sub(stab) = Null(SUBR*);
+ }
}
else
fatal("Can't undefine that kind of object");
if (size == 8)
retnum = s[offset];
else if (size == 16)
- retnum = (s[offset] << 8) + s[offset+1];
+ retnum = ((unsigned long) s[offset] << 8) + s[offset+1];
else if (size == 32)
- retnum = (s[offset] << 24) + (s[offset + 1] << 16) +
+ retnum = ((unsigned long) s[offset] << 24) +
+ ((unsigned long) s[offset + 1] << 16) +
(s[offset + 2] << 8) + s[offset+3];
}
register int offset;
register int size;
register unsigned char *s = (unsigned char*)mstr->str_ptr;
- register unsigned long lval = (unsigned long)str_gnum(str);
+ register unsigned long lval = U_L(str_gnum(str));
int mask;
mstr->str_rare = 0;
if (str->str_state == SS_HASH) {
hash = stab_hash(str->str_u.str_stab);
(void)hiterinit(hash);
+ /*SUPPRESS 560*/
while (entry = hiternext(hash))
do_chop(astr,hiterval(hash,entry));
return;
}
tmps = str_get(str);
- if (!tmps)
- return;
- tmps += str->str_cur - (str->str_cur != 0);
- str_nset(astr,tmps,1); /* remember last char */
- *tmps = '\0'; /* wipe it out */
- str->str_cur = tmps - str->str_ptr;
- str->str_nok = 0;
+ if (tmps && str->str_cur) {
+ tmps += str->str_cur - 1;
+ str_nset(astr,tmps,1); /* remember last char */
+ *tmps = '\0'; /* wipe it out */
+ str->str_cur = tmps - str->str_ptr;
+ str->str_nok = 0;
+ STABSET(str);
+ }
+ else
+ str_nset(astr,"",0);
}
do_vop(optype,str,left,right)
STR *left;
STR *right;
{
- register char *s = str_get(str);
+ register char *s;
register char *l = str_get(left);
register char *r = str_get(right);
register int len;
STR_GROW(str,len);
(void)bzero(str->str_ptr + str->str_cur, len - str->str_cur);
str->str_cur = len;
- s = str_get(str);
+ }
+ str->str_pok = 1;
+ str->str_nok = 0;
+ s = str->str_ptr;
+ if (!s) {
+ str_nset(str,"",0);
+ s = str->str_ptr;
}
switch (optype) {
case O_BIT_AND:
register STR **st = stack->ary_array;
register int sp = arglast[1];
register int items = arglast[2] - sp;
- long arg[8];
+ unsigned long arg[8];
register int i = 0;
int retval = -1;
-#ifdef SYSCALL
+#ifdef HAS_SYSCALL
#ifdef TAINT
for (st += ++sp; items--; st++)
tainted |= (*st)->str_tainted;
*/
while (items--) {
if (st[++sp]->str_nok || !i)
- arg[i++] = (long)str_gnum(st[sp]);
+ arg[i++] = (unsigned long)str_gnum(st[sp]);
#ifndef lint
else
- arg[i++] = (long)st[sp]->str_ptr;
+ arg[i++] = (unsigned long)st[sp]->str_ptr;
#endif /* lint */
}
sp = arglast[1];
arg[7]);
break;
}
- st[sp] = str_static(&str_undef);
- str_numset(st[sp], (double)retval);
- return sp;
+ return retval;
#else
fatal("syscall() unimplemented");
#endif