1 /* $Header: eval.c,v 3.0.1.7 90/08/09 03:33:44 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/09 03:33:44 lwall
10 * patch19: made ~ do vector operation on strings like &, | and ^
11 * patch19: dbmopen(%name...) didn't work right
12 * patch19: dbmopen(name, 'filename', undef) now refrains from creating
13 * patch19: empty %array now returns 0 in scalar context
14 * patch19: die with no arguments no longer exits unconditionally
15 * patch19: return outside a subroutine now returns a reasonable message
16 * patch19: rename done with unlink()/link()/unlink() now checks for clobbering
17 * patch19: -s now returns size of file
19 * Revision 3.0.1.6 90/03/27 15:53:51 lwall
20 * patch16: MSDOS support
21 * patch16: support for machines that can't cast negative floats to unsigned ints
22 * patch16: ioctl didn't return values correctly
24 * Revision 3.0.1.5 90/03/12 16:37:40 lwall
25 * patch13: undef $/ didn't work as advertised
26 * patch13: added list slice operator (LIST)[LIST]
27 * patch13: added splice operator: @oldelems = splice(@array,$offset,$len,LIST)
29 * Revision 3.0.1.4 90/02/28 17:36:59 lwall
30 * patch9: added pipe function
31 * patch9: a return in scalar context wouldn't return array
32 * patch9: !~ now always returns scalar even in array context
33 * patch9: some machines can't cast float to long with high bit set
34 * patch9: piped opens returned undef in child
35 * patch9: @array in scalar context now returns length of array
36 * patch9: chdir; coredumped
37 * patch9: wait no longer ignores signals
38 * patch9: mkdir now handles odd versions of /bin/mkdir
39 * patch9: -l FILEHANDLE now disallowed
41 * Revision 3.0.1.3 89/12/21 20:03:05 lwall
42 * patch7: errno may now be a macro with an lvalue
43 * patch7: ANSI strerror() is now supported
44 * patch7: send() didn't allow a TO argument
45 * patch7: ord() now always returns positive even on signed char machines
47 * Revision 3.0.1.2 89/11/17 15:19:34 lwall
48 * patch5: constant numeric subscripts get lost inside ?:
50 * Revision 3.0.1.1 89/11/11 04:31:51 lwall
51 * patch2: mkdir and rmdir needed to quote argument when passed to shell
52 * patch2: mkdir and rmdir now return better error codes
53 * patch2: fileno, seekdir, rewinddir and closedir now disallow defaults
55 * Revision 3.0 89/10/18 15:17:04 lwall
75 static void (*ihand)();
76 static void (*qhand)();
78 static int (*ihand)();
79 static int (*qhand)();
86 static struct lstring *lstr;
87 static int old_record_separator;
90 double sin(), cos(), atan2(), pow();
111 int arglast[8]; /* highest sp for arg--valid only for non-O_LIST args */
112 unsigned long tmplong;
119 bool assigning = FALSE;
120 double exp(), log(), sqrt(), modf();
121 char *crypt(), *getenv();
122 extern void grow_dlevel();
126 optype = arg->arg_type;
127 maxarg = arg->arg_len;
129 str = arg->arg_ptr.arg_str;
130 if (sp + maxarg > stack->ary_max)
131 astore(stack, sp + maxarg, Nullstr);
132 st = stack->ary_array;
137 deb("%s (%lx) %d args:\n",opname[optype],arg,maxarg);
139 debname[dlevel] = opname[optype][0];
140 debdelim[dlevel] = ':';
141 if (++dlevel >= dlmax)
146 #include "evalargs.xc"
154 if (gimme == G_ARRAY)
160 if (gimme == G_ARRAY)
163 STR_SSET(str,st[arglast[anum]-arglast[0]]);
167 if (gimme == G_ARRAY)
170 STR_SSET(str,st[arglast[anum]-arglast[0]]);
180 anum = (int)str_gnum(st[2]);
182 tmpstr = Str_new(50, 0);
183 str_sset(tmpstr,str);
184 tmps = str_get(tmpstr); /* force to be string */
185 STR_GROW(str, (anum * str->str_cur) + 1);
186 repeatcpy(str->str_ptr, tmps, tmpstr->str_cur, anum);
187 str->str_cur *= anum;
188 str->str_ptr[str->str_cur] = '\0';
191 str_sset(str,&str_no);
195 sp = do_match(str,arg,
197 if (gimme == G_ARRAY)
202 sp = do_match(str,arg,
204 str_sset(str, str_true(str) ? &str_no : &str_yes);
208 sp = do_subst(str,arg,arglast[0]);
211 sp = do_subst(str,arg,arglast[0]);
212 str = arg->arg_ptr.arg_str;
213 str_set(str, str_true(str) ? No : Yes);
216 if (arg[1].arg_flags & AF_ARYOK) {
217 if (arg->arg_len == 1) {
218 arg->arg_type = O_LOCAL;
222 arg->arg_type = O_AASSIGN;
227 arg->arg_type = O_SASSIGN;
232 arglast[2] = arglast[1]; /* push a null array */
241 STR_SSET(str, st[2]);
246 str = arg->arg_ptr.arg_str;
247 for (sp = arglast[0] + 1; sp <= arglast[1]; sp++)
252 if (arg[1].arg_type & A_DONT) {
253 sp = do_defined(str,arg,
257 else if (str->str_pok || str->str_nok)
261 if (arg[1].arg_type & A_DONT) {
262 sp = do_undef(str,arg,
266 else if (str != stab_val(defstab)) {
267 str->str_pok = str->str_nok = 0;
272 sp = do_study(str,arg,
276 value = str_gnum(st[1]);
277 value = pow(value,str_gnum(st[2]));
280 value = str_gnum(st[1]);
281 value *= str_gnum(st[2]);
284 if ((value = str_gnum(st[2])) == 0.0)
285 fatal("Illegal division by zero");
286 value = str_gnum(st[1]) / value;
289 tmplong = (long) str_gnum(st[2]);
291 fatal("Illegal modulus zero");
292 when = (long)str_gnum(st[1]);
295 value = (double)(when % tmplong);
297 value = (double)(tmplong - ((-when - 1) % tmplong)) - 1;
301 value = str_gnum(st[1]);
302 value += str_gnum(st[2]);
305 value = str_gnum(st[1]);
306 value -= str_gnum(st[2]);
309 value = str_gnum(st[1]);
310 anum = (int)str_gnum(st[2]);
312 value = (double)(U_L(value) << anum);
316 value = str_gnum(st[1]);
317 anum = (int)str_gnum(st[2]);
319 value = (double)(U_L(value) >> anum);
323 value = str_gnum(st[1]);
324 value = (value < str_gnum(st[2])) ? 1.0 : 0.0;
327 value = str_gnum(st[1]);
328 value = (value > str_gnum(st[2])) ? 1.0 : 0.0;
331 value = str_gnum(st[1]);
332 value = (value <= str_gnum(st[2])) ? 1.0 : 0.0;
335 value = str_gnum(st[1]);
336 value = (value >= str_gnum(st[2])) ? 1.0 : 0.0;
340 if ((!st[1]->str_nok && !looks_like_number(st[1])) ||
341 (!st[2]->str_nok && !looks_like_number(st[2])) )
342 warn("Possible use of == on string value");
344 value = str_gnum(st[1]);
345 value = (value == str_gnum(st[2])) ? 1.0 : 0.0;
348 value = str_gnum(st[1]);
349 value = (value != str_gnum(st[2])) ? 1.0 : 0.0;
352 if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
353 value = str_gnum(st[1]);
355 value = (double)(U_L(value) & U_L(str_gnum(st[2])));
360 do_vop(optype,str,st[1],st[2]);
363 if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
364 value = str_gnum(st[1]);
366 value = (double)(U_L(value) ^ U_L(str_gnum(st[2])));
371 do_vop(optype,str,st[1],st[2]);
374 if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
375 value = str_gnum(st[1]);
377 value = (double)(U_L(value) | U_L(str_gnum(st[2])));
382 do_vop(optype,str,st[1],st[2]);
384 /* use register in evaluating str_true() */
386 if (str_true(st[1])) {
389 argflags = arg[anum].arg_flags;
390 if (gimme == G_ARRAY)
391 argflags |= AF_ARYOK;
392 argtype = arg[anum].arg_type & A_MASK;
393 argptr = arg[anum].arg_ptr;
401 str_sset(str, st[1]);
409 if (str_true(st[1])) {
411 str_sset(str, st[1]);
421 argflags = arg[anum].arg_flags;
422 if (gimme == G_ARRAY)
423 argflags |= AF_ARYOK;
424 argtype = arg[anum].arg_type & A_MASK;
425 argptr = arg[anum].arg_ptr;
432 anum = (str_true(st[1]) ? 2 : 3);
433 optype = (anum == 2 ? O_ITEM2 : O_ITEM3);
434 argflags = arg[anum].arg_flags;
435 if (gimme == G_ARRAY)
436 argflags |= AF_ARYOK;
437 argtype = arg[anum].arg_type & A_MASK;
438 argptr = arg[anum].arg_ptr;
444 if (gimme == G_ARRAY)
449 value = -str_gnum(st[1]);
452 value = (double) !str_true(st[1]);
455 if (!sawvec || st[1]->str_nok) {
457 value = (double) ~U_L(str_gnum(st[1]));
464 for (anum = str->str_cur; anum; anum--)
469 tmps = stab_name(defoutstab);
471 if ((arg[1].arg_type & A_MASK) == A_WORD)
472 defoutstab = arg[1].arg_ptr.arg_stab;
474 defoutstab = stabent(str_get(st[1]),TRUE);
475 if (!stab_io(defoutstab))
476 stab_io(defoutstab) = stio_new();
477 curoutstab = defoutstab;
485 else if ((arg[1].arg_type & A_MASK) == A_WORD) {
486 if (!(stab = arg[1].arg_ptr.arg_stab))
490 stab = stabent(str_get(st[1]),TRUE);
491 if (!stab_io(stab)) {
497 fp = stab_io(stab)->ofp;
499 if (stab_io(stab)->fmt_stab)
500 form = stab_form(stab_io(stab)->fmt_stab);
502 form = stab_form(stab);
506 warn("No format for filehandle");
508 if (stab_io(stab)->ifp)
509 warn("Filehandle only opened for input");
511 warn("Write on closed filehandle");
518 format(&outrec,form,sp);
519 do_write(&outrec,stab_io(stab),sp);
520 if (stab_io(stab)->flags & IOF_FLUSH)
527 stab = arg[1].arg_ptr.arg_stab;
528 if (st[3]->str_nok || st[3]->str_pok)
529 anum = (int)str_gnum(st[3]);
532 value = (double)hdbmopen(stab_hash(stab),str_get(st[2]),anum);
535 fatal("No dbm or ndbm on this machine");
539 stab = arg[1].arg_ptr.arg_stab;
540 hdbmclose(stab_hash(stab));
543 fatal("No dbm or ndbm on this machine");
546 if ((arg[1].arg_type & A_MASK) == A_WORD)
547 stab = arg[1].arg_ptr.arg_stab;
549 stab = stabent(str_get(st[1]),TRUE);
550 tmps = str_get(st[2]);
551 if (do_open(stab,tmps,st[2]->str_cur)) {
552 value = (double)forkprocess;
553 stab_io(stab)->lines = 0;
556 else if (forkprocess == 0) /* we are a new child */
562 value = (double) do_trans(str,arg);
563 str = arg->arg_ptr.arg_str;
566 str_set(arg->arg_ptr.arg_str, do_trans(str,arg) == 0 ? Yes : No);
567 str = arg->arg_ptr.arg_str;
572 else if ((arg[1].arg_type & A_MASK) == A_WORD)
573 stab = arg[1].arg_ptr.arg_stab;
575 stab = stabent(str_get(st[1]),TRUE);
576 str_set(str, do_close(stab,TRUE) ? Yes : No );
580 sp = do_each(str,stab_hash(arg[1].arg_ptr.arg_stab),
585 sp = do_kv(str,stab_hash(arg[1].arg_ptr.arg_stab), optype,
589 str->str_nok = str->str_pok = 0;
590 str->str_u.str_stab = arg[1].arg_ptr.arg_stab;
591 str->str_state = SS_ARY;
594 ary = stab_array(arg[1].arg_ptr.arg_stab);
595 maxarg = ary->ary_fill + 1;
596 if (gimme == G_ARRAY) { /* array wanted */
599 if (maxarg > 0 && sp + maxarg > stack->ary_max) {
600 astore(stack,sp + maxarg, Nullstr);
601 st = stack->ary_array;
604 Copy(ary->ary_array, &st[1], maxarg, STR*);
609 value = (double)maxarg;
613 anum = ((int)str_gnum(st[2])) - arybase;
614 str = afetch(stab_array(arg[1].arg_ptr.arg_stab),anum,FALSE);
619 tmpstab = arg[1].arg_ptr.arg_stab;
620 tmps = str_get(st[2]);
621 str = hdelete(stab_hash(tmpstab),tmps,st[2]->str_cur);
622 if (tmpstab == envstab)
628 str->str_nok = str->str_pok = 0;
629 str->str_u.str_stab = arg[1].arg_ptr.arg_stab;
630 str->str_state = SS_HASH;
633 if (gimme == G_ARRAY) { /* array wanted */
634 sp = do_kv(str,stab_hash(arg[1].arg_ptr.arg_stab), optype,
639 tmpstab = arg[1].arg_ptr.arg_stab;
640 if (!stab_hash(tmpstab)->tbl_fill)
642 sprintf(buf,"%d/%d",stab_hash(tmpstab)->tbl_fill,
643 stab_hash(tmpstab)->tbl_max+1);
648 tmpstab = arg[1].arg_ptr.arg_stab;
649 tmps = str_get(st[2]);
650 str = hfetch(stab_hash(tmpstab),tmps,st[2]->str_cur,FALSE);
655 anum = ((int)str_gnum(st[2])) - arybase;
656 str = afetch(stab_array(arg[1].arg_ptr.arg_stab),anum,TRUE);
658 fatal("Assignment to non-creatable value, subscript %d",anum);
661 tmpstab = arg[1].arg_ptr.arg_stab;
662 tmps = str_get(st[2]);
663 anum = st[2]->str_cur;
664 str = hfetch(stab_hash(tmpstab),tmps,anum,TRUE);
666 fatal("Assignment to non-creatable value, subscript \"%s\"",tmps);
667 if (tmpstab == envstab) /* heavy wizardry going on here */
668 str_magic(str, tmpstab, 'E', tmps, anum); /* str is now magic */
669 /* he threw the brick up into the air */
670 else if (tmpstab == sigstab)
671 str_magic(str, tmpstab, 'S', tmps, anum);
673 else if (stab_hash(tmpstab)->tbl_dbm)
674 str_magic(str, tmpstab, 'D', tmps, anum);
680 goto do_slice_already;
684 goto do_slice_already;
688 goto do_slice_already;
692 goto do_slice_already;
697 sp = do_slice(arg[1].arg_ptr.arg_stab,str,anum,argtype,
701 sp = do_splice(stab_array(arg[1].arg_ptr.arg_stab),gimme,arglast);
704 if (arglast[2] - arglast[1] != 1)
705 str = do_push(stab_array(arg[1].arg_ptr.arg_stab),arglast);
707 str = Str_new(51,0); /* must copy the STR */
709 (void)apush(stab_array(arg[1].arg_ptr.arg_stab),str);
713 str = apop(ary = stab_array(arg[1].arg_ptr.arg_stab));
714 goto staticalization;
716 str = ashift(ary = stab_array(arg[1].arg_ptr.arg_stab));
720 if (ary->ary_flags & ARF_REAL)
721 (void)str_2static(str);
724 sp = do_unpack(str,gimme,arglast);
727 value = str_gnum(st[3]);
728 sp = do_split(str, arg[2].arg_ptr.arg_spat, (int)value,
733 value = (double)str_len(stab_val(defstab));
735 value = (double)str_len(st[1]);
738 do_sprintf(str, sp-arglast[0], st+1);
741 anum = ((int)str_gnum(st[2])) - arybase; /* anum=where to start*/
742 tmps = str_get(st[1]); /* force conversion to string */
743 if (argtype = (str == st[1]))
744 str = arg->arg_ptr.arg_str;
746 anum += st[1]->str_cur + arybase;
747 if (anum < 0 || anum > st[1]->str_cur)
750 optype = (int)str_gnum(st[3]);
754 anum = st[1]->str_cur - anum; /* anum=how many bytes left*/
757 str_nset(str, tmps, anum);
758 if (argtype) { /* it's an lvalue! */
759 lstr = (struct lstring*)str;
760 str->str_magic = st[1];
761 st[1]->str_rare = 's';
762 lstr->lstr_offset = tmps - str_get(st[1]);
763 lstr->lstr_len = anum;
768 (void)do_pack(str,arglast);
771 sp = do_grep(arg,str,gimme,arglast);
774 do_join(str,arglast);
777 tmps = str_get(st[1]);
778 value = (double) (str_cmp(st[1],st[2]) < 0);
781 tmps = str_get(st[1]);
782 value = (double) (str_cmp(st[1],st[2]) > 0);
785 tmps = str_get(st[1]);
786 value = (double) (str_cmp(st[1],st[2]) <= 0);
789 tmps = str_get(st[1]);
790 value = (double) (str_cmp(st[1],st[2]) >= 0);
793 tmps = str_get(st[1]);
794 value = (double) str_eq(st[1],st[2]);
797 tmps = str_get(st[1]);
798 value = (double) !str_eq(st[1],st[2]);
801 sp = do_subr(arg,gimme,arglast);
802 st = stack->ary_array + arglast[0]; /* maybe realloced */
805 sp = do_dbsubr(arg,gimme,arglast);
806 st = stack->ary_array + arglast[0]; /* maybe realloced */
809 if ((arg[1].arg_type & A_MASK) == A_WORD)
810 stab = arg[1].arg_ptr.arg_stab;
812 stab = stabent(str_get(st[1]),TRUE);
815 sp = do_sort(str,stab,
823 if (arglast[2] - arglast[1] != 1) {
824 do_join(str,arglast);
825 tmps = str_get(st[1]);
829 tmps = str_get(st[2]);
832 tmps = "Warning: something's wrong";
836 if (arglast[2] - arglast[1] != 1) {
837 do_join(str,arglast);
838 tmps = str_get(st[1]);
842 tmps = str_get(st[2]);
850 if ((arg[1].arg_type & A_MASK) == A_WORD)
851 stab = arg[1].arg_ptr.arg_stab;
853 stab = stabent(str_get(st[1]),TRUE);
856 if (!stab_io(stab)) {
858 warn("Filehandle never opened");
861 if (!(fp = stab_io(stab)->ofp)) {
863 if (stab_io(stab)->ifp)
864 warn("Filehandle opened only for input");
866 warn("Print on closed filehandle");
871 if (optype == O_PRTF || arglast[2] - arglast[1] != 1)
872 value = (double)do_aprint(arg,fp,arglast);
874 value = (double)do_print(st[2],fp);
875 if (orslen && optype == O_PRINT)
876 if (fwrite(ors, 1, orslen, fp) == 0)
879 if (stab_io(stab)->flags & IOF_FLUSH)
880 if (fflush(fp) == EOF)
888 tmps = str_get(st[1]);
889 if (!tmps || !*tmps) {
890 tmpstr = hfetch(stab_hash(envstab),"HOME",4,FALSE);
892 tmps = str_get(tmpstr);
894 if (!tmps || !*tmps) {
895 tmpstr = hfetch(stab_hash(envstab),"LOGDIR",6,FALSE);
897 tmps = str_get(tmpstr);
900 taintproper("Insecure dependency in chdir");
902 value = (double)(chdir(tmps) >= 0);
908 anum = (int)str_gnum(st[1]);
915 tmps = str_get(st[1]);
916 str_reset(tmps,arg[2].arg_ptr.arg_hash);
920 if (gimme == G_ARRAY)
923 str = st[sp - arglast[0]]; /* unwanted list, return last item */
930 else if ((arg[1].arg_type & A_MASK) == A_WORD)
931 stab = arg[1].arg_ptr.arg_stab;
933 stab = stabent(str_get(st[1]),TRUE);
934 str_set(str, do_eof(stab) ? Yes : No);
940 else if ((arg[1].arg_type & A_MASK) == A_WORD)
941 stab = arg[1].arg_ptr.arg_stab;
943 stab = stabent(str_get(st[1]),TRUE);
944 if (do_eof(stab)) /* make sure we have fp with something */
951 *str->str_ptr = getc(stab_io(stab)->ifp); /* should never be EOF */
958 else if ((arg[1].arg_type & A_MASK) == A_WORD)
959 stab = arg[1].arg_ptr.arg_stab;
961 stab = stabent(str_get(st[1]),TRUE);
963 value = (double)do_tell(stab);
970 if ((arg[1].arg_type & A_MASK) == A_WORD)
971 stab = arg[1].arg_ptr.arg_stab;
973 stab = stabent(str_get(st[1]),TRUE);
974 tmps = str_get(st[2]);
975 anum = (int)str_gnum(st[3]);
976 STR_GROW(st[2], anum+1), (tmps = str_get(st[2])); /* sneaky */
978 if (!stab_io(stab) || !stab_io(stab)->ifp)
981 else if (optype == O_RECV) {
982 argtype = sizeof buf;
983 optype = (int)str_gnum(st[4]);
984 anum = recvfrom(fileno(stab_io(stab)->ifp), tmps, anum, optype,
987 st[2]->str_cur = anum;
988 st[2]->str_ptr[anum] = '\0';
989 str_nset(str,buf,argtype);
992 str_sset(str,&str_undef);
995 else if (stab_io(stab)->type == 's') {
996 argtype = sizeof buf;
997 anum = recvfrom(fileno(stab_io(stab)->ifp), tmps, anum, 0,
1001 else if (optype == O_RECV)
1005 anum = fread(tmps, 1, anum, stab_io(stab)->ifp);
1008 st[2]->str_cur = anum;
1009 st[2]->str_ptr[anum] = '\0';
1010 value = (double)anum;
1014 if ((arg[1].arg_type & A_MASK) == A_WORD)
1015 stab = arg[1].arg_ptr.arg_stab;
1017 stab = stabent(str_get(st[1]),TRUE);
1018 tmps = str_get(st[2]);
1019 anum = (int)str_gnum(st[3]);
1020 optype = sp - arglast[0];
1023 warn("Too many args on send");
1024 stio = stab_io(stab);
1025 if (!stio || !stio->ifp) {
1028 warn("Send on closed socket");
1030 else if (optype >= 4) {
1031 tmps2 = str_get(st[4]);
1032 anum = sendto(fileno(stab_io(stab)->ifp), tmps, st[2]->str_cur,
1033 anum, tmps2, st[4]->str_cur);
1036 anum = send(fileno(stab_io(stab)->ifp), tmps, st[2]->str_cur, anum);
1039 value = (double)anum;
1045 if ((arg[1].arg_type & A_MASK) == A_WORD)
1046 stab = arg[1].arg_ptr.arg_stab;
1048 stab = stabent(str_get(st[1]),TRUE);
1049 value = str_gnum(st[2]);
1050 str_set(str, do_seek(stab,
1051 (long)value, (int)str_gnum(st[3]) ) ? Yes : No);
1055 tmps = "_SUB_"; /* just fake up a "last _SUB_" */
1057 if (wantarray == G_ARRAY) {
1058 lastretstr = Nullstr;
1059 lastspbase = arglast[1];
1060 lastsize = arglast[2] - arglast[1];
1063 lastretstr = str_static(st[arglast[2] - arglast[0]]);
1069 tmps = str_get(arg[1].arg_ptr.arg_str);
1071 while (loop_ptr >= 0 && (!loop_stack[loop_ptr].loop_label ||
1072 strNE(tmps,loop_stack[loop_ptr].loop_label) )) {
1075 deb("(Skipping label #%d %s)\n",loop_ptr,
1076 loop_stack[loop_ptr].loop_label);
1083 deb("(Found label #%d %s)\n",loop_ptr,
1084 loop_stack[loop_ptr].loop_label);
1089 if (tmps && strEQ(tmps, "_SUB_"))
1090 fatal("Can't return outside a subroutine");
1091 fatal("Bad label: %s", maxarg > 0 ? tmps : "<null>");
1093 if (!lastretstr && optype == O_LAST && lastsize) {
1095 st += lastspbase + 1;
1096 optype = loop_stack[loop_ptr].loop_sp - lastspbase; /* negative */
1098 for (anum = lastsize; anum > 0; anum--,st++)
1099 st[optype] = str_static(st[0]);
1101 longjmp(loop_stack[loop_ptr].loop_env, O_LAST);
1103 longjmp(loop_stack[loop_ptr].loop_env, optype);
1105 case O_GOTO:/* shudder */
1106 goto_targ = str_get(arg[1].arg_ptr.arg_str);
1108 goto_targ = Nullch; /* just restart from top */
1109 if (optype == O_DUMP) {
1113 longjmp(top_env, 1);
1115 tmps = str_get(st[1]);
1117 if (!(tmps2 = fbminstr((unsigned char*)tmps,
1118 (unsigned char*)tmps + st[1]->str_cur, st[2])))
1120 if (tmps2 = fbminstr(Null(unsigned char*),Null(unsigned char*),Nullstr))
1122 value = (double)(-1 + arybase);
1124 value = (double)(tmps2 - tmps + arybase);
1127 tmps = str_get(st[1]);
1128 tmps2 = str_get(st[2]);
1130 if (!(tmps2 = rninstr(tmps, tmps + st[1]->str_cur,
1131 tmps2, tmps2 + st[2]->str_cur)))
1133 if (tmps2 = rninstr(Nullch,Nullch,Nullch,Nullch))
1135 value = (double)(-1 + arybase);
1137 value = (double)(tmps2 - tmps + arybase);
1141 value = (double) time(Null(long*));
1145 sp = do_tms(str,gimme,arglast);
1151 when = (long)str_gnum(st[1]);
1152 sp = do_time(str,localtime(&when),
1159 when = (long)str_gnum(st[1]);
1160 sp = do_time(str,gmtime(&when),
1164 sp = do_truncate(str,arg,
1169 sp = do_stat(str,arg,
1174 tmps = str_get(st[1]);
1176 str_set(str,fcrypt(tmps,str_get(st[2])));
1178 str_set(str,crypt(tmps,str_get(st[2])));
1182 "The crypt() function is unimplemented due to excessive paranoia.");
1186 value = str_gnum(st[1]);
1187 value = atan2(value,str_gnum(st[2]));
1191 value = str_gnum(stab_val(defstab));
1193 value = str_gnum(st[1]);
1198 value = str_gnum(stab_val(defstab));
1200 value = str_gnum(st[1]);
1207 value = str_gnum(st[1]);
1211 value = rand() * value / 2147483648.0;
1214 value = rand() * value / 65536.0;
1217 value = rand() * value / 32768.0;
1219 value = rand() * value / (double)(((unsigned long)1) << RANDBITS);
1230 anum = (int)str_gnum(st[1]);
1235 value = str_gnum(stab_val(defstab));
1237 value = str_gnum(st[1]);
1242 value = str_gnum(stab_val(defstab));
1244 value = str_gnum(st[1]);
1249 value = str_gnum(stab_val(defstab));
1251 value = str_gnum(st[1]);
1252 value = sqrt(value);
1256 value = str_gnum(stab_val(defstab));
1258 value = str_gnum(st[1]);
1260 (void)modf(value,&value);
1262 (void)modf(-value,&value);
1268 tmps = str_get(stab_val(defstab));
1270 tmps = str_get(st[1]);
1272 value = (double) (*tmps & 255);
1275 value = (double) (anum & 255);
1282 tmps = str_get(st[1]);
1284 if (!tmps || !*tmps)
1285 sleep((32767<<16)+32767);
1287 sleep((unsigned int)atoi(tmps));
1289 value = (double)when;
1291 value = ((double)when) - value;
1295 sp = do_range(gimme,arglast);
1298 if (gimme == G_ARRAY) { /* it's a range */
1299 /* can we optimize to constant array? */
1300 if ((arg[1].arg_type & A_MASK) == A_SINGLE &&
1301 (arg[2].arg_type & A_MASK) == A_SINGLE) {
1302 st[2] = arg[2].arg_ptr.arg_str;
1303 sp = do_range(gimme,arglast);
1304 st = stack->ary_array;
1305 maxarg = sp - arglast[0];
1306 str_free(arg[1].arg_ptr.arg_str);
1307 str_free(arg[2].arg_ptr.arg_str);
1308 arg->arg_type = O_ARRAY;
1309 arg[1].arg_type = A_STAB|A_DONT;
1311 stab = arg[1].arg_ptr.arg_stab = aadd(genstab());
1312 ary = stab_array(stab);
1313 afill(ary,maxarg - 1);
1315 while (maxarg-- > 0)
1316 ary->ary_array[maxarg] = str_smake(st[maxarg]);
1319 arg->arg_type = optype = O_RANGE;
1320 maxarg = arg->arg_len = 2;
1322 arg[anum].arg_flags &= ~AF_ARYOK;
1323 argflags = arg[anum].arg_flags;
1324 argtype = arg[anum].arg_type & A_MASK;
1325 arg[anum].arg_type = argtype;
1326 argptr = arg[anum].arg_ptr;
1332 arg->arg_type = O_FLIP;
1335 if ((arg[1].arg_type & A_MASK) == A_SINGLE ?
1336 last_in_stab && (int)str_gnum(st[1]) == stab_io(last_in_stab)->lines
1339 str_numset(str,0.0);
1341 arg->arg_type = optype = O_FLOP;
1342 arg[2].arg_type &= ~A_DONT;
1343 arg[1].arg_type |= A_DONT;
1344 argflags = arg[2].arg_flags;
1345 argtype = arg[2].arg_type & A_MASK;
1346 argptr = arg[2].arg_ptr;
1355 if ((arg[2].arg_type & A_MASK) == A_SINGLE ?
1356 last_in_stab && (int)str_gnum(st[2]) == stab_io(last_in_stab)->lines
1359 arg->arg_type = O_FLIP;
1360 arg[1].arg_type &= ~A_DONT;
1361 arg[2].arg_type |= A_DONT;
1368 if (!anum && (tmpstab = stabent("$",allstabs)))
1369 str_numset(STAB_STR(tmpstab),(double)getpid());
1370 value = (double)anum;
1373 fatal("Unsupported function fork");
1379 anum = wait(&argflags);
1381 pidgone(anum,argflags);
1382 value = (double)anum;
1384 statusvalue = (unsigned short)argflags;
1387 fatal("Unsupported function wait");
1393 if (arglast[2] - arglast[1] == 1) {
1395 tainted |= st[2]->str_tainted;
1396 taintproper("Insecure dependency in system");
1399 while ((anum = vfork()) == -1) {
1400 if (errno != EAGAIN) {
1408 ihand = signal(SIGINT, SIG_IGN);
1409 qhand = signal(SIGQUIT, SIG_IGN);
1410 while ((argtype = wait(&argflags)) != anum && argtype >= 0)
1411 pidgone(argtype,argflags);
1415 (void)signal(SIGINT, ihand);
1416 (void)signal(SIGQUIT, qhand);
1417 statusvalue = (unsigned short)argflags;
1421 value = (double)((unsigned int)argflags & 0xffff);
1423 do_execfree(); /* free any memory child malloced on vfork */
1426 if ((arg[1].arg_type & A_MASK) == A_STAB)
1427 value = (double)do_aexec(st[1],arglast);
1428 else if (arglast[2] - arglast[1] != 1)
1429 value = (double)do_aexec(Nullstr,arglast);
1431 value = (double)do_exec(str_get(str_static(st[2])));
1435 if ((arg[1].arg_type & A_MASK) == A_STAB)
1436 value = (double)do_aspawn(st[1],arglast);
1437 else if (arglast[2] - arglast[1] != 1)
1438 value = (double)do_aspawn(Nullstr,arglast);
1440 value = (double)do_spawn(str_get(str_static(st[2])));
1445 if ((arg[1].arg_type & A_MASK) == A_STAB)
1446 value = (double)do_aexec(st[1],arglast);
1447 else if (arglast[2] - arglast[1] != 1)
1448 value = (double)do_aexec(Nullstr,arglast);
1450 value = (double)do_exec(str_get(str_static(st[2])));
1463 tmps = str_get(stab_val(defstab));
1465 tmps = str_get(st[1]);
1474 case '0': case '1': case '2': case '3': case '4':
1475 case '5': case '6': case '7':
1477 anum += *tmps++ & 15;
1479 case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
1480 case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
1484 anum += (*tmps++ & 7) + 9;
1493 value = (double)anum;
1497 value = (double)apply(optype,arglast);
1500 fatal("Unsupported function chown");
1505 value = (double)apply(optype,arglast);
1508 fatal("Unsupported function kill");
1514 value = (double)apply(optype,arglast);
1523 anum = umask((int)str_gnum(st[1]));
1524 value = (double)anum;
1526 taintproper("Insecure dependency in umask");
1530 fatal("Unsupported function umask");
1534 tmps = str_get(st[1]);
1535 tmps2 = str_get(st[2]);
1537 taintproper("Insecure dependency in rename");
1540 value = (double)(rename(tmps,tmps2) >= 0);
1542 if (same_dirent(tmps2, tmps) /* can always rename to same name */
1545 if (euid || stat(tmps2,&statbuf) < 0 ||
1546 (statbuf.st_mode & S_IFMT) != S_IFDIR )
1547 (void)UNLINK(tmps2);
1548 if (!(anum = link(tmps,tmps2)))
1549 anum = UNLINK(tmps);
1551 value = (double)(anum >= 0);
1556 tmps = str_get(st[1]);
1557 tmps2 = str_get(st[2]);
1559 taintproper("Insecure dependency in link");
1561 value = (double)(link(tmps,tmps2) >= 0);
1564 fatal("Unsupported function link");
1568 tmps = str_get(st[1]);
1569 anum = (int)str_gnum(st[2]);
1571 taintproper("Insecure dependency in mkdir");
1574 value = (double)(mkdir(tmps,anum) >= 0);
1577 (void)strcpy(buf,"mkdir ");
1579 #if !defined(MKDIR) || !defined(RMDIR)
1581 for (tmps2 = buf+6; *tmps; ) {
1585 (void)strcpy(tmps2," 2>&1");
1586 rsfp = mypopen(buf,"r");
1589 tmps2 = fgets(buf,sizeof buf,rsfp);
1590 (void)mypclose(rsfp);
1591 if (tmps2 != Nullch) {
1592 for (errno = 1; errno < sys_nerr; errno++) {
1593 if (instr(buf,sys_errlist[errno])) /* you don't see this */
1598 #define EACCES EPERM
1600 if (instr(buf,"cannot make"))
1602 else if (instr(buf,"non-exist"))
1604 else if (instr(buf,"does not exist"))
1606 else if (instr(buf,"not empty"))
1608 else if (instr(buf,"cannot access"))
1614 else { /* some mkdirs return no failure indication */
1615 tmps = str_get(st[1]);
1616 anum = (stat(tmps,&statbuf) >= 0);
1617 if (optype == O_RMDIR)
1622 errno = EACCES; /* a guess */
1623 value = (double)anum;
1632 tmps = str_get(stab_val(defstab));
1634 tmps = str_get(st[1]);
1636 taintproper("Insecure dependency in rmdir");
1639 value = (double)(rmdir(tmps) >= 0);
1642 (void)strcpy(buf,"rmdir ");
1643 goto one_liner; /* see above in MKDIR */
1647 value = (double)getppid();
1650 fatal("Unsupported function getppid");
1658 anum = (int)str_gnum(st[1]);
1659 value = (double)getpgrp(anum);
1662 fatal("The getpgrp() function is unimplemented on this machine");
1667 argtype = (int)str_gnum(st[1]);
1668 anum = (int)str_gnum(st[2]);
1670 taintproper("Insecure dependency in setpgrp");
1672 value = (double)(setpgrp(argtype,anum) >= 0);
1675 fatal("The setpgrp() function is unimplemented on this machine");
1680 argtype = (int)str_gnum(st[1]);
1681 anum = (int)str_gnum(st[2]);
1682 value = (double)getpriority(argtype,anum);
1685 fatal("The getpriority() function is unimplemented on this machine");
1690 argtype = (int)str_gnum(st[1]);
1691 anum = (int)str_gnum(st[2]);
1692 optype = (int)str_gnum(st[3]);
1694 taintproper("Insecure dependency in setpriority");
1696 value = (double)(setpriority(argtype,anum,optype) >= 0);
1699 fatal("The setpriority() function is unimplemented on this machine");
1705 tmps = str_get(stab_val(defstab));
1707 tmps = str_get(st[1]);
1709 taintproper("Insecure dependency in chroot");
1711 value = (double)(chroot(tmps) >= 0);
1714 fatal("Unsupported function chroot");
1720 stab = last_in_stab;
1721 else if ((arg[1].arg_type & A_MASK) == A_WORD)
1722 stab = arg[1].arg_ptr.arg_stab;
1724 stab = stabent(str_get(st[1]),TRUE);
1725 argtype = U_I(str_gnum(st[2]));
1727 taintproper("Insecure dependency in ioctl");
1729 anum = do_ctl(optype,stab,argtype,st[3]);
1733 value = (double)anum;
1736 str_set(str,"0 but true");
1742 stab = last_in_stab;
1743 else if ((arg[1].arg_type & A_MASK) == A_WORD)
1744 stab = arg[1].arg_ptr.arg_stab;
1746 stab = stabent(str_get(st[1]),TRUE);
1747 if (stab && stab_io(stab))
1748 fp = stab_io(stab)->ifp;
1752 argtype = (int)str_gnum(st[2]);
1753 value = (double)(flock(fileno(fp),argtype) >= 0);
1759 fatal("The flock() function is unimplemented on this machine");
1763 ary = stab_array(arg[1].arg_ptr.arg_stab);
1764 if (arglast[2] - arglast[1] != 1)
1765 do_unshift(ary,arglast);
1767 str = Str_new(52,0); /* must copy the STR */
1768 str_sset(str,st[2]);
1770 (void)astore(ary,0,str);
1772 value = (double)(ary->ary_fill + 1);
1779 tmpstr = stab_val(defstab);
1782 (arg[1].arg_type & A_MASK) != A_NULL ? st[1] : stab_val(defstab);
1784 tainted |= tmpstr->str_tainted;
1785 taintproper("Insecure dependency in eval");
1787 sp = do_eval(tmpstr, optype, arg[2].arg_ptr.arg_hash,
1815 if (mystat(arg,st[1]) < 0)
1817 if (cando(anum,argtype,&statcache))
1822 if (mystat(arg,st[1]) < 0)
1827 if (mystat(arg,st[1]) < 0)
1829 if (statcache.st_uid == (optype == O_FTEOWNED ? euid : uid) )
1833 if (mystat(arg,st[1]) < 0)
1835 if (!statcache.st_size)
1839 if (mystat(arg,st[1]) < 0)
1841 value = (double)statcache.st_size;
1847 goto check_file_type;
1853 goto check_file_type;
1857 goto check_file_type;
1863 goto check_file_type;
1867 if (mystat(arg,st[1]) < 0)
1869 if ((statcache.st_mode & S_IFMT) == anum )
1875 goto check_file_type;
1880 if (arg[1].arg_type & A_DONT)
1881 fatal("You must supply explicit filename with -l");
1883 if (lstat(str_get(st[1]),&statcache) < 0)
1885 if ((statcache.st_mode & S_IFMT) == S_IFLNK )
1891 tmps = str_get(st[1]);
1892 tmps2 = str_get(st[2]);
1894 taintproper("Insecure dependency in symlink");
1896 value = (double)(symlink(tmps,tmps2) >= 0);
1899 fatal("Unsupported function symlink");
1904 tmps = str_get(stab_val(defstab));
1906 tmps = str_get(st[1]);
1907 anum = readlink(tmps,buf,sizeof buf);
1910 str_nset(str,buf,anum);
1913 fatal("Unsupported function readlink");
1936 if (mystat(arg,st[1]) < 0)
1938 if (statcache.st_mode & anum)
1942 if (arg[1].arg_type & A_DONT) {
1943 stab = arg[1].arg_ptr.arg_stab;
1947 stab = stabent(tmps = str_get(st[1]),FALSE);
1948 if (stab && stab_io(stab) && stab_io(stab)->ifp)
1949 anum = fileno(stab_io(stab)->ifp);
1950 else if (isdigit(*tmps))
1959 str = do_fttext(arg,st[1]);
1963 if ((arg[1].arg_type & A_MASK) == A_WORD)
1964 stab = arg[1].arg_ptr.arg_stab;
1966 stab = stabent(str_get(st[1]),TRUE);
1968 value = (double)do_socket(stab,arglast);
1970 (void)do_socket(stab,arglast);
1974 if ((arg[1].arg_type & A_MASK) == A_WORD)
1975 stab = arg[1].arg_ptr.arg_stab;
1977 stab = stabent(str_get(st[1]),TRUE);
1979 value = (double)do_bind(stab,arglast);
1981 (void)do_bind(stab,arglast);
1985 if ((arg[1].arg_type & A_MASK) == A_WORD)
1986 stab = arg[1].arg_ptr.arg_stab;
1988 stab = stabent(str_get(st[1]),TRUE);
1990 value = (double)do_connect(stab,arglast);
1992 (void)do_connect(stab,arglast);
1996 if ((arg[1].arg_type & A_MASK) == A_WORD)
1997 stab = arg[1].arg_ptr.arg_stab;
1999 stab = stabent(str_get(st[1]),TRUE);
2001 value = (double)do_listen(stab,arglast);
2003 (void)do_listen(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 if ((arg[2].arg_type & A_MASK) == A_WORD)
2012 stab2 = arg[2].arg_ptr.arg_stab;
2014 stab2 = stabent(str_get(st[2]),TRUE);
2015 do_accept(str,stab,stab2);
2023 sp = do_ghent(optype,
2031 sp = do_gnent(optype,
2039 sp = do_gpent(optype,
2047 sp = do_gsent(optype,
2051 value = (double) sethostent((int)str_gnum(st[1]));
2054 value = (double) setnetent((int)str_gnum(st[1]));
2057 value = (double) setprotoent((int)str_gnum(st[1]));
2060 value = (double) setservent((int)str_gnum(st[1]));
2063 value = (double) endhostent();
2066 value = (double) endnetent();
2069 value = (double) endprotoent();
2072 value = (double) endservent();
2075 if ((arg[1].arg_type & A_MASK) == A_WORD)
2076 stab = arg[1].arg_ptr.arg_stab;
2078 stab = stabent(str_get(st[1]),TRUE);
2079 if ((arg[2].arg_type & A_MASK) == A_WORD)
2080 stab2 = arg[2].arg_ptr.arg_stab;
2082 stab2 = stabent(str_get(st[2]),TRUE);
2084 value = (double)do_spair(stab,stab2,arglast);
2086 (void)do_spair(stab,stab2,arglast);
2090 if ((arg[1].arg_type & A_MASK) == A_WORD)
2091 stab = arg[1].arg_ptr.arg_stab;
2093 stab = stabent(str_get(st[1]),TRUE);
2095 value = (double)do_shutdown(stab,arglast);
2097 (void)do_shutdown(stab,arglast);
2102 if ((arg[1].arg_type & A_MASK) == A_WORD)
2103 stab = arg[1].arg_ptr.arg_stab;
2105 stab = stabent(str_get(st[1]),TRUE);
2106 sp = do_sopt(optype,stab,arglast);
2110 if ((arg[1].arg_type & A_MASK) == A_WORD)
2111 stab = arg[1].arg_ptr.arg_stab;
2113 stab = stabent(str_get(st[1]),TRUE);
2114 sp = do_getsockname(optype,stab,arglast);
2117 #else /* SOCKET not defined */
2150 fatal("Unsupported socket function");
2154 sp = do_select(gimme,arglast);
2157 fatal("select not implemented");
2162 if ((arg[1].arg_type & A_MASK) == A_WORD)
2163 stab = arg[1].arg_ptr.arg_stab;
2165 stab = stabent(str_get(st[1]),TRUE);
2166 if (!stab || !(stio = stab_io(stab)) || !(fp = stio->ifp))
2173 if ((arg[1].arg_type & A_MASK) == A_WORD)
2174 stab = arg[1].arg_ptr.arg_stab;
2176 stab = stabent(str_get(st[1]),TRUE);
2177 if (!stab || !(stio = stab_io(stab)) || !(fp = stio->ifp))
2180 str_set(str, (setmode(fileno(fp), O_BINARY) != -1) ? Yes : No);
2187 sp = do_vec(str == st[1], arg->arg_ptr.arg_str, arglast);
2193 sp = do_gpwent(optype,
2197 value = (double) setpwent();
2200 value = (double) endpwent();
2205 fatal("Unsupported password function");
2212 sp = do_ggrent(optype,
2216 value = (double) setgrent();
2219 value = (double) endgrent();
2224 fatal("Unsupported group function");
2229 if (!(tmps = getlogin()))
2233 fatal("Unsupported function getlogin");
2244 if ((arg[1].arg_type & A_MASK) == A_WORD)
2245 stab = arg[1].arg_ptr.arg_stab;
2247 stab = stabent(str_get(st[1]),TRUE);
2248 sp = do_dirop(optype,stab,gimme,arglast);
2251 value = (double)do_syscall(arglast);
2255 if ((arg[1].arg_type & A_MASK) == A_WORD)
2256 stab = arg[1].arg_ptr.arg_stab;
2258 stab = stabent(str_get(st[1]),TRUE);
2259 if ((arg[2].arg_type & A_MASK) == A_WORD)
2260 stab2 = arg[2].arg_ptr.arg_stab;
2262 stab2 = stabent(str_get(st[2]),TRUE);
2263 do_pipe(str,stab,stab2);
2266 fatal("Unsupported function pipe");
2277 deb("%s RETURNS \"%s\"\n",opname[optype],str_get(str));
2280 return arglast[0] + 1;
2287 anum = sp - arglast[0];
2290 deb("%s RETURNS ()\n",opname[optype]);
2293 deb("%s RETURNS (\"%s\")\n",opname[optype],str_get(st[1]));
2296 tmps = str_get(st[1]);
2297 deb("%s RETURNS %d ARGS (\"%s\",%s\"%s\")\n",opname[optype],
2298 anum,tmps,anum==2?"":"...,",str_get(st[anum]));
2323 str_numset(str,value);
2330 deb("%s RETURNS \"%f\"\n",opname[optype],value);
2333 return arglast[0] + 1;