1 /* $Header: eval.c,v 3.0.1.3 89/12/21 20:03:05 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.3 89/12/21 20:03:05 lwall
10 * patch7: errno may now be a macro with an lvalue
11 * patch7: ANSI strerror() is now supported
12 * patch7: send() didn't allow a TO argument
13 * patch7: ord() now always returns positive even on signed char machines
15 * Revision 3.0.1.2 89/11/17 15:19:34 lwall
16 * patch5: constant numeric subscripts get lost inside ?:
18 * Revision 3.0.1.1 89/11/11 04:31:51 lwall
19 * patch2: mkdir and rmdir needed to quote argument when passed to shell
20 * patch2: mkdir and rmdir now return better error codes
21 * patch2: fileno, seekdir, rewinddir and closedir now disallow defaults
23 * Revision 3.0 89/10/18 15:17:04 lwall
38 static void (*ihand)();
39 static void (*qhand)();
41 static int (*ihand)();
42 static int (*qhand)();
49 static struct lstring *lstr;
50 static char old_record_separator;
52 double sin(), cos(), atan2(), pow();
73 int arglast[8]; /* highest sp for arg--valid only for non-O_LIST args */
74 unsigned long tmplong;
81 bool assigning = FALSE;
82 double exp(), log(), sqrt(), modf();
83 char *crypt(), *getenv();
84 extern void grow_dlevel();
88 optype = arg->arg_type;
89 maxarg = arg->arg_len;
91 str = arg->arg_ptr.arg_str;
92 if (sp + maxarg > stack->ary_max)
93 astore(stack, sp + maxarg, Nullstr);
94 st = stack->ary_array;
99 deb("%s (%lx) %d args:\n",opname[optype],arg,maxarg);
101 debname[dlevel] = opname[optype][0];
102 debdelim[dlevel] = ':';
103 if (++dlevel >= dlmax)
108 #include "evalargs.xc"
116 if (gimme == G_ARRAY)
122 if (gimme == G_ARRAY)
125 STR_SSET(str,st[arglast[anum]-arglast[0]]);
129 if (gimme == G_ARRAY)
132 STR_SSET(str,st[arglast[anum]-arglast[0]]);
142 anum = (int)str_gnum(st[2]);
144 tmpstr = Str_new(50,0);
145 str_sset(tmpstr,str);
147 str_scat(str,tmpstr);
150 str_sset(str,&str_no);
154 sp = do_match(str,arg,
156 if (gimme == G_ARRAY)
161 sp = do_match(str,arg,
163 if (gimme == G_ARRAY)
165 str_sset(str, str_true(str) ? &str_no : &str_yes);
169 sp = do_subst(str,arg,arglast[0]);
172 sp = do_subst(str,arg,arglast[0]);
173 str = arg->arg_ptr.arg_str;
174 str_set(str, str_true(str) ? No : Yes);
177 if (arg[1].arg_flags & AF_ARYOK) {
178 if (arg->arg_len == 1) {
179 arg->arg_type = O_LOCAL;
183 arg->arg_type = O_AASSIGN;
188 arg->arg_type = O_SASSIGN;
193 arglast[2] = arglast[1]; /* push a null array */
202 STR_SSET(str, st[2]);
207 str = arg->arg_ptr.arg_str;
208 for (sp = arglast[0] + 1; sp <= arglast[1]; sp++)
213 if (arg[1].arg_type & A_DONT) {
214 sp = do_defined(str,arg,
218 else if (str->str_pok || str->str_nok)
222 if (arg[1].arg_type & A_DONT) {
223 sp = do_undef(str,arg,
227 else if (str != stab_val(defstab)) {
228 str->str_pok = str->str_nok = 0;
233 sp = do_study(str,arg,
237 value = str_gnum(st[1]);
238 value = pow(value,str_gnum(st[2]));
241 value = str_gnum(st[1]);
242 value *= str_gnum(st[2]);
245 if ((value = str_gnum(st[2])) == 0.0)
246 fatal("Illegal division by zero");
247 value = str_gnum(st[1]) / value;
250 tmplong = (long) str_gnum(st[2]);
252 fatal("Illegal modulus zero");
253 when = (long)str_gnum(st[1]);
256 value = (double)(when % tmplong);
258 value = (double)(tmplong - (-when % tmplong));
262 value = str_gnum(st[1]);
263 value += str_gnum(st[2]);
266 value = str_gnum(st[1]);
267 value -= str_gnum(st[2]);
270 value = str_gnum(st[1]);
271 anum = (int)str_gnum(st[2]);
273 value = (double)(((long)value) << anum);
277 value = str_gnum(st[1]);
278 anum = (int)str_gnum(st[2]);
280 value = (double)(((long)value) >> anum);
284 value = str_gnum(st[1]);
285 value = (value < str_gnum(st[2])) ? 1.0 : 0.0;
288 value = str_gnum(st[1]);
289 value = (value > str_gnum(st[2])) ? 1.0 : 0.0;
292 value = str_gnum(st[1]);
293 value = (value <= str_gnum(st[2])) ? 1.0 : 0.0;
296 value = str_gnum(st[1]);
297 value = (value >= str_gnum(st[2])) ? 1.0 : 0.0;
301 if ((!st[1]->str_nok && !looks_like_number(st[1])) ||
302 (!st[2]->str_nok && !looks_like_number(st[2])) )
303 warn("Possible use of == on string value");
305 value = str_gnum(st[1]);
306 value = (value == str_gnum(st[2])) ? 1.0 : 0.0;
309 value = str_gnum(st[1]);
310 value = (value != str_gnum(st[2])) ? 1.0 : 0.0;
313 if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
314 value = str_gnum(st[1]);
316 value = (double)(((long)value) & (long)str_gnum(st[2]));
321 do_vop(optype,str,st[1],st[2]);
324 if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
325 value = str_gnum(st[1]);
327 value = (double)(((long)value) ^ (long)str_gnum(st[2]));
332 do_vop(optype,str,st[1],st[2]);
335 if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
336 value = str_gnum(st[1]);
338 value = (double)(((long)value) | (long)str_gnum(st[2]));
343 do_vop(optype,str,st[1],st[2]);
345 /* use register in evaluating str_true() */
347 if (str_true(st[1])) {
350 argflags = arg[anum].arg_flags;
351 if (gimme == G_ARRAY)
352 argflags |= AF_ARYOK;
353 argtype = arg[anum].arg_type & A_MASK;
354 argptr = arg[anum].arg_ptr;
362 str_sset(str, st[1]);
370 if (str_true(st[1])) {
372 str_sset(str, st[1]);
382 argflags = arg[anum].arg_flags;
383 if (gimme == G_ARRAY)
384 argflags |= AF_ARYOK;
385 argtype = arg[anum].arg_type & A_MASK;
386 argptr = arg[anum].arg_ptr;
393 anum = (str_true(st[1]) ? 2 : 3);
394 optype = (anum == 2 ? O_ITEM2 : O_ITEM3);
395 argflags = arg[anum].arg_flags;
396 if (gimme == G_ARRAY)
397 argflags |= AF_ARYOK;
398 argtype = arg[anum].arg_type & A_MASK;
399 argptr = arg[anum].arg_ptr;
405 if (gimme == G_ARRAY)
410 value = -str_gnum(st[1]);
413 value = (double) !str_true(st[1]);
417 value = (double) ~(long)str_gnum(st[1]);
421 tmps = stab_name(defoutstab);
423 if ((arg[1].arg_type & A_MASK) == A_WORD)
424 defoutstab = arg[1].arg_ptr.arg_stab;
426 defoutstab = stabent(str_get(st[1]),TRUE);
427 if (!stab_io(defoutstab))
428 stab_io(defoutstab) = stio_new();
429 curoutstab = defoutstab;
437 else if ((arg[1].arg_type & A_MASK) == A_WORD) {
438 if (!(stab = arg[1].arg_ptr.arg_stab))
442 stab = stabent(str_get(st[1]),TRUE);
443 if (!stab_io(stab)) {
449 fp = stab_io(stab)->ofp;
451 if (stab_io(stab)->fmt_stab)
452 form = stab_form(stab_io(stab)->fmt_stab);
454 form = stab_form(stab);
458 warn("No format for filehandle");
460 if (stab_io(stab)->ifp)
461 warn("Filehandle only opened for input");
463 warn("Write on closed filehandle");
470 format(&outrec,form,sp);
471 do_write(&outrec,stab_io(stab),sp);
472 if (stab_io(stab)->flags & IOF_FLUSH)
479 if ((arg[1].arg_type & A_MASK) == A_WORD)
480 stab = arg[1].arg_ptr.arg_stab;
482 stab = stabent(str_get(st[1]),TRUE);
483 anum = (int)str_gnum(st[3]);
484 value = (double)hdbmopen(stab_hash(stab),str_get(st[2]),anum);
487 fatal("No dbm or ndbm on this machine");
491 if ((arg[1].arg_type & A_MASK) == A_WORD)
492 stab = arg[1].arg_ptr.arg_stab;
494 stab = stabent(str_get(st[1]),TRUE);
495 hdbmclose(stab_hash(stab));
498 fatal("No dbm or ndbm on this machine");
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 if (do_open(stab,str_get(st[2]))) {
506 value = (double)forkprocess;
507 stab_io(stab)->lines = 0;
514 value = (double) do_trans(str,arg);
515 str = arg->arg_ptr.arg_str;
518 str_set(arg->arg_ptr.arg_str, do_trans(str,arg) == 0 ? Yes : No);
519 str = arg->arg_ptr.arg_str;
524 else if ((arg[1].arg_type & A_MASK) == A_WORD)
525 stab = arg[1].arg_ptr.arg_stab;
527 stab = stabent(str_get(st[1]),TRUE);
528 str_set(str, do_close(stab,TRUE) ? Yes : No );
532 sp = do_each(str,stab_hash(arg[1].arg_ptr.arg_stab),
537 sp = do_kv(str,stab_hash(arg[1].arg_ptr.arg_stab), optype,
541 str->str_nok = str->str_pok = 0;
542 str->str_u.str_stab = arg[1].arg_ptr.arg_stab;
543 str->str_state = SS_ARY;
546 ary = stab_array(arg[1].arg_ptr.arg_stab);
547 maxarg = ary->ary_fill + 1;
548 if (gimme == G_ARRAY) { /* array wanted */
551 if (maxarg > 0 && sp + maxarg > stack->ary_max) {
552 astore(stack,sp + maxarg, Nullstr);
553 st = stack->ary_array;
555 Copy(ary->ary_array, &st[sp+1], maxarg, STR*);
560 str = afetch(ary,maxarg - 1,FALSE);
563 anum = ((int)str_gnum(st[2])) - arybase;
564 str = afetch(stab_array(arg[1].arg_ptr.arg_stab),anum,FALSE);
569 tmpstab = arg[1].arg_ptr.arg_stab;
570 tmps = str_get(st[2]);
571 str = hdelete(stab_hash(tmpstab),tmps,st[2]->str_cur);
572 if (tmpstab == envstab)
578 str->str_nok = str->str_pok = 0;
579 str->str_u.str_stab = arg[1].arg_ptr.arg_stab;
580 str->str_state = SS_HASH;
583 if (gimme == G_ARRAY) { /* array wanted */
584 sp = do_kv(str,stab_hash(arg[1].arg_ptr.arg_stab), optype,
589 tmpstab = arg[1].arg_ptr.arg_stab;
590 sprintf(buf,"%d/%d",stab_hash(tmpstab)->tbl_fill,
591 stab_hash(tmpstab)->tbl_max+1);
596 tmpstab = arg[1].arg_ptr.arg_stab;
597 tmps = str_get(st[2]);
598 str = hfetch(stab_hash(tmpstab),tmps,st[2]->str_cur,FALSE);
603 anum = ((int)str_gnum(st[2])) - arybase;
604 str = afetch(stab_array(arg[1].arg_ptr.arg_stab),anum,TRUE);
606 fatal("Assignment to non-creatable value, subscript %d",anum);
609 tmpstab = arg[1].arg_ptr.arg_stab;
610 tmps = str_get(st[2]);
611 anum = st[2]->str_cur;
612 str = hfetch(stab_hash(tmpstab),tmps,anum,TRUE);
614 fatal("Assignment to non-creatable value, subscript \"%s\"",tmps);
615 if (tmpstab == envstab) /* heavy wizardry going on here */
616 str_magic(str, tmpstab, 'E', tmps, anum); /* str is now magic */
617 /* he threw the brick up into the air */
618 else if (tmpstab == sigstab)
619 str_magic(str, tmpstab, 'S', tmps, anum);
621 else if (stab_hash(tmpstab)->tbl_dbm)
622 str_magic(str, tmpstab, 'D', tmps, anum);
628 goto do_slice_already;
632 goto do_slice_already;
636 goto do_slice_already;
641 sp = do_slice(arg[1].arg_ptr.arg_stab,anum,argtype,
645 if (arglast[2] - arglast[1] != 1)
646 str = do_push(stab_array(arg[1].arg_ptr.arg_stab),arglast);
648 str = Str_new(51,0); /* must copy the STR */
650 (void)apush(stab_array(arg[1].arg_ptr.arg_stab),str);
654 str = apop(ary = stab_array(arg[1].arg_ptr.arg_stab));
655 goto staticalization;
657 str = ashift(ary = stab_array(arg[1].arg_ptr.arg_stab));
661 if (ary->ary_flags & ARF_REAL)
662 (void)str_2static(str);
665 sp = do_unpack(str,gimme,arglast);
668 value = str_gnum(st[3]);
669 sp = do_split(str, arg[2].arg_ptr.arg_spat, (int)value,
674 value = (double)str_len(stab_val(defstab));
676 value = (double)str_len(st[1]);
679 do_sprintf(str, sp-arglast[0], st+1);
682 anum = ((int)str_gnum(st[2])) - arybase; /* anum=where to start*/
683 tmps = str_get(st[1]); /* force conversion to string */
684 if (argtype = (str == st[1]))
685 str = arg->arg_ptr.arg_str;
687 anum += st[1]->str_cur + arybase;
688 if (anum < 0 || anum > st[1]->str_cur)
691 optype = (int)str_gnum(st[3]);
695 anum = st[1]->str_cur - anum; /* anum=how many bytes left*/
698 str_nset(str, tmps, anum);
699 if (argtype) { /* it's an lvalue! */
700 lstr = (struct lstring*)str;
701 str->str_magic = st[1];
702 st[1]->str_rare = 's';
703 lstr->lstr_offset = tmps - str_get(st[1]);
704 lstr->lstr_len = anum;
709 (void)do_pack(str,arglast);
712 sp = do_grep(arg,str,gimme,arglast);
715 do_join(str,arglast);
718 tmps = str_get(st[1]);
719 value = (double) (str_cmp(st[1],st[2]) < 0);
722 tmps = str_get(st[1]);
723 value = (double) (str_cmp(st[1],st[2]) > 0);
726 tmps = str_get(st[1]);
727 value = (double) (str_cmp(st[1],st[2]) <= 0);
730 tmps = str_get(st[1]);
731 value = (double) (str_cmp(st[1],st[2]) >= 0);
734 tmps = str_get(st[1]);
735 value = (double) str_eq(st[1],st[2]);
738 tmps = str_get(st[1]);
739 value = (double) !str_eq(st[1],st[2]);
742 sp = do_subr(arg,gimme,arglast);
743 st = stack->ary_array + arglast[0]; /* maybe realloced */
746 sp = do_dbsubr(arg,gimme,arglast);
747 st = stack->ary_array + arglast[0]; /* maybe realloced */
750 if ((arg[1].arg_type & A_MASK) == A_WORD)
751 stab = arg[1].arg_ptr.arg_stab;
753 stab = stabent(str_get(st[1]),TRUE);
756 sp = do_sort(str,stab,
764 if (arglast[2] - arglast[1] != 1) {
765 do_join(str,arglast);
766 tmps = str_get(st[1]);
770 tmps = str_get(st[2]);
773 tmps = "Warning: something's wrong";
777 if (arglast[2] - arglast[1] != 1) {
778 do_join(str,arglast);
779 tmps = str_get(st[1]);
783 tmps = str_get(st[2]);
791 if ((arg[1].arg_type & A_MASK) == A_WORD)
792 stab = arg[1].arg_ptr.arg_stab;
794 stab = stabent(str_get(st[1]),TRUE);
797 if (!stab_io(stab)) {
799 warn("Filehandle never opened");
802 if (!(fp = stab_io(stab)->ofp)) {
804 if (stab_io(stab)->ifp)
805 warn("Filehandle opened only for input");
807 warn("Print on closed filehandle");
812 if (optype == O_PRTF || arglast[2] - arglast[1] != 1)
813 value = (double)do_aprint(arg,fp,arglast);
815 value = (double)do_print(st[2],fp);
816 if (orslen && optype == O_PRINT)
817 if (fwrite(ors, 1, orslen, fp) == 0)
820 if (stab_io(stab)->flags & IOF_FLUSH)
821 if (fflush(fp) == EOF)
827 tmps = str_get(stab_val(defstab));
829 tmps = str_get(st[1]);
830 if (!tmps || !*tmps) {
831 tmpstr = hfetch(stab_hash(envstab),"HOME",4,FALSE);
833 tmps = str_get(tmpstr);
835 if (!tmps || !*tmps) {
836 tmpstr = hfetch(stab_hash(envstab),"LOGDIR",6,FALSE);
838 tmps = str_get(tmpstr);
841 taintproper("Insecure dependency in chdir");
843 value = (double)(chdir(tmps) >= 0);
849 anum = (int)str_gnum(st[1]);
856 tmps = str_get(st[1]);
857 str_reset(tmps,arg[2].arg_ptr.arg_hash);
861 if (gimme == G_ARRAY)
864 str = st[sp - arglast[0]]; /* unwanted list, return last item */
871 else if ((arg[1].arg_type & A_MASK) == A_WORD)
872 stab = arg[1].arg_ptr.arg_stab;
874 stab = stabent(str_get(st[1]),TRUE);
875 str_set(str, do_eof(stab) ? Yes : No);
881 else if ((arg[1].arg_type & A_MASK) == A_WORD)
882 stab = arg[1].arg_ptr.arg_stab;
884 stab = stabent(str_get(st[1]),TRUE);
885 if (do_eof(stab)) /* make sure we have fp with something */
892 *str->str_ptr = getc(stab_io(stab)->ifp); /* should never be EOF */
899 else if ((arg[1].arg_type & A_MASK) == A_WORD)
900 stab = arg[1].arg_ptr.arg_stab;
902 stab = stabent(str_get(st[1]),TRUE);
904 value = (double)do_tell(stab);
911 if ((arg[1].arg_type & A_MASK) == A_WORD)
912 stab = arg[1].arg_ptr.arg_stab;
914 stab = stabent(str_get(st[1]),TRUE);
915 tmps = str_get(st[2]);
916 anum = (int)str_gnum(st[3]);
917 STR_GROW(st[2], anum+1), (tmps = str_get(st[2])); /* sneaky */
919 if (!stab_io(stab) || !stab_io(stab)->ifp)
922 else if (optype == O_RECV) {
923 argtype = sizeof buf;
924 optype = (int)str_gnum(st[4]);
925 anum = recvfrom(fileno(stab_io(stab)->ifp), tmps, anum, optype,
928 st[2]->str_cur = anum;
929 st[2]->str_ptr[anum] = '\0';
930 str_nset(str,buf,argtype);
933 str_sset(str,&str_undef);
936 else if (stab_io(stab)->type == 's') {
937 argtype = sizeof buf;
938 anum = recvfrom(fileno(stab_io(stab)->ifp), tmps, anum, 0,
942 else if (optype == O_RECV)
946 anum = fread(tmps, 1, anum, stab_io(stab)->ifp);
949 st[2]->str_cur = anum;
950 st[2]->str_ptr[anum] = '\0';
951 value = (double)anum;
955 if ((arg[1].arg_type & A_MASK) == A_WORD)
956 stab = arg[1].arg_ptr.arg_stab;
958 stab = stabent(str_get(st[1]),TRUE);
959 tmps = str_get(st[2]);
960 anum = (int)str_gnum(st[3]);
961 optype = sp - arglast[0];
964 warn("Too many args on send");
965 stio = stab_io(stab);
966 if (!stio || !stio->ifp) {
969 warn("Send on closed socket");
971 else if (optype >= 4) {
972 tmps2 = str_get(st[4]);
973 anum = sendto(fileno(stab_io(stab)->ifp), tmps, st[2]->str_cur,
974 anum, tmps2, st[4]->str_cur);
977 anum = send(fileno(stab_io(stab)->ifp), tmps, st[2]->str_cur, anum);
980 value = (double)anum;
986 if ((arg[1].arg_type & A_MASK) == A_WORD)
987 stab = arg[1].arg_ptr.arg_stab;
989 stab = stabent(str_get(st[1]),TRUE);
990 value = str_gnum(st[2]);
991 str_set(str, do_seek(stab,
992 (long)value, (int)str_gnum(st[3]) ) ? Yes : No);
996 tmps = "SUB"; /* just fake up a "last SUB" */
998 if (gimme == G_ARRAY) {
999 lastretstr = Nullstr;
1000 lastspbase = arglast[1];
1001 lastsize = arglast[2] - arglast[1];
1004 lastretstr = str_static(st[arglast[2] - arglast[0]]);
1010 tmps = str_get(arg[1].arg_ptr.arg_str);
1012 while (loop_ptr >= 0 && (!loop_stack[loop_ptr].loop_label ||
1013 strNE(tmps,loop_stack[loop_ptr].loop_label) )) {
1016 deb("(Skipping label #%d %s)\n",loop_ptr,
1017 loop_stack[loop_ptr].loop_label);
1024 deb("(Found label #%d %s)\n",loop_ptr,
1025 loop_stack[loop_ptr].loop_label);
1030 fatal("Bad label: %s", maxarg > 0 ? tmps : "<null>");
1031 if (!lastretstr && optype == O_LAST && lastsize) {
1033 st += lastspbase + 1;
1034 optype = loop_stack[loop_ptr].loop_sp - lastspbase; /* negative */
1036 for (anum = lastsize; anum > 0; anum--,st++)
1037 st[optype] = str_static(st[0]);
1039 longjmp(loop_stack[loop_ptr].loop_env, O_LAST);
1041 longjmp(loop_stack[loop_ptr].loop_env, optype);
1043 case O_GOTO:/* shudder */
1044 goto_targ = str_get(arg[1].arg_ptr.arg_str);
1046 goto_targ = Nullch; /* just restart from top */
1047 if (optype == O_DUMP) {
1051 longjmp(top_env, 1);
1053 tmps = str_get(st[1]);
1055 if (!(tmps2 = fbminstr((unsigned char*)tmps,
1056 (unsigned char*)tmps + st[1]->str_cur, st[2])))
1058 if (tmps2 = fbminstr(Null(unsigned char*),Null(unsigned char*),Nullstr))
1060 value = (double)(-1 + arybase);
1062 value = (double)(tmps2 - tmps + arybase);
1065 tmps = str_get(st[1]);
1066 tmps2 = str_get(st[2]);
1068 if (!(tmps2 = rninstr(tmps, tmps + st[1]->str_cur,
1069 tmps2, tmps2 + st[2]->str_cur)))
1071 if (tmps2 = rninstr(Nullch,Nullch,Nullch,Nullch))
1073 value = (double)(-1 + arybase);
1075 value = (double)(tmps2 - tmps + arybase);
1079 value = (double) time(Null(long*));
1083 sp = do_tms(str,gimme,arglast);
1089 when = (long)str_gnum(st[1]);
1090 sp = do_time(str,localtime(&when),
1097 when = (long)str_gnum(st[1]);
1098 sp = do_time(str,gmtime(&when),
1103 sp = do_stat(str,arg,
1108 tmps = str_get(st[1]);
1110 str_set(str,fcrypt(tmps,str_get(st[2])));
1112 str_set(str,crypt(tmps,str_get(st[2])));
1116 "The crypt() function is unimplemented due to excessive paranoia.");
1120 value = str_gnum(st[1]);
1121 value = atan2(value,str_gnum(st[2]));
1125 value = str_gnum(stab_val(defstab));
1127 value = str_gnum(st[1]);
1132 value = str_gnum(stab_val(defstab));
1134 value = str_gnum(st[1]);
1141 value = str_gnum(st[1]);
1145 value = rand() * value / 2147483648.0;
1148 value = rand() * value / 65536.0;
1151 value = rand() * value / 32768.0;
1153 value = rand() * value / (double)(((unsigned long)1) << RANDBITS);
1164 anum = (int)str_gnum(st[1]);
1169 value = str_gnum(stab_val(defstab));
1171 value = str_gnum(st[1]);
1176 value = str_gnum(stab_val(defstab));
1178 value = str_gnum(st[1]);
1183 value = str_gnum(stab_val(defstab));
1185 value = str_gnum(st[1]);
1186 value = sqrt(value);
1190 value = str_gnum(stab_val(defstab));
1192 value = str_gnum(st[1]);
1194 (void)modf(value,&value);
1196 (void)modf(-value,&value);
1202 tmps = str_get(stab_val(defstab));
1204 tmps = str_get(st[1]);
1206 value = (double) (*tmps & 255);
1209 value = (double) (anum & 255);
1216 tmps = str_get(st[1]);
1218 if (!tmps || !*tmps)
1219 sleep((32767<<16)+32767);
1221 sleep((unsigned int)atoi(tmps));
1223 value = (double)when;
1225 value = ((double)when) - value;
1229 sp = do_range(gimme,arglast);
1232 if (gimme == G_ARRAY) { /* it's a range */
1233 /* can we optimize to constant array? */
1234 if ((arg[1].arg_type & A_MASK) == A_SINGLE &&
1235 (arg[2].arg_type & A_MASK) == A_SINGLE) {
1236 st[2] = arg[2].arg_ptr.arg_str;
1237 sp = do_range(gimme,arglast);
1238 st = stack->ary_array;
1239 maxarg = sp - arglast[0];
1240 str_free(arg[1].arg_ptr.arg_str);
1241 str_free(arg[2].arg_ptr.arg_str);
1242 arg->arg_type = O_ARRAY;
1243 arg[1].arg_type = A_STAB|A_DONT;
1245 stab = arg[1].arg_ptr.arg_stab = aadd(genstab());
1246 ary = stab_array(stab);
1247 afill(ary,maxarg - 1);
1249 while (maxarg-- > 0)
1250 ary->ary_array[maxarg] = str_smake(st[maxarg]);
1253 arg->arg_type = optype = O_RANGE;
1254 maxarg = arg->arg_len = 2;
1256 arg[anum].arg_flags &= ~AF_ARYOK;
1257 argflags = arg[anum].arg_flags;
1258 argtype = arg[anum].arg_type & A_MASK;
1259 arg[anum].arg_type = argtype;
1260 argptr = arg[anum].arg_ptr;
1266 arg->arg_type = O_FLIP;
1269 if ((arg[1].arg_type & A_MASK) == A_SINGLE ?
1270 last_in_stab && (int)str_gnum(st[1]) == stab_io(last_in_stab)->lines
1273 str_numset(str,0.0);
1275 arg->arg_type = optype = O_FLOP;
1276 arg[2].arg_type &= ~A_DONT;
1277 arg[1].arg_type |= A_DONT;
1278 argflags = arg[2].arg_flags;
1279 argtype = arg[2].arg_type & A_MASK;
1280 argptr = arg[2].arg_ptr;
1289 if ((arg[2].arg_type & A_MASK) == A_SINGLE ?
1290 last_in_stab && (int)str_gnum(st[2]) == stab_io(last_in_stab)->lines
1293 arg->arg_type = O_FLIP;
1294 arg[1].arg_type &= ~A_DONT;
1295 arg[2].arg_type |= A_DONT;
1301 if (!anum && (tmpstab = stabent("$",allstabs)))
1302 str_numset(STAB_STR(tmpstab),(double)getpid());
1303 value = (double)anum;
1307 ihand = signal(SIGINT, SIG_IGN);
1308 qhand = signal(SIGQUIT, SIG_IGN);
1309 anum = wait(&argflags);
1311 pidgone(anum,argflags);
1312 value = (double)anum;
1316 (void)signal(SIGINT, ihand);
1317 (void)signal(SIGQUIT, qhand);
1318 statusvalue = (unsigned short)argflags;
1322 if (arglast[2] - arglast[1] == 1) {
1324 tainted |= st[2]->str_tainted;
1325 taintproper("Insecure dependency in system");
1328 while ((anum = vfork()) == -1) {
1329 if (errno != EAGAIN) {
1337 ihand = signal(SIGINT, SIG_IGN);
1338 qhand = signal(SIGQUIT, SIG_IGN);
1339 while ((argtype = wait(&argflags)) != anum && argtype >= 0)
1340 pidgone(argtype,argflags);
1344 (void)signal(SIGINT, ihand);
1345 (void)signal(SIGQUIT, qhand);
1346 statusvalue = (unsigned short)argflags;
1350 value = (double)((unsigned int)argflags & 0xffff);
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])));
1363 if ((arg[1].arg_type & A_MASK) == A_STAB)
1364 value = (double)do_aexec(st[1],arglast);
1365 else if (arglast[2] - arglast[1] != 1)
1366 value = (double)do_aexec(Nullstr,arglast);
1368 value = (double)do_exec(str_get(str_static(st[2])));
1381 tmps = str_get(stab_val(defstab));
1383 tmps = str_get(st[1]);
1392 case '0': case '1': case '2': case '3': case '4':
1393 case '5': case '6': case '7':
1395 anum += *tmps++ & 15;
1397 case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
1398 case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
1402 anum += (*tmps++ & 7) + 9;
1411 value = (double)anum;
1418 value = (double)apply(optype,arglast);
1426 anum = umask((int)str_gnum(st[1]));
1427 value = (double)anum;
1429 taintproper("Insecure dependency in umask");
1433 tmps = str_get(st[1]);
1434 tmps2 = str_get(st[2]);
1436 taintproper("Insecure dependency in rename");
1439 value = (double)(rename(tmps,tmps2) >= 0);
1441 if (euid || stat(tmps2,&statbuf) < 0 ||
1442 (statbuf.st_mode & S_IFMT) != S_IFDIR )
1443 (void)UNLINK(tmps2); /* avoid unlinking a directory */
1444 if (!(anum = link(tmps,tmps2)))
1445 anum = UNLINK(tmps);
1446 value = (double)(anum >= 0);
1450 tmps = str_get(st[1]);
1451 tmps2 = str_get(st[2]);
1453 taintproper("Insecure dependency in link");
1455 value = (double)(link(tmps,tmps2) >= 0);
1458 tmps = str_get(st[1]);
1459 anum = (int)str_gnum(st[2]);
1461 taintproper("Insecure dependency in mkdir");
1464 value = (double)(mkdir(tmps,anum) >= 0);
1467 (void)strcpy(buf,"mkdir ");
1469 #if !defined(MKDIR) || !defined(RMDIR)
1471 for (tmps2 = buf+6; *tmps; ) {
1475 (void)strcpy(tmps2," 2>&1");
1476 rsfp = mypopen(buf,"r");
1479 tmps2 = fgets(buf,sizeof buf,rsfp);
1480 (void)mypclose(rsfp);
1481 if (tmps2 != Nullch) {
1482 for (errno = 1; errno < sys_nerr; errno++) {
1483 if (instr(buf,sys_errlist[errno])) /* you don't see this */
1488 #define EACCES EPERM
1490 if (instr(buf,"cannot make"))
1492 else if (instr(buf,"non-exist"))
1494 else if (instr(buf,"not empty"))
1496 else if (instr(buf,"cannot access"))
1502 else { /* some mkdirs return no failure indication */
1503 tmps = str_get(st[1]);
1504 anum = (stat(tmps,&statbuf) >= 0);
1505 if (optype == O_RMDIR)
1510 errno = EACCES; /* a guess */
1511 value = (double)anum;
1520 tmps = str_get(stab_val(defstab));
1522 tmps = str_get(st[1]);
1524 taintproper("Insecure dependency in rmdir");
1527 value = (double)(rmdir(tmps) >= 0);
1530 (void)strcpy(buf,"rmdir ");
1531 goto one_liner; /* see above in MKDIR */
1534 value = (double)getppid();
1541 anum = (int)str_gnum(st[1]);
1542 value = (double)getpgrp(anum);
1545 fatal("The getpgrp() function is unimplemented on this machine");
1550 argtype = (int)str_gnum(st[1]);
1551 anum = (int)str_gnum(st[2]);
1553 taintproper("Insecure dependency in setpgrp");
1555 value = (double)(setpgrp(argtype,anum) >= 0);
1558 fatal("The setpgrp() function is unimplemented on this machine");
1563 argtype = (int)str_gnum(st[1]);
1564 anum = (int)str_gnum(st[2]);
1565 value = (double)getpriority(argtype,anum);
1568 fatal("The getpriority() function is unimplemented on this machine");
1573 argtype = (int)str_gnum(st[1]);
1574 anum = (int)str_gnum(st[2]);
1575 optype = (int)str_gnum(st[3]);
1577 taintproper("Insecure dependency in setpriority");
1579 value = (double)(setpriority(argtype,anum,optype) >= 0);
1582 fatal("The setpriority() function is unimplemented on this machine");
1587 tmps = str_get(stab_val(defstab));
1589 tmps = str_get(st[1]);
1591 taintproper("Insecure dependency in chroot");
1593 value = (double)(chroot(tmps) >= 0);
1598 stab = last_in_stab;
1599 else if ((arg[1].arg_type & A_MASK) == A_WORD)
1600 stab = arg[1].arg_ptr.arg_stab;
1602 stab = stabent(str_get(st[1]),TRUE);
1603 argtype = (int)str_gnum(st[2]);
1605 taintproper("Insecure dependency in ioctl");
1607 anum = do_ctl(optype,stab,argtype,st[3]);
1612 str_set(str,"0 but true");
1618 stab = last_in_stab;
1619 else if ((arg[1].arg_type & A_MASK) == A_WORD)
1620 stab = arg[1].arg_ptr.arg_stab;
1622 stab = stabent(str_get(st[1]),TRUE);
1623 if (stab && stab_io(stab))
1624 fp = stab_io(stab)->ifp;
1628 argtype = (int)str_gnum(st[2]);
1629 value = (double)(flock(fileno(fp),argtype) >= 0);
1635 fatal("The flock() function is unimplemented on this machine");
1639 ary = stab_array(arg[1].arg_ptr.arg_stab);
1640 if (arglast[2] - arglast[1] != 1)
1641 do_unshift(ary,arglast);
1643 str = Str_new(52,0); /* must copy the STR */
1644 str_sset(str,st[2]);
1646 (void)astore(ary,0,str);
1648 value = (double)(ary->ary_fill + 1);
1653 tmpstr = stab_val(defstab);
1656 (arg[1].arg_type & A_MASK) != A_NULL ? st[1] : stab_val(defstab);
1658 tainted |= tmpstr->str_tainted;
1659 taintproper("Insecure dependency in eval");
1661 sp = do_eval(tmpstr, optype, arg[2].arg_ptr.arg_hash,
1689 if (mystat(arg,st[1]) < 0)
1691 if (cando(anum,argtype,&statcache))
1696 if (mystat(arg,st[1]) < 0)
1701 if (mystat(arg,st[1]) < 0)
1703 if (statcache.st_uid == (optype == O_FTEOWNED ? euid : uid) )
1707 if (mystat(arg,st[1]) < 0)
1709 if (!statcache.st_size)
1713 if (mystat(arg,st[1]) < 0)
1715 if (statcache.st_size)
1722 goto check_file_type;
1728 goto check_file_type;
1731 goto check_file_type;
1734 goto check_file_type;
1738 if (mystat(arg,st[1]) < 0)
1740 if ((statcache.st_mode & S_IFMT) == anum )
1746 goto check_file_type;
1752 if (lstat(str_get(st[1]),&statcache) < 0)
1754 if ((statcache.st_mode & S_IFMT) == S_IFLNK )
1760 tmps = str_get(st[1]);
1761 tmps2 = str_get(st[2]);
1763 taintproper("Insecure dependency in symlink");
1765 value = (double)(symlink(tmps,tmps2) >= 0);
1768 fatal("Unsupported function symlink()");
1773 tmps = str_get(stab_val(defstab));
1775 tmps = str_get(st[1]);
1776 anum = readlink(tmps,buf,sizeof buf);
1779 str_nset(str,buf,anum);
1782 fatal("Unsupported function readlink()");
1793 if (mystat(arg,st[1]) < 0)
1795 if (statcache.st_mode & anum)
1799 if (arg[1].arg_type & A_DONT) {
1800 stab = arg[1].arg_ptr.arg_stab;
1804 stab = stabent(tmps = str_get(st[1]),FALSE);
1805 if (stab && stab_io(stab) && stab_io(stab)->ifp)
1806 anum = fileno(stab_io(stab)->ifp);
1807 else if (isdigit(*tmps))
1816 str = do_fttext(arg,st[1]);
1820 if ((arg[1].arg_type & A_MASK) == A_WORD)
1821 stab = arg[1].arg_ptr.arg_stab;
1823 stab = stabent(str_get(st[1]),TRUE);
1825 value = (double)do_socket(stab,arglast);
1827 (void)do_socket(stab,arglast);
1831 if ((arg[1].arg_type & A_MASK) == A_WORD)
1832 stab = arg[1].arg_ptr.arg_stab;
1834 stab = stabent(str_get(st[1]),TRUE);
1836 value = (double)do_bind(stab,arglast);
1838 (void)do_bind(stab,arglast);
1842 if ((arg[1].arg_type & A_MASK) == A_WORD)
1843 stab = arg[1].arg_ptr.arg_stab;
1845 stab = stabent(str_get(st[1]),TRUE);
1847 value = (double)do_connect(stab,arglast);
1849 (void)do_connect(stab,arglast);
1853 if ((arg[1].arg_type & A_MASK) == A_WORD)
1854 stab = arg[1].arg_ptr.arg_stab;
1856 stab = stabent(str_get(st[1]),TRUE);
1858 value = (double)do_listen(stab,arglast);
1860 (void)do_listen(stab,arglast);
1864 if ((arg[1].arg_type & A_MASK) == A_WORD)
1865 stab = arg[1].arg_ptr.arg_stab;
1867 stab = stabent(str_get(st[1]),TRUE);
1868 if ((arg[2].arg_type & A_MASK) == A_WORD)
1869 stab2 = arg[2].arg_ptr.arg_stab;
1871 stab2 = stabent(str_get(st[2]),TRUE);
1872 do_accept(str,stab,stab2);
1880 sp = do_ghent(optype,
1888 sp = do_gnent(optype,
1896 sp = do_gpent(optype,
1904 sp = do_gsent(optype,
1908 value = (double) sethostent((int)str_gnum(st[1]));
1911 value = (double) setnetent((int)str_gnum(st[1]));
1914 value = (double) setprotoent((int)str_gnum(st[1]));
1917 value = (double) setservent((int)str_gnum(st[1]));
1920 value = (double) endhostent();
1923 value = (double) endnetent();
1926 value = (double) endprotoent();
1929 value = (double) endservent();
1932 sp = do_select(gimme,arglast);
1935 if ((arg[1].arg_type & A_MASK) == A_WORD)
1936 stab = arg[1].arg_ptr.arg_stab;
1938 stab = stabent(str_get(st[1]),TRUE);
1939 if ((arg[2].arg_type & A_MASK) == A_WORD)
1940 stab2 = arg[2].arg_ptr.arg_stab;
1942 stab2 = stabent(str_get(st[2]),TRUE);
1944 value = (double)do_spair(stab,stab2,arglast);
1946 (void)do_spair(stab,stab2,arglast);
1950 if ((arg[1].arg_type & A_MASK) == A_WORD)
1951 stab = arg[1].arg_ptr.arg_stab;
1953 stab = stabent(str_get(st[1]),TRUE);
1955 value = (double)do_shutdown(stab,arglast);
1957 (void)do_shutdown(stab,arglast);
1962 if ((arg[1].arg_type & A_MASK) == A_WORD)
1963 stab = arg[1].arg_ptr.arg_stab;
1965 stab = stabent(str_get(st[1]),TRUE);
1966 sp = do_sopt(optype,stab,arglast);
1970 if ((arg[1].arg_type & A_MASK) == A_WORD)
1971 stab = arg[1].arg_ptr.arg_stab;
1973 stab = stabent(str_get(st[1]),TRUE);
1974 sp = do_getsockname(optype,stab,arglast);
1977 #else /* SOCKET not defined */
2011 fatal("Unsupported socket function");
2016 if ((arg[1].arg_type & A_MASK) == A_WORD)
2017 stab = arg[1].arg_ptr.arg_stab;
2019 stab = stabent(str_get(st[1]),TRUE);
2020 if (!stab || !(stio = stab_io(stab)) || !(fp = stio->ifp))
2025 sp = do_vec(str == st[1], arg->arg_ptr.arg_str, arglast);
2030 sp = do_gpwent(optype,
2034 value = (double) setpwent();
2037 value = (double) endpwent();
2042 sp = do_ggrent(optype,
2046 value = (double) setgrent();
2049 value = (double) endgrent();
2052 if (!(tmps = getlogin()))
2064 if ((arg[1].arg_type & A_MASK) == A_WORD)
2065 stab = arg[1].arg_ptr.arg_stab;
2067 stab = stabent(str_get(st[1]),TRUE);
2068 sp = do_dirop(optype,stab,gimme,arglast);
2071 value = (double)do_syscall(arglast);
2081 deb("%s RETURNS \"%s\"\n",opname[optype],str_get(str));
2084 return arglast[0] + 1;
2091 deb("%s RETURNS ARRAY OF %d ARGS\n",opname[optype],sp - arglast[0]);
2113 str_numset(str,value);
2120 deb("%s RETURNS \"%f\"\n",opname[optype],value);
2123 return arglast[0] + 1;