1 /* $RCSfile: doarg.c,v $$Revision: 4.0.1.4 $$Date: 91/11/05 16:35:06 $
3 * Copyright (c) 1991, Larry Wall
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.
9 * Revision 4.0.1.4 91/11/05 16:35:06 lwall
10 * patch11: /$foo/o optimizer could access deallocated data
11 * patch11: minimum match length calculation in regexp is now cumulative
12 * patch11: added some support for 64-bit integers
13 * patch11: prepared for ctype implementations that don't define isascii()
14 * patch11: sprintf() now supports any length of s field
15 * patch11: indirect subroutine calls through magic vars (e.g. &$1) didn't work
16 * patch11: defined(&$foo) and undef(&$foo) didn't work
18 * Revision 4.0.1.3 91/06/10 01:18:41 lwall
19 * patch10: pack(hh,1) dumped core
21 * Revision 4.0.1.2 91/06/07 10:42:17 lwall
22 * patch4: new copyright notice
23 * patch4: // wouldn't use previous pattern if it started with a null character
24 * patch4: //o and s///o now optimize themselves fully at runtime
25 * patch4: added global modifier for pattern matches
26 * patch4: undef @array disabled "@array" interpolation
27 * patch4: chop("") was returning "\0" rather than ""
28 * patch4: vector logical operations &, | and ^ sometimes returned null string
29 * patch4: syscall couldn't pass numbers with most significant bit set on sparcs
31 * Revision 4.0.1.1 91/04/11 17:40:14 lwall
32 * patch1: fixed undefined environ problem
33 * patch1: fixed debugger coredump on subroutines
35 * Revision 4.0 91/03/20 01:06:42 lwall
43 #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
47 extern unsigned char fold[];
50 #pragma function(memcmp)
51 #endif /* BUGGY_MSC */
62 register char *s = str_get(str);
63 char *strend = s + str->str_cur;
69 int maxiters = (strend - s) + 10;
75 rspat = spat = arg[2].arg_ptr.arg_spat;
77 fatal("panic: do_subst");
78 else if (spat->spat_runtime) {
80 (void)eval(spat->spat_runtime,G_SCALAR,sp);
81 m = str_get(dstr = stack->ary_array[sp+1]);
83 if (spat->spat_regexp) {
84 regfree(spat->spat_regexp);
85 spat->spat_regexp = Null(REGEXP*); /* required if regcomp pukes */
87 spat->spat_regexp = regcomp(m,m+dstr->str_cur,
88 spat->spat_flags & SPAT_FOLD);
89 if (spat->spat_flags & SPAT_KEEP) {
90 scanconst(spat, m, dstr->str_cur);
91 arg_free(spat->spat_runtime); /* it won't change, so */
92 spat->spat_runtime = Nullarg; /* no point compiling again */
94 if (curcmd->c_expr && (curcmd->c_flags & CF_OPTIMIZE) == CFT_EVAL) {
95 curcmd->c_flags &= ~CF_OPTIMIZE;
96 opt_arg(curcmd, 1, curcmd->c_type == C_EXPR);
102 deb("2.SPAT /%s/\n",spat->spat_regexp->precomp);
105 safebase = ((!spat->spat_regexp || !spat->spat_regexp->nparens) &&
107 if (!spat->spat_regexp->prelen && lastspat)
111 if (hint < s || hint > strend)
112 fatal("panic: hint in do_match");
115 if (spat->spat_regexp->regback >= 0) {
116 s -= spat->spat_regexp->regback;
123 else if (spat->spat_short) {
124 if (spat->spat_flags & SPAT_SCANFIRST) {
125 if (str->str_pok & SP_STUDIED) {
126 if (screamfirst[spat->spat_short->str_rare] < 0)
128 else if (!(s = screaminstr(str,spat->spat_short)))
132 else if (!(s = fbminstr((unsigned char*)s, (unsigned char*)strend,
136 if (s && spat->spat_regexp->regback >= 0) {
137 ++spat->spat_short->str_u.str_useful;
138 s -= spat->spat_regexp->regback;
145 else if (!multiline && (*spat->spat_short->str_ptr != *s ||
146 bcmp(spat->spat_short->str_ptr, s, spat->spat_slen) ))
148 if (--spat->spat_short->str_u.str_useful < 0) {
149 str_free(spat->spat_short);
150 spat->spat_short = Nullstr; /* opt is being useless */
153 once = !(rspat->spat_flags & SPAT_GLOBAL);
154 if (rspat->spat_flags & SPAT_CONST) { /* known replacement string? */
155 if ((rspat->spat_repl[1].arg_type & A_MASK) == A_SINGLE)
156 dstr = rspat->spat_repl[1].arg_ptr.arg_str;
157 else { /* constant over loop, anyway */
158 (void)eval(rspat->spat_repl,G_SCALAR,sp);
159 dstr = stack->ary_array[sp+1];
162 clen = dstr->str_cur;
163 if (clen <= spat->spat_regexp->minlen) {
164 /* can do inplace substitution */
165 if (regexec(spat->spat_regexp, s, strend, orig, 0,
166 str->str_pok & SP_STUDIED ? str : Nullstr, safebase)) {
167 if (spat->spat_regexp->subbase) /* oops, no we can't */
171 str->str_pok = SP_VALID; /* disable possible screamer */
173 m = spat->spat_regexp->startp[0];
174 d = spat->spat_regexp->endp[0];
176 if (m - s > strend - d) { /* faster to shorten from end */
178 (void)bcopy(c, m, clen);
183 (void)bcopy(d, m, i);
187 str->str_cur = m - s;
189 str_numset(arg->arg_ptr.arg_str, 1.0);
190 stack->ary_array[++sp] = arg->arg_ptr.arg_str;
194 else if (i = m - s) { /* faster from front */
202 (void)bcopy(c, m, clen);
204 str_numset(arg->arg_ptr.arg_str, 1.0);
205 stack->ary_array[++sp] = arg->arg_ptr.arg_str;
211 (void)bcopy(c,d,clen);
213 str_numset(arg->arg_ptr.arg_str, 1.0);
214 stack->ary_array[++sp] = arg->arg_ptr.arg_str;
220 str_numset(arg->arg_ptr.arg_str, 1.0);
221 stack->ary_array[++sp] = arg->arg_ptr.arg_str;
227 if (iters++ > maxiters)
228 fatal("Substitution loop");
229 m = spat->spat_regexp->startp[0];
237 (void)bcopy(c,d,clen);
240 s = spat->spat_regexp->endp[0];
241 } while (regexec(spat->spat_regexp, s, strend, orig, s == m,
242 Nullstr, TRUE)); /* (don't match same null twice) */
245 str->str_cur = d - str->str_ptr + i;
246 (void)bcopy(s,d,i+1); /* include the Null */
249 str_numset(arg->arg_ptr.arg_str, (double)iters);
250 stack->ary_array[++sp] = arg->arg_ptr.arg_str;
253 str_numset(arg->arg_ptr.arg_str, 0.0);
254 stack->ary_array[++sp] = arg->arg_ptr.arg_str;
260 if (regexec(spat->spat_regexp, s, strend, orig, 0,
261 str->str_pok & SP_STUDIED ? str : Nullstr, safebase)) {
263 dstr = Str_new(25,str_len(str));
264 str_nset(dstr,m,s-m);
265 if (spat->spat_regexp->subbase)
269 if (iters++ > maxiters)
270 fatal("Substitution loop");
271 if (spat->spat_regexp->subbase
272 && spat->spat_regexp->subbase != orig) {
275 orig = spat->spat_regexp->subbase;
277 strend = s + (strend - m);
279 m = spat->spat_regexp->startp[0];
280 str_ncat(dstr,s,m-s);
281 s = spat->spat_regexp->endp[0];
284 str_ncat(dstr,c,clen);
287 char *mysubbase = spat->spat_regexp->subbase;
289 spat->spat_regexp->subbase = Nullch; /* so recursion works */
290 (void)eval(rspat->spat_repl,G_SCALAR,sp);
291 str_scat(dstr,stack->ary_array[sp+1]);
292 if (spat->spat_regexp->subbase)
293 Safefree(spat->spat_regexp->subbase);
294 spat->spat_regexp->subbase = mysubbase;
298 } while (regexec(spat->spat_regexp, s, strend, orig, s == m, Nullstr,
300 str_ncat(dstr,s,strend - s);
301 str_replace(str,dstr);
303 str_numset(arg->arg_ptr.arg_str, (double)iters);
304 stack->ary_array[++sp] = arg->arg_ptr.arg_str;
307 str_numset(arg->arg_ptr.arg_str, 0.0);
308 stack->ary_array[++sp] = arg->arg_ptr.arg_str;
312 ++spat->spat_short->str_u.str_useful;
313 str_numset(arg->arg_ptr.arg_str, 0.0);
314 stack->ary_array[++sp] = arg->arg_ptr.arg_str;
318 #pragma intrinsic(memcmp)
319 #endif /* BUGGY_MSC */
328 register int matches = 0;
332 register int squash = arg[2].arg_len & 1;
334 tbl = (short*) arg[2].arg_ptr.arg_cval;
336 send = s + str->str_cur;
338 fatal("panic: do_trans");
344 if (!arg[2].arg_len) {
346 if ((ch = tbl[*s & 0377]) >= 0) {
356 if ((ch = tbl[*s & 0377]) >= 0) {
358 if (matches++ && squash) {
367 else if (ch == -1) /* -1 is unmapped character */
368 *d++ = *s; /* -2 is delete character */
371 matches += send - d; /* account for disappeared chars */
373 str->str_cur = d - str->str_ptr;
384 register STR **st = stack->ary_array;
385 register int sp = arglast[1];
386 register int items = arglast[2] - sp;
387 register char *delim = str_get(st[sp]);
388 int delimlen = st[sp]->str_cur;
392 str_sset(str, *st++);
396 for (; items > 0; items--,st++) {
397 str_ncat(str,delim,delimlen);
402 for (; items > 0; items--,st++)
413 register STR **st = stack->ary_array;
414 register int sp = arglast[1];
416 register char *pat = str_get(st[sp]);
417 register char *patend = pat + st[sp]->str_cur;
422 static char *null10 = "\0\0\0\0\0\0\0\0\0\0";
423 static char *space10 = " ";
425 /* These must not be in registers: */
431 unsigned long aulong;
434 unsigned quad auquad;
440 items = arglast[2] - sp;
443 while (pat < patend) {
444 #define NEXTFROM (items-- > 0 ? *st++ : &str_no)
447 len = index("@Xxu",datumtype) ? 0 : items;
450 else if (isDIGIT(*pat)) {
452 while (isDIGIT(*pat))
453 len = (len * 10) + (*pat++ - '0');
461 fatal("% may only be used in unpack");
472 if (str->str_cur < len)
473 fatal("X outside of string");
475 str->str_ptr[str->str_cur] = '\0';
480 str_ncat(str,null10,10);
483 str_ncat(str,null10,len);
488 aptr = str_get(fromstr);
490 len = fromstr->str_cur;
491 if (fromstr->str_cur > len)
492 str_ncat(str,aptr,len);
494 str_ncat(str,aptr,fromstr->str_cur);
495 len -= fromstr->str_cur;
496 if (datumtype == 'A') {
498 str_ncat(str,space10,10);
501 str_ncat(str,space10,len);
505 str_ncat(str,null10,10);
508 str_ncat(str,null10,len);
520 aptr = str_get(fromstr);
522 len = fromstr->str_cur;
525 str->str_cur += (len+7)/8;
526 STR_GROW(str, str->str_cur + 1);
527 aptr = str->str_ptr + aint;
528 if (len > fromstr->str_cur)
529 len = fromstr->str_cur;
532 if (datumtype == 'B') {
533 for (len = 0; len++ < aint;) {
538 *aptr++ = items & 0xff;
544 for (len = 0; len++ < aint;) {
550 *aptr++ = items & 0xff;
556 if (datumtype == 'B')
557 items <<= 7 - (aint & 7);
559 items >>= 7 - (aint & 7);
560 *aptr++ = items & 0xff;
562 pat = str->str_ptr + str->str_cur;
578 aptr = str_get(fromstr);
580 len = fromstr->str_cur;
583 str->str_cur += (len+1)/2;
584 STR_GROW(str, str->str_cur + 1);
585 aptr = str->str_ptr + aint;
586 if (len > fromstr->str_cur)
587 len = fromstr->str_cur;
590 if (datumtype == 'H') {
591 for (len = 0; len++ < aint;) {
593 items |= ((*pat++ & 15) + 9) & 15;
595 items |= *pat++ & 15;
599 *aptr++ = items & 0xff;
605 for (len = 0; len++ < aint;) {
607 items |= (((*pat++ & 15) + 9) & 15) << 4;
609 items |= (*pat++ & 15) << 4;
613 *aptr++ = items & 0xff;
619 *aptr++ = items & 0xff;
620 pat = str->str_ptr + str->str_cur;
632 aint = (int)str_gnum(fromstr);
634 str_ncat(str,&achar,sizeof(char));
637 /* Float and double added by gnb@melba.bby.oz.au 22/11/89 */
642 afloat = (float)str_gnum(fromstr);
643 str_ncat(str, (char *)&afloat, sizeof (float));
650 adouble = (double)str_gnum(fromstr);
651 str_ncat(str, (char *)&adouble, sizeof (double));
657 ashort = (short)str_gnum(fromstr);
659 ashort = htons(ashort);
661 str_ncat(str,(char*)&ashort,sizeof(short));
668 ashort = (short)str_gnum(fromstr);
669 str_ncat(str,(char*)&ashort,sizeof(short));
675 auint = U_I(str_gnum(fromstr));
676 str_ncat(str,(char*)&auint,sizeof(unsigned int));
682 aint = (int)str_gnum(fromstr);
683 str_ncat(str,(char*)&aint,sizeof(int));
689 aulong = U_L(str_gnum(fromstr));
691 aulong = htonl(aulong);
693 str_ncat(str,(char*)&aulong,sizeof(unsigned long));
699 aulong = U_L(str_gnum(fromstr));
700 str_ncat(str,(char*)&aulong,sizeof(unsigned long));
706 along = (long)str_gnum(fromstr);
707 str_ncat(str,(char*)&along,sizeof(long));
714 auquad = (unsigned quad)str_gnum(fromstr);
715 str_ncat(str,(char*)&auquad,sizeof(unsigned quad));
721 aquad = (quad)str_gnum(fromstr);
722 str_ncat(str,(char*)&aquad,sizeof(quad));
729 aptr = str_get(fromstr);
730 str_ncat(str,(char*)&aptr,sizeof(char*));
735 aptr = str_get(fromstr);
736 aint = fromstr->str_cur;
737 STR_GROW(str,aint * 4 / 3);
749 doencodes(str, aptr, todo);
760 doencodes(str, s, len)
768 str_ncat(str, hunk, 1);
771 hunk[0] = ' ' + (077 & (*s >> 2));
772 hunk[1] = ' ' + (077 & ((*s << 4) & 060 | (s[1] >> 4) & 017));
773 hunk[2] = ' ' + (077 & ((s[1] << 2) & 074 | (s[2] >> 6) & 03));
774 hunk[3] = ' ' + (077 & (s[2] & 077));
775 str_ncat(str, hunk, 4);
779 for (s = str->str_ptr; *s; s++) {
783 str_ncat(str, "\n", 1);
787 do_sprintf(str,len,sarg)
800 static STR *sargnull = &str_no;
810 len--; /* don't count pattern string */
811 t = s = str_get(*sarg);
812 send = s + (*sarg)->str_cur;
817 if (len <= 0 || !(arg = *sarg++))
821 for ( ; t < send && *t != '%'; t++) ;
823 break; /* end of format string, ignore extra args */
832 for (t++; t < send; t++) {
841 case '0': case '1': case '2': case '3': case '4':
842 case '5': case '6': case '7': case '8': case '9':
843 case '.': case '#': case '-': case '+': case ' ':
857 xlen = (int)str_gnum(arg);
858 if (strEQ(f,"%c")) { /* some printfs fail on null chars */
864 (void)sprintf(xs,f,xlen);
876 (void)sprintf(buf,s,(quad)str_gnum(arg));
880 (void)sprintf(xs,f,(long)str_gnum(arg));
882 (void)sprintf(xs,f,(int)str_gnum(arg));
888 case 'x': case 'o': case 'u':
891 value = str_gnum(arg);
894 (void)sprintf(buf,s,(unsigned quad)value);
898 (void)sprintf(xs,f,U_L(value));
900 (void)sprintf(xs,f,U_I(value));
903 case 'E': case 'e': case 'f': case 'G': case 'g':
906 (void)sprintf(xs,f,str_gnum(arg));
914 if (*xs == 'S' && xs[1] == 't' && xs[2] == 'B' && xs[3] == '\0'
915 && xlen == sizeof(STBP)) {
916 STR *tmpstr = Str_new(24,0);
918 stab_fullname(tmpstr, ((STAB*)arg)); /* a stab value! */
919 sprintf(tokenbuf,"*%s",tmpstr->str_ptr);
920 /* reformat to non-binary */
922 xlen = strlen(tokenbuf);
925 if (strEQ(f,"%s")) { /* some printfs fail on >128 chars */
926 break; /* so handle simple cases */
928 else if (f[1] == '-') {
929 char *mp = index(f, '.');
935 int max = atoi(mp+1);
942 else if (isDIGIT(f[1])) {
943 char *mp = index(f, '.');
949 int max = atoi(mp+1);
956 strcpy(tokenbuf+64,f); /* sprintf($s,...$s...) */
958 (void)sprintf(buf,tokenbuf+64,xs);
963 /* end of switch, copy results */
965 STR_GROW(str, str->str_cur + (f - s) + xlen + 1 + pre + post);
966 str_ncat(str, s, f - s);
968 repeatcpy(str->str_ptr + str->str_cur, " ", 1, pre);
971 str_ncat(str, xs, xlen);
973 repeatcpy(str->str_ptr + str->str_cur, " ", 1, post);
974 str->str_cur += post;
977 break; /* break from for loop */
980 str_ncat(str, s, t - s);
989 register STR **st = stack->ary_array;
990 register int sp = arglast[1];
991 register int items = arglast[2] - sp;
992 register STR *str = &str_undef;
994 for (st += ++sp; items > 0; items--,st++) {
998 (void)apush(ary,str);
1004 do_unshift(ary,arglast)
1005 register ARRAY *ary;
1008 register STR **st = stack->ary_array;
1009 register int sp = arglast[1];
1010 register int items = arglast[2] - sp;
1014 aunshift(ary,items);
1016 for (st += ++sp; i < items; i++,st++) {
1017 str = Str_new(27,0);
1019 (void)astore(ary,i,str);
1024 do_subr(arg,gimme,arglast)
1029 register STR **st = stack->ary_array;
1030 register int sp = arglast[1];
1031 register int items = arglast[2] - sp;
1035 int oldsave = savestack->ary_fill;
1036 int oldtmps_base = tmps_base;
1037 int hasargs = ((arg[2].arg_type & A_MASK) != A_NULL);
1040 if ((arg[1].arg_type & A_MASK) == A_WORD)
1041 stab = arg[1].arg_ptr.arg_stab;
1043 STR *tmpstr = STAB_STR(arg[1].arg_ptr.arg_stab);
1046 stab = stabent(str_get(tmpstr),TRUE);
1051 fatal("Undefined subroutine called");
1052 if (!(sub = stab_sub(stab))) {
1053 STR *tmpstr = arg[0].arg_ptr.arg_str;
1055 stab_fullname(tmpstr, stab);
1056 fatal("Undefined subroutine \"%s\" called",tmpstr->str_ptr);
1058 if (arg->arg_type == O_DBSUBR && !sub->usersub) {
1059 str = stab_val(DBsub);
1061 stab_fullname(str,stab);
1062 sub = stab_sub(DBsub);
1064 fatal("No DBsub routine");
1066 str = Str_new(15, sizeof(CSV));
1067 str->str_state = SS_SCSV;
1068 (void)apush(savestack,str);
1069 csv = (CSV*)str->str_ptr;
1072 csv->curcsv = curcsv;
1073 csv->curcmd = curcmd;
1074 csv->depth = sub->depth;
1075 csv->wantarray = gimme;
1076 csv->hasargs = hasargs;
1080 csv->savearray = Null(ARRAY*);;
1081 csv->argarray = Null(ARRAY*);
1082 st[sp] = arg->arg_ptr.arg_str;
1085 return (*sub->usersub)(sub->userindex,sp,items);
1088 csv->savearray = stab_xarray(defstab);
1089 csv->argarray = afake(defstab, items, &st[sp+1]);
1090 stab_xarray(defstab) = csv->argarray;
1093 if (sub->depth >= 2) { /* save temporaries on recursion? */
1094 if (sub->depth == 100 && dowarn)
1095 warn("Deep recursion on subroutine \"%s\"",stab_name(stab));
1096 savelist(sub->tosave->ary_array,sub->tosave->ary_fill);
1098 tmps_base = tmps_max;
1099 sp = cmd_exec(sub->cmd,gimme, --sp); /* so do it already */
1100 st = stack->ary_array;
1102 tmps_base = oldtmps_base;
1103 for (items = arglast[0] + 1; items <= sp; items++)
1104 st[items] = str_mortal(st[items]);
1105 /* in case restore wipes old str */
1106 restorelist(oldsave);
1111 do_assign(arg,gimme,arglast)
1117 register STR **st = stack->ary_array;
1118 STR **firstrelem = st + arglast[1] + 1;
1119 STR **firstlelem = st + arglast[0] + 1;
1120 STR **lastrelem = st + arglast[2];
1121 STR **lastlelem = st + arglast[1];
1122 register STR **relem;
1123 register STR **lelem;
1126 register ARRAY *ary;
1127 register int makelocal;
1131 makelocal = (arg->arg_flags & AF_LOCAL) != 0;
1132 localizing = makelocal;
1133 delaymagic = DM_DELAY; /* catch simultaneous items */
1135 /* If there's a common identifier on both sides we have to take
1136 * special care that assigning the identifier on the left doesn't
1137 * clobber a value on the right that's used later in the list.
1139 if (arg->arg_flags & AF_COMMON) {
1140 for (relem = firstrelem; relem <= lastrelem; relem++) {
1143 *relem = str_mortal(str);
1150 while (lelem <= lastlelem) {
1152 if (str->str_state >= SS_HASH) {
1153 if (str->str_state == SS_ARY) {
1155 ary = saveary(str->str_u.str_stab);
1157 ary = stab_array(str->str_u.str_stab);
1161 while (relem <= lastrelem) { /* gobble up all the rest */
1162 str = Str_new(28,0);
1164 str_sset(str,*relem);
1166 (void)astore(ary,i++,str);
1169 else if (str->str_state == SS_HASH) {
1173 STAB *tmpstab = str->str_u.str_stab;
1176 hash = savehash(str->str_u.str_stab);
1178 hash = stab_hash(str->str_u.str_stab);
1179 if (tmpstab == envstab) {
1181 environ[0] = Nullch;
1183 else if (tmpstab == sigstab) {
1188 for (i = 1; i < NSIG; i++)
1189 signal(i, SIG_DFL); /* crunch, crunch, crunch */
1192 else if (hash->tbl_dbm)
1195 hclear(hash, magic == 'D'); /* wipe any dbm file too */
1198 while (relem < lastrelem) { /* gobble up all the rest */
1202 str = &str_no, relem++;
1203 tmps = str_get(str);
1204 tmpstr = Str_new(29,0);
1206 str_sset(tmpstr,*relem); /* value */
1207 *(relem++) = tmpstr;
1208 (void)hstore(hash,tmps,str->str_cur,tmpstr,0);
1210 str_magic(tmpstr, tmpstab, magic, tmps, str->str_cur);
1211 stabset(tmpstr->str_magic, tmpstr);
1216 fatal("panic: do_assign");
1221 if (relem <= lastrelem) {
1222 str_sset(str, *relem);
1226 str_sset(str, &str_undef);
1227 if (gimme == G_ARRAY) {
1228 i = ++lastrelem - firstrelem;
1229 relem++; /* tacky, I suppose */
1230 astore(stack,i,str);
1231 if (st != stack->ary_array) {
1232 st = stack->ary_array;
1233 firstrelem = st + arglast[1] + 1;
1234 firstlelem = st + arglast[0] + 1;
1235 lastlelem = st + arglast[1];
1237 relem = lastrelem + 1;
1244 if (delaymagic > 1) {
1245 if (delaymagic & DM_REUID) {
1249 if (uid != euid || setuid(uid) < 0)
1250 fatal("No setreuid available");
1253 if (delaymagic & DM_REGID) {
1257 if (gid != egid || setgid(gid) < 0)
1258 fatal("No setregid available");
1264 if (gimme == G_ARRAY) {
1265 i = lastrelem - firstrelem + 1;
1267 Copy(firstrelem, firstlelem, i, STR*);
1268 return arglast[0] + i;
1271 str_numset(arg->arg_ptr.arg_str,(double)(arglast[2] - arglast[1]));
1272 *firstlelem = arg->arg_ptr.arg_str;
1273 return arglast[0] + 1;
1277 int /*SUPPRESS 590*/
1278 do_study(str,arg,gimme,arglast)
1284 register unsigned char *s;
1285 register int pos = str->str_cur;
1287 register int *sfirst;
1288 register int *snext;
1289 static int maxscream = -1;
1290 static STR *lastscream = Nullstr;
1292 int retarg = arglast[0] + 1;
1295 s = (unsigned char*)(str_get(str));
1297 s = Null(unsigned char*);
1300 lastscream->str_pok &= ~SP_STUDIED;
1306 if (pos > maxscream) {
1307 if (maxscream < 0) {
1308 maxscream = pos + 80;
1309 New(301,screamfirst, 256, int);
1310 New(302,screamnext, maxscream, int);
1313 maxscream = pos + pos / 4;
1314 Renew(screamnext, maxscream, int);
1318 sfirst = screamfirst;
1321 if (!sfirst || !snext)
1322 fatal("do_study: out of memory");
1324 for (ch = 256; ch; --ch)
1328 while (--pos >= 0) {
1330 if (sfirst[ch] >= 0)
1331 snext[pos] = sfirst[ch] - pos;
1336 /* If there were any case insensitive searches, we must assume they
1337 * all are. This speeds up insensitive searches much more than
1338 * it slows down sensitive ones.
1341 sfirst[fold[ch]] = pos;
1344 str->str_pok |= SP_STUDIED;
1347 str_numset(arg->arg_ptr.arg_str,(double)retval);
1348 stack->ary_array[retarg] = arg->arg_ptr.arg_str;
1352 int /*SUPPRESS 590*/
1353 do_defined(str,arg,gimme,arglast)
1360 register int retarg = arglast[0] + 1;
1365 if ((arg[1].arg_type & A_MASK) != A_LEXPR)
1366 fatal("Illegal argument to defined()");
1367 arg = arg[1].arg_ptr.arg_arg;
1368 type = arg->arg_type;
1370 if (type == O_SUBR || type == O_DBSUBR) {
1371 if ((arg[1].arg_type & A_MASK) == A_WORD)
1372 retval = stab_sub(arg[1].arg_ptr.arg_stab) != 0;
1374 STR *tmpstr = STAB_STR(arg[1].arg_ptr.arg_stab);
1376 retval = tmpstr && stab_sub(stabent(str_get(tmpstr),TRUE)) != 0;
1379 else if (type == O_ARRAY || type == O_LARRAY ||
1380 type == O_ASLICE || type == O_LASLICE )
1381 retval = ((ary = stab_xarray(arg[1].arg_ptr.arg_stab)) != 0
1382 && ary->ary_max >= 0 );
1383 else if (type == O_HASH || type == O_LHASH ||
1384 type == O_HSLICE || type == O_LHSLICE )
1385 retval = ((hash = stab_xhash(arg[1].arg_ptr.arg_stab)) != 0
1386 && hash->tbl_array);
1389 str_numset(str,(double)retval);
1390 stack->ary_array[retarg] = str;
1394 int /*SUPPRESS 590*/
1395 do_undef(str,arg,gimme,arglast)
1402 register STAB *stab;
1403 int retarg = arglast[0] + 1;
1405 if ((arg[1].arg_type & A_MASK) != A_LEXPR)
1406 fatal("Illegal argument to undef()");
1407 arg = arg[1].arg_ptr.arg_arg;
1408 type = arg->arg_type;
1410 if (type == O_ARRAY || type == O_LARRAY) {
1411 stab = arg[1].arg_ptr.arg_stab;
1412 afree(stab_xarray(stab));
1413 stab_xarray(stab) = anew(stab); /* so "@array" still works */
1415 else if (type == O_HASH || type == O_LHASH) {
1416 stab = arg[1].arg_ptr.arg_stab;
1417 if (stab == envstab)
1418 environ[0] = Nullch;
1419 else if (stab == sigstab) {
1422 for (i = 1; i < NSIG; i++)
1423 signal(i, SIG_DFL); /* munch, munch, munch */
1425 (void)hfree(stab_xhash(stab), TRUE);
1426 stab_xhash(stab) = Null(HASH*);
1428 else if (type == O_SUBR || type == O_DBSUBR) {
1429 stab = arg[1].arg_ptr.arg_stab;
1430 if ((arg[1].arg_type & A_MASK) != A_WORD) {
1431 STR *tmpstr = STAB_STR(arg[1].arg_ptr.arg_stab);
1434 stab = stabent(str_get(tmpstr),TRUE);
1438 if (stab && stab_sub(stab)) {
1439 cmd_free(stab_sub(stab)->cmd);
1440 stab_sub(stab)->cmd = Nullcmd;
1441 afree(stab_sub(stab)->tosave);
1442 Safefree(stab_sub(stab));
1443 stab_sub(stab) = Null(SUBR*);
1447 fatal("Can't undefine that kind of object");
1448 str_numset(str,0.0);
1449 stack->ary_array[retarg] = str;
1454 do_vec(lvalue,astr,arglast)
1459 STR **st = stack->ary_array;
1460 int sp = arglast[0];
1461 register STR *str = st[++sp];
1462 register int offset = (int)str_gnum(st[++sp]);
1463 register int size = (int)str_gnum(st[++sp]);
1464 unsigned char *s = (unsigned char*)str_get(str);
1465 unsigned long retnum;
1469 offset *= size; /* turn into bit offset */
1470 len = (offset + size + 7) / 8;
1471 if (offset < 0 || size < 1)
1473 else if (!lvalue && len > str->str_cur)
1476 if (len > str->str_cur) {
1478 (void)bzero(str->str_ptr + str->str_cur, len - str->str_cur);
1481 s = (unsigned char*)str_get(str);
1483 retnum = (s[offset >> 3] >> (offset & 7)) & ((1 << size) - 1);
1488 else if (size == 16)
1489 retnum = ((unsigned long) s[offset] << 8) + s[offset+1];
1490 else if (size == 32)
1491 retnum = ((unsigned long) s[offset] << 24) +
1492 ((unsigned long) s[offset + 1] << 16) +
1493 (s[offset + 2] << 8) + s[offset+3];
1496 if (lvalue) { /* it's an lvalue! */
1497 struct lstring *lstr = (struct lstring*)astr;
1499 astr->str_magic = str;
1500 st[sp]->str_rare = 'v';
1501 lstr->lstr_offset = offset;
1502 lstr->lstr_len = size;
1506 str_numset(astr,(double)retnum);
1516 struct lstring *lstr = (struct lstring*)str;
1517 register int offset;
1519 register unsigned char *s = (unsigned char*)mstr->str_ptr;
1520 register unsigned long lval = U_L(str_gnum(str));
1524 str->str_magic = Nullstr;
1525 offset = lstr->lstr_offset;
1526 size = lstr->lstr_len;
1528 mask = (1 << size) - 1;
1532 s[offset] &= ~(mask << size);
1533 s[offset] |= lval << size;
1537 s[offset] = lval & 255;
1538 else if (size == 16) {
1539 s[offset] = (lval >> 8) & 255;
1540 s[offset+1] = lval & 255;
1542 else if (size == 32) {
1543 s[offset] = (lval >> 24) & 255;
1544 s[offset+1] = (lval >> 16) & 255;
1545 s[offset+2] = (lval >> 8) & 255;
1546 s[offset+3] = lval & 255;
1555 register char *tmps;
1563 if (str->str_state == SS_ARY) {
1564 ary = stab_array(str->str_u.str_stab);
1565 for (i = 0; i <= ary->ary_fill; i++)
1566 do_chop(astr,ary->ary_array[i]);
1569 if (str->str_state == SS_HASH) {
1570 hash = stab_hash(str->str_u.str_stab);
1571 (void)hiterinit(hash);
1573 while (entry = hiternext(hash))
1574 do_chop(astr,hiterval(hash,entry));
1577 tmps = str_get(str);
1578 if (tmps && str->str_cur) {
1579 tmps += str->str_cur - 1;
1580 str_nset(astr,tmps,1); /* remember last char */
1581 *tmps = '\0'; /* wipe it out */
1582 str->str_cur = tmps - str->str_ptr;
1587 str_nset(astr,"",0);
1590 do_vop(optype,str,left,right)
1596 register char *l = str_get(left);
1597 register char *r = str_get(right);
1600 len = left->str_cur;
1601 if (len > right->str_cur)
1602 len = right->str_cur;
1603 if (str->str_cur > len)
1605 else if (str->str_cur < len) {
1607 (void)bzero(str->str_ptr + str->str_cur, len - str->str_cur);
1631 if (right->str_cur > len)
1632 str_ncat(str,right->str_ptr+len,right->str_cur - len);
1633 else if (left->str_cur > len)
1634 str_ncat(str,left->str_ptr+len,left->str_cur - len);
1643 register STR **st = stack->ary_array;
1644 register int sp = arglast[1];
1645 register int items = arglast[2] - sp;
1646 unsigned long arg[8];
1652 for (st += ++sp; items--; st++)
1653 tainted |= (*st)->str_tainted;
1654 st = stack->ary_array;
1656 items = arglast[2] - sp;
1659 taintproper("Insecure dependency in syscall");
1661 /* This probably won't work on machines where sizeof(long) != sizeof(int)
1662 * or where sizeof(long) != sizeof(char*). But such machines will
1663 * not likely have syscall implemented either, so who cares?
1666 if (st[++sp]->str_nok || !i)
1667 arg[i++] = (unsigned long)str_gnum(st[sp]);
1670 arg[i++] = (unsigned long)st[sp]->str_ptr;
1674 items = arglast[2] - sp;
1677 fatal("Too few args to syscall");
1679 retval = syscall(arg[0]);
1682 retval = syscall(arg[0],arg[1]);
1685 retval = syscall(arg[0],arg[1],arg[2]);
1688 retval = syscall(arg[0],arg[1],arg[2],arg[3]);
1691 retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4]);
1694 retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5]);
1697 retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6]);
1700 retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6],
1706 fatal("syscall() unimplemented");