1 /* $RCSfile: doarg.c,v $$Revision: 4.0.1.3 $$Date: 91/06/10 01:18:41 $
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.3 91/06/10 01:18:41 lwall
10 * patch10: pack(hh,1) dumped core
12 * Revision 4.0.1.2 91/06/07 10:42:17 lwall
13 * patch4: new copyright notice
14 * patch4: // wouldn't use previous pattern if it started with a null character
15 * patch4: //o and s///o now optimize themselves fully at runtime
16 * patch4: added global modifier for pattern matches
17 * patch4: undef @array disabled "@array" interpolation
18 * patch4: chop("") was returning "\0" rather than ""
19 * patch4: vector logical operations &, | and ^ sometimes returned null string
20 * patch4: syscall couldn't pass numbers with most significant bit set on sparcs
22 * Revision 4.0.1.1 91/04/11 17:40:14 lwall
23 * patch1: fixed undefined environ problem
24 * patch1: fixed debugger coredump on subroutines
26 * Revision 4.0 91/03/20 01:06:42 lwall
34 #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
38 extern unsigned char fold[];
41 #pragma function(memcmp)
42 #endif /* BUGGY_MSC */
53 register char *s = str_get(str);
54 char *strend = s + str->str_cur;
60 int maxiters = (strend - s) + 10;
66 rspat = spat = arg[2].arg_ptr.arg_spat;
68 fatal("panic: do_subst");
69 else if (spat->spat_runtime) {
71 (void)eval(spat->spat_runtime,G_SCALAR,sp);
72 m = str_get(dstr = stack->ary_array[sp+1]);
74 if (spat->spat_regexp) {
75 regfree(spat->spat_regexp);
76 spat->spat_regexp = Null(REGEXP*); /* required if regcomp pukes */
78 spat->spat_regexp = regcomp(m,m+dstr->str_cur,
79 spat->spat_flags & SPAT_FOLD);
80 if (spat->spat_flags & SPAT_KEEP) {
81 arg_free(spat->spat_runtime); /* it won't change, so */
82 spat->spat_runtime = Nullarg; /* no point compiling again */
83 scanconst(spat, m, dstr->str_cur);
85 if (curcmd->c_expr && (curcmd->c_flags & CF_OPTIMIZE) == CFT_EVAL) {
86 curcmd->c_flags &= ~CF_OPTIMIZE;
87 opt_arg(curcmd, 1, curcmd->c_type == C_EXPR);
93 deb("2.SPAT /%s/\n",spat->spat_regexp->precomp);
96 safebase = ((!spat->spat_regexp || !spat->spat_regexp->nparens) &&
98 if (!spat->spat_regexp->prelen && lastspat)
102 if (hint < s || hint > strend)
103 fatal("panic: hint in do_match");
106 if (spat->spat_regexp->regback >= 0) {
107 s -= spat->spat_regexp->regback;
114 else if (spat->spat_short) {
115 if (spat->spat_flags & SPAT_SCANFIRST) {
116 if (str->str_pok & SP_STUDIED) {
117 if (screamfirst[spat->spat_short->str_rare] < 0)
119 else if (!(s = screaminstr(str,spat->spat_short)))
123 else if (!(s = fbminstr((unsigned char*)s, (unsigned char*)strend,
127 if (s && spat->spat_regexp->regback >= 0) {
128 ++spat->spat_short->str_u.str_useful;
129 s -= spat->spat_regexp->regback;
136 else if (!multiline && (*spat->spat_short->str_ptr != *s ||
137 bcmp(spat->spat_short->str_ptr, s, spat->spat_slen) ))
139 if (--spat->spat_short->str_u.str_useful < 0) {
140 str_free(spat->spat_short);
141 spat->spat_short = Nullstr; /* opt is being useless */
144 once = !(rspat->spat_flags & SPAT_GLOBAL);
145 if (rspat->spat_flags & SPAT_CONST) { /* known replacement string? */
146 if ((rspat->spat_repl[1].arg_type & A_MASK) == A_SINGLE)
147 dstr = rspat->spat_repl[1].arg_ptr.arg_str;
148 else { /* constant over loop, anyway */
149 (void)eval(rspat->spat_repl,G_SCALAR,sp);
150 dstr = stack->ary_array[sp+1];
153 clen = dstr->str_cur;
154 if (clen <= spat->spat_slen + (int)spat->spat_regexp->regback) {
155 /* can do inplace substitution */
156 if (regexec(spat->spat_regexp, s, strend, orig, 0,
157 str->str_pok & SP_STUDIED ? str : Nullstr, safebase)) {
158 if (spat->spat_regexp->subbase) /* oops, no we can't */
162 str->str_pok = SP_VALID; /* disable possible screamer */
164 m = spat->spat_regexp->startp[0];
165 d = spat->spat_regexp->endp[0];
167 if (m - s > strend - d) { /* faster to shorten from end */
169 (void)bcopy(c, m, clen);
174 (void)bcopy(d, m, i);
178 str->str_cur = m - s;
180 str_numset(arg->arg_ptr.arg_str, 1.0);
181 stack->ary_array[++sp] = arg->arg_ptr.arg_str;
184 else if (i = m - s) { /* faster from front */
192 (void)bcopy(c, m, clen);
194 str_numset(arg->arg_ptr.arg_str, 1.0);
195 stack->ary_array[++sp] = arg->arg_ptr.arg_str;
201 (void)bcopy(c,d,clen);
203 str_numset(arg->arg_ptr.arg_str, 1.0);
204 stack->ary_array[++sp] = arg->arg_ptr.arg_str;
210 str_numset(arg->arg_ptr.arg_str, 1.0);
211 stack->ary_array[++sp] = arg->arg_ptr.arg_str;
217 if (iters++ > maxiters)
218 fatal("Substitution loop");
219 m = spat->spat_regexp->startp[0];
226 (void)bcopy(c,d,clen);
229 s = spat->spat_regexp->endp[0];
230 } while (regexec(spat->spat_regexp, s, strend, orig, s == m,
231 Nullstr, TRUE)); /* (don't match same null twice) */
234 str->str_cur = d - str->str_ptr + i;
235 (void)bcopy(s,d,i+1); /* include the Null */
238 str_numset(arg->arg_ptr.arg_str, (double)iters);
239 stack->ary_array[++sp] = arg->arg_ptr.arg_str;
242 str_numset(arg->arg_ptr.arg_str, 0.0);
243 stack->ary_array[++sp] = arg->arg_ptr.arg_str;
249 if (regexec(spat->spat_regexp, s, strend, orig, 0,
250 str->str_pok & SP_STUDIED ? str : Nullstr, safebase)) {
252 dstr = Str_new(25,str_len(str));
253 str_nset(dstr,m,s-m);
254 if (spat->spat_regexp->subbase)
258 if (iters++ > maxiters)
259 fatal("Substitution loop");
260 if (spat->spat_regexp->subbase
261 && spat->spat_regexp->subbase != orig) {
264 orig = spat->spat_regexp->subbase;
266 strend = s + (strend - m);
268 m = spat->spat_regexp->startp[0];
269 str_ncat(dstr,s,m-s);
270 s = spat->spat_regexp->endp[0];
273 str_ncat(dstr,c,clen);
276 char *mysubbase = spat->spat_regexp->subbase;
278 spat->spat_regexp->subbase = Nullch; /* so recursion works */
279 (void)eval(rspat->spat_repl,G_SCALAR,sp);
280 str_scat(dstr,stack->ary_array[sp+1]);
281 if (spat->spat_regexp->subbase)
282 Safefree(spat->spat_regexp->subbase);
283 spat->spat_regexp->subbase = mysubbase;
287 } while (regexec(spat->spat_regexp, s, strend, orig, s == m, Nullstr,
289 str_ncat(dstr,s,strend - s);
290 str_replace(str,dstr);
292 str_numset(arg->arg_ptr.arg_str, (double)iters);
293 stack->ary_array[++sp] = arg->arg_ptr.arg_str;
296 str_numset(arg->arg_ptr.arg_str, 0.0);
297 stack->ary_array[++sp] = arg->arg_ptr.arg_str;
301 ++spat->spat_short->str_u.str_useful;
302 str_numset(arg->arg_ptr.arg_str, 0.0);
303 stack->ary_array[++sp] = arg->arg_ptr.arg_str;
307 #pragma intrinsic(memcmp)
308 #endif /* BUGGY_MSC */
317 register int matches = 0;
321 register int squash = arg[2].arg_len & 1;
323 tbl = (short*) arg[2].arg_ptr.arg_cval;
325 send = s + str->str_cur;
327 fatal("panic: do_trans");
333 if (!arg[2].arg_len) {
335 if ((ch = tbl[*s & 0377]) >= 0) {
345 if ((ch = tbl[*s & 0377]) >= 0) {
347 if (matches++ && squash) {
356 else if (ch == -1) /* -1 is unmapped character */
357 *d++ = *s; /* -2 is delete character */
360 matches += send - d; /* account for disappeared chars */
362 str->str_cur = d - str->str_ptr;
373 register STR **st = stack->ary_array;
374 register int sp = arglast[1];
375 register int items = arglast[2] - sp;
376 register char *delim = str_get(st[sp]);
377 int delimlen = st[sp]->str_cur;
381 str_sset(str, *st++);
385 for (; items > 0; items--,st++) {
386 str_ncat(str,delim,delimlen);
391 for (; items > 0; items--,st++)
402 register STR **st = stack->ary_array;
403 register int sp = arglast[1];
405 register char *pat = str_get(st[sp]);
406 register char *patend = pat + st[sp]->str_cur;
410 static char *null10 = "\0\0\0\0\0\0\0\0\0\0";
411 static char *space10 = " ";
413 /* These must not be in registers: */
419 unsigned long aulong;
424 items = arglast[2] - sp;
427 while (pat < patend) {
428 #define NEXTFROM (items-- > 0 ? *st++ : &str_no)
431 len = index("@Xxu",datumtype) ? 0 : items;
434 else if (isdigit(*pat)) {
436 while (isdigit(*pat))
437 len = (len * 10) + (*pat++ - '0');
445 fatal("% may only be used in unpack");
456 if (str->str_cur < len)
457 fatal("X outside of string");
459 str->str_ptr[str->str_cur] = '\0';
464 str_ncat(str,null10,10);
467 str_ncat(str,null10,len);
472 aptr = str_get(fromstr);
474 len = fromstr->str_cur;
475 if (fromstr->str_cur > len)
476 str_ncat(str,aptr,len);
478 str_ncat(str,aptr,fromstr->str_cur);
479 len -= fromstr->str_cur;
480 if (datumtype == 'A') {
482 str_ncat(str,space10,10);
485 str_ncat(str,space10,len);
489 str_ncat(str,null10,10);
492 str_ncat(str,null10,len);
504 aptr = str_get(fromstr);
506 len = fromstr->str_cur;
509 str->str_cur += (len+7)/8;
510 STR_GROW(str, str->str_cur + 1);
511 aptr = str->str_ptr + aint;
512 if (len > fromstr->str_cur)
513 len = fromstr->str_cur;
516 if (datumtype == 'B') {
517 for (len = 0; len++ < aint;) {
522 *aptr++ = items & 0xff;
528 for (len = 0; len++ < aint;) {
534 *aptr++ = items & 0xff;
540 if (datumtype == 'B')
541 items <<= 7 - (aint & 7);
543 items >>= 7 - (aint & 7);
544 *aptr++ = items & 0xff;
546 pat = str->str_ptr + str->str_cur;
562 aptr = str_get(fromstr);
564 len = fromstr->str_cur;
567 str->str_cur += (len+1)/2;
568 STR_GROW(str, str->str_cur + 1);
569 aptr = str->str_ptr + aint;
570 if (len > fromstr->str_cur)
571 len = fromstr->str_cur;
574 if (datumtype == 'H') {
575 for (len = 0; len++ < aint;) {
577 items |= ((*pat++ & 15) + 9) & 15;
579 items |= *pat++ & 15;
583 *aptr++ = items & 0xff;
589 for (len = 0; len++ < aint;) {
591 items |= (((*pat++ & 15) + 9) & 15) << 4;
593 items |= (*pat++ & 15) << 4;
597 *aptr++ = items & 0xff;
603 *aptr++ = items & 0xff;
604 pat = str->str_ptr + str->str_cur;
616 aint = (int)str_gnum(fromstr);
618 str_ncat(str,&achar,sizeof(char));
621 /* Float and double added by gnb@melba.bby.oz.au 22/11/89 */
626 afloat = (float)str_gnum(fromstr);
627 str_ncat(str, (char *)&afloat, sizeof (float));
634 adouble = (double)str_gnum(fromstr);
635 str_ncat(str, (char *)&adouble, sizeof (double));
641 ashort = (short)str_gnum(fromstr);
643 ashort = htons(ashort);
645 str_ncat(str,(char*)&ashort,sizeof(short));
652 ashort = (short)str_gnum(fromstr);
653 str_ncat(str,(char*)&ashort,sizeof(short));
659 auint = U_I(str_gnum(fromstr));
660 str_ncat(str,(char*)&auint,sizeof(unsigned int));
666 aint = (int)str_gnum(fromstr);
667 str_ncat(str,(char*)&aint,sizeof(int));
673 aulong = U_L(str_gnum(fromstr));
675 aulong = htonl(aulong);
677 str_ncat(str,(char*)&aulong,sizeof(unsigned long));
683 aulong = U_L(str_gnum(fromstr));
684 str_ncat(str,(char*)&aulong,sizeof(unsigned long));
690 along = (long)str_gnum(fromstr);
691 str_ncat(str,(char*)&along,sizeof(long));
697 aptr = str_get(fromstr);
698 str_ncat(str,(char*)&aptr,sizeof(char*));
703 aptr = str_get(fromstr);
704 aint = fromstr->str_cur;
705 STR_GROW(str,aint * 4 / 3);
717 doencodes(str, aptr, todo);
728 doencodes(str, s, len)
736 str_ncat(str, hunk, 1);
739 hunk[0] = ' ' + (077 & (*s >> 2));
740 hunk[1] = ' ' + (077 & ((*s << 4) & 060 | (s[1] >> 4) & 017));
741 hunk[2] = ' ' + (077 & ((s[1] << 2) & 074 | (s[2] >> 6) & 03));
742 hunk[3] = ' ' + (077 & (s[2] & 077));
743 str_ncat(str, hunk, 4);
747 for (s = str->str_ptr; *s; s++) {
751 str_ncat(str, "\n", 1);
755 do_sprintf(str,len,sarg)
765 static STR *sargnull = &str_no;
773 len--; /* don't count pattern string */
774 origs = t = s = str_get(*sarg);
775 send = s + (*sarg)->str_cur;
778 if (len <= 0 || !*sarg) {
782 for ( ; t < send && *t != '%'; t++) ;
784 break; /* end of format string, ignore extra args */
789 for (t++; t < send; t++) {
798 case '0': case '1': case '2': case '3': case '4':
799 case '5': case '6': case '7': case '8': case '9':
800 case '.': case '#': case '-': case '+': case ' ':
808 xlen = (int)str_gnum(*(sarg++));
809 if (strEQ(f,"%c")) { /* some printfs fail on null chars */
815 (void)sprintf(xs,f,xlen);
826 (void)sprintf(xs,f,(long)str_gnum(*(sarg++)));
828 (void)sprintf(xs,f,(int)str_gnum(*(sarg++)));
834 case 'x': case 'o': case 'u':
837 value = str_gnum(*(sarg++));
839 (void)sprintf(xs,f,U_L(value));
841 (void)sprintf(xs,f,U_I(value));
844 case 'E': case 'e': case 'f': case 'G': case 'g':
847 (void)sprintf(xs,f,str_gnum(*(sarg++)));
854 xlen = (*sarg)->str_cur;
855 if (*xs == 'S' && xs[1] == 't' && xs[2] == 'B' && xs[3] == '\0'
856 && xlen == sizeof(STBP)) {
857 STR *tmpstr = Str_new(24,0);
859 stab_fullname(tmpstr, ((STAB*)(*sarg))); /* a stab value! */
860 sprintf(tokenbuf,"*%s",tmpstr->str_ptr);
861 /* reformat to non-binary */
863 xlen = strlen(tokenbuf);
867 if (strEQ(f,"%s")) { /* some printfs fail on >128 chars */
868 break; /* so handle simple case */
870 strcpy(tokenbuf+64,f); /* sprintf($s,...$s...) */
872 (void)sprintf(buf,tokenbuf+64,xs);
877 /* end of switch, copy results */
879 STR_GROW(str, str->str_cur + (f - s) + len + 1);
880 str_ncat(str, s, f - s);
881 str_ncat(str, xs, xlen);
883 break; /* break from for loop */
886 str_ncat(str, s, t - s);
895 register STR **st = stack->ary_array;
896 register int sp = arglast[1];
897 register int items = arglast[2] - sp;
898 register STR *str = &str_undef;
900 for (st += ++sp; items > 0; items--,st++) {
904 (void)apush(ary,str);
910 do_unshift(ary,arglast)
914 register STR **st = stack->ary_array;
915 register int sp = arglast[1];
916 register int items = arglast[2] - sp;
922 for (st += ++sp; i < items; i++,st++) {
925 (void)astore(ary,i,str);
930 do_subr(arg,gimme,arglast)
935 register STR **st = stack->ary_array;
936 register int sp = arglast[1];
937 register int items = arglast[2] - sp;
941 int oldsave = savestack->ary_fill;
942 int oldtmps_base = tmps_base;
943 int hasargs = ((arg[2].arg_type & A_MASK) != A_NULL);
946 if ((arg[1].arg_type & A_MASK) == A_WORD)
947 stab = arg[1].arg_ptr.arg_stab;
949 STR *tmpstr = stab_val(arg[1].arg_ptr.arg_stab);
952 stab = stabent(str_get(tmpstr),TRUE);
957 fatal("Undefined subroutine called");
958 if (!(sub = stab_sub(stab))) {
959 STR *tmpstr = arg[0].arg_ptr.arg_str;
961 stab_fullname(tmpstr, stab);
962 fatal("Undefined subroutine \"%s\" called",tmpstr->str_ptr);
964 if (arg->arg_type == O_DBSUBR && !sub->usersub) {
965 str = stab_val(DBsub);
967 stab_fullname(str,stab);
968 sub = stab_sub(DBsub);
970 fatal("No DBsub routine");
972 str = Str_new(15, sizeof(CSV));
973 str->str_state = SS_SCSV;
974 (void)apush(savestack,str);
975 csv = (CSV*)str->str_ptr;
978 csv->curcsv = curcsv;
979 csv->curcmd = curcmd;
980 csv->depth = sub->depth;
981 csv->wantarray = gimme;
982 csv->hasargs = hasargs;
986 csv->savearray = Null(ARRAY*);;
987 csv->argarray = Null(ARRAY*);
988 st[sp] = arg->arg_ptr.arg_str;
991 return (*sub->usersub)(sub->userindex,sp,items);
994 csv->savearray = stab_xarray(defstab);
995 csv->argarray = afake(defstab, items, &st[sp+1]);
996 stab_xarray(defstab) = csv->argarray;
999 if (sub->depth >= 2) { /* save temporaries on recursion? */
1000 if (sub->depth == 100 && dowarn)
1001 warn("Deep recursion on subroutine \"%s\"",stab_name(stab));
1002 savelist(sub->tosave->ary_array,sub->tosave->ary_fill);
1004 tmps_base = tmps_max;
1005 sp = cmd_exec(sub->cmd,gimme, --sp); /* so do it already */
1006 st = stack->ary_array;
1008 tmps_base = oldtmps_base;
1009 for (items = arglast[0] + 1; items <= sp; items++)
1010 st[items] = str_mortal(st[items]);
1011 /* in case restore wipes old str */
1012 restorelist(oldsave);
1017 do_assign(arg,gimme,arglast)
1023 register STR **st = stack->ary_array;
1024 STR **firstrelem = st + arglast[1] + 1;
1025 STR **firstlelem = st + arglast[0] + 1;
1026 STR **lastrelem = st + arglast[2];
1027 STR **lastlelem = st + arglast[1];
1028 register STR **relem;
1029 register STR **lelem;
1032 register ARRAY *ary;
1033 register int makelocal;
1037 makelocal = (arg->arg_flags & AF_LOCAL);
1038 localizing = makelocal;
1039 delaymagic = DM_DELAY; /* catch simultaneous items */
1041 /* If there's a common identifier on both sides we have to take
1042 * special care that assigning the identifier on the left doesn't
1043 * clobber a value on the right that's used later in the list.
1045 if (arg->arg_flags & AF_COMMON) {
1046 for (relem = firstrelem; relem <= lastrelem; relem++) {
1048 *relem = str_mortal(str);
1055 while (lelem <= lastlelem) {
1057 if (str->str_state >= SS_HASH) {
1058 if (str->str_state == SS_ARY) {
1060 ary = saveary(str->str_u.str_stab);
1062 ary = stab_array(str->str_u.str_stab);
1066 while (relem <= lastrelem) { /* gobble up all the rest */
1067 str = Str_new(28,0);
1069 str_sset(str,*relem);
1071 (void)astore(ary,i++,str);
1074 else if (str->str_state == SS_HASH) {
1078 STAB *tmpstab = str->str_u.str_stab;
1081 hash = savehash(str->str_u.str_stab);
1083 hash = stab_hash(str->str_u.str_stab);
1084 if (tmpstab == envstab) {
1086 environ[0] = Nullch;
1088 else if (tmpstab == sigstab) {
1093 for (i = 1; i < NSIG; i++)
1094 signal(i, SIG_DFL); /* crunch, crunch, crunch */
1097 else if (hash->tbl_dbm)
1100 hclear(hash, magic == 'D'); /* wipe any dbm file too */
1103 while (relem < lastrelem) { /* gobble up all the rest */
1107 str = &str_no, relem++;
1108 tmps = str_get(str);
1109 tmpstr = Str_new(29,0);
1111 str_sset(tmpstr,*relem); /* value */
1112 *(relem++) = tmpstr;
1113 (void)hstore(hash,tmps,str->str_cur,tmpstr,0);
1115 str_magic(tmpstr, tmpstab, magic, tmps, str->str_cur);
1116 stabset(tmpstr->str_magic, tmpstr);
1121 fatal("panic: do_assign");
1126 if (relem <= lastrelem) {
1127 str_sset(str, *relem);
1131 str_sset(str, &str_undef);
1132 if (gimme == G_ARRAY) {
1133 i = ++lastrelem - firstrelem;
1134 relem++; /* tacky, I suppose */
1135 astore(stack,i,str);
1136 if (st != stack->ary_array) {
1137 st = stack->ary_array;
1138 firstrelem = st + arglast[1] + 1;
1139 firstlelem = st + arglast[0] + 1;
1140 lastlelem = st + arglast[1];
1142 relem = lastrelem + 1;
1149 if (delaymagic > 1) {
1150 if (delaymagic & DM_REUID) {
1154 if (uid != euid || setuid(uid) < 0)
1155 fatal("No setreuid available");
1158 if (delaymagic & DM_REGID) {
1162 if (gid != egid || setgid(gid) < 0)
1163 fatal("No setregid available");
1169 if (gimme == G_ARRAY) {
1170 i = lastrelem - firstrelem + 1;
1172 Copy(firstrelem, firstlelem, i, STR*);
1173 return arglast[0] + i;
1176 str_numset(arg->arg_ptr.arg_str,(double)(arglast[2] - arglast[1]));
1177 *firstlelem = arg->arg_ptr.arg_str;
1178 return arglast[0] + 1;
1183 do_study(str,arg,gimme,arglast)
1189 register unsigned char *s;
1190 register int pos = str->str_cur;
1192 register int *sfirst;
1193 register int *snext;
1194 static int maxscream = -1;
1195 static STR *lastscream = Nullstr;
1197 int retarg = arglast[0] + 1;
1200 s = (unsigned char*)(str_get(str));
1202 s = Null(unsigned char*);
1205 lastscream->str_pok &= ~SP_STUDIED;
1211 if (pos > maxscream) {
1212 if (maxscream < 0) {
1213 maxscream = pos + 80;
1214 New(301,screamfirst, 256, int);
1215 New(302,screamnext, maxscream, int);
1218 maxscream = pos + pos / 4;
1219 Renew(screamnext, maxscream, int);
1223 sfirst = screamfirst;
1226 if (!sfirst || !snext)
1227 fatal("do_study: out of memory");
1229 for (ch = 256; ch; --ch)
1233 while (--pos >= 0) {
1235 if (sfirst[ch] >= 0)
1236 snext[pos] = sfirst[ch] - pos;
1241 /* If there were any case insensitive searches, we must assume they
1242 * all are. This speeds up insensitive searches much more than
1243 * it slows down sensitive ones.
1246 sfirst[fold[ch]] = pos;
1249 str->str_pok |= SP_STUDIED;
1252 str_numset(arg->arg_ptr.arg_str,(double)retval);
1253 stack->ary_array[retarg] = arg->arg_ptr.arg_str;
1258 do_defined(str,arg,gimme,arglast)
1265 register int retarg = arglast[0] + 1;
1270 if ((arg[1].arg_type & A_MASK) != A_LEXPR)
1271 fatal("Illegal argument to defined()");
1272 arg = arg[1].arg_ptr.arg_arg;
1273 type = arg->arg_type;
1275 if (type == O_SUBR || type == O_DBSUBR)
1276 retval = stab_sub(arg[1].arg_ptr.arg_stab) != 0;
1277 else if (type == O_ARRAY || type == O_LARRAY ||
1278 type == O_ASLICE || type == O_LASLICE )
1279 retval = ((ary = stab_xarray(arg[1].arg_ptr.arg_stab)) != 0
1280 && ary->ary_max >= 0 );
1281 else if (type == O_HASH || type == O_LHASH ||
1282 type == O_HSLICE || type == O_LHSLICE )
1283 retval = ((hash = stab_xhash(arg[1].arg_ptr.arg_stab)) != 0
1284 && hash->tbl_array);
1287 str_numset(str,(double)retval);
1288 stack->ary_array[retarg] = str;
1293 do_undef(str,arg,gimme,arglast)
1300 register STAB *stab;
1301 int retarg = arglast[0] + 1;
1303 if ((arg[1].arg_type & A_MASK) != A_LEXPR)
1304 fatal("Illegal argument to undef()");
1305 arg = arg[1].arg_ptr.arg_arg;
1306 type = arg->arg_type;
1308 if (type == O_ARRAY || type == O_LARRAY) {
1309 stab = arg[1].arg_ptr.arg_stab;
1310 afree(stab_xarray(stab));
1311 stab_xarray(stab) = anew(stab); /* so "@array" still works */
1313 else if (type == O_HASH || type == O_LHASH) {
1314 stab = arg[1].arg_ptr.arg_stab;
1315 if (stab == envstab)
1316 environ[0] = Nullch;
1317 else if (stab == sigstab) {
1320 for (i = 1; i < NSIG; i++)
1321 signal(i, SIG_DFL); /* munch, munch, munch */
1323 (void)hfree(stab_xhash(stab), TRUE);
1324 stab_xhash(stab) = Null(HASH*);
1326 else if (type == O_SUBR || type == O_DBSUBR) {
1327 stab = arg[1].arg_ptr.arg_stab;
1328 if (stab_sub(stab)) {
1329 cmd_free(stab_sub(stab)->cmd);
1330 stab_sub(stab)->cmd = Nullcmd;
1331 afree(stab_sub(stab)->tosave);
1332 Safefree(stab_sub(stab));
1333 stab_sub(stab) = Null(SUBR*);
1337 fatal("Can't undefine that kind of object");
1338 str_numset(str,0.0);
1339 stack->ary_array[retarg] = str;
1344 do_vec(lvalue,astr,arglast)
1349 STR **st = stack->ary_array;
1350 int sp = arglast[0];
1351 register STR *str = st[++sp];
1352 register int offset = (int)str_gnum(st[++sp]);
1353 register int size = (int)str_gnum(st[++sp]);
1354 unsigned char *s = (unsigned char*)str_get(str);
1355 unsigned long retnum;
1359 offset *= size; /* turn into bit offset */
1360 len = (offset + size + 7) / 8;
1361 if (offset < 0 || size < 1)
1363 else if (!lvalue && len > str->str_cur)
1366 if (len > str->str_cur) {
1368 (void)bzero(str->str_ptr + str->str_cur, len - str->str_cur);
1371 s = (unsigned char*)str_get(str);
1373 retnum = (s[offset >> 3] >> (offset & 7)) & ((1 << size) - 1);
1378 else if (size == 16)
1379 retnum = (s[offset] << 8) + s[offset+1];
1380 else if (size == 32)
1381 retnum = (s[offset] << 24) + (s[offset + 1] << 16) +
1382 (s[offset + 2] << 8) + s[offset+3];
1385 if (lvalue) { /* it's an lvalue! */
1386 struct lstring *lstr = (struct lstring*)astr;
1388 astr->str_magic = str;
1389 st[sp]->str_rare = 'v';
1390 lstr->lstr_offset = offset;
1391 lstr->lstr_len = size;
1395 str_numset(astr,(double)retnum);
1405 struct lstring *lstr = (struct lstring*)str;
1406 register int offset;
1408 register unsigned char *s = (unsigned char*)mstr->str_ptr;
1409 register unsigned long lval = U_L(str_gnum(str));
1413 str->str_magic = Nullstr;
1414 offset = lstr->lstr_offset;
1415 size = lstr->lstr_len;
1417 mask = (1 << size) - 1;
1421 s[offset] &= ~(mask << size);
1422 s[offset] |= lval << size;
1426 s[offset] = lval & 255;
1427 else if (size == 16) {
1428 s[offset] = (lval >> 8) & 255;
1429 s[offset+1] = lval & 255;
1431 else if (size == 32) {
1432 s[offset] = (lval >> 24) & 255;
1433 s[offset+1] = (lval >> 16) & 255;
1434 s[offset+2] = (lval >> 8) & 255;
1435 s[offset+3] = lval & 255;
1444 register char *tmps;
1452 if (str->str_state == SS_ARY) {
1453 ary = stab_array(str->str_u.str_stab);
1454 for (i = 0; i <= ary->ary_fill; i++)
1455 do_chop(astr,ary->ary_array[i]);
1458 if (str->str_state == SS_HASH) {
1459 hash = stab_hash(str->str_u.str_stab);
1460 (void)hiterinit(hash);
1461 while (entry = hiternext(hash))
1462 do_chop(astr,hiterval(hash,entry));
1465 tmps = str_get(str);
1466 if (tmps && str->str_cur) {
1467 tmps += str->str_cur - 1;
1468 str_nset(astr,tmps,1); /* remember last char */
1469 *tmps = '\0'; /* wipe it out */
1470 str->str_cur = tmps - str->str_ptr;
1475 str_nset(astr,"",0);
1478 do_vop(optype,str,left,right)
1484 register char *l = str_get(left);
1485 register char *r = str_get(right);
1488 len = left->str_cur;
1489 if (len > right->str_cur)
1490 len = right->str_cur;
1491 if (str->str_cur > len)
1493 else if (str->str_cur < len) {
1495 (void)bzero(str->str_ptr + str->str_cur, len - str->str_cur);
1519 if (right->str_cur > len)
1520 str_ncat(str,right->str_ptr+len,right->str_cur - len);
1521 else if (left->str_cur > len)
1522 str_ncat(str,left->str_ptr+len,left->str_cur - len);
1531 register STR **st = stack->ary_array;
1532 register int sp = arglast[1];
1533 register int items = arglast[2] - sp;
1534 unsigned long arg[8];
1540 for (st += ++sp; items--; st++)
1541 tainted |= (*st)->str_tainted;
1542 st = stack->ary_array;
1544 items = arglast[2] - sp;
1547 taintproper("Insecure dependency in syscall");
1549 /* This probably won't work on machines where sizeof(long) != sizeof(int)
1550 * or where sizeof(long) != sizeof(char*). But such machines will
1551 * not likely have syscall implemented either, so who cares?
1554 if (st[++sp]->str_nok || !i)
1555 arg[i++] = (unsigned long)str_gnum(st[sp]);
1558 arg[i++] = (unsigned long)st[sp]->str_ptr;
1562 items = arglast[2] - sp;
1565 fatal("Too few args to syscall");
1567 retval = syscall(arg[0]);
1570 retval = syscall(arg[0],arg[1]);
1573 retval = syscall(arg[0],arg[1],arg[2]);
1576 retval = syscall(arg[0],arg[1],arg[2],arg[3]);
1579 retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4]);
1582 retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5]);
1585 retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6]);
1588 retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6],
1594 fatal("syscall() unimplemented");