1 /* $Header: eval.c,v 3.0.1.5 90/03/12 16:37:40 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.5 90/03/12 16:37:40 lwall
10 * patch13: undef $/ didn't work as advertised
11 * patch13: added list slice operator (LIST)[LIST]
12 * patch13: added splice operator: @oldelems = splice(@array,$offset,$len,LIST)
14 * Revision 3.0.1.4 90/02/28 17:36:59 lwall
15 * patch9: added pipe function
16 * patch9: a return in scalar context wouldn't return array
17 * patch9: !~ now always returns scalar even in array context
18 * patch9: some machines can't cast float to long with high bit set
19 * patch9: piped opens returned undef in child
20 * patch9: @array in scalar context now returns length of array
21 * patch9: chdir; coredumped
22 * patch9: wait no longer ignores signals
23 * patch9: mkdir now handles odd versions of /bin/mkdir
24 * patch9: -l FILEHANDLE now disallowed
26 * Revision 3.0.1.3 89/12/21 20:03:05 lwall
27 * patch7: errno may now be a macro with an lvalue
28 * patch7: ANSI strerror() is now supported
29 * patch7: send() didn't allow a TO argument
30 * patch7: ord() now always returns positive even on signed char machines
32 * Revision 3.0.1.2 89/11/17 15:19:34 lwall
33 * patch5: constant numeric subscripts get lost inside ?:
35 * Revision 3.0.1.1 89/11/11 04:31:51 lwall
36 * patch2: mkdir and rmdir needed to quote argument when passed to shell
37 * patch2: mkdir and rmdir now return better error codes
38 * patch2: fileno, seekdir, rewinddir and closedir now disallow defaults
40 * Revision 3.0 89/10/18 15:17:04 lwall
55 static void (*ihand)();
56 static void (*qhand)();
58 static int (*ihand)();
59 static int (*qhand)();
66 static struct lstring *lstr;
67 static int old_record_separator;
70 double sin(), cos(), atan2(), pow();
91 int arglast[8]; /* highest sp for arg--valid only for non-O_LIST args */
92 unsigned long tmplong;
99 bool assigning = FALSE;
100 double exp(), log(), sqrt(), modf();
101 char *crypt(), *getenv();
102 extern void grow_dlevel();
106 optype = arg->arg_type;
107 maxarg = arg->arg_len;
109 str = arg->arg_ptr.arg_str;
110 if (sp + maxarg > stack->ary_max)
111 astore(stack, sp + maxarg, Nullstr);
112 st = stack->ary_array;
117 deb("%s (%lx) %d args:\n",opname[optype],arg,maxarg);
119 debname[dlevel] = opname[optype][0];
120 debdelim[dlevel] = ':';
121 if (++dlevel >= dlmax)
126 #include "evalargs.xc"
134 if (gimme == G_ARRAY)
140 if (gimme == G_ARRAY)
143 STR_SSET(str,st[arglast[anum]-arglast[0]]);
147 if (gimme == G_ARRAY)
150 STR_SSET(str,st[arglast[anum]-arglast[0]]);
160 anum = (int)str_gnum(st[2]);
162 tmpstr = Str_new(50, 0);
163 str_sset(tmpstr,str);
164 tmps = str_get(tmpstr); /* force to be string */
165 STR_GROW(str, (anum * str->str_cur) + 1);
166 repeatcpy(str->str_ptr, tmps, tmpstr->str_cur, anum);
167 str->str_cur *= anum;
168 str->str_ptr[str->str_cur] = '\0';
171 str_sset(str,&str_no);
175 sp = do_match(str,arg,
177 if (gimme == G_ARRAY)
182 sp = do_match(str,arg,
184 str_sset(str, str_true(str) ? &str_no : &str_yes);
188 sp = do_subst(str,arg,arglast[0]);
191 sp = do_subst(str,arg,arglast[0]);
192 str = arg->arg_ptr.arg_str;
193 str_set(str, str_true(str) ? No : Yes);
196 if (arg[1].arg_flags & AF_ARYOK) {
197 if (arg->arg_len == 1) {
198 arg->arg_type = O_LOCAL;
202 arg->arg_type = O_AASSIGN;
207 arg->arg_type = O_SASSIGN;
212 arglast[2] = arglast[1]; /* push a null array */
221 STR_SSET(str, st[2]);
226 str = arg->arg_ptr.arg_str;
227 for (sp = arglast[0] + 1; sp <= arglast[1]; sp++)
232 if (arg[1].arg_type & A_DONT) {
233 sp = do_defined(str,arg,
237 else if (str->str_pok || str->str_nok)
241 if (arg[1].arg_type & A_DONT) {
242 sp = do_undef(str,arg,
246 else if (str != stab_val(defstab)) {
247 str->str_pok = str->str_nok = 0;
252 sp = do_study(str,arg,
256 value = str_gnum(st[1]);
257 value = pow(value,str_gnum(st[2]));
260 value = str_gnum(st[1]);
261 value *= str_gnum(st[2]);
264 if ((value = str_gnum(st[2])) == 0.0)
265 fatal("Illegal division by zero");
266 value = str_gnum(st[1]) / value;
269 tmplong = (long) str_gnum(st[2]);
271 fatal("Illegal modulus zero");
272 when = (long)str_gnum(st[1]);
275 value = (double)(when % tmplong);
277 value = (double)(tmplong - (-when % tmplong));
281 value = str_gnum(st[1]);
282 value += str_gnum(st[2]);
285 value = str_gnum(st[1]);
286 value -= str_gnum(st[2]);
289 value = str_gnum(st[1]);
290 anum = (int)str_gnum(st[2]);
292 value = (double)(((unsigned long)value) << anum);
296 value = str_gnum(st[1]);
297 anum = (int)str_gnum(st[2]);
299 value = (double)(((unsigned long)value) >> anum);
303 value = str_gnum(st[1]);
304 value = (value < str_gnum(st[2])) ? 1.0 : 0.0;
307 value = str_gnum(st[1]);
308 value = (value > str_gnum(st[2])) ? 1.0 : 0.0;
311 value = str_gnum(st[1]);
312 value = (value <= str_gnum(st[2])) ? 1.0 : 0.0;
315 value = str_gnum(st[1]);
316 value = (value >= str_gnum(st[2])) ? 1.0 : 0.0;
320 if ((!st[1]->str_nok && !looks_like_number(st[1])) ||
321 (!st[2]->str_nok && !looks_like_number(st[2])) )
322 warn("Possible use of == on string value");
324 value = str_gnum(st[1]);
325 value = (value == str_gnum(st[2])) ? 1.0 : 0.0;
328 value = str_gnum(st[1]);
329 value = (value != str_gnum(st[2])) ? 1.0 : 0.0;
332 if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
333 value = str_gnum(st[1]);
335 value = (double)(((unsigned long)value) &
336 (unsigned long)str_gnum(st[2]));
341 do_vop(optype,str,st[1],st[2]);
344 if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
345 value = str_gnum(st[1]);
347 value = (double)(((unsigned long)value) ^
348 (unsigned long)str_gnum(st[2]));
353 do_vop(optype,str,st[1],st[2]);
356 if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
357 value = str_gnum(st[1]);
359 value = (double)(((unsigned long)value) |
360 (unsigned long)str_gnum(st[2]));
365 do_vop(optype,str,st[1],st[2]);
367 /* use register in evaluating str_true() */
369 if (str_true(st[1])) {
372 argflags = arg[anum].arg_flags;
373 if (gimme == G_ARRAY)
374 argflags |= AF_ARYOK;
375 argtype = arg[anum].arg_type & A_MASK;
376 argptr = arg[anum].arg_ptr;
384 str_sset(str, st[1]);
392 if (str_true(st[1])) {
394 str_sset(str, st[1]);
404 argflags = arg[anum].arg_flags;
405 if (gimme == G_ARRAY)
406 argflags |= AF_ARYOK;
407 argtype = arg[anum].arg_type & A_MASK;
408 argptr = arg[anum].arg_ptr;
415 anum = (str_true(st[1]) ? 2 : 3);
416 optype = (anum == 2 ? O_ITEM2 : O_ITEM3);
417 argflags = arg[anum].arg_flags;
418 if (gimme == G_ARRAY)
419 argflags |= AF_ARYOK;
420 argtype = arg[anum].arg_type & A_MASK;
421 argptr = arg[anum].arg_ptr;
427 if (gimme == G_ARRAY)
432 value = -str_gnum(st[1]);
435 value = (double) !str_true(st[1]);
439 value = (double) ~(unsigned long)str_gnum(st[1]);
443 tmps = stab_name(defoutstab);
445 if ((arg[1].arg_type & A_MASK) == A_WORD)
446 defoutstab = arg[1].arg_ptr.arg_stab;
448 defoutstab = stabent(str_get(st[1]),TRUE);
449 if (!stab_io(defoutstab))
450 stab_io(defoutstab) = stio_new();
451 curoutstab = defoutstab;
459 else if ((arg[1].arg_type & A_MASK) == A_WORD) {
460 if (!(stab = arg[1].arg_ptr.arg_stab))
464 stab = stabent(str_get(st[1]),TRUE);
465 if (!stab_io(stab)) {
471 fp = stab_io(stab)->ofp;
473 if (stab_io(stab)->fmt_stab)
474 form = stab_form(stab_io(stab)->fmt_stab);
476 form = stab_form(stab);
480 warn("No format for filehandle");
482 if (stab_io(stab)->ifp)
483 warn("Filehandle only opened for input");
485 warn("Write on closed filehandle");
492 format(&outrec,form,sp);
493 do_write(&outrec,stab_io(stab),sp);
494 if (stab_io(stab)->flags & IOF_FLUSH)
501 if ((arg[1].arg_type & A_MASK) == A_WORD)
502 stab = arg[1].arg_ptr.arg_stab;
504 stab = stabent(str_get(st[1]),TRUE);
505 anum = (int)str_gnum(st[3]);
506 value = (double)hdbmopen(stab_hash(stab),str_get(st[2]),anum);
509 fatal("No dbm or ndbm on this machine");
513 if ((arg[1].arg_type & A_MASK) == A_WORD)
514 stab = arg[1].arg_ptr.arg_stab;
516 stab = stabent(str_get(st[1]),TRUE);
517 hdbmclose(stab_hash(stab));
520 fatal("No dbm or ndbm on this machine");
523 if ((arg[1].arg_type & A_MASK) == A_WORD)
524 stab = arg[1].arg_ptr.arg_stab;
526 stab = stabent(str_get(st[1]),TRUE);
527 tmps = str_get(st[2]);
528 if (do_open(stab,tmps,st[2]->str_cur)) {
529 value = (double)forkprocess;
530 stab_io(stab)->lines = 0;
533 else if (forkprocess == 0) /* we are a new child */
539 value = (double) do_trans(str,arg);
540 str = arg->arg_ptr.arg_str;
543 str_set(arg->arg_ptr.arg_str, do_trans(str,arg) == 0 ? Yes : No);
544 str = arg->arg_ptr.arg_str;
549 else if ((arg[1].arg_type & A_MASK) == A_WORD)
550 stab = arg[1].arg_ptr.arg_stab;
552 stab = stabent(str_get(st[1]),TRUE);
553 str_set(str, do_close(stab,TRUE) ? Yes : No );
557 sp = do_each(str,stab_hash(arg[1].arg_ptr.arg_stab),
562 sp = do_kv(str,stab_hash(arg[1].arg_ptr.arg_stab), optype,
566 str->str_nok = str->str_pok = 0;
567 str->str_u.str_stab = arg[1].arg_ptr.arg_stab;
568 str->str_state = SS_ARY;
571 ary = stab_array(arg[1].arg_ptr.arg_stab);
572 maxarg = ary->ary_fill + 1;
573 if (gimme == G_ARRAY) { /* array wanted */
576 if (maxarg > 0 && sp + maxarg > stack->ary_max) {
577 astore(stack,sp + maxarg, Nullstr);
578 st = stack->ary_array;
580 Copy(ary->ary_array, &st[sp+1], maxarg, STR*);
585 value = (double)maxarg;
589 anum = ((int)str_gnum(st[2])) - arybase;
590 str = afetch(stab_array(arg[1].arg_ptr.arg_stab),anum,FALSE);
595 tmpstab = arg[1].arg_ptr.arg_stab;
596 tmps = str_get(st[2]);
597 str = hdelete(stab_hash(tmpstab),tmps,st[2]->str_cur);
598 if (tmpstab == envstab)
604 str->str_nok = str->str_pok = 0;
605 str->str_u.str_stab = arg[1].arg_ptr.arg_stab;
606 str->str_state = SS_HASH;
609 if (gimme == G_ARRAY) { /* array wanted */
610 sp = do_kv(str,stab_hash(arg[1].arg_ptr.arg_stab), optype,
615 tmpstab = arg[1].arg_ptr.arg_stab;
616 sprintf(buf,"%d/%d",stab_hash(tmpstab)->tbl_fill,
617 stab_hash(tmpstab)->tbl_max+1);
622 tmpstab = arg[1].arg_ptr.arg_stab;
623 tmps = str_get(st[2]);
624 str = hfetch(stab_hash(tmpstab),tmps,st[2]->str_cur,FALSE);
629 anum = ((int)str_gnum(st[2])) - arybase;
630 str = afetch(stab_array(arg[1].arg_ptr.arg_stab),anum,TRUE);
632 fatal("Assignment to non-creatable value, subscript %d",anum);
635 tmpstab = arg[1].arg_ptr.arg_stab;
636 tmps = str_get(st[2]);
637 anum = st[2]->str_cur;
638 str = hfetch(stab_hash(tmpstab),tmps,anum,TRUE);
640 fatal("Assignment to non-creatable value, subscript \"%s\"",tmps);
641 if (tmpstab == envstab) /* heavy wizardry going on here */
642 str_magic(str, tmpstab, 'E', tmps, anum); /* str is now magic */
643 /* he threw the brick up into the air */
644 else if (tmpstab == sigstab)
645 str_magic(str, tmpstab, 'S', tmps, anum);
647 else if (stab_hash(tmpstab)->tbl_dbm)
648 str_magic(str, tmpstab, 'D', tmps, anum);
654 goto do_slice_already;
658 goto do_slice_already;
662 goto do_slice_already;
666 goto do_slice_already;
671 sp = do_slice(arg[1].arg_ptr.arg_stab,str,anum,argtype,
675 sp = do_splice(stab_array(arg[1].arg_ptr.arg_stab),str,gimme,arglast);
678 if (arglast[2] - arglast[1] != 1)
679 str = do_push(stab_array(arg[1].arg_ptr.arg_stab),arglast);
681 str = Str_new(51,0); /* must copy the STR */
683 (void)apush(stab_array(arg[1].arg_ptr.arg_stab),str);
687 str = apop(ary = stab_array(arg[1].arg_ptr.arg_stab));
688 goto staticalization;
690 str = ashift(ary = stab_array(arg[1].arg_ptr.arg_stab));
694 if (ary->ary_flags & ARF_REAL)
695 (void)str_2static(str);
698 sp = do_unpack(str,gimme,arglast);
701 value = str_gnum(st[3]);
702 sp = do_split(str, arg[2].arg_ptr.arg_spat, (int)value,
707 value = (double)str_len(stab_val(defstab));
709 value = (double)str_len(st[1]);
712 do_sprintf(str, sp-arglast[0], st+1);
715 anum = ((int)str_gnum(st[2])) - arybase; /* anum=where to start*/
716 tmps = str_get(st[1]); /* force conversion to string */
717 if (argtype = (str == st[1]))
718 str = arg->arg_ptr.arg_str;
720 anum += st[1]->str_cur + arybase;
721 if (anum < 0 || anum > st[1]->str_cur)
724 optype = (int)str_gnum(st[3]);
728 anum = st[1]->str_cur - anum; /* anum=how many bytes left*/
731 str_nset(str, tmps, anum);
732 if (argtype) { /* it's an lvalue! */
733 lstr = (struct lstring*)str;
734 str->str_magic = st[1];
735 st[1]->str_rare = 's';
736 lstr->lstr_offset = tmps - str_get(st[1]);
737 lstr->lstr_len = anum;
742 (void)do_pack(str,arglast);
745 sp = do_grep(arg,str,gimme,arglast);
748 do_join(str,arglast);
751 tmps = str_get(st[1]);
752 value = (double) (str_cmp(st[1],st[2]) < 0);
755 tmps = str_get(st[1]);
756 value = (double) (str_cmp(st[1],st[2]) > 0);
759 tmps = str_get(st[1]);
760 value = (double) (str_cmp(st[1],st[2]) <= 0);
763 tmps = str_get(st[1]);
764 value = (double) (str_cmp(st[1],st[2]) >= 0);
767 tmps = str_get(st[1]);
768 value = (double) str_eq(st[1],st[2]);
771 tmps = str_get(st[1]);
772 value = (double) !str_eq(st[1],st[2]);
775 sp = do_subr(arg,gimme,arglast);
776 st = stack->ary_array + arglast[0]; /* maybe realloced */
779 sp = do_dbsubr(arg,gimme,arglast);
780 st = stack->ary_array + arglast[0]; /* maybe realloced */
783 if ((arg[1].arg_type & A_MASK) == A_WORD)
784 stab = arg[1].arg_ptr.arg_stab;
786 stab = stabent(str_get(st[1]),TRUE);
789 sp = do_sort(str,stab,
797 if (arglast[2] - arglast[1] != 1) {
798 do_join(str,arglast);
799 tmps = str_get(st[1]);
803 tmps = str_get(st[2]);
806 tmps = "Warning: something's wrong";
810 if (arglast[2] - arglast[1] != 1) {
811 do_join(str,arglast);
812 tmps = str_get(st[1]);
816 tmps = str_get(st[2]);
824 if ((arg[1].arg_type & A_MASK) == A_WORD)
825 stab = arg[1].arg_ptr.arg_stab;
827 stab = stabent(str_get(st[1]),TRUE);
830 if (!stab_io(stab)) {
832 warn("Filehandle never opened");
835 if (!(fp = stab_io(stab)->ofp)) {
837 if (stab_io(stab)->ifp)
838 warn("Filehandle opened only for input");
840 warn("Print on closed filehandle");
845 if (optype == O_PRTF || arglast[2] - arglast[1] != 1)
846 value = (double)do_aprint(arg,fp,arglast);
848 value = (double)do_print(st[2],fp);
849 if (orslen && optype == O_PRINT)
850 if (fwrite(ors, 1, orslen, fp) == 0)
853 if (stab_io(stab)->flags & IOF_FLUSH)
854 if (fflush(fp) == EOF)
862 tmps = str_get(st[1]);
863 if (!tmps || !*tmps) {
864 tmpstr = hfetch(stab_hash(envstab),"HOME",4,FALSE);
866 tmps = str_get(tmpstr);
868 if (!tmps || !*tmps) {
869 tmpstr = hfetch(stab_hash(envstab),"LOGDIR",6,FALSE);
871 tmps = str_get(tmpstr);
874 taintproper("Insecure dependency in chdir");
876 value = (double)(chdir(tmps) >= 0);
882 anum = (int)str_gnum(st[1]);
889 tmps = str_get(st[1]);
890 str_reset(tmps,arg[2].arg_ptr.arg_hash);
894 if (gimme == G_ARRAY)
897 str = st[sp - arglast[0]]; /* unwanted list, return last item */
904 else if ((arg[1].arg_type & A_MASK) == A_WORD)
905 stab = arg[1].arg_ptr.arg_stab;
907 stab = stabent(str_get(st[1]),TRUE);
908 str_set(str, do_eof(stab) ? Yes : No);
914 else if ((arg[1].arg_type & A_MASK) == A_WORD)
915 stab = arg[1].arg_ptr.arg_stab;
917 stab = stabent(str_get(st[1]),TRUE);
918 if (do_eof(stab)) /* make sure we have fp with something */
925 *str->str_ptr = getc(stab_io(stab)->ifp); /* should never be EOF */
932 else if ((arg[1].arg_type & A_MASK) == A_WORD)
933 stab = arg[1].arg_ptr.arg_stab;
935 stab = stabent(str_get(st[1]),TRUE);
937 value = (double)do_tell(stab);
944 if ((arg[1].arg_type & A_MASK) == A_WORD)
945 stab = arg[1].arg_ptr.arg_stab;
947 stab = stabent(str_get(st[1]),TRUE);
948 tmps = str_get(st[2]);
949 anum = (int)str_gnum(st[3]);
950 STR_GROW(st[2], anum+1), (tmps = str_get(st[2])); /* sneaky */
952 if (!stab_io(stab) || !stab_io(stab)->ifp)
955 else if (optype == O_RECV) {
956 argtype = sizeof buf;
957 optype = (int)str_gnum(st[4]);
958 anum = recvfrom(fileno(stab_io(stab)->ifp), tmps, anum, optype,
961 st[2]->str_cur = anum;
962 st[2]->str_ptr[anum] = '\0';
963 str_nset(str,buf,argtype);
966 str_sset(str,&str_undef);
969 else if (stab_io(stab)->type == 's') {
970 argtype = sizeof buf;
971 anum = recvfrom(fileno(stab_io(stab)->ifp), tmps, anum, 0,
975 else if (optype == O_RECV)
979 anum = fread(tmps, 1, anum, stab_io(stab)->ifp);
982 st[2]->str_cur = anum;
983 st[2]->str_ptr[anum] = '\0';
984 value = (double)anum;
988 if ((arg[1].arg_type & A_MASK) == A_WORD)
989 stab = arg[1].arg_ptr.arg_stab;
991 stab = stabent(str_get(st[1]),TRUE);
992 tmps = str_get(st[2]);
993 anum = (int)str_gnum(st[3]);
994 optype = sp - arglast[0];
997 warn("Too many args on send");
998 stio = stab_io(stab);
999 if (!stio || !stio->ifp) {
1002 warn("Send on closed socket");
1004 else if (optype >= 4) {
1005 tmps2 = str_get(st[4]);
1006 anum = sendto(fileno(stab_io(stab)->ifp), tmps, st[2]->str_cur,
1007 anum, tmps2, st[4]->str_cur);
1010 anum = send(fileno(stab_io(stab)->ifp), tmps, st[2]->str_cur, anum);
1013 value = (double)anum;
1019 if ((arg[1].arg_type & A_MASK) == A_WORD)
1020 stab = arg[1].arg_ptr.arg_stab;
1022 stab = stabent(str_get(st[1]),TRUE);
1023 value = str_gnum(st[2]);
1024 str_set(str, do_seek(stab,
1025 (long)value, (int)str_gnum(st[3]) ) ? Yes : No);
1029 tmps = "_SUB_"; /* just fake up a "last _SUB_" */
1031 if (wantarray == G_ARRAY) {
1032 lastretstr = Nullstr;
1033 lastspbase = arglast[1];
1034 lastsize = arglast[2] - arglast[1];
1037 lastretstr = str_static(st[arglast[2] - arglast[0]]);
1043 tmps = str_get(arg[1].arg_ptr.arg_str);
1045 while (loop_ptr >= 0 && (!loop_stack[loop_ptr].loop_label ||
1046 strNE(tmps,loop_stack[loop_ptr].loop_label) )) {
1049 deb("(Skipping label #%d %s)\n",loop_ptr,
1050 loop_stack[loop_ptr].loop_label);
1057 deb("(Found label #%d %s)\n",loop_ptr,
1058 loop_stack[loop_ptr].loop_label);
1063 fatal("Bad label: %s", maxarg > 0 ? tmps : "<null>");
1064 if (!lastretstr && optype == O_LAST && lastsize) {
1066 st += lastspbase + 1;
1067 optype = loop_stack[loop_ptr].loop_sp - lastspbase; /* negative */
1069 for (anum = lastsize; anum > 0; anum--,st++)
1070 st[optype] = str_static(st[0]);
1072 longjmp(loop_stack[loop_ptr].loop_env, O_LAST);
1074 longjmp(loop_stack[loop_ptr].loop_env, optype);
1076 case O_GOTO:/* shudder */
1077 goto_targ = str_get(arg[1].arg_ptr.arg_str);
1079 goto_targ = Nullch; /* just restart from top */
1080 if (optype == O_DUMP) {
1084 longjmp(top_env, 1);
1086 tmps = str_get(st[1]);
1088 if (!(tmps2 = fbminstr((unsigned char*)tmps,
1089 (unsigned char*)tmps + st[1]->str_cur, st[2])))
1091 if (tmps2 = fbminstr(Null(unsigned char*),Null(unsigned char*),Nullstr))
1093 value = (double)(-1 + arybase);
1095 value = (double)(tmps2 - tmps + arybase);
1098 tmps = str_get(st[1]);
1099 tmps2 = str_get(st[2]);
1101 if (!(tmps2 = rninstr(tmps, tmps + st[1]->str_cur,
1102 tmps2, tmps2 + st[2]->str_cur)))
1104 if (tmps2 = rninstr(Nullch,Nullch,Nullch,Nullch))
1106 value = (double)(-1 + arybase);
1108 value = (double)(tmps2 - tmps + arybase);
1112 value = (double) time(Null(long*));
1116 sp = do_tms(str,gimme,arglast);
1122 when = (long)str_gnum(st[1]);
1123 sp = do_time(str,localtime(&when),
1130 when = (long)str_gnum(st[1]);
1131 sp = do_time(str,gmtime(&when),
1136 sp = do_stat(str,arg,
1141 tmps = str_get(st[1]);
1143 str_set(str,fcrypt(tmps,str_get(st[2])));
1145 str_set(str,crypt(tmps,str_get(st[2])));
1149 "The crypt() function is unimplemented due to excessive paranoia.");
1153 value = str_gnum(st[1]);
1154 value = atan2(value,str_gnum(st[2]));
1158 value = str_gnum(stab_val(defstab));
1160 value = str_gnum(st[1]);
1165 value = str_gnum(stab_val(defstab));
1167 value = str_gnum(st[1]);
1174 value = str_gnum(st[1]);
1178 value = rand() * value / 2147483648.0;
1181 value = rand() * value / 65536.0;
1184 value = rand() * value / 32768.0;
1186 value = rand() * value / (double)(((unsigned long)1) << RANDBITS);
1197 anum = (int)str_gnum(st[1]);
1202 value = str_gnum(stab_val(defstab));
1204 value = str_gnum(st[1]);
1209 value = str_gnum(stab_val(defstab));
1211 value = str_gnum(st[1]);
1216 value = str_gnum(stab_val(defstab));
1218 value = str_gnum(st[1]);
1219 value = sqrt(value);
1223 value = str_gnum(stab_val(defstab));
1225 value = str_gnum(st[1]);
1227 (void)modf(value,&value);
1229 (void)modf(-value,&value);
1235 tmps = str_get(stab_val(defstab));
1237 tmps = str_get(st[1]);
1239 value = (double) (*tmps & 255);
1242 value = (double) (anum & 255);
1249 tmps = str_get(st[1]);
1251 if (!tmps || !*tmps)
1252 sleep((32767<<16)+32767);
1254 sleep((unsigned int)atoi(tmps));
1256 value = (double)when;
1258 value = ((double)when) - value;
1262 sp = do_range(gimme,arglast);
1265 if (gimme == G_ARRAY) { /* it's a range */
1266 /* can we optimize to constant array? */
1267 if ((arg[1].arg_type & A_MASK) == A_SINGLE &&
1268 (arg[2].arg_type & A_MASK) == A_SINGLE) {
1269 st[2] = arg[2].arg_ptr.arg_str;
1270 sp = do_range(gimme,arglast);
1271 st = stack->ary_array;
1272 maxarg = sp - arglast[0];
1273 str_free(arg[1].arg_ptr.arg_str);
1274 str_free(arg[2].arg_ptr.arg_str);
1275 arg->arg_type = O_ARRAY;
1276 arg[1].arg_type = A_STAB|A_DONT;
1278 stab = arg[1].arg_ptr.arg_stab = aadd(genstab());
1279 ary = stab_array(stab);
1280 afill(ary,maxarg - 1);
1282 while (maxarg-- > 0)
1283 ary->ary_array[maxarg] = str_smake(st[maxarg]);
1286 arg->arg_type = optype = O_RANGE;
1287 maxarg = arg->arg_len = 2;
1289 arg[anum].arg_flags &= ~AF_ARYOK;
1290 argflags = arg[anum].arg_flags;
1291 argtype = arg[anum].arg_type & A_MASK;
1292 arg[anum].arg_type = argtype;
1293 argptr = arg[anum].arg_ptr;
1299 arg->arg_type = O_FLIP;
1302 if ((arg[1].arg_type & A_MASK) == A_SINGLE ?
1303 last_in_stab && (int)str_gnum(st[1]) == stab_io(last_in_stab)->lines
1306 str_numset(str,0.0);
1308 arg->arg_type = optype = O_FLOP;
1309 arg[2].arg_type &= ~A_DONT;
1310 arg[1].arg_type |= A_DONT;
1311 argflags = arg[2].arg_flags;
1312 argtype = arg[2].arg_type & A_MASK;
1313 argptr = arg[2].arg_ptr;
1322 if ((arg[2].arg_type & A_MASK) == A_SINGLE ?
1323 last_in_stab && (int)str_gnum(st[2]) == stab_io(last_in_stab)->lines
1326 arg->arg_type = O_FLIP;
1327 arg[1].arg_type &= ~A_DONT;
1328 arg[2].arg_type |= A_DONT;
1334 if (!anum && (tmpstab = stabent("$",allstabs)))
1335 str_numset(STAB_STR(tmpstab),(double)getpid());
1336 value = (double)anum;
1340 /* ihand = signal(SIGINT, SIG_IGN); */
1341 /* qhand = signal(SIGQUIT, SIG_IGN); */
1342 anum = wait(&argflags);
1344 pidgone(anum,argflags);
1345 value = (double)anum;
1347 /* ihand = qhand = 0; */
1349 /* (void)signal(SIGINT, ihand); */
1350 /* (void)signal(SIGQUIT, qhand); */
1351 statusvalue = (unsigned short)argflags;
1355 if (arglast[2] - arglast[1] == 1) {
1357 tainted |= st[2]->str_tainted;
1358 taintproper("Insecure dependency in system");
1361 while ((anum = vfork()) == -1) {
1362 if (errno != EAGAIN) {
1370 ihand = signal(SIGINT, SIG_IGN);
1371 qhand = signal(SIGQUIT, SIG_IGN);
1372 while ((argtype = wait(&argflags)) != anum && argtype >= 0)
1373 pidgone(argtype,argflags);
1377 (void)signal(SIGINT, ihand);
1378 (void)signal(SIGQUIT, qhand);
1379 statusvalue = (unsigned short)argflags;
1383 value = (double)((unsigned int)argflags & 0xffff);
1387 if ((arg[1].arg_type & A_MASK) == A_STAB)
1388 value = (double)do_aexec(st[1],arglast);
1389 else if (arglast[2] - arglast[1] != 1)
1390 value = (double)do_aexec(Nullstr,arglast);
1392 value = (double)do_exec(str_get(str_static(st[2])));
1396 if ((arg[1].arg_type & A_MASK) == A_STAB)
1397 value = (double)do_aexec(st[1],arglast);
1398 else if (arglast[2] - arglast[1] != 1)
1399 value = (double)do_aexec(Nullstr,arglast);
1401 value = (double)do_exec(str_get(str_static(st[2])));
1414 tmps = str_get(stab_val(defstab));
1416 tmps = str_get(st[1]);
1425 case '0': case '1': case '2': case '3': case '4':
1426 case '5': case '6': case '7':
1428 anum += *tmps++ & 15;
1430 case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
1431 case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
1435 anum += (*tmps++ & 7) + 9;
1444 value = (double)anum;
1451 value = (double)apply(optype,arglast);
1459 anum = umask((int)str_gnum(st[1]));
1460 value = (double)anum;
1462 taintproper("Insecure dependency in umask");
1466 tmps = str_get(st[1]);
1467 tmps2 = str_get(st[2]);
1469 taintproper("Insecure dependency in rename");
1472 value = (double)(rename(tmps,tmps2) >= 0);
1474 if (euid || stat(tmps2,&statbuf) < 0 ||
1475 (statbuf.st_mode & S_IFMT) != S_IFDIR )
1476 (void)UNLINK(tmps2); /* avoid unlinking a directory */
1477 if (!(anum = link(tmps,tmps2)))
1478 anum = UNLINK(tmps);
1479 value = (double)(anum >= 0);
1483 tmps = str_get(st[1]);
1484 tmps2 = str_get(st[2]);
1486 taintproper("Insecure dependency in link");
1488 value = (double)(link(tmps,tmps2) >= 0);
1491 tmps = str_get(st[1]);
1492 anum = (int)str_gnum(st[2]);
1494 taintproper("Insecure dependency in mkdir");
1497 value = (double)(mkdir(tmps,anum) >= 0);
1500 (void)strcpy(buf,"mkdir ");
1502 #if !defined(MKDIR) || !defined(RMDIR)
1504 for (tmps2 = buf+6; *tmps; ) {
1508 (void)strcpy(tmps2," 2>&1");
1509 rsfp = mypopen(buf,"r");
1512 tmps2 = fgets(buf,sizeof buf,rsfp);
1513 (void)mypclose(rsfp);
1514 if (tmps2 != Nullch) {
1515 for (errno = 1; errno < sys_nerr; errno++) {
1516 if (instr(buf,sys_errlist[errno])) /* you don't see this */
1521 #define EACCES EPERM
1523 if (instr(buf,"cannot make"))
1525 else if (instr(buf,"non-exist"))
1527 else if (instr(buf,"does not exist"))
1529 else if (instr(buf,"not empty"))
1531 else if (instr(buf,"cannot access"))
1537 else { /* some mkdirs return no failure indication */
1538 tmps = str_get(st[1]);
1539 anum = (stat(tmps,&statbuf) >= 0);
1540 if (optype == O_RMDIR)
1545 errno = EACCES; /* a guess */
1546 value = (double)anum;
1555 tmps = str_get(stab_val(defstab));
1557 tmps = str_get(st[1]);
1559 taintproper("Insecure dependency in rmdir");
1562 value = (double)(rmdir(tmps) >= 0);
1565 (void)strcpy(buf,"rmdir ");
1566 goto one_liner; /* see above in MKDIR */
1569 value = (double)getppid();
1576 anum = (int)str_gnum(st[1]);
1577 value = (double)getpgrp(anum);
1580 fatal("The getpgrp() function is unimplemented on this machine");
1585 argtype = (int)str_gnum(st[1]);
1586 anum = (int)str_gnum(st[2]);
1588 taintproper("Insecure dependency in setpgrp");
1590 value = (double)(setpgrp(argtype,anum) >= 0);
1593 fatal("The setpgrp() function is unimplemented on this machine");
1598 argtype = (int)str_gnum(st[1]);
1599 anum = (int)str_gnum(st[2]);
1600 value = (double)getpriority(argtype,anum);
1603 fatal("The getpriority() function is unimplemented on this machine");
1608 argtype = (int)str_gnum(st[1]);
1609 anum = (int)str_gnum(st[2]);
1610 optype = (int)str_gnum(st[3]);
1612 taintproper("Insecure dependency in setpriority");
1614 value = (double)(setpriority(argtype,anum,optype) >= 0);
1617 fatal("The setpriority() function is unimplemented on this machine");
1622 tmps = str_get(stab_val(defstab));
1624 tmps = str_get(st[1]);
1626 taintproper("Insecure dependency in chroot");
1628 value = (double)(chroot(tmps) >= 0);
1633 stab = last_in_stab;
1634 else if ((arg[1].arg_type & A_MASK) == A_WORD)
1635 stab = arg[1].arg_ptr.arg_stab;
1637 stab = stabent(str_get(st[1]),TRUE);
1638 argtype = (unsigned int)str_gnum(st[2]);
1640 taintproper("Insecure dependency in ioctl");
1642 anum = do_ctl(optype,stab,argtype,st[3]);
1647 str_set(str,"0 but true");
1653 stab = last_in_stab;
1654 else if ((arg[1].arg_type & A_MASK) == A_WORD)
1655 stab = arg[1].arg_ptr.arg_stab;
1657 stab = stabent(str_get(st[1]),TRUE);
1658 if (stab && stab_io(stab))
1659 fp = stab_io(stab)->ifp;
1663 argtype = (int)str_gnum(st[2]);
1664 value = (double)(flock(fileno(fp),argtype) >= 0);
1670 fatal("The flock() function is unimplemented on this machine");
1674 ary = stab_array(arg[1].arg_ptr.arg_stab);
1675 if (arglast[2] - arglast[1] != 1)
1676 do_unshift(ary,arglast);
1678 str = Str_new(52,0); /* must copy the STR */
1679 str_sset(str,st[2]);
1681 (void)astore(ary,0,str);
1683 value = (double)(ary->ary_fill + 1);
1688 tmpstr = stab_val(defstab);
1691 (arg[1].arg_type & A_MASK) != A_NULL ? st[1] : stab_val(defstab);
1693 tainted |= tmpstr->str_tainted;
1694 taintproper("Insecure dependency in eval");
1696 sp = do_eval(tmpstr, optype, arg[2].arg_ptr.arg_hash,
1724 if (mystat(arg,st[1]) < 0)
1726 if (cando(anum,argtype,&statcache))
1731 if (mystat(arg,st[1]) < 0)
1736 if (mystat(arg,st[1]) < 0)
1738 if (statcache.st_uid == (optype == O_FTEOWNED ? euid : uid) )
1742 if (mystat(arg,st[1]) < 0)
1744 if (!statcache.st_size)
1748 if (mystat(arg,st[1]) < 0)
1750 if (statcache.st_size)
1757 goto check_file_type;
1763 goto check_file_type;
1766 goto check_file_type;
1769 goto check_file_type;
1773 if (mystat(arg,st[1]) < 0)
1775 if ((statcache.st_mode & S_IFMT) == anum )
1781 goto check_file_type;
1786 if (arg[1].arg_type & A_DONT)
1787 fatal("You must supply explicit filename with -l");
1789 if (lstat(str_get(st[1]),&statcache) < 0)
1791 if ((statcache.st_mode & S_IFMT) == S_IFLNK )
1797 tmps = str_get(st[1]);
1798 tmps2 = str_get(st[2]);
1800 taintproper("Insecure dependency in symlink");
1802 value = (double)(symlink(tmps,tmps2) >= 0);
1805 fatal("Unsupported function symlink()");
1810 tmps = str_get(stab_val(defstab));
1812 tmps = str_get(st[1]);
1813 anum = readlink(tmps,buf,sizeof buf);
1816 str_nset(str,buf,anum);
1819 fatal("Unsupported function readlink()");
1830 if (mystat(arg,st[1]) < 0)
1832 if (statcache.st_mode & anum)
1836 if (arg[1].arg_type & A_DONT) {
1837 stab = arg[1].arg_ptr.arg_stab;
1841 stab = stabent(tmps = str_get(st[1]),FALSE);
1842 if (stab && stab_io(stab) && stab_io(stab)->ifp)
1843 anum = fileno(stab_io(stab)->ifp);
1844 else if (isdigit(*tmps))
1853 str = do_fttext(arg,st[1]);
1857 if ((arg[1].arg_type & A_MASK) == A_WORD)
1858 stab = arg[1].arg_ptr.arg_stab;
1860 stab = stabent(str_get(st[1]),TRUE);
1862 value = (double)do_socket(stab,arglast);
1864 (void)do_socket(stab,arglast);
1868 if ((arg[1].arg_type & A_MASK) == A_WORD)
1869 stab = arg[1].arg_ptr.arg_stab;
1871 stab = stabent(str_get(st[1]),TRUE);
1873 value = (double)do_bind(stab,arglast);
1875 (void)do_bind(stab,arglast);
1879 if ((arg[1].arg_type & A_MASK) == A_WORD)
1880 stab = arg[1].arg_ptr.arg_stab;
1882 stab = stabent(str_get(st[1]),TRUE);
1884 value = (double)do_connect(stab,arglast);
1886 (void)do_connect(stab,arglast);
1890 if ((arg[1].arg_type & A_MASK) == A_WORD)
1891 stab = arg[1].arg_ptr.arg_stab;
1893 stab = stabent(str_get(st[1]),TRUE);
1895 value = (double)do_listen(stab,arglast);
1897 (void)do_listen(stab,arglast);
1901 if ((arg[1].arg_type & A_MASK) == A_WORD)
1902 stab = arg[1].arg_ptr.arg_stab;
1904 stab = stabent(str_get(st[1]),TRUE);
1905 if ((arg[2].arg_type & A_MASK) == A_WORD)
1906 stab2 = arg[2].arg_ptr.arg_stab;
1908 stab2 = stabent(str_get(st[2]),TRUE);
1909 do_accept(str,stab,stab2);
1917 sp = do_ghent(optype,
1925 sp = do_gnent(optype,
1933 sp = do_gpent(optype,
1941 sp = do_gsent(optype,
1945 value = (double) sethostent((int)str_gnum(st[1]));
1948 value = (double) setnetent((int)str_gnum(st[1]));
1951 value = (double) setprotoent((int)str_gnum(st[1]));
1954 value = (double) setservent((int)str_gnum(st[1]));
1957 value = (double) endhostent();
1960 value = (double) endnetent();
1963 value = (double) endprotoent();
1966 value = (double) endservent();
1969 sp = do_select(gimme,arglast);
1972 if ((arg[1].arg_type & A_MASK) == A_WORD)
1973 stab = arg[1].arg_ptr.arg_stab;
1975 stab = stabent(str_get(st[1]),TRUE);
1976 if ((arg[2].arg_type & A_MASK) == A_WORD)
1977 stab2 = arg[2].arg_ptr.arg_stab;
1979 stab2 = stabent(str_get(st[2]),TRUE);
1981 value = (double)do_spair(stab,stab2,arglast);
1983 (void)do_spair(stab,stab2,arglast);
1987 if ((arg[1].arg_type & A_MASK) == A_WORD)
1988 stab = arg[1].arg_ptr.arg_stab;
1990 stab = stabent(str_get(st[1]),TRUE);
1992 value = (double)do_shutdown(stab,arglast);
1994 (void)do_shutdown(stab,arglast);
1999 if ((arg[1].arg_type & A_MASK) == A_WORD)
2000 stab = arg[1].arg_ptr.arg_stab;
2002 stab = stabent(str_get(st[1]),TRUE);
2003 sp = do_sopt(optype,stab,arglast);
2007 if ((arg[1].arg_type & A_MASK) == A_WORD)
2008 stab = arg[1].arg_ptr.arg_stab;
2010 stab = stabent(str_get(st[1]),TRUE);
2011 sp = do_getsockname(optype,stab,arglast);
2014 #else /* SOCKET not defined */
2048 fatal("Unsupported socket function");
2053 if ((arg[1].arg_type & A_MASK) == A_WORD)
2054 stab = arg[1].arg_ptr.arg_stab;
2056 stab = stabent(str_get(st[1]),TRUE);
2057 if (!stab || !(stio = stab_io(stab)) || !(fp = stio->ifp))
2062 sp = do_vec(str == st[1], arg->arg_ptr.arg_str, arglast);
2067 sp = do_gpwent(optype,
2071 value = (double) setpwent();
2074 value = (double) endpwent();
2079 sp = do_ggrent(optype,
2083 value = (double) setgrent();
2086 value = (double) endgrent();
2089 if (!(tmps = getlogin()))
2101 if ((arg[1].arg_type & A_MASK) == A_WORD)
2102 stab = arg[1].arg_ptr.arg_stab;
2104 stab = stabent(str_get(st[1]),TRUE);
2105 sp = do_dirop(optype,stab,gimme,arglast);
2108 value = (double)do_syscall(arglast);
2111 if ((arg[1].arg_type & A_MASK) == A_WORD)
2112 stab = arg[1].arg_ptr.arg_stab;
2114 stab = stabent(str_get(st[1]),TRUE);
2115 if ((arg[2].arg_type & A_MASK) == A_WORD)
2116 stab2 = arg[2].arg_ptr.arg_stab;
2118 stab2 = stabent(str_get(st[2]),TRUE);
2119 do_pipe(str,stab,stab2);
2130 deb("%s RETURNS \"%s\"\n",opname[optype],str_get(str));
2133 return arglast[0] + 1;
2140 anum = sp - arglast[0];
2143 deb("%s RETURNS ()\n",opname[optype]);
2146 deb("%s RETURNS (\"%s\")\n",opname[optype],str_get(st[1]));
2149 deb("%s RETURNS %d ARGS (\"%s\",%s\"%s\"\n",opname[optype],anum,
2150 str_get(st[1]),anum==2?"":"...,",str_get(st[anum]));
2175 str_numset(str,value);
2182 deb("%s RETURNS \"%f\"\n",opname[optype],value);
2185 return arglast[0] + 1;