-/* $Header: doarg.c,v 3.0.1.1 89/11/11 04:17:20 lwall Locked $
+/* $Header: doarg.c,v 3.0.1.6 90/08/09 02:48:38 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: doarg.c,v $
+ * Revision 3.0.1.6 90/08/09 02:48:38 lwall
+ * patch19: fixed double include of <signal.h>
+ * patch19: pack/unpack can now do native float and double
+ * patch19: pack/unpack can now have absolute and negative positioning
+ * patch19: pack/unpack can now have use * to specify all the rest of input
+ * patch19: unpack can do checksumming
+ * patch19: $< and $> better supported on machines without setreuid
+ * patch19: Added support for linked-in C subroutines
+ *
+ * Revision 3.0.1.5 90/03/27 15:39:03 lwall
+ * patch16: MSDOS support
+ * patch16: support for machines that can't cast negative floats to unsigned ints
+ * patch16: sprintf($s,...,$s,...) didn't work
+ *
+ * Revision 3.0.1.4 90/03/12 16:28:42 lwall
+ * patch13: pack of ascii strings could call str_ncat() with negative length
+ * patch13: printf("%s", *foo) was busted
+ *
+ * Revision 3.0.1.3 90/02/28 16:56:58 lwall
+ * patch9: split now can split into more than 10000 elements
+ * patch9: sped up pack and unpack
+ * patch9: pack of unsigned ints and longs blew up some places
+ * patch9: sun3 can't cast negative float to unsigned int or long
+ * patch9: local($.) didn't work
+ * patch9: grep(s/foo/bar/, @abc = @xyz) modified @xyz rather than @abc
+ * patch9: syscall returned stack size rather than value of system call
+ *
+ * Revision 3.0.1.2 89/12/21 19:52:15 lwall
+ * patch7: a pattern wouldn't match a null string before the first character
+ * patch7: certain patterns didn't match correctly at end of string
+ *
* 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
#include "EXTERN.h"
#include "perl.h"
+#ifndef NSIG
#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)
STR *str;
register char *d;
int clen;
int iters = 0;
+ int maxiters = (strend - s) + 10;
register int i;
bool once;
char *orig;
if (spat->spat_regexp)
regfree(spat->spat_regexp);
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) {
arg_free(spat->spat_runtime); /* it won't change, so */
spat->spat_runtime = Nullarg; /* no point compiling again */
clen = dstr->str_cur;
if (clen <= spat->spat_slen + spat->spat_regexp->regback) {
/* 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;
/* NOTREACHED */
}
do {
- if (iters++ > 10000)
+ if (iters++ > maxiters)
fatal("Substitution loop");
m = spat->spat_regexp->startp[0];
if (i = m - s) {
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) {
}
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)
char achar;
short ashort;
int aint;
+ unsigned int auint;
long along;
+ unsigned long aulong;
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);
+ if (*pat == '*') {
+ len = index("@Xxu",datumtype) ? 0 : items;
+ pat++;
+ }
+ else if (isdigit(*pat)) {
+ len = *pat++ - '0';
while (isdigit(*pat))
- 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:
+ str->str_cur -= len;
+ if (str->str_cur < 0)
+ fatal("X outside of string");
+ 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);
}
- str_ncat(str,space10,len);
- }
- else {
- while (len >= 10) {
- str_ncat(str,null10,10);
- len -= 10;
+ else {
+ while (len >= 10) {
+ str_ncat(str,null10,10);
+ len -= 10;
+ }
+ str_ncat(str,null10,len);
}
- str_ncat(str,null10,len);
}
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;
}
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;
}
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*)&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;
+ }
+ str_ncat(str, "\n", 1);
+}
+
void
do_sprintf(str,len,sarg)
register STR *str;
register char *send;
char *xs;
int xlen;
+ double value;
+ char *origs;
str_set(str,"");
len--; /* don't count pattern string */
- s = str_get(*sarg);
+ origs = s = str_get(*sarg);
send = s + (*sarg)->str_cur;
sarg++;
for ( ; s < send; len--) {
case 'x': case 'o': case 'u':
ch = *(++t);
*t = '\0';
+ value = str_gnum(*(sarg++));
if (dolong)
- (void)sprintf(buf,s,(unsigned long)str_gnum(*(sarg++)));
+ (void)sprintf(buf,s,U_L(value));
else
- (void)sprintf(buf,s,(unsigned int)str_gnum(*(sarg++)));
+ (void)sprintf(buf,s,U_I(value));
s = t;
*(t--) = ch;
break;
*t = '\0';
xs = str_get(*sarg);
xlen = (*sarg)->str_cur;
- if (*xs == 'S' && xs[1] == 't' && xs[2] == 'a' && xs[3] == 'b'
+ if (*xs == 'S' && xs[1] == 't' && xs[2] == 'B'
&& xlen == sizeof(STBP) && strlen(xs) < xlen) {
xs = stab_name(((STAB*)(*sarg))); /* a stab value! */
sprintf(tokenbuf,"*%s",xs); /* reformat to non-binary */
if (strEQ(t-2,"%s")) { /* some printfs fail on >128 chars */
*buf = '\0';
str_ncat(str,s,t - s - 2);
+ *t = ch;
str_ncat(str,xs,xlen); /* so handle simple case */
}
- else
+ else {
+ if (origs == xs) { /* sprintf($s,...$s...) */
+ strcpy(tokenbuf+64,s);
+ s = tokenbuf+64;
+ *t = ch;
+ }
(void)sprintf(buf,s,xs);
+ }
sarg++;
s = t;
*(t--) = ch;
}
if (!stab)
fatal("Undefined subroutine called");
+ saveint(&wantarray);
+ wantarray = gimme;
sub = stab_sub(stab);
if (!sub)
fatal("Undefined subroutine \"%s\" called", stab_name(stab));
+ if (sub->usersub) {
+ st[sp] = arg->arg_ptr.arg_str;
+ if ((arg[2].arg_type & A_MASK) == A_NULL)
+ items = 0;
+ return sub->usersub(sub->userindex,sp,items);
+ }
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));
}
if (!stab)
fatal("Undefined subroutine called");
- sub = stab_sub(stab);
- if (!sub)
- fatal("Undefined subroutine \"%s\" called", stab_name(stab));
+ saveint(&wantarray);
+ wantarray = gimme;
/* begin differences */
str = stab_val(DBsub);
saveitem(str);
}
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));
int i;
makelocal = (arg->arg_flags & AF_LOCAL);
+ localizing = makelocal;
delaymagic = DM_DELAY; /* catch simultaneous items */
/* If there's a common identifier on both sides we have to take
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);
}
}
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);
}
}
else {
if (makelocal)
saveitem(str);
- if (relem <= lastrelem)
- str_sset(str, *(relem++));
- else
+ if (relem <= lastrelem) {
+ str_sset(str, *relem);
+ *(relem++) = str;
+ }
+ else {
str_nset(str, "", 0);
+ 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) {
+ if (delaymagic & DM_REUID) {
#ifdef SETREUID
- if (delaymagic & DM_REUID)
setreuid(uid,euid);
+#else
+ if (uid != euid || setuid(uid) < 0)
+ fatal("No setreuid available");
#endif
+ }
+ if (delaymagic & DM_REGID) {
#ifdef SETREGID
- if (delaymagic & DM_REGID)
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)
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;
+ else if (type == O_SUBR || type == O_DBSUBR)
+ retval = stab_sub(arg[1].arg_ptr.arg_stab) != 0;
else
retval = FALSE;
str_numset(str,(double)retval);
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;
arg[7]);
break;
}
- st[sp] = str_static(&str_undef);
- str_numset(st[sp], (double)retval);
- return sp;
+ return retval;
#else
fatal("syscall() unimplemented");
#endif
projects / p5sagit/p5-mst-13.2.git / blobdiff