1 /* $Header: doarg.c,v 3.0.1.7 90/08/13 22:14:15 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.7 90/08/13 22:14:15 lwall
10 * patch28: the NSIG hack didn't work on Xenix
11 * patch28: defined(@array) and defined(%array) didn't work right
13 * Revision 3.0.1.6 90/08/09 02:48:38 lwall
14 * patch19: fixed double include of <signal.h>
15 * patch19: pack/unpack can now do native float and double
16 * patch19: pack/unpack can now have absolute and negative positioning
17 * patch19: pack/unpack can now have use * to specify all the rest of input
18 * patch19: unpack can do checksumming
19 * patch19: $< and $> better supported on machines without setreuid
20 * patch19: Added support for linked-in C subroutines
22 * Revision 3.0.1.5 90/03/27 15:39:03 lwall
23 * patch16: MSDOS support
24 * patch16: support for machines that can't cast negative floats to unsigned ints
25 * patch16: sprintf($s,...,$s,...) didn't work
27 * Revision 3.0.1.4 90/03/12 16:28:42 lwall
28 * patch13: pack of ascii strings could call str_ncat() with negative length
29 * patch13: printf("%s", *foo) was busted
31 * Revision 3.0.1.3 90/02/28 16:56:58 lwall
32 * patch9: split now can split into more than 10000 elements
33 * patch9: sped up pack and unpack
34 * patch9: pack of unsigned ints and longs blew up some places
35 * patch9: sun3 can't cast negative float to unsigned int or long
36 * patch9: local($.) didn't work
37 * patch9: grep(s/foo/bar/, @abc = @xyz) modified @xyz rather than @abc
38 * patch9: syscall returned stack size rather than value of system call
40 * Revision 3.0.1.2 89/12/21 19:52:15 lwall
41 * patch7: a pattern wouldn't match a null string before the first character
42 * patch7: certain patterns didn't match correctly at end of string
44 * Revision 3.0.1.1 89/11/11 04:17:20 lwall
45 * patch2: printf %c, %D, %X and %O didn't work right
46 * patch2: printf of unsigned vs signed needed separate casts on some machines
48 * Revision 3.0 89/10/18 15:10:41 lwall
56 #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
60 extern unsigned char fold[];
65 #pragma function(memcmp)
66 #endif /* BUGGY_MSC */
77 register char *s = str_get(str);
78 char *strend = s + str->str_cur;
84 int maxiters = (strend - s) + 10;
90 rspat = spat = arg[2].arg_ptr.arg_spat;
92 fatal("panic: do_subst");
93 else if (spat->spat_runtime) {
95 (void)eval(spat->spat_runtime,G_SCALAR,sp);
96 m = str_get(dstr = stack->ary_array[sp+1]);
98 if (spat->spat_regexp)
99 regfree(spat->spat_regexp);
100 spat->spat_regexp = regcomp(m,m+dstr->str_cur,
101 spat->spat_flags & SPAT_FOLD);
102 if (spat->spat_flags & SPAT_KEEP) {
103 arg_free(spat->spat_runtime); /* it won't change, so */
104 spat->spat_runtime = Nullarg; /* no point compiling again */
109 deb("2.SPAT /%s/\n",spat->spat_regexp->precomp);
112 safebase = ((!spat->spat_regexp || !spat->spat_regexp->nparens) &&
114 if (!*spat->spat_regexp->precomp && lastspat)
118 if (hint < s || hint > strend)
119 fatal("panic: hint in do_match");
122 if (spat->spat_regexp->regback >= 0) {
123 s -= spat->spat_regexp->regback;
130 else if (spat->spat_short) {
131 if (spat->spat_flags & SPAT_SCANFIRST) {
132 if (str->str_pok & SP_STUDIED) {
133 if (screamfirst[spat->spat_short->str_rare] < 0)
135 else if (!(s = screaminstr(str,spat->spat_short)))
139 else if (!(s = fbminstr((unsigned char*)s, (unsigned char*)strend,
143 if (s && spat->spat_regexp->regback >= 0) {
144 ++spat->spat_short->str_u.str_useful;
145 s -= spat->spat_regexp->regback;
152 else if (!multiline && (*spat->spat_short->str_ptr != *s ||
153 bcmp(spat->spat_short->str_ptr, s, spat->spat_slen) ))
155 if (--spat->spat_short->str_u.str_useful < 0) {
156 str_free(spat->spat_short);
157 spat->spat_short = Nullstr; /* opt is being useless */
160 once = ((rspat->spat_flags & SPAT_ONCE) != 0);
161 if (rspat->spat_flags & SPAT_CONST) { /* known replacement string? */
162 if ((rspat->spat_repl[1].arg_type & A_MASK) == A_SINGLE)
163 dstr = rspat->spat_repl[1].arg_ptr.arg_str;
164 else { /* constant over loop, anyway */
165 (void)eval(rspat->spat_repl,G_SCALAR,sp);
166 dstr = stack->ary_array[sp+1];
169 clen = dstr->str_cur;
170 if (clen <= spat->spat_slen + spat->spat_regexp->regback) {
171 /* can do inplace substitution */
172 if (regexec(spat->spat_regexp, s, strend, orig, 0,
173 str->str_pok & SP_STUDIED ? str : Nullstr, safebase)) {
174 if (spat->spat_regexp->subbase) /* oops, no we can't */
178 str->str_pok = SP_VALID; /* disable possible screamer */
180 m = spat->spat_regexp->startp[0];
181 d = spat->spat_regexp->endp[0];
183 if (m - s > strend - d) { /* faster to shorten from end */
185 (void)bcopy(c, m, clen);
190 (void)bcopy(d, m, i);
194 str->str_cur = m - s;
196 str_numset(arg->arg_ptr.arg_str, 1.0);
197 stack->ary_array[++sp] = arg->arg_ptr.arg_str;
200 else if (i = m - s) { /* faster from front */
208 (void)bcopy(c, m, clen);
210 str_numset(arg->arg_ptr.arg_str, 1.0);
211 stack->ary_array[++sp] = arg->arg_ptr.arg_str;
217 (void)bcopy(c,d,clen);
219 str_numset(arg->arg_ptr.arg_str, 1.0);
220 stack->ary_array[++sp] = arg->arg_ptr.arg_str;
226 str_numset(arg->arg_ptr.arg_str, 1.0);
227 stack->ary_array[++sp] = arg->arg_ptr.arg_str;
233 if (iters++ > maxiters)
234 fatal("Substitution loop");
235 m = spat->spat_regexp->startp[0];
242 (void)bcopy(c,d,clen);
245 s = spat->spat_regexp->endp[0];
246 } while (regexec(spat->spat_regexp, s, strend, orig, s == m,
247 Nullstr, TRUE)); /* (don't match same null twice) */
250 str->str_cur = d - str->str_ptr + i;
251 (void)bcopy(s,d,i+1); /* include the Null */
254 str_numset(arg->arg_ptr.arg_str, (double)iters);
255 stack->ary_array[++sp] = arg->arg_ptr.arg_str;
258 str_numset(arg->arg_ptr.arg_str, 0.0);
259 stack->ary_array[++sp] = arg->arg_ptr.arg_str;
265 if (regexec(spat->spat_regexp, s, strend, orig, 0,
266 str->str_pok & SP_STUDIED ? str : Nullstr, safebase)) {
268 dstr = Str_new(25,str_len(str));
269 str_nset(dstr,m,s-m);
270 if (spat->spat_regexp->subbase)
274 if (iters++ > maxiters)
275 fatal("Substitution loop");
276 if (spat->spat_regexp->subbase
277 && spat->spat_regexp->subbase != orig) {
280 orig = spat->spat_regexp->subbase;
282 strend = s + (strend - m);
284 m = spat->spat_regexp->startp[0];
285 str_ncat(dstr,s,m-s);
286 s = spat->spat_regexp->endp[0];
289 str_ncat(dstr,c,clen);
292 (void)eval(rspat->spat_repl,G_SCALAR,sp);
293 str_scat(dstr,stack->ary_array[sp+1]);
297 } while (regexec(spat->spat_regexp, s, strend, orig, s == m, Nullstr,
299 str_ncat(dstr,s,strend - s);
300 str_replace(str,dstr);
302 str_numset(arg->arg_ptr.arg_str, (double)iters);
303 stack->ary_array[++sp] = arg->arg_ptr.arg_str;
306 str_numset(arg->arg_ptr.arg_str, 0.0);
307 stack->ary_array[++sp] = arg->arg_ptr.arg_str;
311 ++spat->spat_short->str_u.str_useful;
312 str_numset(arg->arg_ptr.arg_str, 0.0);
313 stack->ary_array[++sp] = arg->arg_ptr.arg_str;
317 #pragma intrinsic(memcmp)
318 #endif /* BUGGY_MSC */
327 register int matches = 0;
331 tbl = arg[2].arg_ptr.arg_cval;
333 send = s + str->str_cur;
335 fatal("panic: do_trans");
342 if (ch = tbl[*s & 0377]) {
357 register STR **st = stack->ary_array;
358 register int sp = arglast[1];
359 register int items = arglast[2] - sp;
360 register char *delim = str_get(st[sp]);
361 int delimlen = st[sp]->str_cur;
368 for (; items > 0; items--,st++) {
369 str_ncat(str,delim,delimlen);
380 register STR **st = stack->ary_array;
381 register int sp = arglast[1];
383 register char *pat = str_get(st[sp]);
384 register char *patend = pat + st[sp]->str_cur;
388 static char *null10 = "\0\0\0\0\0\0\0\0\0\0";
389 static char *space10 = " ";
391 /* These must not be in registers: */
397 unsigned long aulong;
402 items = arglast[2] - sp;
405 while (pat < patend) {
406 #define NEXTFROM (items-- > 0 ? *st++ : &str_no)
409 len = index("@Xxu",datumtype) ? 0 : items;
412 else if (isdigit(*pat)) {
414 while (isdigit(*pat))
415 len = (len * 10) + (*pat++ - '0');
423 fatal("% may only be used in unpack");
435 if (str->str_cur < 0)
436 fatal("X outside of string");
437 str->str_ptr[str->str_cur] = '\0';
442 str_ncat(str,null10,10);
445 str_ncat(str,null10,len);
450 aptr = str_get(fromstr);
452 len = fromstr->str_cur;
453 if (fromstr->str_cur > len)
454 str_ncat(str,aptr,len);
456 str_ncat(str,aptr,fromstr->str_cur);
457 len -= fromstr->str_cur;
458 if (datumtype == 'A') {
460 str_ncat(str,space10,10);
463 str_ncat(str,space10,len);
467 str_ncat(str,null10,10);
470 str_ncat(str,null10,len);
478 aint = (int)str_gnum(fromstr);
480 str_ncat(str,&achar,sizeof(char));
483 /* Float and double added by gnb@melba.bby.oz.au 22/11/89 */
488 afloat = (float)str_gnum(fromstr);
489 str_ncat(str, (char *)&afloat, sizeof (float));
496 adouble = (double)str_gnum(fromstr);
497 str_ncat(str, (char *)&adouble, sizeof (double));
503 ashort = (short)str_gnum(fromstr);
505 ashort = htons(ashort);
507 str_ncat(str,(char*)&ashort,sizeof(short));
514 ashort = (short)str_gnum(fromstr);
515 str_ncat(str,(char*)&ashort,sizeof(short));
521 auint = U_I(str_gnum(fromstr));
522 str_ncat(str,(char*)&auint,sizeof(unsigned int));
528 aint = (int)str_gnum(fromstr);
529 str_ncat(str,(char*)&aint,sizeof(int));
535 along = (long)str_gnum(fromstr);
537 along = htonl(along);
539 str_ncat(str,(char*)&along,sizeof(long));
545 aulong = U_L(str_gnum(fromstr));
546 str_ncat(str,(char*)&aulong,sizeof(unsigned long));
552 along = (long)str_gnum(fromstr);
553 str_ncat(str,(char*)&along,sizeof(long));
559 aptr = str_get(fromstr);
560 str_ncat(str,(char*)&aptr,sizeof(char*));
565 aptr = str_get(fromstr);
566 aint = fromstr->str_cur;
567 STR_GROW(str,aint * 4 / 3);
579 doencodes(str, aptr, todo);
590 doencodes(str, s, len)
598 str_ncat(str, hunk, 1);
601 hunk[0] = ' ' + (077 & (*s >> 2));
602 hunk[1] = ' ' + (077 & ((*s << 4) & 060 | (s[1] >> 4) & 017));
603 hunk[2] = ' ' + (077 & ((s[1] << 2) & 074 | (s[2] >> 6) & 03));
604 hunk[3] = ' ' + (077 & (s[2] & 077));
605 str_ncat(str, hunk, 4);
609 str_ncat(str, "\n", 1);
613 do_sprintf(str,len,sarg)
622 static STR *sargnull = &str_no;
630 len--; /* don't count pattern string */
631 origs = s = str_get(*sarg);
632 send = s + (*sarg)->str_cur;
634 for ( ; s < send; len--) {
635 if (len <= 0 || !*sarg) {
640 for (t = s; t < send && *t != '%'; t++) ;
642 break; /* not enough % patterns, oh well */
643 for (t++; *sarg && t < send && t != s; t++) {
648 (void)sprintf(buf,s);
653 case '0': case '1': case '2': case '3': case '4':
654 case '5': case '6': case '7': case '8': case '9':
655 case '.': case '#': case '-': case '+':
663 xlen = (int)str_gnum(*(sarg++));
664 if (strEQ(t-2,"%c")) { /* some printfs fail on null chars */
666 str_ncat(str,s,t - s - 2);
667 str_ncat(str,buf,1); /* so handle simple case */
671 (void)sprintf(buf,s,xlen);
682 (void)sprintf(buf,s,(long)str_gnum(*(sarg++)));
684 (void)sprintf(buf,s,(int)str_gnum(*(sarg++)));
691 case 'x': case 'o': case 'u':
694 value = str_gnum(*(sarg++));
696 (void)sprintf(buf,s,U_L(value));
698 (void)sprintf(buf,s,U_I(value));
702 case 'E': case 'e': case 'f': case 'G': case 'g':
705 (void)sprintf(buf,s,str_gnum(*(sarg++)));
713 xlen = (*sarg)->str_cur;
714 if (*xs == 'S' && xs[1] == 't' && xs[2] == 'B'
715 && xlen == sizeof(STBP) && strlen(xs) < xlen) {
716 xs = stab_name(((STAB*)(*sarg))); /* a stab value! */
717 sprintf(tokenbuf,"*%s",xs); /* reformat to non-binary */
719 xlen = strlen(tokenbuf);
721 if (strEQ(t-2,"%s")) { /* some printfs fail on >128 chars */
723 str_ncat(str,s,t - s - 2);
725 str_ncat(str,xs,xlen); /* so handle simple case */
728 if (origs == xs) { /* sprintf($s,...$s...) */
729 strcpy(tokenbuf+64,s);
733 (void)sprintf(buf,s,xs);
741 if (s < t && t >= send) {
749 (void)sprintf(buf,s,0,0,0,0);
760 register STR **st = stack->ary_array;
761 register int sp = arglast[1];
762 register int items = arglast[2] - sp;
763 register STR *str = &str_undef;
765 for (st += ++sp; items > 0; items--,st++) {
769 (void)apush(ary,str);
775 do_unshift(ary,arglast)
779 register STR **st = stack->ary_array;
780 register int sp = arglast[1];
781 register int items = arglast[2] - sp;
787 for (st += ++sp; i < items; i++,st++) {
790 (void)astore(ary,i,str);
795 do_subr(arg,gimme,arglast)
800 register STR **st = stack->ary_array;
801 register int sp = arglast[1];
802 register int items = arglast[2] - sp;
806 char *oldfile = filename;
807 int oldsave = savestack->ary_fill;
808 int oldtmps_base = tmps_base;
810 if ((arg[1].arg_type & A_MASK) == A_WORD)
811 stab = arg[1].arg_ptr.arg_stab;
813 STR *tmpstr = stab_val(arg[1].arg_ptr.arg_stab);
816 stab = stabent(str_get(tmpstr),TRUE);
821 fatal("Undefined subroutine called");
824 sub = stab_sub(stab);
826 fatal("Undefined subroutine \"%s\" called", stab_name(stab));
828 st[sp] = arg->arg_ptr.arg_str;
829 if ((arg[2].arg_type & A_MASK) == A_NULL)
831 return sub->usersub(sub->userindex,sp,items);
833 if ((arg[2].arg_type & A_MASK) != A_NULL) {
834 savearray = stab_xarray(defstab);
835 stab_xarray(defstab) = afake(defstab, items, &st[sp+1]);
837 savelong(&sub->depth);
839 if (sub->depth >= 2) { /* save temporaries on recursion? */
840 if (sub->depth == 100 && dowarn)
841 warn("Deep recursion on subroutine \"%s\"",stab_name(stab));
842 savelist(sub->tosave->ary_array,sub->tosave->ary_fill);
844 filename = sub->filename;
845 tmps_base = tmps_max;
846 sp = cmd_exec(sub->cmd,gimme,--sp); /* so do it already */
847 st = stack->ary_array;
849 if ((arg[2].arg_type & A_MASK) != A_NULL) {
850 afree(stab_xarray(defstab)); /* put back old $_[] */
851 stab_xarray(defstab) = savearray;
854 tmps_base = oldtmps_base;
855 if (savestack->ary_fill > oldsave) {
856 for (items = arglast[0] + 1; items <= sp; items++)
857 st[items] = str_static(st[items]);
858 /* in case restore wipes old str */
859 restorelist(oldsave);
865 do_dbsubr(arg,gimme,arglast)
870 register STR **st = stack->ary_array;
871 register int sp = arglast[1];
872 register int items = arglast[2] - sp;
877 char *oldfile = filename;
878 int oldsave = savestack->ary_fill;
879 int oldtmps_base = tmps_base;
881 if ((arg[1].arg_type & A_MASK) == A_WORD)
882 stab = arg[1].arg_ptr.arg_stab;
884 STR *tmpstr = stab_val(arg[1].arg_ptr.arg_stab);
887 stab = stabent(str_get(tmpstr),TRUE);
892 fatal("Undefined subroutine called");
895 /* begin differences */
896 str = stab_val(DBsub);
898 str_set(str,stab_name(stab));
899 sub = stab_sub(DBsub);
901 fatal("No DBsub routine");
902 /* end differences */
903 if ((arg[2].arg_type & A_MASK) != A_NULL) {
904 savearray = stab_xarray(defstab);
905 stab_xarray(defstab) = afake(defstab, items, &st[sp+1]);
907 savelong(&sub->depth);
909 if (sub->depth >= 2) { /* save temporaries on recursion? */
910 if (sub->depth == 100 && dowarn)
911 warn("Deep recursion on subroutine \"%s\"",stab_name(stab));
912 savelist(sub->tosave->ary_array,sub->tosave->ary_fill);
914 filename = sub->filename;
915 tmps_base = tmps_max;
916 sp = cmd_exec(sub->cmd,gimme, --sp); /* so do it already */
917 st = stack->ary_array;
919 if ((arg[2].arg_type & A_MASK) != A_NULL) {
920 afree(stab_xarray(defstab)); /* put back old $_[] */
921 stab_xarray(defstab) = savearray;
924 tmps_base = oldtmps_base;
925 if (savestack->ary_fill > oldsave) {
926 for (items = arglast[0] + 1; items <= sp; items++)
927 st[items] = str_static(st[items]);
928 /* in case restore wipes old str */
929 restorelist(oldsave);
935 do_assign(arg,gimme,arglast)
941 register STR **st = stack->ary_array;
942 STR **firstrelem = st + arglast[1] + 1;
943 STR **firstlelem = st + arglast[0] + 1;
944 STR **lastrelem = st + arglast[2];
945 STR **lastlelem = st + arglast[1];
946 register STR **relem;
947 register STR **lelem;
951 register int makelocal;
955 makelocal = (arg->arg_flags & AF_LOCAL);
956 localizing = makelocal;
957 delaymagic = DM_DELAY; /* catch simultaneous items */
959 /* If there's a common identifier on both sides we have to take
960 * special care that assigning the identifier on the left doesn't
961 * clobber a value on the right that's used later in the list.
963 if (arg->arg_flags & AF_COMMON) {
964 for (relem = firstrelem; relem <= lastrelem; relem++) {
966 *relem = str_static(str);
973 while (lelem <= lastlelem) {
975 if (str->str_state >= SS_HASH) {
976 if (str->str_state == SS_ARY) {
978 ary = saveary(str->str_u.str_stab);
980 ary = stab_array(str->str_u.str_stab);
984 while (relem <= lastrelem) { /* gobble up all the rest */
987 str_sset(str,*relem);
989 (void)astore(ary,i++,str);
992 else if (str->str_state == SS_HASH) {
997 hash = savehash(str->str_u.str_stab);
999 hash = stab_hash(str->str_u.str_stab);
1002 while (relem < lastrelem) { /* gobble up all the rest */
1006 str = &str_no, relem++;
1007 tmps = str_get(str);
1008 tmpstr = Str_new(29,0);
1010 str_sset(tmpstr,*relem); /* value */
1011 *(relem++) = tmpstr;
1012 (void)hstore(hash,tmps,str->str_cur,tmpstr,0);
1016 fatal("panic: do_assign");
1021 if (relem <= lastrelem) {
1022 str_sset(str, *relem);
1026 str_nset(str, "", 0);
1027 if (gimme == G_ARRAY) {
1028 i = ++lastrelem - firstrelem;
1029 relem++; /* tacky, I suppose */
1030 astore(stack,i,str);
1031 if (st != stack->ary_array) {
1032 st = stack->ary_array;
1033 firstrelem = st + arglast[1] + 1;
1034 firstlelem = st + arglast[0] + 1;
1035 lastlelem = st + arglast[1];
1037 relem = lastrelem + 1;
1044 if (delaymagic > 1) {
1045 if (delaymagic & DM_REUID) {
1049 if (uid != euid || setuid(uid) < 0)
1050 fatal("No setreuid available");
1053 if (delaymagic & DM_REGID) {
1057 if (gid != egid || setgid(gid) < 0)
1058 fatal("No setregid available");
1064 if (gimme == G_ARRAY) {
1065 i = lastrelem - firstrelem + 1;
1067 Copy(firstrelem, firstlelem, i, STR*);
1068 return arglast[0] + i;
1071 str_numset(arg->arg_ptr.arg_str,(double)(arglast[2] - arglast[1]));
1072 *firstlelem = arg->arg_ptr.arg_str;
1073 return arglast[0] + 1;
1078 do_study(str,arg,gimme,arglast)
1084 register unsigned char *s;
1085 register int pos = str->str_cur;
1087 register int *sfirst;
1088 register int *snext;
1089 static int maxscream = -1;
1090 static STR *lastscream = Nullstr;
1092 int retarg = arglast[0] + 1;
1095 s = (unsigned char*)(str_get(str));
1097 s = Null(unsigned char*);
1100 lastscream->str_pok &= ~SP_STUDIED;
1106 if (pos > maxscream) {
1107 if (maxscream < 0) {
1108 maxscream = pos + 80;
1109 New(301,screamfirst, 256, int);
1110 New(302,screamnext, maxscream, int);
1113 maxscream = pos + pos / 4;
1114 Renew(screamnext, maxscream, int);
1118 sfirst = screamfirst;
1121 if (!sfirst || !snext)
1122 fatal("do_study: out of memory");
1124 for (ch = 256; ch; --ch)
1128 while (--pos >= 0) {
1130 if (sfirst[ch] >= 0)
1131 snext[pos] = sfirst[ch] - pos;
1136 /* If there were any case insensitive searches, we must assume they
1137 * all are. This speeds up insensitive searches much more than
1138 * it slows down sensitive ones.
1141 sfirst[fold[ch]] = pos;
1144 str->str_pok |= SP_STUDIED;
1147 str_numset(arg->arg_ptr.arg_str,(double)retval);
1148 stack->ary_array[retarg] = arg->arg_ptr.arg_str;
1153 do_defined(str,arg,gimme,arglast)
1160 register int retarg = arglast[0] + 1;
1165 if ((arg[1].arg_type & A_MASK) != A_LEXPR)
1166 fatal("Illegal argument to defined()");
1167 arg = arg[1].arg_ptr.arg_arg;
1168 type = arg->arg_type;
1170 if (type == O_SUBR || type == O_DBSUBR)
1171 retval = stab_sub(arg[1].arg_ptr.arg_stab) != 0;
1172 else if (type == O_ARRAY || type == O_LARRAY ||
1173 type == O_ASLICE || type == O_LASLICE )
1174 retval = ((ary = stab_xarray(arg[1].arg_ptr.arg_stab)) != 0
1175 && ary->ary_max >= 0 );
1176 else if (type == O_HASH || type == O_LHASH ||
1177 type == O_HSLICE || type == O_LHSLICE )
1178 retval = ((hash = stab_xhash(arg[1].arg_ptr.arg_stab)) != 0
1179 && hash->tbl_array);
1182 str_numset(str,(double)retval);
1183 stack->ary_array[retarg] = str;
1188 do_undef(str,arg,gimme,arglast)
1195 register STAB *stab;
1196 int retarg = arglast[0] + 1;
1198 if ((arg[1].arg_type & A_MASK) != A_LEXPR)
1199 fatal("Illegal argument to undef()");
1200 arg = arg[1].arg_ptr.arg_arg;
1201 type = arg->arg_type;
1203 if (type == O_ARRAY || type == O_LARRAY) {
1204 stab = arg[1].arg_ptr.arg_stab;
1205 afree(stab_xarray(stab));
1206 stab_xarray(stab) = Null(ARRAY*);
1208 else if (type == O_HASH || type == O_LHASH) {
1209 stab = arg[1].arg_ptr.arg_stab;
1210 (void)hfree(stab_xhash(stab));
1211 stab_xhash(stab) = Null(HASH*);
1213 else if (type == O_SUBR || type == O_DBSUBR) {
1214 stab = arg[1].arg_ptr.arg_stab;
1215 cmd_free(stab_sub(stab)->cmd);
1216 afree(stab_sub(stab)->tosave);
1217 Safefree(stab_sub(stab));
1218 stab_sub(stab) = Null(SUBR*);
1221 fatal("Can't undefine that kind of object");
1222 str_numset(str,0.0);
1223 stack->ary_array[retarg] = str;
1228 do_vec(lvalue,astr,arglast)
1233 STR **st = stack->ary_array;
1234 int sp = arglast[0];
1235 register STR *str = st[++sp];
1236 register int offset = (int)str_gnum(st[++sp]);
1237 register int size = (int)str_gnum(st[++sp]);
1238 unsigned char *s = (unsigned char*)str_get(str);
1239 unsigned long retnum;
1243 offset *= size; /* turn into bit offset */
1244 len = (offset + size + 7) / 8;
1245 if (offset < 0 || size < 1)
1247 else if (!lvalue && len > str->str_cur)
1250 if (len > str->str_cur) {
1252 (void)bzero(str->str_ptr + str->str_cur, len - str->str_cur);
1255 s = (unsigned char*)str_get(str);
1257 retnum = (s[offset >> 3] >> (offset & 7)) & ((1 << size) - 1);
1262 else if (size == 16)
1263 retnum = (s[offset] << 8) + s[offset+1];
1264 else if (size == 32)
1265 retnum = (s[offset] << 24) + (s[offset + 1] << 16) +
1266 (s[offset + 2] << 8) + s[offset+3];
1269 if (lvalue) { /* it's an lvalue! */
1270 struct lstring *lstr = (struct lstring*)astr;
1272 astr->str_magic = str;
1273 st[sp]->str_rare = 'v';
1274 lstr->lstr_offset = offset;
1275 lstr->lstr_len = size;
1279 str_numset(astr,(double)retnum);
1289 struct lstring *lstr = (struct lstring*)str;
1290 register int offset;
1292 register unsigned char *s = (unsigned char*)mstr->str_ptr;
1293 register unsigned long lval = U_L(str_gnum(str));
1297 str->str_magic = Nullstr;
1298 offset = lstr->lstr_offset;
1299 size = lstr->lstr_len;
1301 mask = (1 << size) - 1;
1305 s[offset] &= ~(mask << size);
1306 s[offset] |= lval << size;
1310 s[offset] = lval & 255;
1311 else if (size == 16) {
1312 s[offset] = (lval >> 8) & 255;
1313 s[offset+1] = lval & 255;
1315 else if (size == 32) {
1316 s[offset] = (lval >> 24) & 255;
1317 s[offset+1] = (lval >> 16) & 255;
1318 s[offset+2] = (lval >> 8) & 255;
1319 s[offset+3] = lval & 255;
1328 register char *tmps;
1336 if (str->str_state == SS_ARY) {
1337 ary = stab_array(str->str_u.str_stab);
1338 for (i = 0; i <= ary->ary_fill; i++)
1339 do_chop(astr,ary->ary_array[i]);
1342 if (str->str_state == SS_HASH) {
1343 hash = stab_hash(str->str_u.str_stab);
1344 (void)hiterinit(hash);
1345 while (entry = hiternext(hash))
1346 do_chop(astr,hiterval(hash,entry));
1349 tmps = str_get(str);
1352 tmps += str->str_cur - (str->str_cur != 0);
1353 str_nset(astr,tmps,1); /* remember last char */
1354 *tmps = '\0'; /* wipe it out */
1355 str->str_cur = tmps - str->str_ptr;
1359 do_vop(optype,str,left,right)
1364 register char *s = str_get(str);
1365 register char *l = str_get(left);
1366 register char *r = str_get(right);
1369 len = left->str_cur;
1370 if (len > right->str_cur)
1371 len = right->str_cur;
1372 if (str->str_cur > len)
1374 else if (str->str_cur < len) {
1376 (void)bzero(str->str_ptr + str->str_cur, len - str->str_cur);
1394 if (right->str_cur > len)
1395 str_ncat(str,right->str_ptr+len,right->str_cur - len);
1396 else if (left->str_cur > len)
1397 str_ncat(str,left->str_ptr+len,left->str_cur - len);
1406 register STR **st = stack->ary_array;
1407 register int sp = arglast[1];
1408 register int items = arglast[2] - sp;
1415 for (st += ++sp; items--; st++)
1416 tainted |= (*st)->str_tainted;
1417 st = stack->ary_array;
1419 items = arglast[2] - sp;
1422 taintproper("Insecure dependency in syscall");
1424 /* This probably won't work on machines where sizeof(long) != sizeof(int)
1425 * or where sizeof(long) != sizeof(char*). But such machines will
1426 * not likely have syscall implemented either, so who cares?
1429 if (st[++sp]->str_nok || !i)
1430 arg[i++] = (long)str_gnum(st[sp]);
1433 arg[i++] = (long)st[sp]->str_ptr;
1437 items = arglast[2] - sp;
1440 fatal("Too few args to syscall");
1442 retval = syscall(arg[0]);
1445 retval = syscall(arg[0],arg[1]);
1448 retval = syscall(arg[0],arg[1],arg[2]);
1451 retval = syscall(arg[0],arg[1],arg[2],arg[3]);
1454 retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4]);
1457 retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5]);
1460 retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6]);
1463 retval = syscall(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6],
1469 fatal("syscall() unimplemented");