1 /* $Header: eval.c,v 3.0.1.1 89/11/11 04:31:51 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.1 89/11/11 04:31:51 lwall
10 * patch2: mkdir and rmdir needed to quote argument when passed to shell
11 * patch2: mkdir and rmdir now return better error codes
12 * patch2: fileno, seekdir, rewinddir and closedir now disallow defaults
14 * Revision 3.0 89/10/18 15:17:04 lwall
32 static void (*ihand)();
33 static void (*qhand)();
35 static int (*ihand)();
36 static int (*qhand)();
43 static struct lstring *lstr;
44 static char old_record_separator;
46 double sin(), cos(), atan2(), pow();
51 extern char *sys_errlist[];
70 int arglast[8]; /* highest sp for arg--valid only for non-O_LIST args */
71 unsigned long tmplong;
78 bool assigning = FALSE;
79 double exp(), log(), sqrt(), modf();
80 char *crypt(), *getenv();
81 extern void grow_dlevel();
85 optype = arg->arg_type;
86 maxarg = arg->arg_len;
88 str = arg->arg_ptr.arg_str;
89 if (sp + maxarg > stack->ary_max)
90 astore(stack, sp + maxarg, Nullstr);
91 st = stack->ary_array;
96 deb("%s (%lx) %d args:\n",opname[optype],arg,maxarg);
98 debname[dlevel] = opname[optype][0];
99 debdelim[dlevel] = ':';
100 if (++dlevel >= dlmax)
105 #include "evalargs.xc"
113 if (gimme == G_ARRAY)
119 if (gimme == G_ARRAY)
122 STR_SSET(str,st[arglast[anum]-arglast[0]]);
126 if (gimme == G_ARRAY)
129 STR_SSET(str,st[arglast[anum]-arglast[0]]);
139 anum = (int)str_gnum(st[2]);
141 tmpstr = Str_new(50,0);
142 str_sset(tmpstr,str);
144 str_scat(str,tmpstr);
147 str_sset(str,&str_no);
151 sp = do_match(str,arg,
153 if (gimme == G_ARRAY)
158 sp = do_match(str,arg,
160 if (gimme == G_ARRAY)
162 str_sset(str, str_true(str) ? &str_no : &str_yes);
166 sp = do_subst(str,arg,arglast[0]);
169 sp = do_subst(str,arg,arglast[0]);
170 str = arg->arg_ptr.arg_str;
171 str_set(str, str_true(str) ? No : Yes);
174 if (arg[1].arg_flags & AF_ARYOK) {
175 if (arg->arg_len == 1) {
176 arg->arg_type = O_LOCAL;
180 arg->arg_type = O_AASSIGN;
185 arg->arg_type = O_SASSIGN;
190 arglast[2] = arglast[1]; /* push a null array */
199 STR_SSET(str, st[2]);
204 str = arg->arg_ptr.arg_str;
205 for (sp = arglast[0] + 1; sp <= arglast[1]; sp++)
210 if (arg[1].arg_type & A_DONT) {
211 sp = do_defined(str,arg,
215 else if (str->str_pok || str->str_nok)
219 if (arg[1].arg_type & A_DONT) {
220 sp = do_undef(str,arg,
224 else if (str != stab_val(defstab)) {
225 str->str_pok = str->str_nok = 0;
230 sp = do_study(str,arg,
234 value = str_gnum(st[1]);
235 value = pow(value,str_gnum(st[2]));
238 value = str_gnum(st[1]);
239 value *= str_gnum(st[2]);
242 if ((value = str_gnum(st[2])) == 0.0)
243 fatal("Illegal division by zero");
244 value = str_gnum(st[1]) / value;
247 tmplong = (long) str_gnum(st[2]);
249 fatal("Illegal modulus zero");
250 when = (long)str_gnum(st[1]);
253 value = (double)(when % tmplong);
255 value = (double)(tmplong - (-when % tmplong));
259 value = str_gnum(st[1]);
260 value += str_gnum(st[2]);
263 value = str_gnum(st[1]);
264 value -= str_gnum(st[2]);
267 value = str_gnum(st[1]);
268 anum = (int)str_gnum(st[2]);
270 value = (double)(((long)value) << anum);
274 value = str_gnum(st[1]);
275 anum = (int)str_gnum(st[2]);
277 value = (double)(((long)value) >> anum);
281 value = str_gnum(st[1]);
282 value = (value < str_gnum(st[2])) ? 1.0 : 0.0;
285 value = str_gnum(st[1]);
286 value = (value > str_gnum(st[2])) ? 1.0 : 0.0;
289 value = str_gnum(st[1]);
290 value = (value <= str_gnum(st[2])) ? 1.0 : 0.0;
293 value = str_gnum(st[1]);
294 value = (value >= str_gnum(st[2])) ? 1.0 : 0.0;
298 if ((!st[1]->str_nok && !looks_like_number(st[1])) ||
299 (!st[2]->str_nok && !looks_like_number(st[2])) )
300 warn("Possible use of == on string value");
302 value = str_gnum(st[1]);
303 value = (value == str_gnum(st[2])) ? 1.0 : 0.0;
306 value = str_gnum(st[1]);
307 value = (value != str_gnum(st[2])) ? 1.0 : 0.0;
310 if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
311 value = str_gnum(st[1]);
313 value = (double)(((long)value) & (long)str_gnum(st[2]));
318 do_vop(optype,str,st[1],st[2]);
321 if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
322 value = str_gnum(st[1]);
324 value = (double)(((long)value) ^ (long)str_gnum(st[2]));
329 do_vop(optype,str,st[1],st[2]);
332 if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
333 value = str_gnum(st[1]);
335 value = (double)(((long)value) | (long)str_gnum(st[2]));
340 do_vop(optype,str,st[1],st[2]);
342 /* use register in evaluating str_true() */
344 if (str_true(st[1])) {
347 argflags = arg[anum].arg_flags;
348 if (gimme == G_ARRAY)
349 argflags |= AF_ARYOK;
350 argtype = arg[anum].arg_type & A_MASK;
351 argptr = arg[anum].arg_ptr;
359 str_sset(str, st[1]);
367 if (str_true(st[1])) {
369 str_sset(str, st[1]);
379 argflags = arg[anum].arg_flags;
380 if (gimme == G_ARRAY)
381 argflags |= AF_ARYOK;
382 argtype = arg[anum].arg_type & A_MASK;
383 argptr = arg[anum].arg_ptr;
390 anum = (str_true(st[1]) ? 2 : 3);
391 optype = (anum == 2 ? O_ITEM2 : O_ITEM3);
392 argflags = arg[anum].arg_flags;
393 if (gimme == G_ARRAY)
394 argflags |= AF_ARYOK;
395 argtype = arg[anum].arg_type & A_MASK;
396 argptr = arg[anum].arg_ptr;
402 if (gimme == G_ARRAY)
407 value = -str_gnum(st[1]);
410 value = (double) !str_true(st[1]);
414 value = (double) ~(long)str_gnum(st[1]);
418 tmps = stab_name(defoutstab);
420 if ((arg[1].arg_type & A_MASK) == A_WORD)
421 defoutstab = arg[1].arg_ptr.arg_stab;
423 defoutstab = stabent(str_get(st[1]),TRUE);
424 if (!stab_io(defoutstab))
425 stab_io(defoutstab) = stio_new();
426 curoutstab = defoutstab;
434 else if ((arg[1].arg_type & A_MASK) == A_WORD) {
435 if (!(stab = arg[1].arg_ptr.arg_stab))
439 stab = stabent(str_get(st[1]),TRUE);
440 if (!stab_io(stab)) {
446 fp = stab_io(stab)->ofp;
448 if (stab_io(stab)->fmt_stab)
449 form = stab_form(stab_io(stab)->fmt_stab);
451 form = stab_form(stab);
455 warn("No format for filehandle");
457 if (stab_io(stab)->ifp)
458 warn("Filehandle only opened for input");
460 warn("Write on closed filehandle");
467 format(&outrec,form,sp);
468 do_write(&outrec,stab_io(stab),sp);
469 if (stab_io(stab)->flags & IOF_FLUSH)
476 if ((arg[1].arg_type & A_MASK) == A_WORD)
477 stab = arg[1].arg_ptr.arg_stab;
479 stab = stabent(str_get(st[1]),TRUE);
480 anum = (int)str_gnum(st[3]);
481 value = (double)hdbmopen(stab_hash(stab),str_get(st[2]),anum);
484 fatal("No dbm or ndbm on this machine");
488 if ((arg[1].arg_type & A_MASK) == A_WORD)
489 stab = arg[1].arg_ptr.arg_stab;
491 stab = stabent(str_get(st[1]),TRUE);
492 hdbmclose(stab_hash(stab));
495 fatal("No dbm or ndbm on this machine");
498 if ((arg[1].arg_type & A_MASK) == A_WORD)
499 stab = arg[1].arg_ptr.arg_stab;
501 stab = stabent(str_get(st[1]),TRUE);
502 if (do_open(stab,str_get(st[2]))) {
503 value = (double)forkprocess;
504 stab_io(stab)->lines = 0;
511 value = (double) do_trans(str,arg);
512 str = arg->arg_ptr.arg_str;
515 str_set(arg->arg_ptr.arg_str, do_trans(str,arg) == 0 ? Yes : No);
516 str = arg->arg_ptr.arg_str;
521 else if ((arg[1].arg_type & A_MASK) == A_WORD)
522 stab = arg[1].arg_ptr.arg_stab;
524 stab = stabent(str_get(st[1]),TRUE);
525 str_set(str, do_close(stab,TRUE) ? Yes : No );
529 sp = do_each(str,stab_hash(arg[1].arg_ptr.arg_stab),
534 sp = do_kv(str,stab_hash(arg[1].arg_ptr.arg_stab), optype,
538 str->str_nok = str->str_pok = 0;
539 str->str_u.str_stab = arg[1].arg_ptr.arg_stab;
540 str->str_state = SS_ARY;
543 ary = stab_array(arg[1].arg_ptr.arg_stab);
544 maxarg = ary->ary_fill + 1;
545 if (gimme == G_ARRAY) { /* array wanted */
548 if (maxarg > 0 && sp + maxarg > stack->ary_max) {
549 astore(stack,sp + maxarg, Nullstr);
550 st = stack->ary_array;
552 Copy(ary->ary_array, &st[sp+1], maxarg, STR*);
557 str = afetch(ary,maxarg - 1,FALSE);
560 str = afetch(stab_array(arg[1].arg_ptr.arg_stab),
561 ((int)str_gnum(st[2])) - arybase,FALSE);
566 tmpstab = arg[1].arg_ptr.arg_stab;
567 tmps = str_get(st[2]);
568 str = hdelete(stab_hash(tmpstab),tmps,st[2]->str_cur);
569 if (tmpstab == envstab)
575 str->str_nok = str->str_pok = 0;
576 str->str_u.str_stab = arg[1].arg_ptr.arg_stab;
577 str->str_state = SS_HASH;
580 if (gimme == G_ARRAY) { /* array wanted */
581 sp = do_kv(str,stab_hash(arg[1].arg_ptr.arg_stab), optype,
586 tmpstab = arg[1].arg_ptr.arg_stab;
587 sprintf(buf,"%d/%d",stab_hash(tmpstab)->tbl_fill,
588 stab_hash(tmpstab)->tbl_max+1);
593 tmpstab = arg[1].arg_ptr.arg_stab;
594 tmps = str_get(st[2]);
595 str = hfetch(stab_hash(tmpstab),tmps,st[2]->str_cur,FALSE);
600 anum = ((int)str_gnum(st[2])) - arybase;
601 str = afetch(stab_array(arg[1].arg_ptr.arg_stab),anum,TRUE);
603 fatal("Assignment to non-creatable value, subscript %d",anum);
606 tmpstab = arg[1].arg_ptr.arg_stab;
607 tmps = str_get(st[2]);
608 anum = st[2]->str_cur;
609 str = hfetch(stab_hash(tmpstab),tmps,anum,TRUE);
611 fatal("Assignment to non-creatable value, subscript \"%s\"",tmps);
612 if (tmpstab == envstab) /* heavy wizardry going on here */
613 str_magic(str, tmpstab, 'E', tmps, anum); /* str is now magic */
614 /* he threw the brick up into the air */
615 else if (tmpstab == sigstab)
616 str_magic(str, tmpstab, 'S', tmps, anum);
618 else if (stab_hash(tmpstab)->tbl_dbm)
619 str_magic(str, tmpstab, 'D', tmps, anum);
625 goto do_slice_already;
629 goto do_slice_already;
633 goto do_slice_already;
638 sp = do_slice(arg[1].arg_ptr.arg_stab,anum,argtype,
642 if (arglast[2] - arglast[1] != 1)
643 str = do_push(stab_array(arg[1].arg_ptr.arg_stab),arglast);
645 str = Str_new(51,0); /* must copy the STR */
647 (void)apush(stab_array(arg[1].arg_ptr.arg_stab),str);
651 str = apop(ary = stab_array(arg[1].arg_ptr.arg_stab));
652 goto staticalization;
654 str = ashift(ary = stab_array(arg[1].arg_ptr.arg_stab));
658 if (ary->ary_flags & ARF_REAL)
659 (void)str_2static(str);
662 sp = do_unpack(str,gimme,arglast);
665 value = str_gnum(st[3]);
666 sp = do_split(str, arg[2].arg_ptr.arg_spat, (int)value,
671 value = (double)str_len(stab_val(defstab));
673 value = (double)str_len(st[1]);
676 do_sprintf(str, sp-arglast[0], st+1);
679 anum = ((int)str_gnum(st[2])) - arybase; /* anum=where to start*/
680 tmps = str_get(st[1]); /* force conversion to string */
681 if (argtype = (str == st[1]))
682 str = arg->arg_ptr.arg_str;
684 anum += st[1]->str_cur + arybase;
685 if (anum < 0 || anum > st[1]->str_cur)
688 optype = (int)str_gnum(st[3]);
692 anum = st[1]->str_cur - anum; /* anum=how many bytes left*/
695 str_nset(str, tmps, anum);
696 if (argtype) { /* it's an lvalue! */
697 lstr = (struct lstring*)str;
698 str->str_magic = st[1];
699 st[1]->str_rare = 's';
700 lstr->lstr_offset = tmps - str_get(st[1]);
701 lstr->lstr_len = anum;
706 (void)do_pack(str,arglast);
709 sp = do_grep(arg,str,gimme,arglast);
712 do_join(str,arglast);
715 tmps = str_get(st[1]);
716 value = (double) (str_cmp(st[1],st[2]) < 0);
719 tmps = str_get(st[1]);
720 value = (double) (str_cmp(st[1],st[2]) > 0);
723 tmps = str_get(st[1]);
724 value = (double) (str_cmp(st[1],st[2]) <= 0);
727 tmps = str_get(st[1]);
728 value = (double) (str_cmp(st[1],st[2]) >= 0);
731 tmps = str_get(st[1]);
732 value = (double) str_eq(st[1],st[2]);
735 tmps = str_get(st[1]);
736 value = (double) !str_eq(st[1],st[2]);
739 sp = do_subr(arg,gimme,arglast);
740 st = stack->ary_array + arglast[0]; /* maybe realloced */
743 sp = do_dbsubr(arg,gimme,arglast);
744 st = stack->ary_array + arglast[0]; /* maybe realloced */
747 if ((arg[1].arg_type & A_MASK) == A_WORD)
748 stab = arg[1].arg_ptr.arg_stab;
750 stab = stabent(str_get(st[1]),TRUE);
753 sp = do_sort(str,stab,
761 if (arglast[2] - arglast[1] != 1) {
762 do_join(str,arglast);
763 tmps = str_get(st[1]);
767 tmps = str_get(st[2]);
770 tmps = "Warning: something's wrong";
774 if (arglast[2] - arglast[1] != 1) {
775 do_join(str,arglast);
776 tmps = str_get(st[1]);
780 tmps = str_get(st[2]);
788 if ((arg[1].arg_type & A_MASK) == A_WORD)
789 stab = arg[1].arg_ptr.arg_stab;
791 stab = stabent(str_get(st[1]),TRUE);
794 if (!stab_io(stab)) {
796 warn("Filehandle never opened");
799 if (!(fp = stab_io(stab)->ofp)) {
801 if (stab_io(stab)->ifp)
802 warn("Filehandle opened only for input");
804 warn("Print on closed filehandle");
809 if (optype == O_PRTF || arglast[2] - arglast[1] != 1)
810 value = (double)do_aprint(arg,fp,arglast);
812 value = (double)do_print(st[2],fp);
813 if (orslen && optype == O_PRINT)
814 if (fwrite(ors, 1, orslen, fp) == 0)
817 if (stab_io(stab)->flags & IOF_FLUSH)
818 if (fflush(fp) == EOF)
824 tmps = str_get(stab_val(defstab));
826 tmps = str_get(st[1]);
827 if (!tmps || !*tmps) {
828 tmpstr = hfetch(stab_hash(envstab),"HOME",4,FALSE);
830 tmps = str_get(tmpstr);
832 if (!tmps || !*tmps) {
833 tmpstr = hfetch(stab_hash(envstab),"LOGDIR",6,FALSE);
835 tmps = str_get(tmpstr);
838 taintproper("Insecure dependency in chdir");
840 value = (double)(chdir(tmps) >= 0);
846 anum = (int)str_gnum(st[1]);
853 tmps = str_get(st[1]);
854 str_reset(tmps,arg[2].arg_ptr.arg_hash);
858 if (gimme == G_ARRAY)
861 str = st[sp - arglast[0]]; /* unwanted list, return last item */
868 else if ((arg[1].arg_type & A_MASK) == A_WORD)
869 stab = arg[1].arg_ptr.arg_stab;
871 stab = stabent(str_get(st[1]),TRUE);
872 str_set(str, do_eof(stab) ? Yes : No);
878 else if ((arg[1].arg_type & A_MASK) == A_WORD)
879 stab = arg[1].arg_ptr.arg_stab;
881 stab = stabent(str_get(st[1]),TRUE);
882 if (do_eof(stab)) /* make sure we have fp with something */
889 *str->str_ptr = getc(stab_io(stab)->ifp); /* should never be EOF */
896 else if ((arg[1].arg_type & A_MASK) == A_WORD)
897 stab = arg[1].arg_ptr.arg_stab;
899 stab = stabent(str_get(st[1]),TRUE);
901 value = (double)do_tell(stab);
908 if ((arg[1].arg_type & A_MASK) == A_WORD)
909 stab = arg[1].arg_ptr.arg_stab;
911 stab = stabent(str_get(st[1]),TRUE);
912 tmps = str_get(st[2]);
913 anum = (int)str_gnum(st[3]);
914 STR_GROW(st[2], anum+1), (tmps = str_get(st[2])); /* sneaky */
916 if (!stab_io(stab) || !stab_io(stab)->ifp)
919 else if (optype == O_RECV) {
920 argtype = sizeof buf;
921 optype = (int)str_gnum(st[4]);
922 anum = recvfrom(fileno(stab_io(stab)->ifp), tmps, anum, optype,
925 st[2]->str_cur = anum;
926 st[2]->str_ptr[anum] = '\0';
927 str_nset(str,buf,argtype);
930 str_sset(str,&str_undef);
933 else if (stab_io(stab)->type == 's') {
934 argtype = sizeof buf;
935 anum = recvfrom(fileno(stab_io(stab)->ifp), tmps, anum, 0,
939 else if (optype == O_RECV)
943 anum = fread(tmps, 1, anum, stab_io(stab)->ifp);
946 st[2]->str_cur = anum;
947 st[2]->str_ptr[anum] = '\0';
948 value = (double)anum;
952 if ((arg[1].arg_type & A_MASK) == A_WORD)
953 stab = arg[1].arg_ptr.arg_stab;
955 stab = stabent(str_get(st[1]),TRUE);
956 tmps = str_get(st[2]);
957 anum = (int)str_gnum(st[3]);
958 optype = sp - arglast[0];
961 warn("Too many args on send");
963 tmps2 = str_get(st[4]);
964 anum = sendto(fileno(stab_io(stab)->ifp), tmps, st[2]->str_cur,
965 anum, tmps2, st[4]->str_cur);
968 anum = send(fileno(stab_io(stab)->ifp), tmps, st[2]->str_cur, anum);
971 value = (double)anum;
977 if ((arg[1].arg_type & A_MASK) == A_WORD)
978 stab = arg[1].arg_ptr.arg_stab;
980 stab = stabent(str_get(st[1]),TRUE);
981 value = str_gnum(st[2]);
982 str_set(str, do_seek(stab,
983 (long)value, (int)str_gnum(st[3]) ) ? Yes : No);
987 tmps = "SUB"; /* just fake up a "last SUB" */
989 if (gimme == G_ARRAY) {
990 lastretstr = Nullstr;
991 lastspbase = arglast[1];
992 lastsize = arglast[2] - arglast[1];
995 lastretstr = str_static(st[arglast[2] - arglast[0]]);
1001 tmps = str_get(arg[1].arg_ptr.arg_str);
1003 while (loop_ptr >= 0 && (!loop_stack[loop_ptr].loop_label ||
1004 strNE(tmps,loop_stack[loop_ptr].loop_label) )) {
1007 deb("(Skipping label #%d %s)\n",loop_ptr,
1008 loop_stack[loop_ptr].loop_label);
1015 deb("(Found label #%d %s)\n",loop_ptr,
1016 loop_stack[loop_ptr].loop_label);
1021 fatal("Bad label: %s", maxarg > 0 ? tmps : "<null>");
1022 if (!lastretstr && optype == O_LAST && lastsize) {
1024 st += lastspbase + 1;
1025 optype = loop_stack[loop_ptr].loop_sp - lastspbase; /* negative */
1027 for (anum = lastsize; anum > 0; anum--,st++)
1028 st[optype] = str_static(st[0]);
1030 longjmp(loop_stack[loop_ptr].loop_env, O_LAST);
1032 longjmp(loop_stack[loop_ptr].loop_env, optype);
1034 case O_GOTO:/* shudder */
1035 goto_targ = str_get(arg[1].arg_ptr.arg_str);
1037 goto_targ = Nullch; /* just restart from top */
1038 if (optype == O_DUMP) {
1042 longjmp(top_env, 1);
1044 tmps = str_get(st[1]);
1046 if (!(tmps2 = fbminstr((unsigned char*)tmps,
1047 (unsigned char*)tmps + st[1]->str_cur, st[2])))
1049 if (tmps2 = fbminstr(Null(unsigned char*),Null(unsigned char*),Nullstr))
1051 value = (double)(-1 + arybase);
1053 value = (double)(tmps2 - tmps + arybase);
1056 tmps = str_get(st[1]);
1057 tmps2 = str_get(st[2]);
1059 if (!(tmps2 = rninstr(tmps, tmps + st[1]->str_cur,
1060 tmps2, tmps2 + st[2]->str_cur)))
1062 if (tmps2 = rninstr(Nullch,Nullch,Nullch,Nullch))
1064 value = (double)(-1 + arybase);
1066 value = (double)(tmps2 - tmps + arybase);
1070 value = (double) time(Null(long*));
1074 sp = do_tms(str,gimme,arglast);
1080 when = (long)str_gnum(st[1]);
1081 sp = do_time(str,localtime(&when),
1088 when = (long)str_gnum(st[1]);
1089 sp = do_time(str,gmtime(&when),
1094 sp = do_stat(str,arg,
1099 tmps = str_get(st[1]);
1101 str_set(str,fcrypt(tmps,str_get(st[2])));
1103 str_set(str,crypt(tmps,str_get(st[2])));
1107 "The crypt() function is unimplemented due to excessive paranoia.");
1111 value = str_gnum(st[1]);
1112 value = atan2(value,str_gnum(st[2]));
1116 value = str_gnum(stab_val(defstab));
1118 value = str_gnum(st[1]);
1123 value = str_gnum(stab_val(defstab));
1125 value = str_gnum(st[1]);
1132 value = str_gnum(st[1]);
1136 value = rand() * value / 2147483648.0;
1139 value = rand() * value / 65536.0;
1142 value = rand() * value / 32768.0;
1144 value = rand() * value / (double)(((unsigned long)1) << RANDBITS);
1155 anum = (int)str_gnum(st[1]);
1160 value = str_gnum(stab_val(defstab));
1162 value = str_gnum(st[1]);
1167 value = str_gnum(stab_val(defstab));
1169 value = str_gnum(st[1]);
1174 value = str_gnum(stab_val(defstab));
1176 value = str_gnum(st[1]);
1177 value = sqrt(value);
1181 value = str_gnum(stab_val(defstab));
1183 value = str_gnum(st[1]);
1185 (void)modf(value,&value);
1187 (void)modf(-value,&value);
1193 tmps = str_get(stab_val(defstab));
1195 tmps = str_get(st[1]);
1197 value = (double) *tmps;
1200 value = (double) anum;
1207 tmps = str_get(st[1]);
1209 if (!tmps || !*tmps)
1210 sleep((32767<<16)+32767);
1212 sleep((unsigned int)atoi(tmps));
1214 value = (double)when;
1216 value = ((double)when) - value;
1220 sp = do_range(gimme,arglast);
1223 if (gimme == G_ARRAY) { /* it's a range */
1224 /* can we optimize to constant array? */
1225 if ((arg[1].arg_type & A_MASK) == A_SINGLE &&
1226 (arg[2].arg_type & A_MASK) == A_SINGLE) {
1227 st[2] = arg[2].arg_ptr.arg_str;
1228 sp = do_range(gimme,arglast);
1229 st = stack->ary_array;
1230 maxarg = sp - arglast[0];
1231 str_free(arg[1].arg_ptr.arg_str);
1232 str_free(arg[2].arg_ptr.arg_str);
1233 arg->arg_type = O_ARRAY;
1234 arg[1].arg_type = A_STAB|A_DONT;
1236 stab = arg[1].arg_ptr.arg_stab = aadd(genstab());
1237 ary = stab_array(stab);
1238 afill(ary,maxarg - 1);
1240 while (maxarg-- > 0)
1241 ary->ary_array[maxarg] = str_smake(st[maxarg]);
1244 arg->arg_type = optype = O_RANGE;
1245 maxarg = arg->arg_len = 2;
1247 arg[anum].arg_flags &= ~AF_ARYOK;
1248 argflags = arg[anum].arg_flags;
1249 argtype = arg[anum].arg_type & A_MASK;
1250 arg[anum].arg_type = argtype;
1251 argptr = arg[anum].arg_ptr;
1257 arg->arg_type = O_FLIP;
1260 if ((arg[1].arg_type & A_MASK) == A_SINGLE ?
1261 last_in_stab && (int)str_gnum(st[1]) == stab_io(last_in_stab)->lines
1264 str_numset(str,0.0);
1266 arg->arg_type = optype = O_FLOP;
1267 arg[2].arg_type &= ~A_DONT;
1268 arg[1].arg_type |= A_DONT;
1269 argflags = arg[2].arg_flags;
1270 argtype = arg[2].arg_type & A_MASK;
1271 argptr = arg[2].arg_ptr;
1280 if ((arg[2].arg_type & A_MASK) == A_SINGLE ?
1281 last_in_stab && (int)str_gnum(st[2]) == stab_io(last_in_stab)->lines
1284 arg->arg_type = O_FLIP;
1285 arg[1].arg_type &= ~A_DONT;
1286 arg[2].arg_type |= A_DONT;
1292 if (!anum && (tmpstab = stabent("$",allstabs)))
1293 str_numset(STAB_STR(tmpstab),(double)getpid());
1294 value = (double)anum;
1298 ihand = signal(SIGINT, SIG_IGN);
1299 qhand = signal(SIGQUIT, SIG_IGN);
1300 anum = wait(&argflags);
1302 pidgone(anum,argflags);
1303 value = (double)anum;
1307 (void)signal(SIGINT, ihand);
1308 (void)signal(SIGQUIT, qhand);
1309 statusvalue = (unsigned short)argflags;
1313 if (arglast[2] - arglast[1] == 1) {
1315 tainted |= st[2]->str_tainted;
1316 taintproper("Insecure dependency in system");
1319 while ((anum = vfork()) == -1) {
1320 if (errno != EAGAIN) {
1328 ihand = signal(SIGINT, SIG_IGN);
1329 qhand = signal(SIGQUIT, SIG_IGN);
1330 while ((argtype = wait(&argflags)) != anum && argtype >= 0)
1331 pidgone(argtype,argflags);
1335 (void)signal(SIGINT, ihand);
1336 (void)signal(SIGQUIT, qhand);
1337 statusvalue = (unsigned short)argflags;
1341 value = (double)((unsigned int)argflags & 0xffff);
1345 if ((arg[1].arg_type & A_MASK) == A_STAB)
1346 value = (double)do_aexec(st[1],arglast);
1347 else if (arglast[2] - arglast[1] != 1)
1348 value = (double)do_aexec(Nullstr,arglast);
1350 value = (double)do_exec(str_get(str_static(st[2])));
1354 if ((arg[1].arg_type & A_MASK) == A_STAB)
1355 value = (double)do_aexec(st[1],arglast);
1356 else if (arglast[2] - arglast[1] != 1)
1357 value = (double)do_aexec(Nullstr,arglast);
1359 value = (double)do_exec(str_get(str_static(st[2])));
1372 tmps = str_get(stab_val(defstab));
1374 tmps = str_get(st[1]);
1383 case '0': case '1': case '2': case '3': case '4':
1384 case '5': case '6': case '7':
1386 anum += *tmps++ & 15;
1388 case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
1389 case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
1393 anum += (*tmps++ & 7) + 9;
1402 value = (double)anum;
1409 value = (double)apply(optype,arglast);
1417 anum = umask((int)str_gnum(st[1]));
1418 value = (double)anum;
1420 taintproper("Insecure dependency in umask");
1424 tmps = str_get(st[1]);
1425 tmps2 = str_get(st[2]);
1427 taintproper("Insecure dependency in rename");
1430 value = (double)(rename(tmps,tmps2) >= 0);
1432 if (euid || stat(tmps2,&statbuf) < 0 ||
1433 (statbuf.st_mode & S_IFMT) != S_IFDIR )
1434 (void)UNLINK(tmps2); /* avoid unlinking a directory */
1435 if (!(anum = link(tmps,tmps2)))
1436 anum = UNLINK(tmps);
1437 value = (double)(anum >= 0);
1441 tmps = str_get(st[1]);
1442 tmps2 = str_get(st[2]);
1444 taintproper("Insecure dependency in link");
1446 value = (double)(link(tmps,tmps2) >= 0);
1449 tmps = str_get(st[1]);
1450 anum = (int)str_gnum(st[2]);
1452 taintproper("Insecure dependency in mkdir");
1455 value = (double)(mkdir(tmps,anum) >= 0);
1458 (void)strcpy(buf,"mkdir ");
1460 #if !defined(MKDIR) || !defined(RMDIR)
1462 for (tmps2 = buf+6; *tmps; ) {
1466 (void)strcpy(tmps2," 2>&1");
1467 rsfp = mypopen(buf,"r");
1470 tmps2 = fgets(buf,sizeof buf,rsfp);
1471 (void)mypclose(rsfp);
1472 if (tmps2 != Nullch) {
1473 for (errno = 1; errno < sys_nerr; errno++) {
1474 if (instr(buf,sys_errlist[errno])) /* you don't see this */
1479 #define EACCES EPERM
1481 if (instr(buf,"cannot make"))
1483 else if (instr(buf,"non-exist"))
1485 else if (instr(buf,"not empty"))
1487 else if (instr(buf,"cannot access"))
1493 else { /* some mkdirs return no failure indication */
1494 tmps = str_get(st[1]);
1495 anum = (stat(tmps,&statbuf) >= 0);
1496 if (optype == O_RMDIR)
1501 errno = EACCES; /* a guess */
1502 value = (double)anum;
1511 tmps = str_get(stab_val(defstab));
1513 tmps = str_get(st[1]);
1515 taintproper("Insecure dependency in rmdir");
1518 value = (double)(rmdir(tmps) >= 0);
1521 (void)strcpy(buf,"rmdir ");
1522 goto one_liner; /* see above in MKDIR */
1525 value = (double)getppid();
1532 anum = (int)str_gnum(st[1]);
1533 value = (double)getpgrp(anum);
1536 fatal("The getpgrp() function is unimplemented on this machine");
1541 argtype = (int)str_gnum(st[1]);
1542 anum = (int)str_gnum(st[2]);
1544 taintproper("Insecure dependency in setpgrp");
1546 value = (double)(setpgrp(argtype,anum) >= 0);
1549 fatal("The setpgrp() function is unimplemented on this machine");
1554 argtype = (int)str_gnum(st[1]);
1555 anum = (int)str_gnum(st[2]);
1556 value = (double)getpriority(argtype,anum);
1559 fatal("The getpriority() function is unimplemented on this machine");
1564 argtype = (int)str_gnum(st[1]);
1565 anum = (int)str_gnum(st[2]);
1566 optype = (int)str_gnum(st[3]);
1568 taintproper("Insecure dependency in setpriority");
1570 value = (double)(setpriority(argtype,anum,optype) >= 0);
1573 fatal("The setpriority() function is unimplemented on this machine");
1578 tmps = str_get(stab_val(defstab));
1580 tmps = str_get(st[1]);
1582 taintproper("Insecure dependency in chroot");
1584 value = (double)(chroot(tmps) >= 0);
1589 stab = last_in_stab;
1590 else if ((arg[1].arg_type & A_MASK) == A_WORD)
1591 stab = arg[1].arg_ptr.arg_stab;
1593 stab = stabent(str_get(st[1]),TRUE);
1594 argtype = (int)str_gnum(st[2]);
1596 taintproper("Insecure dependency in ioctl");
1598 anum = do_ctl(optype,stab,argtype,st[3]);
1603 str_set(str,"0 but true");
1609 stab = last_in_stab;
1610 else if ((arg[1].arg_type & A_MASK) == A_WORD)
1611 stab = arg[1].arg_ptr.arg_stab;
1613 stab = stabent(str_get(st[1]),TRUE);
1614 if (stab && stab_io(stab))
1615 fp = stab_io(stab)->ifp;
1619 argtype = (int)str_gnum(st[2]);
1620 value = (double)(flock(fileno(fp),argtype) >= 0);
1626 fatal("The flock() function is unimplemented on this machine");
1630 ary = stab_array(arg[1].arg_ptr.arg_stab);
1631 if (arglast[2] - arglast[1] != 1)
1632 do_unshift(ary,arglast);
1634 str = Str_new(52,0); /* must copy the STR */
1635 str_sset(str,st[2]);
1637 (void)astore(ary,0,str);
1639 value = (double)(ary->ary_fill + 1);
1644 tmpstr = stab_val(defstab);
1647 (arg[1].arg_type & A_MASK) != A_NULL ? st[1] : stab_val(defstab);
1649 tainted |= tmpstr->str_tainted;
1650 taintproper("Insecure dependency in eval");
1652 sp = do_eval(tmpstr, optype, arg[2].arg_ptr.arg_hash,
1680 if (mystat(arg,st[1]) < 0)
1682 if (cando(anum,argtype,&statcache))
1687 if (mystat(arg,st[1]) < 0)
1692 if (mystat(arg,st[1]) < 0)
1694 if (statcache.st_uid == (optype == O_FTEOWNED ? euid : uid) )
1698 if (mystat(arg,st[1]) < 0)
1700 if (!statcache.st_size)
1704 if (mystat(arg,st[1]) < 0)
1706 if (statcache.st_size)
1713 goto check_file_type;
1719 goto check_file_type;
1722 goto check_file_type;
1725 goto check_file_type;
1729 if (mystat(arg,st[1]) < 0)
1731 if ((statcache.st_mode & S_IFMT) == anum )
1737 goto check_file_type;
1743 if (lstat(str_get(st[1]),&statcache) < 0)
1745 if ((statcache.st_mode & S_IFMT) == S_IFLNK )
1751 tmps = str_get(st[1]);
1752 tmps2 = str_get(st[2]);
1754 taintproper("Insecure dependency in symlink");
1756 value = (double)(symlink(tmps,tmps2) >= 0);
1759 fatal("Unsupported function symlink()");
1764 tmps = str_get(stab_val(defstab));
1766 tmps = str_get(st[1]);
1767 anum = readlink(tmps,buf,sizeof buf);
1770 str_nset(str,buf,anum);
1773 fatal("Unsupported function readlink()");
1784 if (mystat(arg,st[1]) < 0)
1786 if (statcache.st_mode & anum)
1790 if (arg[1].arg_type & A_DONT) {
1791 stab = arg[1].arg_ptr.arg_stab;
1795 stab = stabent(tmps = str_get(st[1]),FALSE);
1796 if (stab && stab_io(stab) && stab_io(stab)->ifp)
1797 anum = fileno(stab_io(stab)->ifp);
1798 else if (isdigit(*tmps))
1807 str = do_fttext(arg,st[1]);
1811 if ((arg[1].arg_type & A_MASK) == A_WORD)
1812 stab = arg[1].arg_ptr.arg_stab;
1814 stab = stabent(str_get(st[1]),TRUE);
1816 value = (double)do_socket(stab,arglast);
1818 (void)do_socket(stab,arglast);
1822 if ((arg[1].arg_type & A_MASK) == A_WORD)
1823 stab = arg[1].arg_ptr.arg_stab;
1825 stab = stabent(str_get(st[1]),TRUE);
1827 value = (double)do_bind(stab,arglast);
1829 (void)do_bind(stab,arglast);
1833 if ((arg[1].arg_type & A_MASK) == A_WORD)
1834 stab = arg[1].arg_ptr.arg_stab;
1836 stab = stabent(str_get(st[1]),TRUE);
1838 value = (double)do_connect(stab,arglast);
1840 (void)do_connect(stab,arglast);
1844 if ((arg[1].arg_type & A_MASK) == A_WORD)
1845 stab = arg[1].arg_ptr.arg_stab;
1847 stab = stabent(str_get(st[1]),TRUE);
1849 value = (double)do_listen(stab,arglast);
1851 (void)do_listen(stab,arglast);
1855 if ((arg[1].arg_type & A_MASK) == A_WORD)
1856 stab = arg[1].arg_ptr.arg_stab;
1858 stab = stabent(str_get(st[1]),TRUE);
1859 if ((arg[2].arg_type & A_MASK) == A_WORD)
1860 stab2 = arg[2].arg_ptr.arg_stab;
1862 stab2 = stabent(str_get(st[2]),TRUE);
1863 do_accept(str,stab,stab2);
1871 sp = do_ghent(optype,
1879 sp = do_gnent(optype,
1887 sp = do_gpent(optype,
1895 sp = do_gsent(optype,
1899 value = (double) sethostent((int)str_gnum(st[1]));
1902 value = (double) setnetent((int)str_gnum(st[1]));
1905 value = (double) setprotoent((int)str_gnum(st[1]));
1908 value = (double) setservent((int)str_gnum(st[1]));
1911 value = (double) endhostent();
1914 value = (double) endnetent();
1917 value = (double) endprotoent();
1920 value = (double) endservent();
1923 sp = do_select(gimme,arglast);
1926 if ((arg[1].arg_type & A_MASK) == A_WORD)
1927 stab = arg[1].arg_ptr.arg_stab;
1929 stab = stabent(str_get(st[1]),TRUE);
1930 if ((arg[2].arg_type & A_MASK) == A_WORD)
1931 stab2 = arg[2].arg_ptr.arg_stab;
1933 stab2 = stabent(str_get(st[2]),TRUE);
1935 value = (double)do_spair(stab,stab2,arglast);
1937 (void)do_spair(stab,stab2,arglast);
1941 if ((arg[1].arg_type & A_MASK) == A_WORD)
1942 stab = arg[1].arg_ptr.arg_stab;
1944 stab = stabent(str_get(st[1]),TRUE);
1946 value = (double)do_shutdown(stab,arglast);
1948 (void)do_shutdown(stab,arglast);
1953 if ((arg[1].arg_type & A_MASK) == A_WORD)
1954 stab = arg[1].arg_ptr.arg_stab;
1956 stab = stabent(str_get(st[1]),TRUE);
1957 sp = do_sopt(optype,stab,arglast);
1961 if ((arg[1].arg_type & A_MASK) == A_WORD)
1962 stab = arg[1].arg_ptr.arg_stab;
1964 stab = stabent(str_get(st[1]),TRUE);
1965 sp = do_getsockname(optype,stab,arglast);
1968 #else /* SOCKET not defined */
2002 fatal("Unsupported socket function");
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 (!stab || !(stio = stab_io(stab)) || !(fp = stio->ifp))
2016 sp = do_vec(str == st[1], arg->arg_ptr.arg_str, arglast);
2021 sp = do_gpwent(optype,
2025 value = (double) setpwent();
2028 value = (double) endpwent();
2033 sp = do_ggrent(optype,
2037 value = (double) setgrent();
2040 value = (double) endgrent();
2043 if (!(tmps = getlogin()))
2055 if ((arg[1].arg_type & A_MASK) == A_WORD)
2056 stab = arg[1].arg_ptr.arg_stab;
2058 stab = stabent(str_get(st[1]),TRUE);
2059 sp = do_dirop(optype,stab,gimme,arglast);
2062 value = (double)do_syscall(arglast);
2072 deb("%s RETURNS \"%s\"\n",opname[optype],str_get(str));
2075 return arglast[0] + 1;
2082 deb("%s RETURNS ARRAY OF %d ARGS\n",opname[optype],sp - arglast[0]);
2104 str_numset(str,value);
2111 deb("%s RETURNS \"%f\"\n",opname[optype],value);
2114 return arglast[0] + 1;