1 /* $Header: doarg.c,v 3.0.1.8 90/10/15 16:04:04 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.8 90/10/15 16:04:04 lwall
10 * patch29: @ENV = () now works
11 * patch29: added caller
12 * patch29: tr/// now understands c, d and s options, and handles nulls right
13 * patch29: *foo now prints as *package'foo
14 * patch29: added caller
15 * patch29: local() without initialization now creates undefined values
17 * Revision 3.0.1.7 90/08/13 22:14:15 lwall
18 * patch28: the NSIG hack didn't work on Xenix
19 * patch28: defined(@array) and defined(%array) didn't work right
21 * Revision 3.0.1.6 90/08/09 02:48:38 lwall
22 * patch19: fixed double include of <signal.h>
23 * patch19: pack/unpack can now do native float and double
24 * patch19: pack/unpack can now have absolute and negative positioning
25 * patch19: pack/unpack can now have use * to specify all the rest of input
26 * patch19: unpack can do checksumming
27 * patch19: $< and $> better supported on machines without setreuid
28 * patch19: Added support for linked-in C subroutines
30 * Revision 3.0.1.5 90/03/27 15:39:03 lwall
31 * patch16: MSDOS support
32 * patch16: support for machines that can't cast negative floats to unsigned ints
33 * patch16: sprintf($s,...,$s,...) didn't work
35 * Revision 3.0.1.4 90/03/12 16:28:42 lwall
36 * patch13: pack of ascii strings could call str_ncat() with negative length
37 * patch13: printf("%s", *foo) was busted
39 * Revision 3.0.1.3 90/02/28 16:56:58 lwall
40 * patch9: split now can split into more than 10000 elements
41 * patch9: sped up pack and unpack
42 * patch9: pack of unsigned ints and longs blew up some places
43 * patch9: sun3 can't cast negative float to unsigned int or long
44 * patch9: local($.) didn't work
45 * patch9: grep(s/foo/bar/, @abc = @xyz) modified @xyz rather than @abc
46 * patch9: syscall returned stack size rather than value of system call
48 * Revision 3.0.1.2 89/12/21 19:52:15 lwall
49 * patch7: a pattern wouldn't match a null string before the first character
50 * patch7: certain patterns didn't match correctly at end of string
52 * Revision 3.0.1.1 89/11/11 04:17:20 lwall
53 * patch2: printf %c, %D, %X and %O didn't work right
54 * patch2: printf of unsigned vs signed needed separate casts on some machines
56 * Revision 3.0 89/10/18 15:10:41 lwall
64 #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
68 extern unsigned char fold[];
70 extern char **environ;
73 #pragma function(memcmp)
74 #endif /* BUGGY_MSC */
85 register char *s = str_get(str);
86 char *strend = s + str->str_cur;
92 int maxiters = (strend - s) + 10;
98 rspat = spat = arg[2].arg_ptr.arg_spat;
100 fatal("panic: do_subst");
101 else if (spat->spat_runtime) {
103 (void)eval(spat->spat_runtime,G_SCALAR,sp);
104 m = str_get(dstr = stack->ary_array[sp+1]);
106 if (spat->spat_regexp)
107 regfree(spat->spat_regexp);
108 spat->spat_regexp = regcomp(m,m+dstr->str_cur,
109 spat->spat_flags & SPAT_FOLD);
110 if (spat->spat_flags & SPAT_KEEP) {
111 arg_free(spat->spat_runtime); /* it won't change, so */
112 spat->spat_runtime = Nullarg; /* no point compiling again */
117 deb("2.SPAT /%s/\n",spat->spat_regexp->precomp);
120 safebase = ((!spat->spat_regexp || !spat->spat_regexp->nparens) &&
122 if (!*spat->spat_regexp->precomp && lastspat)
126 if (hint < s || hint > strend)
127 fatal("panic: hint in do_match");
130 if (spat->spat_regexp->regback >= 0) {
131 s -= spat->spat_regexp->regback;
138 else if (spat->spat_short) {
139 if (spat->spat_flags & SPAT_SCANFIRST) {
140 if (str->str_pok & SP_STUDIED) {
141 if (screamfirst[spat->spat_short->str_rare] < 0)
143 else if (!(s = screaminstr(str,spat->spat_short)))
147 else if (!(s = fbminstr((unsigned char*)s, (unsigned char*)strend,
151 if (s && spat->spat_regexp->regback >= 0) {
152 ++spat->spat_short->str_u.str_useful;
153 s -= spat->spat_regexp->regback;
160 else if (!multiline && (*spat->spat_short->str_ptr != *s ||
161 bcmp(spat->spat_short->str_ptr, s, spat->spat_slen) ))
163 if (--spat->spat_short->str_u.str_useful < 0) {
164 str_free(spat->spat_short);
165 spat->spat_short = Nullstr; /* opt is being useless */
168 once = ((rspat->spat_flags & SPAT_ONCE) != 0);
169 if (rspat->spat_flags & SPAT_CONST) { /* known replacement string? */
170 if ((rspat->spat_repl[1].arg_type & A_MASK) == A_SINGLE)
171 dstr = rspat->spat_repl[1].arg_ptr.arg_str;
172 else { /* constant over loop, anyway */
173 (void)eval(rspat->spat_repl,G_SCALAR,sp);
174 dstr = stack->ary_array[sp+1];
177 clen = dstr->str_cur;
178 if (clen <= spat->spat_slen + spat->spat_regexp->regback) {
179 /* can do inplace substitution */
180 if (regexec(spat->spat_regexp, s, strend, orig, 0,
181 str->str_pok & SP_STUDIED ? str : Nullstr, safebase)) {
182 if (spat->spat_regexp->subbase) /* oops, no we can't */
186 str->str_pok = SP_VALID; /* disable possible screamer */
188 m = spat->spat_regexp->startp[0];
189 d = spat->spat_regexp->endp[0];
191 if (m - s > strend - d) { /* faster to shorten from end */
193 (void)bcopy(c, m, clen);
198 (void)bcopy(d, m, i);
202 str->str_cur = m - s;
204 str_numset(arg->arg_ptr.arg_str, 1.0);
205 stack->ary_array[++sp] = arg->arg_ptr.arg_str;
208 else if (i = m - s) { /* faster from front */
216 (void)bcopy(c, m, clen);
218 str_numset(arg->arg_ptr.arg_str, 1.0);
219 stack->ary_array[++sp] = arg->arg_ptr.arg_str;
225 (void)bcopy(c,d,clen);
227 str_numset(arg->arg_ptr.arg_str, 1.0);
228 stack->ary_array[++sp] = arg->arg_ptr.arg_str;
234 str_numset(arg->arg_ptr.arg_str, 1.0);
235 stack->ary_array[++sp] = arg->arg_ptr.arg_str;
241 if (iters++ > maxiters)
242 fatal("Substitution loop");
243 m = spat->spat_regexp->startp[0];
250 (void)bcopy(c,d,clen);
253 s = spat->spat_regexp->endp[0];
254 } while (regexec(spat->spat_regexp, s, strend, orig, s == m,
255 Nullstr, TRUE)); /* (don't match same null twice) */
258 str->str_cur = d - str->str_ptr + i;
259 (void)bcopy(s,d,i+1); /* include the Null */
262 str_numset(arg->arg_ptr.arg_str, (double)iters);
263 stack->ary_array[++sp] = arg->arg_ptr.arg_str;
266 str_numset(arg->arg_ptr.arg_str, 0.0);
267 stack->ary_array[++sp] = arg->arg_ptr.arg_str;
273 if (regexec(spat->spat_regexp, s, strend, orig, 0,
274 str->str_pok & SP_STUDIED ? str : Nullstr, safebase)) {
276 dstr = Str_new(25,str_len(str));
277 str_nset(dstr,m,s-m);
278 if (spat->spat_regexp->subbase)
282 if (iters++ > maxiters)
283 fatal("Substitution loop");
284 if (spat->spat_regexp->subbase
285 && spat->spat_regexp->subbase != orig) {
288 orig = spat->spat_regexp->subbase;
290 strend = s + (strend - m);
292 m = spat->spat_regexp->startp[0];
293 str_ncat(dstr,s,m-s);
294 s = spat->spat_regexp->endp[0];
297 str_ncat(dstr,c,clen);
300 (void)eval(rspat->spat_repl,G_SCALAR,sp);
301 str_scat(dstr,stack->ary_array[sp+1]);
305 } while (regexec(spat->spat_regexp, s, strend, orig, s == m, Nullstr,
307 str_ncat(dstr,s,strend - s);
308 str_replace(str,dstr);
310 str_numset(arg->arg_ptr.arg_str, (double)iters);
311 stack->ary_array[++sp] = arg->arg_ptr.arg_str;
314 str_numset(arg->arg_ptr.arg_str, 0.0);
315 stack->ary_array[++sp] = arg->arg_ptr.arg_str;
319 ++spat->spat_short->str_u.str_useful;
320 str_numset(arg->arg_ptr.arg_str, 0.0);
321 stack->ary_array[++sp] = arg->arg_ptr.arg_str;
325 #pragma intrinsic(memcmp)
326 #endif /* BUGGY_MSC */
335 register int matches = 0;
339 register int squash = arg[2].arg_len & 1;
341 tbl = (short*) arg[2].arg_ptr.arg_cval;
343 send = s + str->str_cur;
345 fatal("panic: do_trans");
351 if (!arg[2].arg_len) {
353 if ((ch = tbl[*s & 0377]) >= 0) {
363 if ((ch = tbl[*s & 0377]) >= 0) {
365 if (matches++ && squash) {
374 else if (ch == -1) /* -1 is unmapped character */
375 *d++ = *s; /* -2 is delete character */
378 matches += send - d; /* account for disappeared chars */
380 str->str_cur = d - str->str_ptr;
391 register STR **st = stack->ary_array;
392 register int sp = arglast[1];
393 register int items = arglast[2] - sp;
394 register char *delim = str_get(st[sp]);
395 int delimlen = st[sp]->str_cur;
402 for (; items > 0; items--,st++) {
403 str_ncat(str,delim,delimlen);
414 register STR **st = stack->ary_array;
415 register int sp = arglast[1];
417 register char *pat = str_get(st[sp]);
418 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;
436 items = arglast[2] - sp;
439 while (pat < patend) {
440 #define NEXTFROM (items-- > 0 ? *st++ : &str_no)
443 len = index("@Xxu",datumtype) ? 0 : items;
446 else if (isdigit(*pat)) {
448 while (isdigit(*pat))
449 len = (len * 10) + (*pat++ - '0');
457 fatal("% may only be used in unpack");
469 if (str->str_cur < 0)
470 fatal("X outside of string");
471 str->str_ptr[str->str_cur] = '\0';
476 str_ncat(str,null10,10);
479 str_ncat(str,null10,len);
484 aptr = str_get(fromstr);
486 len = fromstr->str_cur;
487 if (fromstr->str_cur > len)
488 str_ncat(str,aptr,len);
490 str_ncat(str,aptr,fromstr->str_cur);
491 len -= fromstr->str_cur;
492 if (datumtype == 'A') {
494 str_ncat(str,space10,10);
497 str_ncat(str,space10,len);
501 str_ncat(str,null10,10);
504 str_ncat(str,null10,len);
512 aint = (int)str_gnum(fromstr);
514 str_ncat(str,&achar,sizeof(char));
517 /* Float and double added by gnb@melba.bby.oz.au 22/11/89 */
522 afloat = (float)str_gnum(fromstr);
523 str_ncat(str, (char *)&afloat, sizeof (float));
530 adouble = (double)str_gnum(fromstr);
531 str_ncat(str, (char *)&adouble, sizeof (double));
537 ashort = (short)str_gnum(fromstr);
539 ashort = htons(ashort);
541 str_ncat(str,(char*)&ashort,sizeof(short));
548 ashort = (short)str_gnum(fromstr);
549 str_ncat(str,(char*)&ashort,sizeof(short));
555 auint = U_I(str_gnum(fromstr));
556 str_ncat(str,(char*)&auint,sizeof(unsigned int));
562 aint = (int)str_gnum(fromstr);
563 str_ncat(str,(char*)&aint,sizeof(int));
569 along = (long)str_gnum(fromstr);
571 along = htonl(along);
573 str_ncat(str,(char*)&along,sizeof(long));
579 aulong = U_L(str_gnum(fromstr));
580 str_ncat(str,(char*)&aulong,sizeof(unsigned long));
586 along = (long)str_gnum(fromstr);
587 str_ncat(str,(char*)&along,sizeof(long));
593 aptr = str_get(fromstr);
594 str_ncat(str,(char*)&aptr,sizeof(char*));
599 aptr = str_get(fromstr);
600 aint = fromstr->str_cur;
601 STR_GROW(str,aint * 4 / 3);
613 doencodes(str, aptr, todo);
624 doencodes(str, s, len)
632 str_ncat(str, hunk, 1);
635 hunk[0] = ' ' + (077 & (*s >> 2));
636 hunk[1] = ' ' + (077 & ((*s << 4) & 060 | (s[1] >> 4) & 017));
637 hunk[2] = ' ' + (077 & ((s[1] << 2) & 074 | (s[2] >> 6) & 03));
638 hunk[3] = ' ' + (077 & (s[2] & 077));
639 str_ncat(str, hunk, 4);
643 str_ncat(str, "\n", 1);
647 do_sprintf(str,len,sarg)
656 static STR *sargnull = &str_no;
664 len--; /* don't count pattern string */
665 origs = s = str_get(*sarg);
666 send = s + (*sarg)->str_cur;
668 for ( ; s < send; len--) {
669 if (len <= 0 || !*sarg) {
674 for (t = s; t < send && *t != '%'; t++) ;
676 break; /* not enough % patterns, oh well */
677 for (t++; *sarg && t < send && t != s; t++) {
682 (void)sprintf(buf,s);
687 case '0': case '1': case '2': case '3': case '4':
688 case '5': case '6': case '7': case '8': case '9':
689 case '.': case '#': case '-': case '+':
697 xlen = (int)str_gnum(*(sarg++));
698 if (strEQ(t-2,"%c")) { /* some printfs fail on null chars */
700 str_ncat(str,s,t - s - 2);
701 str_ncat(str,buf,1); /* so handle simple case */
705 (void)sprintf(buf,s,xlen);
716 (void)sprintf(buf,s,(long)str_gnum(*(sarg++)));
718 (void)sprintf(buf,s,(int)str_gnum(*(sarg++)));
725 case 'x': case 'o': case 'u':
728 value = str_gnum(*(sarg++));
730 (void)sprintf(buf,s,U_L(value));
732 (void)sprintf(buf,s,U_I(value));
736 case 'E': case 'e': case 'f': case 'G': case 'g':
739 (void)sprintf(buf,s,str_gnum(*(sarg++)));
747 xlen = (*sarg)->str_cur;
748 if (*xs == 'S' && xs[1] == 't' && xs[2] == 'B'
749 && xlen == sizeof(STBP) && strlen(xs) < xlen) {
750 STR *tmpstr = Str_new(24,0);
752 stab_fullname(tmpstr, ((STAB*)(*sarg))); /* a stab value! */
753 sprintf(tokenbuf,"*%s",tmpstr->str_ptr);
754 /* reformat to non-binary */
756 xlen = strlen(tokenbuf);
759 if (strEQ(t-2,"%s")) { /* some printfs fail on >128 chars */
761 str_ncat(str,s,t - s - 2);
763 str_ncat(str,xs,xlen); /* so handle simple case */
766 if (origs == xs) { /* sprintf($s,...$s...) */
767 strcpy(tokenbuf+64,s);
771 (void)sprintf(buf,s,xs);
779 if (s < t && t >= send) {
787 (void)sprintf(buf,s,0,0,0,0);
798 register STR **st = stack->ary_array;
799 register int sp = arglast[1];
800 register int items = arglast[2] - sp;
801 register STR *str = &str_undef;
803 for (st += ++sp; items > 0; items--,st++) {
807 (void)apush(ary,str);
813 do_unshift(ary,arglast)
817 register STR **st = stack->ary_array;
818 register int sp = arglast[1];
819 register int items = arglast[2] - sp;
825 for (st += ++sp; i < items; i++,st++) {
828 (void)astore(ary,i,str);
833 do_subr(arg,gimme,arglast)
838 register STR **st = stack->ary_array;
839 register int sp = arglast[1];
840 register int items = arglast[2] - sp;
844 int oldsave = savestack->ary_fill;
845 int oldtmps_base = tmps_base;
846 int hasargs = ((arg[2].arg_type & A_MASK) != A_NULL);
849 if ((arg[1].arg_type & A_MASK) == A_WORD)
850 stab = arg[1].arg_ptr.arg_stab;
852 STR *tmpstr = stab_val(arg[1].arg_ptr.arg_stab);
855 stab = stabent(str_get(tmpstr),TRUE);
860 fatal("Undefined subroutine called");
861 if (arg->arg_type == O_DBSUBR) {
862 str = stab_val(DBsub);
864 stab_fullname(str,stab);
865 sub = stab_sub(DBsub);
867 fatal("No DBsub routine");
870 if (!(sub = stab_sub(stab))) {
871 STR *tmpstr = arg[0].arg_ptr.arg_str;
873 stab_fullname(tmpstr, stab);
874 fatal("Undefined subroutine \"%s\" called",tmpstr->str_ptr);
877 str = Str_new(15, sizeof(CSV));
878 str->str_state = SS_SCSV;
879 (void)apush(savestack,str);
880 csv = (CSV*)str->str_ptr;
883 csv->curcsv = curcsv;
884 csv->curcmd = curcmd;
885 csv->depth = sub->depth;
886 csv->wantarray = gimme;
887 csv->hasargs = hasargs;
890 st[sp] = arg->arg_ptr.arg_str;
893 return (*sub->usersub)(sub->userindex,sp,items);
896 csv->savearray = stab_xarray(defstab);
897 csv->argarray = afake(defstab, items, &st[sp+1]);
898 stab_xarray(defstab) = csv->argarray;
901 if (sub->depth >= 2) { /* save temporaries on recursion? */
902 if (sub->depth == 100 && dowarn)
903 warn("Deep recursion on subroutine \"%s\"",stab_name(stab));
904 savelist(sub->tosave->ary_array,sub->tosave->ary_fill);
906 tmps_base = tmps_max;
907 sp = cmd_exec(sub->cmd,gimme, --sp); /* so do it already */
908 st = stack->ary_array;
910 tmps_base = oldtmps_base;
911 for (items = arglast[0] + 1; items <= sp; items++)
912 st[items] = str_static(st[items]);
913 /* in case restore wipes old str */
914 restorelist(oldsave);
919 do_assign(arg,gimme,arglast)
925 register STR **st = stack->ary_array;
926 STR **firstrelem = st + arglast[1] + 1;
927 STR **firstlelem = st + arglast[0] + 1;
928 STR **lastrelem = st + arglast[2];
929 STR **lastlelem = st + arglast[1];
930 register STR **relem;
931 register STR **lelem;
935 register int makelocal;
939 makelocal = (arg->arg_flags & AF_LOCAL);
940 localizing = makelocal;
941 delaymagic = DM_DELAY; /* catch simultaneous items */
943 /* If there's a common identifier on both sides we have to take
944 * special care that assigning the identifier on the left doesn't
945 * clobber a value on the right that's used later in the list.
947 if (arg->arg_flags & AF_COMMON) {
948 for (relem = firstrelem; relem <= lastrelem; relem++) {
950 *relem = str_static(str);
957 while (lelem <= lastlelem) {
959 if (str->str_state >= SS_HASH) {
960 if (str->str_state == SS_ARY) {
962 ary = saveary(str->str_u.str_stab);
964 ary = stab_array(str->str_u.str_stab);
968 while (relem <= lastrelem) { /* gobble up all the rest */
971 str_sset(str,*relem);
973 (void)astore(ary,i++,str);
976 else if (str->str_state == SS_HASH) {
980 STAB *tmpstab = str->str_u.str_stab;
983 hash = savehash(str->str_u.str_stab);
985 hash = stab_hash(str->str_u.str_stab);
986 if (tmpstab == envstab) {
990 else if (tmpstab == sigstab) {
995 for (i = 1; i < NSIG; i++)
996 signal(i, SIG_DFL); /* crunch, crunch, crunch */
999 else if (hash->tbl_dbm)
1002 hclear(hash, magic == 'D'); /* wipe any dbm file too */
1005 while (relem < lastrelem) { /* gobble up all the rest */
1009 str = &str_no, relem++;
1010 tmps = str_get(str);
1011 tmpstr = Str_new(29,0);
1013 str_sset(tmpstr,*relem); /* value */
1014 *(relem++) = tmpstr;
1015 (void)hstore(hash,tmps,str->str_cur,tmpstr,0);
1017 str_magic(tmpstr, tmpstab, magic, tmps, str->str_cur);
1018 stabset(tmpstr->str_magic, tmpstr);
1023 fatal("panic: do_assign");
1028 if (relem <= lastrelem) {
1029 str_sset(str, *relem);
1033 str_sset(str, &str_undef);
1034 if (gimme == G_ARRAY) {
1035 i = ++lastrelem - firstrelem;
1036 relem++; /* tacky, I suppose */
1037 astore(stack,i,str);
1038 if (st != stack->ary_array) {
1039 st = stack->ary_array;
1040 firstrelem = st + arglast[1] + 1;
1041 firstlelem = st + arglast[0] + 1;
1042 lastlelem = st + arglast[1];
1044 relem = lastrelem + 1;
1051 if (delaymagic > 1) {
1052 if (delaymagic & DM_REUID) {
1056 if (uid != euid || setuid(uid) < 0)
1057 fatal("No setreuid available");
1060 if (delaymagic & DM_REGID) {
1064 if (gid != egid || setgid(gid) < 0)
1065 fatal("No setregid available");
1071 if (gimme == G_ARRAY) {
1072 i = lastrelem - firstrelem + 1;
1074 Copy(firstrelem, firstlelem, i, STR*);
1075 return arglast[0] + i;
1078 str_numset(arg->arg_ptr.arg_str,(double)(arglast[2] - arglast[1]));
1079 *firstlelem = arg->arg_ptr.arg_str;
1080 return arglast[0] + 1;
1085 do_study(str,arg,gimme,arglast)
1091 register unsigned char *s;
1092 register int pos = str->str_cur;
1094 register int *sfirst;
1095 register int *snext;
1096 static int maxscream = -1;
1097 static STR *lastscream = Nullstr;
1099 int retarg = arglast[0] + 1;
1102 s = (unsigned char*)(str_get(str));
1104 s = Null(unsigned char*);
1107 lastscream->str_pok &= ~SP_STUDIED;
1113 if (pos > maxscream) {
1114 if (maxscream < 0) {
1115 maxscream = pos + 80;
1116 New(301,screamfirst, 256, int);
1117 New(302,screamnext, maxscream, int);
1120 maxscream = pos + pos / 4;
1121 Renew(screamnext, maxscream, int);
1125 sfirst = screamfirst;
1128 if (!sfirst || !snext)
1129 fatal("do_study: out of memory");
1131 for (ch = 256; ch; --ch)
1135 while (--pos >= 0) {
1137 if (sfirst[ch] >= 0)
1138 snext[pos] = sfirst[ch] - pos;
1143 /* If there were any case insensitive searches, we must assume they
1144 * all are. This speeds up insensitive searches much more than
1145 * it slows down sensitive ones.
1148 sfirst[fold[ch]] = pos;
1151 str->str_pok |= SP_STUDIED;
1154 str_numset(arg->arg_ptr.arg_str,(double)retval);
1155 stack->ary_array[retarg] = arg->arg_ptr.arg_str;
1160 do_defined(str,arg,gimme,arglast)
1167 register int retarg = arglast[0] + 1;
1172 if ((arg[1].arg_type & A_MASK) != A_LEXPR)
1173 fatal("Illegal argument to defined()");
1174 arg = arg[1].arg_ptr.arg_arg;
1175 type = arg->arg_type;
1177 if (type == O_SUBR || type == O_DBSUBR)
1178 retval = stab_sub(arg[1].arg_ptr.arg_stab) != 0;
1179 else if (type == O_ARRAY || type == O_LARRAY ||
1180 type == O_ASLICE || type == O_LASLICE )
1181 retval = ((ary = stab_xarray(arg[1].arg_ptr.arg_stab)) != 0
1182 && ary->ary_max >= 0 );
1183 else if (type == O_HASH || type == O_LHASH ||
1184 type == O_HSLICE || type == O_LHSLICE )
1185 retval = ((hash = stab_xhash(arg[1].arg_ptr.arg_stab)) != 0
1186 && hash->tbl_array);
1189 str_numset(str,(double)retval);
1190 stack->ary_array[retarg] = str;
1195 do_undef(str,arg,gimme,arglast)
1202 register STAB *stab;
1203 int retarg = arglast[0] + 1;
1205 if ((arg[1].arg_type & A_MASK) != A_LEXPR)
1206 fatal("Illegal argument to undef()");
1207 arg = arg[1].arg_ptr.arg_arg;
1208 type = arg->arg_type;
1210 if (type == O_ARRAY || type == O_LARRAY) {
1211 stab = arg[1].arg_ptr.arg_stab;
1212 afree(stab_xarray(stab));
1213 stab_xarray(stab) = Null(ARRAY*);
1215 else if (type == O_HASH || type == O_LHASH) {
1216 stab = arg[1].arg_ptr.arg_stab;
1217 if (stab == envstab)
1218 environ[0] = Nullch;
1219 else if (stab == sigstab) {
1222 for (i = 1; i < NSIG; i++)
1223 signal(i, SIG_DFL); /* munch, munch, munch */
1225 (void)hfree(stab_xhash(stab), TRUE);
1226 stab_xhash(stab) = Null(HASH*);
1228 else if (type == O_SUBR || type == O_DBSUBR) {
1229 stab = arg[1].arg_ptr.arg_stab;
1230 cmd_free(stab_sub(stab)->cmd);
1231 afree(stab_sub(stab)->tosave);
1232 Safefree(stab_sub(stab));
1233 stab_sub(stab) = Null(SUBR*);
1236 fatal("Can't undefine that kind of object");
1237 str_numset(str,0.0);
1238 stack->ary_array[retarg] = str;
1243 do_vec(lvalue,astr,arglast)
1248 STR **st = stack->ary_array;
1249 int sp = arglast[0];
1250 register STR *str = st[++sp];
1251 register int offset = (int)str_gnum(st[++sp]);
1252 register int size = (int)str_gnum(st[++sp]);
1253 unsigned char *s = (unsigned char*)str_get(str);
1254 unsigned long retnum;
1258 offset *= size; /* turn into bit offset */
1259 len = (offset + size + 7) / 8;
1260 if (offset < 0 || size < 1)
1262 else if (!lvalue && len > str->str_cur)
1265 if (len > str->str_cur) {
1267 (void)bzero(str->str_ptr + str->str_cur, len - str->str_cur);
1270 s = (unsigned char*)str_get(str);
1272 retnum = (s[offset >> 3] >> (offset & 7)) & ((1 << size) - 1);
1277 else if (size == 16)
1278 retnum = (s[offset] << 8) + s[offset+1];
1279 else if (size == 32)
1280 retnum = (s[offset] << 24) + (s[offset + 1] << 16) +
1281 (s[offset + 2] << 8) + s[offset+3];
1284 if (lvalue) { /* it's an lvalue! */
1285 struct lstring *lstr = (struct lstring*)astr;
1287 astr->str_magic = str;
1288 st[sp]->str_rare = 'v';
1289 lstr->lstr_offset = offset;
1290 lstr->lstr_len = size;
1294 str_numset(astr,(double)retnum);
1304 struct lstring *lstr = (struct lstring*)str;
1305 register int offset;
1307 register unsigned char *s = (unsigned char*)mstr->str_ptr;
1308 register unsigned long lval = U_L(str_gnum(str));
1312 str->str_magic = Nullstr;
1313 offset = lstr->lstr_offset;
1314 size = lstr->lstr_len;
1316 mask = (1 << size) - 1;
1320 s[offset] &= ~(mask << size);
1321 s[offset] |= lval << size;
1325 s[offset] = lval & 255;
1326 else if (size == 16) {
1327 s[offset] = (lval >> 8) & 255;
1328 s[offset+1] = lval & 255;
1330 else if (size == 32) {
1331 s[offset] = (lval >> 24) & 255;
1332 s[offset+1] = (lval >> 16) & 255;
1333 s[offset+2] = (lval >> 8) & 255;
1334 s[offset+3] = lval & 255;
1343 register char *tmps;
1351 if (str->str_state == SS_ARY) {
1352 ary = stab_array(str->str_u.str_stab);
1353 for (i = 0; i <= ary->ary_fill; i++)
1354 do_chop(astr,ary->ary_array[i]);
1357 if (str->str_state == SS_HASH) {
1358 hash = stab_hash(str->str_u.str_stab);
1359 (void)hiterinit(hash);
1360 while (entry = hiternext(hash))
1361 do_chop(astr,hiterval(hash,entry));
1364 tmps = str_get(str);
1367 tmps += str->str_cur - (str->str_cur != 0);
1368 str_nset(astr,tmps,1); /* remember last char */
1369 *tmps = '\0'; /* wipe it out */
1370 str->str_cur = tmps - str->str_ptr;
1374 do_vop(optype,str,left,right)
1379 register char *s = str_get(str);
1380 register char *l = str_get(left);
1381 register char *r = str_get(right);
1384 len = left->str_cur;
1385 if (len > right->str_cur)
1386 len = right->str_cur;
1387 if (str->str_cur > len)
1389 else if (str->str_cur < len) {
1391 (void)bzero(str->str_ptr + str->str_cur, len - str->str_cur);
1409 if (right->str_cur > len)
1410 str_ncat(str,right->str_ptr+len,right->str_cur - len);
1411 else if (left->str_cur > len)
1412 str_ncat(str,left->str_ptr+len,left->str_cur - len);
1421 register STR **st = stack->ary_array;
1422 register int sp = arglast[1];
1423 register int items = arglast[2] - sp;
1430 for (st += ++sp; items--; st++)
1431 tainted |= (*st)->str_tainted;
1432 st = stack->ary_array;
1434 items = arglast[2] - sp;
1437 taintproper("Insecure dependency in syscall");
1439 /* This probably won't work on machines where sizeof(long) != sizeof(int)
1440 * or where sizeof(long) != sizeof(char*). But such machines will
1441 * not likely have syscall implemented either, so who cares?
1444 if (st[++sp]->str_nok || !i)
1445 arg[i++] = (long)str_gnum(st[sp]);
1448 arg[i++] = (long)st[sp]->str_ptr;
1452 items = arglast[2] - sp;
1455 fatal("Too few args to syscall");
1457 retval = syscall(arg[0]);
1460 retval = syscall(arg[0],arg[1]);
1463 retval = syscall(arg[0],arg[1],arg[2]);
1466 retval = syscall(arg[0],arg[1],arg[2],arg[3]);
1469 retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4]);
1472 retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5]);
1475 retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6]);
1478 retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6],
1484 fatal("syscall() unimplemented");