1 /* $Header: doarg.c,v 3.0.1.10 91/01/11 17:41:39 lwall Locked $
3 * Copyright (c) 1989, Larry Wall
5 * You may distribute under the terms of the GNU General Public License
6 * as specified in the README file that comes with the perl 3.0 kit.
9 * Revision 3.0.1.10 91/01/11 17:41:39 lwall
10 * patch42: added binary and hex pack/unpack options
11 * patch42: fixed casting problem with n and N pack options
12 * patch42: fixed printf("%c", 0)
13 * patch42: the perl debugger was dumping core frequently
15 * Revision 3.0.1.9 90/11/10 01:14:31 lwall
16 * patch38: random cleanup
17 * patch38: optimized join('',...)
18 * patch38: printf cleaned up
20 * Revision 3.0.1.8 90/10/15 16:04:04 lwall
21 * patch29: @ENV = () now works
22 * patch29: added caller
23 * patch29: tr/// now understands c, d and s options, and handles nulls right
24 * patch29: *foo now prints as *package'foo
25 * patch29: added caller
26 * patch29: local() without initialization now creates undefined values
28 * Revision 3.0.1.7 90/08/13 22:14:15 lwall
29 * patch28: the NSIG hack didn't work on Xenix
30 * patch28: defined(@array) and defined(%array) didn't work right
32 * Revision 3.0.1.6 90/08/09 02:48:38 lwall
33 * patch19: fixed double include of <signal.h>
34 * patch19: pack/unpack can now do native float and double
35 * patch19: pack/unpack can now have absolute and negative positioning
36 * patch19: pack/unpack can now have use * to specify all the rest of input
37 * patch19: unpack can do checksumming
38 * patch19: $< and $> better supported on machines without setreuid
39 * patch19: Added support for linked-in C subroutines
41 * Revision 3.0.1.5 90/03/27 15:39:03 lwall
42 * patch16: MSDOS support
43 * patch16: support for machines that can't cast negative floats to unsigned ints
44 * patch16: sprintf($s,...,$s,...) didn't work
46 * Revision 3.0.1.4 90/03/12 16:28:42 lwall
47 * patch13: pack of ascii strings could call str_ncat() with negative length
48 * patch13: printf("%s", *foo) was busted
50 * Revision 3.0.1.3 90/02/28 16:56:58 lwall
51 * patch9: split now can split into more than 10000 elements
52 * patch9: sped up pack and unpack
53 * patch9: pack of unsigned ints and longs blew up some places
54 * patch9: sun3 can't cast negative float to unsigned int or long
55 * patch9: local($.) didn't work
56 * patch9: grep(s/foo/bar/, @abc = @xyz) modified @xyz rather than @abc
57 * patch9: syscall returned stack size rather than value of system call
59 * Revision 3.0.1.2 89/12/21 19:52:15 lwall
60 * patch7: a pattern wouldn't match a null string before the first character
61 * patch7: certain patterns didn't match correctly at end of string
63 * Revision 3.0.1.1 89/11/11 04:17:20 lwall
64 * patch2: printf %c, %D, %X and %O didn't work right
65 * patch2: printf of unsigned vs signed needed separate casts on some machines
67 * Revision 3.0 89/10/18 15:10:41 lwall
75 #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
79 extern unsigned char fold[];
81 extern char **environ;
84 #pragma function(memcmp)
85 #endif /* BUGGY_MSC */
96 register char *s = str_get(str);
97 char *strend = s + str->str_cur;
103 int maxiters = (strend - s) + 10;
109 rspat = spat = arg[2].arg_ptr.arg_spat;
111 fatal("panic: do_subst");
112 else if (spat->spat_runtime) {
114 (void)eval(spat->spat_runtime,G_SCALAR,sp);
115 m = str_get(dstr = stack->ary_array[sp+1]);
117 if (spat->spat_regexp)
118 regfree(spat->spat_regexp);
119 spat->spat_regexp = regcomp(m,m+dstr->str_cur,
120 spat->spat_flags & SPAT_FOLD);
121 if (spat->spat_flags & SPAT_KEEP) {
122 arg_free(spat->spat_runtime); /* it won't change, so */
123 spat->spat_runtime = Nullarg; /* no point compiling again */
128 deb("2.SPAT /%s/\n",spat->spat_regexp->precomp);
131 safebase = ((!spat->spat_regexp || !spat->spat_regexp->nparens) &&
133 if (!*spat->spat_regexp->precomp && lastspat)
137 if (hint < s || hint > strend)
138 fatal("panic: hint in do_match");
141 if (spat->spat_regexp->regback >= 0) {
142 s -= spat->spat_regexp->regback;
149 else if (spat->spat_short) {
150 if (spat->spat_flags & SPAT_SCANFIRST) {
151 if (str->str_pok & SP_STUDIED) {
152 if (screamfirst[spat->spat_short->str_rare] < 0)
154 else if (!(s = screaminstr(str,spat->spat_short)))
158 else if (!(s = fbminstr((unsigned char*)s, (unsigned char*)strend,
162 if (s && spat->spat_regexp->regback >= 0) {
163 ++spat->spat_short->str_u.str_useful;
164 s -= spat->spat_regexp->regback;
171 else if (!multiline && (*spat->spat_short->str_ptr != *s ||
172 bcmp(spat->spat_short->str_ptr, s, spat->spat_slen) ))
174 if (--spat->spat_short->str_u.str_useful < 0) {
175 str_free(spat->spat_short);
176 spat->spat_short = Nullstr; /* opt is being useless */
179 once = ((rspat->spat_flags & SPAT_ONCE) != 0);
180 if (rspat->spat_flags & SPAT_CONST) { /* known replacement string? */
181 if ((rspat->spat_repl[1].arg_type & A_MASK) == A_SINGLE)
182 dstr = rspat->spat_repl[1].arg_ptr.arg_str;
183 else { /* constant over loop, anyway */
184 (void)eval(rspat->spat_repl,G_SCALAR,sp);
185 dstr = stack->ary_array[sp+1];
188 clen = dstr->str_cur;
189 if (clen <= spat->spat_slen + spat->spat_regexp->regback) {
190 /* can do inplace substitution */
191 if (regexec(spat->spat_regexp, s, strend, orig, 0,
192 str->str_pok & SP_STUDIED ? str : Nullstr, safebase)) {
193 if (spat->spat_regexp->subbase) /* oops, no we can't */
197 str->str_pok = SP_VALID; /* disable possible screamer */
199 m = spat->spat_regexp->startp[0];
200 d = spat->spat_regexp->endp[0];
202 if (m - s > strend - d) { /* faster to shorten from end */
204 (void)bcopy(c, m, clen);
209 (void)bcopy(d, m, i);
213 str->str_cur = m - s;
215 str_numset(arg->arg_ptr.arg_str, 1.0);
216 stack->ary_array[++sp] = arg->arg_ptr.arg_str;
219 else if (i = m - s) { /* faster from front */
227 (void)bcopy(c, m, clen);
229 str_numset(arg->arg_ptr.arg_str, 1.0);
230 stack->ary_array[++sp] = arg->arg_ptr.arg_str;
236 (void)bcopy(c,d,clen);
238 str_numset(arg->arg_ptr.arg_str, 1.0);
239 stack->ary_array[++sp] = arg->arg_ptr.arg_str;
245 str_numset(arg->arg_ptr.arg_str, 1.0);
246 stack->ary_array[++sp] = arg->arg_ptr.arg_str;
252 if (iters++ > maxiters)
253 fatal("Substitution loop");
254 m = spat->spat_regexp->startp[0];
261 (void)bcopy(c,d,clen);
264 s = spat->spat_regexp->endp[0];
265 } while (regexec(spat->spat_regexp, s, strend, orig, s == m,
266 Nullstr, TRUE)); /* (don't match same null twice) */
269 str->str_cur = d - str->str_ptr + i;
270 (void)bcopy(s,d,i+1); /* include the Null */
273 str_numset(arg->arg_ptr.arg_str, (double)iters);
274 stack->ary_array[++sp] = arg->arg_ptr.arg_str;
277 str_numset(arg->arg_ptr.arg_str, 0.0);
278 stack->ary_array[++sp] = arg->arg_ptr.arg_str;
284 if (regexec(spat->spat_regexp, s, strend, orig, 0,
285 str->str_pok & SP_STUDIED ? str : Nullstr, safebase)) {
287 dstr = Str_new(25,str_len(str));
288 str_nset(dstr,m,s-m);
289 if (spat->spat_regexp->subbase)
293 if (iters++ > maxiters)
294 fatal("Substitution loop");
295 if (spat->spat_regexp->subbase
296 && spat->spat_regexp->subbase != orig) {
299 orig = spat->spat_regexp->subbase;
301 strend = s + (strend - m);
303 m = spat->spat_regexp->startp[0];
304 str_ncat(dstr,s,m-s);
305 s = spat->spat_regexp->endp[0];
308 str_ncat(dstr,c,clen);
311 (void)eval(rspat->spat_repl,G_SCALAR,sp);
312 str_scat(dstr,stack->ary_array[sp+1]);
316 } while (regexec(spat->spat_regexp, s, strend, orig, s == m, Nullstr,
318 str_ncat(dstr,s,strend - s);
319 str_replace(str,dstr);
321 str_numset(arg->arg_ptr.arg_str, (double)iters);
322 stack->ary_array[++sp] = arg->arg_ptr.arg_str;
325 str_numset(arg->arg_ptr.arg_str, 0.0);
326 stack->ary_array[++sp] = arg->arg_ptr.arg_str;
330 ++spat->spat_short->str_u.str_useful;
331 str_numset(arg->arg_ptr.arg_str, 0.0);
332 stack->ary_array[++sp] = arg->arg_ptr.arg_str;
336 #pragma intrinsic(memcmp)
337 #endif /* BUGGY_MSC */
346 register int matches = 0;
350 register int squash = arg[2].arg_len & 1;
352 tbl = (short*) arg[2].arg_ptr.arg_cval;
354 send = s + str->str_cur;
356 fatal("panic: do_trans");
362 if (!arg[2].arg_len) {
364 if ((ch = tbl[*s & 0377]) >= 0) {
374 if ((ch = tbl[*s & 0377]) >= 0) {
376 if (matches++ && squash) {
385 else if (ch == -1) /* -1 is unmapped character */
386 *d++ = *s; /* -2 is delete character */
389 matches += send - d; /* account for disappeared chars */
391 str->str_cur = d - str->str_ptr;
402 register STR **st = stack->ary_array;
403 register int sp = arglast[1];
404 register int items = arglast[2] - sp;
405 register char *delim = str_get(st[sp]);
406 int delimlen = st[sp]->str_cur;
414 for (; items > 0; items--,st++) {
415 str_ncat(str,delim,delimlen);
420 for (; items > 0; items--,st++)
431 register STR **st = stack->ary_array;
432 register int sp = arglast[1];
434 register char *pat = str_get(st[sp]);
435 register char *patend = pat + st[sp]->str_cur;
439 static char *null10 = "\0\0\0\0\0\0\0\0\0\0";
440 static char *space10 = " ";
442 /* These must not be in registers: */
448 unsigned long aulong;
453 items = arglast[2] - sp;
456 while (pat < patend) {
457 #define NEXTFROM (items-- > 0 ? *st++ : &str_no)
460 len = index("@Xxu",datumtype) ? 0 : items;
463 else if (isdigit(*pat)) {
465 while (isdigit(*pat))
466 len = (len * 10) + (*pat++ - '0');
474 fatal("% may only be used in unpack");
485 if (str->str_cur < len)
486 fatal("X outside of string");
488 str->str_ptr[str->str_cur] = '\0';
493 str_ncat(str,null10,10);
496 str_ncat(str,null10,len);
501 aptr = str_get(fromstr);
503 len = fromstr->str_cur;
504 if (fromstr->str_cur > len)
505 str_ncat(str,aptr,len);
507 str_ncat(str,aptr,fromstr->str_cur);
508 len -= fromstr->str_cur;
509 if (datumtype == 'A') {
511 str_ncat(str,space10,10);
514 str_ncat(str,space10,len);
518 str_ncat(str,null10,10);
521 str_ncat(str,null10,len);
529 int saveitems = items;
532 aptr = str_get(fromstr);
534 len = fromstr->str_cur;
537 str->str_cur += (len+7)/8;
538 STR_GROW(str, str->str_cur + 1);
539 aptr = str->str_ptr + aint;
540 if (len > fromstr->str_cur)
541 len = fromstr->str_cur;
544 if (datumtype == 'B') {
545 for (len = 0; len++ < aint;) {
550 *aptr++ = items & 0xff;
556 for (len = 0; len++ < aint;) {
562 *aptr++ = items & 0xff;
568 if (datumtype == 'B')
569 items <<= 7 - (aint & 7);
571 items >>= 7 - (aint & 7);
572 *aptr++ = items & 0xff;
574 pat = str->str_ptr + str->str_cur;
586 int saveitems = items;
589 aptr = str_get(fromstr);
591 len = fromstr->str_cur;
594 str->str_cur += (len+1)/2;
595 STR_GROW(str, str->str_cur + 1);
596 aptr = str->str_ptr + aint;
597 if (len > fromstr->str_cur)
598 len = fromstr->str_cur;
601 if (datumtype == 'H') {
602 for (len = 0; len++ < aint;) {
604 items |= ((*pat++ & 15) + 9) & 15;
606 items |= *pat++ & 15;
610 *aptr++ = items & 0xff;
616 for (len = 0; len++ < aint;) {
618 items |= (((*pat++ & 15) + 9) & 15) << 4;
620 items |= (*pat++ & 15) << 4;
624 *aptr++ = items & 0xff;
630 *aptr++ = items & 0xff;
631 pat = str->str_ptr + str->str_cur;
643 aint = (int)str_gnum(fromstr);
645 str_ncat(str,&achar,sizeof(char));
648 /* Float and double added by gnb@melba.bby.oz.au 22/11/89 */
653 afloat = (float)str_gnum(fromstr);
654 str_ncat(str, (char *)&afloat, sizeof (float));
661 adouble = (double)str_gnum(fromstr);
662 str_ncat(str, (char *)&adouble, sizeof (double));
668 ashort = (short)str_gnum(fromstr);
670 ashort = htons(ashort);
672 str_ncat(str,(char*)&ashort,sizeof(short));
679 ashort = (short)str_gnum(fromstr);
680 str_ncat(str,(char*)&ashort,sizeof(short));
686 auint = U_I(str_gnum(fromstr));
687 str_ncat(str,(char*)&auint,sizeof(unsigned int));
693 aint = (int)str_gnum(fromstr);
694 str_ncat(str,(char*)&aint,sizeof(int));
700 aulong = U_L(str_gnum(fromstr));
702 aulong = htonl(aulong);
704 str_ncat(str,(char*)&aulong,sizeof(unsigned long));
710 aulong = U_L(str_gnum(fromstr));
711 str_ncat(str,(char*)&aulong,sizeof(unsigned long));
717 along = (long)str_gnum(fromstr);
718 str_ncat(str,(char*)&along,sizeof(long));
724 aptr = str_get(fromstr);
725 str_ncat(str,(char*)&aptr,sizeof(char*));
730 aptr = str_get(fromstr);
731 aint = fromstr->str_cur;
732 STR_GROW(str,aint * 4 / 3);
744 doencodes(str, aptr, todo);
755 doencodes(str, s, len)
763 str_ncat(str, hunk, 1);
766 hunk[0] = ' ' + (077 & (*s >> 2));
767 hunk[1] = ' ' + (077 & ((*s << 4) & 060 | (s[1] >> 4) & 017));
768 hunk[2] = ' ' + (077 & ((s[1] << 2) & 074 | (s[2] >> 6) & 03));
769 hunk[3] = ' ' + (077 & (s[2] & 077));
770 str_ncat(str, hunk, 4);
774 str_ncat(str, "\n", 1);
778 do_sprintf(str,len,sarg)
788 static STR *sargnull = &str_no;
796 len--; /* don't count pattern string */
797 origs = t = s = str_get(*sarg);
798 send = s + (*sarg)->str_cur;
801 if (len <= 0 || !*sarg) {
805 for ( ; t < send && *t != '%'; t++) ;
807 break; /* end of format string, ignore extra args */
812 for (t++; t < send; t++) {
821 case '0': case '1': case '2': case '3': case '4':
822 case '5': case '6': case '7': case '8': case '9':
823 case '.': case '#': case '-': case '+': case ' ':
831 xlen = (int)str_gnum(*(sarg++));
832 if (strEQ(f,"%c")) { /* some printfs fail on null chars */
838 (void)sprintf(xs,f,xlen);
849 (void)sprintf(xs,f,(long)str_gnum(*(sarg++)));
851 (void)sprintf(xs,f,(int)str_gnum(*(sarg++)));
857 case 'x': case 'o': case 'u':
860 value = str_gnum(*(sarg++));
862 (void)sprintf(xs,f,U_L(value));
864 (void)sprintf(xs,f,U_I(value));
867 case 'E': case 'e': case 'f': case 'G': case 'g':
870 (void)sprintf(xs,f,str_gnum(*(sarg++)));
877 xlen = (*sarg)->str_cur;
878 if (*xs == 'S' && xs[1] == 't' && xs[2] == 'B'
879 && xlen == sizeof(STBP) && strlen(xs) < xlen) {
880 STR *tmpstr = Str_new(24,0);
882 stab_fullname(tmpstr, ((STAB*)(*sarg))); /* a stab value! */
883 sprintf(tokenbuf,"*%s",tmpstr->str_ptr);
884 /* reformat to non-binary */
886 xlen = strlen(tokenbuf);
890 if (strEQ(f,"%s")) { /* some printfs fail on >128 chars */
891 break; /* so handle simple case */
893 strcpy(tokenbuf+64,f); /* sprintf($s,...$s...) */
895 (void)sprintf(buf,tokenbuf+64,xs);
900 /* end of switch, copy results */
902 STR_GROW(str, str->str_cur + (f - s) + len + 1);
903 str_ncat(str, s, f - s);
904 str_ncat(str, xs, xlen);
906 break; /* break from for loop */
909 str_ncat(str, s, t - s);
918 register STR **st = stack->ary_array;
919 register int sp = arglast[1];
920 register int items = arglast[2] - sp;
921 register STR *str = &str_undef;
923 for (st += ++sp; items > 0; items--,st++) {
927 (void)apush(ary,str);
933 do_unshift(ary,arglast)
937 register STR **st = stack->ary_array;
938 register int sp = arglast[1];
939 register int items = arglast[2] - sp;
945 for (st += ++sp; i < items; i++,st++) {
948 (void)astore(ary,i,str);
953 do_subr(arg,gimme,arglast)
958 register STR **st = stack->ary_array;
959 register int sp = arglast[1];
960 register int items = arglast[2] - sp;
964 int oldsave = savestack->ary_fill;
965 int oldtmps_base = tmps_base;
966 int hasargs = ((arg[2].arg_type & A_MASK) != A_NULL);
969 if ((arg[1].arg_type & A_MASK) == A_WORD)
970 stab = arg[1].arg_ptr.arg_stab;
972 STR *tmpstr = stab_val(arg[1].arg_ptr.arg_stab);
975 stab = stabent(str_get(tmpstr),TRUE);
980 fatal("Undefined subroutine called");
981 if (arg->arg_type == O_DBSUBR) {
982 str = stab_val(DBsub);
984 stab_fullname(str,stab);
985 sub = stab_sub(DBsub);
987 fatal("No DBsub routine");
990 if (!(sub = stab_sub(stab))) {
991 STR *tmpstr = arg[0].arg_ptr.arg_str;
993 stab_fullname(tmpstr, stab);
994 fatal("Undefined subroutine \"%s\" called",tmpstr->str_ptr);
997 str = Str_new(15, sizeof(CSV));
998 str->str_state = SS_SCSV;
999 (void)apush(savestack,str);
1000 csv = (CSV*)str->str_ptr;
1003 csv->curcsv = curcsv;
1004 csv->curcmd = curcmd;
1005 csv->depth = sub->depth;
1006 csv->wantarray = gimme;
1007 csv->hasargs = hasargs;
1011 csv->savearray = Null(ARRAY*);;
1012 csv->argarray = Null(ARRAY*);
1013 st[sp] = arg->arg_ptr.arg_str;
1016 return (*sub->usersub)(sub->userindex,sp,items);
1019 csv->savearray = stab_xarray(defstab);
1020 csv->argarray = afake(defstab, items, &st[sp+1]);
1021 stab_xarray(defstab) = csv->argarray;
1024 if (sub->depth >= 2) { /* save temporaries on recursion? */
1025 if (sub->depth == 100 && dowarn)
1026 warn("Deep recursion on subroutine \"%s\"",stab_name(stab));
1027 savelist(sub->tosave->ary_array,sub->tosave->ary_fill);
1029 tmps_base = tmps_max;
1030 sp = cmd_exec(sub->cmd,gimme, --sp); /* so do it already */
1031 st = stack->ary_array;
1033 tmps_base = oldtmps_base;
1034 for (items = arglast[0] + 1; items <= sp; items++)
1035 st[items] = str_static(st[items]);
1036 /* in case restore wipes old str */
1037 restorelist(oldsave);
1042 do_assign(arg,gimme,arglast)
1048 register STR **st = stack->ary_array;
1049 STR **firstrelem = st + arglast[1] + 1;
1050 STR **firstlelem = st + arglast[0] + 1;
1051 STR **lastrelem = st + arglast[2];
1052 STR **lastlelem = st + arglast[1];
1053 register STR **relem;
1054 register STR **lelem;
1057 register ARRAY *ary;
1058 register int makelocal;
1062 makelocal = (arg->arg_flags & AF_LOCAL);
1063 localizing = makelocal;
1064 delaymagic = DM_DELAY; /* catch simultaneous items */
1066 /* If there's a common identifier on both sides we have to take
1067 * special care that assigning the identifier on the left doesn't
1068 * clobber a value on the right that's used later in the list.
1070 if (arg->arg_flags & AF_COMMON) {
1071 for (relem = firstrelem; relem <= lastrelem; relem++) {
1073 *relem = str_static(str);
1080 while (lelem <= lastlelem) {
1082 if (str->str_state >= SS_HASH) {
1083 if (str->str_state == SS_ARY) {
1085 ary = saveary(str->str_u.str_stab);
1087 ary = stab_array(str->str_u.str_stab);
1091 while (relem <= lastrelem) { /* gobble up all the rest */
1092 str = Str_new(28,0);
1094 str_sset(str,*relem);
1096 (void)astore(ary,i++,str);
1099 else if (str->str_state == SS_HASH) {
1103 STAB *tmpstab = str->str_u.str_stab;
1106 hash = savehash(str->str_u.str_stab);
1108 hash = stab_hash(str->str_u.str_stab);
1109 if (tmpstab == envstab) {
1111 environ[0] = Nullch;
1113 else if (tmpstab == sigstab) {
1118 for (i = 1; i < NSIG; i++)
1119 signal(i, SIG_DFL); /* crunch, crunch, crunch */
1122 else if (hash->tbl_dbm)
1125 hclear(hash, magic == 'D'); /* wipe any dbm file too */
1128 while (relem < lastrelem) { /* gobble up all the rest */
1132 str = &str_no, relem++;
1133 tmps = str_get(str);
1134 tmpstr = Str_new(29,0);
1136 str_sset(tmpstr,*relem); /* value */
1137 *(relem++) = tmpstr;
1138 (void)hstore(hash,tmps,str->str_cur,tmpstr,0);
1140 str_magic(tmpstr, tmpstab, magic, tmps, str->str_cur);
1141 stabset(tmpstr->str_magic, tmpstr);
1146 fatal("panic: do_assign");
1151 if (relem <= lastrelem) {
1152 str_sset(str, *relem);
1156 str_sset(str, &str_undef);
1157 if (gimme == G_ARRAY) {
1158 i = ++lastrelem - firstrelem;
1159 relem++; /* tacky, I suppose */
1160 astore(stack,i,str);
1161 if (st != stack->ary_array) {
1162 st = stack->ary_array;
1163 firstrelem = st + arglast[1] + 1;
1164 firstlelem = st + arglast[0] + 1;
1165 lastlelem = st + arglast[1];
1167 relem = lastrelem + 1;
1174 if (delaymagic > 1) {
1175 if (delaymagic & DM_REUID) {
1179 if (uid != euid || setuid(uid) < 0)
1180 fatal("No setreuid available");
1183 if (delaymagic & DM_REGID) {
1187 if (gid != egid || setgid(gid) < 0)
1188 fatal("No setregid available");
1194 if (gimme == G_ARRAY) {
1195 i = lastrelem - firstrelem + 1;
1197 Copy(firstrelem, firstlelem, i, STR*);
1198 return arglast[0] + i;
1201 str_numset(arg->arg_ptr.arg_str,(double)(arglast[2] - arglast[1]));
1202 *firstlelem = arg->arg_ptr.arg_str;
1203 return arglast[0] + 1;
1208 do_study(str,arg,gimme,arglast)
1214 register unsigned char *s;
1215 register int pos = str->str_cur;
1217 register int *sfirst;
1218 register int *snext;
1219 static int maxscream = -1;
1220 static STR *lastscream = Nullstr;
1222 int retarg = arglast[0] + 1;
1225 s = (unsigned char*)(str_get(str));
1227 s = Null(unsigned char*);
1230 lastscream->str_pok &= ~SP_STUDIED;
1236 if (pos > maxscream) {
1237 if (maxscream < 0) {
1238 maxscream = pos + 80;
1239 New(301,screamfirst, 256, int);
1240 New(302,screamnext, maxscream, int);
1243 maxscream = pos + pos / 4;
1244 Renew(screamnext, maxscream, int);
1248 sfirst = screamfirst;
1251 if (!sfirst || !snext)
1252 fatal("do_study: out of memory");
1254 for (ch = 256; ch; --ch)
1258 while (--pos >= 0) {
1260 if (sfirst[ch] >= 0)
1261 snext[pos] = sfirst[ch] - pos;
1266 /* If there were any case insensitive searches, we must assume they
1267 * all are. This speeds up insensitive searches much more than
1268 * it slows down sensitive ones.
1271 sfirst[fold[ch]] = pos;
1274 str->str_pok |= SP_STUDIED;
1277 str_numset(arg->arg_ptr.arg_str,(double)retval);
1278 stack->ary_array[retarg] = arg->arg_ptr.arg_str;
1283 do_defined(str,arg,gimme,arglast)
1290 register int retarg = arglast[0] + 1;
1295 if ((arg[1].arg_type & A_MASK) != A_LEXPR)
1296 fatal("Illegal argument to defined()");
1297 arg = arg[1].arg_ptr.arg_arg;
1298 type = arg->arg_type;
1300 if (type == O_SUBR || type == O_DBSUBR)
1301 retval = stab_sub(arg[1].arg_ptr.arg_stab) != 0;
1302 else if (type == O_ARRAY || type == O_LARRAY ||
1303 type == O_ASLICE || type == O_LASLICE )
1304 retval = ((ary = stab_xarray(arg[1].arg_ptr.arg_stab)) != 0
1305 && ary->ary_max >= 0 );
1306 else if (type == O_HASH || type == O_LHASH ||
1307 type == O_HSLICE || type == O_LHSLICE )
1308 retval = ((hash = stab_xhash(arg[1].arg_ptr.arg_stab)) != 0
1309 && hash->tbl_array);
1312 str_numset(str,(double)retval);
1313 stack->ary_array[retarg] = str;
1318 do_undef(str,arg,gimme,arglast)
1325 register STAB *stab;
1326 int retarg = arglast[0] + 1;
1328 if ((arg[1].arg_type & A_MASK) != A_LEXPR)
1329 fatal("Illegal argument to undef()");
1330 arg = arg[1].arg_ptr.arg_arg;
1331 type = arg->arg_type;
1333 if (type == O_ARRAY || type == O_LARRAY) {
1334 stab = arg[1].arg_ptr.arg_stab;
1335 afree(stab_xarray(stab));
1336 stab_xarray(stab) = Null(ARRAY*);
1338 else if (type == O_HASH || type == O_LHASH) {
1339 stab = arg[1].arg_ptr.arg_stab;
1340 if (stab == envstab)
1341 environ[0] = Nullch;
1342 else if (stab == sigstab) {
1345 for (i = 1; i < NSIG; i++)
1346 signal(i, SIG_DFL); /* munch, munch, munch */
1348 (void)hfree(stab_xhash(stab), TRUE);
1349 stab_xhash(stab) = Null(HASH*);
1351 else if (type == O_SUBR || type == O_DBSUBR) {
1352 stab = arg[1].arg_ptr.arg_stab;
1353 cmd_free(stab_sub(stab)->cmd);
1354 afree(stab_sub(stab)->tosave);
1355 Safefree(stab_sub(stab));
1356 stab_sub(stab) = Null(SUBR*);
1359 fatal("Can't undefine that kind of object");
1360 str_numset(str,0.0);
1361 stack->ary_array[retarg] = str;
1366 do_vec(lvalue,astr,arglast)
1371 STR **st = stack->ary_array;
1372 int sp = arglast[0];
1373 register STR *str = st[++sp];
1374 register int offset = (int)str_gnum(st[++sp]);
1375 register int size = (int)str_gnum(st[++sp]);
1376 unsigned char *s = (unsigned char*)str_get(str);
1377 unsigned long retnum;
1381 offset *= size; /* turn into bit offset */
1382 len = (offset + size + 7) / 8;
1383 if (offset < 0 || size < 1)
1385 else if (!lvalue && len > str->str_cur)
1388 if (len > str->str_cur) {
1390 (void)bzero(str->str_ptr + str->str_cur, len - str->str_cur);
1393 s = (unsigned char*)str_get(str);
1395 retnum = (s[offset >> 3] >> (offset & 7)) & ((1 << size) - 1);
1400 else if (size == 16)
1401 retnum = (s[offset] << 8) + s[offset+1];
1402 else if (size == 32)
1403 retnum = (s[offset] << 24) + (s[offset + 1] << 16) +
1404 (s[offset + 2] << 8) + s[offset+3];
1407 if (lvalue) { /* it's an lvalue! */
1408 struct lstring *lstr = (struct lstring*)astr;
1410 astr->str_magic = str;
1411 st[sp]->str_rare = 'v';
1412 lstr->lstr_offset = offset;
1413 lstr->lstr_len = size;
1417 str_numset(astr,(double)retnum);
1427 struct lstring *lstr = (struct lstring*)str;
1428 register int offset;
1430 register unsigned char *s = (unsigned char*)mstr->str_ptr;
1431 register unsigned long lval = U_L(str_gnum(str));
1435 str->str_magic = Nullstr;
1436 offset = lstr->lstr_offset;
1437 size = lstr->lstr_len;
1439 mask = (1 << size) - 1;
1443 s[offset] &= ~(mask << size);
1444 s[offset] |= lval << size;
1448 s[offset] = lval & 255;
1449 else if (size == 16) {
1450 s[offset] = (lval >> 8) & 255;
1451 s[offset+1] = lval & 255;
1453 else if (size == 32) {
1454 s[offset] = (lval >> 24) & 255;
1455 s[offset+1] = (lval >> 16) & 255;
1456 s[offset+2] = (lval >> 8) & 255;
1457 s[offset+3] = lval & 255;
1466 register char *tmps;
1474 if (str->str_state == SS_ARY) {
1475 ary = stab_array(str->str_u.str_stab);
1476 for (i = 0; i <= ary->ary_fill; i++)
1477 do_chop(astr,ary->ary_array[i]);
1480 if (str->str_state == SS_HASH) {
1481 hash = stab_hash(str->str_u.str_stab);
1482 (void)hiterinit(hash);
1483 while (entry = hiternext(hash))
1484 do_chop(astr,hiterval(hash,entry));
1487 tmps = str_get(str);
1490 tmps += str->str_cur - (str->str_cur != 0);
1491 str_nset(astr,tmps,1); /* remember last char */
1492 *tmps = '\0'; /* wipe it out */
1493 str->str_cur = tmps - str->str_ptr;
1497 do_vop(optype,str,left,right)
1502 register char *s = str_get(str);
1503 register char *l = str_get(left);
1504 register char *r = str_get(right);
1507 len = left->str_cur;
1508 if (len > right->str_cur)
1509 len = right->str_cur;
1510 if (str->str_cur > len)
1512 else if (str->str_cur < len) {
1514 (void)bzero(str->str_ptr + str->str_cur, len - str->str_cur);
1532 if (right->str_cur > len)
1533 str_ncat(str,right->str_ptr+len,right->str_cur - len);
1534 else if (left->str_cur > len)
1535 str_ncat(str,left->str_ptr+len,left->str_cur - len);
1544 register STR **st = stack->ary_array;
1545 register int sp = arglast[1];
1546 register int items = arglast[2] - sp;
1553 for (st += ++sp; items--; st++)
1554 tainted |= (*st)->str_tainted;
1555 st = stack->ary_array;
1557 items = arglast[2] - sp;
1560 taintproper("Insecure dependency in syscall");
1562 /* This probably won't work on machines where sizeof(long) != sizeof(int)
1563 * or where sizeof(long) != sizeof(char*). But such machines will
1564 * not likely have syscall implemented either, so who cares?
1567 if (st[++sp]->str_nok || !i)
1568 arg[i++] = (long)str_gnum(st[sp]);
1571 arg[i++] = (long)st[sp]->str_ptr;
1575 items = arglast[2] - sp;
1578 fatal("Too few args to syscall");
1580 retval = syscall(arg[0]);
1583 retval = syscall(arg[0],arg[1]);
1586 retval = syscall(arg[0],arg[1],arg[2]);
1589 retval = syscall(arg[0],arg[1],arg[2],arg[3]);
1592 retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4]);
1595 retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5]);
1598 retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6]);
1601 retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6],
1607 fatal("syscall() unimplemented");