view release on metacpan or  search on metacpan

radamsa/c/libradamsa.c  view on Meta::CPAN

         } else if (WIFSIGNALED(status)) {
            r[1] = F(2);
            r[2] = F(WTERMSIG(status));
         } else if (WIFSTOPPED(status)) {
            r[1] = F(3);
            r[2] = F(WSTOPSIG(status));
         /*} else if (WIFCONTINUED(status)) {
            r[1] = F(4);
            r[2] = F(1); */
         } else {
            r = (word *)IFALSE;
         }
         return (word)r; }
      case 20: /* chdir path → bool */
         return BOOL(stringp(a) && chdir((char *)a + W) == 0);
      case 21: /* kill pid signal → bool */
         return BOOL(kill(cnum(a), immval(b)) == 0);
      case 22: /* unlink path → bool */
         return BOOL(stringp(a) && unlink((char *)a + W) == 0);
      case 23: /* rmdir path → bool */
         return BOOL(stringp(a) && rmdir((char *)a + W) == 0);
      case 24: /* mknod path (type . mode) dev → bool */
         if (stringp(a) && pairp(b)) {
            const char *path = (const char *)a + W;
            const mode_t type = cnum(G(b, 1)), mode = immval(G(b, 2));
            if ((type == S_IFDIR ? mkdir(path, mode) : mknod(path, type | mode, cnum(c))) == 0)
               return ITRUE;
         }
         return IFALSE;
      case 25: /* lseek port offset whence → offset | #f */
         if (is_type(a, TPORT)) {
            off_t o = lseek(immval(a), cnum(b), cnum(c));
            if (o != -1)
               return onum(o, 1);
         }
         return IFALSE;
      case 26:
         if (a != IFALSE) {
            static struct termios old;
            tcgetattr(0, &old);
            old.c_iflag &= ~(IGNBRK | BRKINT | PARMRK | ISTRIP | INLCR | IGNCR | ICRNL | IXON);
            old.c_oflag &= ~OPOST;
            old.c_lflag &= ~(ECHO | ECHONL | ICANON | ISIG | IEXTEN);
            old.c_cflag &= ~(CSIZE | PARENB);
            old.c_cflag |= CS8;
            return BOOL(tcsetattr(0, TCSANOW, &old) == 0);
         }
         return BOOL(tcsetattr(0, TCSANOW, &tsettings) == 0);
      case 27: { /* sendmsg sock (port . ipv4) bvec */
         int sock = immval(a);
         int port;
         struct sockaddr_in peer;
         byte *ip, *data = (byte *)c + W;
         size_t len = payl_len(header(c));
         port = immval(G(b, 1));
         ip = (byte *)G(b, 2) + W;
         peer.sin_family = AF_INET;
         peer.sin_port = htons(port);
         peer.sin_addr.s_addr = htonl(ip[0] << 24 | ip[1] << 16 | ip[2] << 8 | ip[3]);
         return BOOL(sendto(sock, data, len, 0, (struct sockaddr *)&peer, sizeof(peer)) != -1); }
      case 28: /* setenv <owl-raw-bvec-or-ascii-leaf-string> <owl-raw-bvec-or-ascii-leaf-string-or-#f> */
         if (stringp(a) && (b == IFALSE || stringp(b))) {
            const char *name = (const char *)a + W;
            if ((b != IFALSE ? setenv(name, (const char *)b + W, 1) : unsetenv(name)) == 0)
               return ITRUE;
         }
         return IFALSE;
      case 29:
         return prim_connect((word *) a, b, c);
      case 30: /* dup2 old-port new-fd → new-port | #f */
         if (is_type(a, TPORT)) {
            int fd = dup2(immval(a), immval(b));
            if (fd != -1)
               return make_immediate(fd, TPORT);
         }
         return IFALSE;
      case 31: { /* pipe → '(read-port . write-port) | #f */
         int fd[2];
         if (pipe(fd) != 0)
            return IFALSE;
         return cons(make_immediate(fd[0], TPORT), make_immediate(fd[1], TPORT)); }
      case 32: /* rename src dst → bool */
         return BOOL(stringp(a) && stringp(b) && rename((char *)a + W, (char *)b + W) == 0);
      case 33: /* link src dst → bool */
         return BOOL(stringp(a) && stringp(b) && link((char *)a + W, (char *)b + W) == 0);
      case 34: /* symlink src dst → bool */
         return BOOL(stringp(a) && stringp(b) && symlink((char *)a + W, (char *)b + W) == 0);
      case 35: /* readlink path → raw-sting | #false */
         if (stringp(a)) {
            size_t len = memend - fp;
            size_t max = len > MAXOBJ ? MAXPAYL + 1 : (len - 1) * W;
            /* the last byte is temporarily used to check, if the string fits */
            len = readlink((const char *)a + W, (char *)fp + W, max);
            if (len != (size_t)-1 && len != max)
               return mkraw(TSTRING, len);
         }
         return IFALSE;
      case 36: /* getcwd → raw-sting | #false */
         {
            size_t len = memend - fp;
            size_t max = len > MAXOBJ ? MAXPAYL + 1 : (len - 1) * W;
            /* the last byte is temporarily used for the terminating '\0' */
            if (getcwd((char *)fp + W, max) != NULL)
               return mkraw(TSTRING, strnlen((char *)fp + W, max - 1));
         }
         return IFALSE;
      case 37: /* umask mask → mask */
         return F(umask(immval(a)));
      case 38: /* stat fd|path follow → list */
         if (immediatep(a) || stringp(a)) {
            struct stat st;
            int flg = b != IFALSE ? 0 : AT_SYMLINK_NOFOLLOW;
            if ((allocp(a) ? fstatat(AT_FDCWD, (char *)a + W, &st, flg) : fstat(immval(a), &st)) == 0) {
               word lst = INULL;
               lst = cons(onum(st.st_blocks, 1), lst);
               lst = cons(onum(st.st_blksize, 1), lst);
               lst = cons(onum(st.st_ctim.tv_sec * INT64_C(1000000000) + st.st_atim.tv_nsec, 1), lst);
               lst = cons(onum(st.st_mtim.tv_sec * INT64_C(1000000000) + st.st_atim.tv_nsec, 1), lst);
               lst = cons(onum(st.st_atim.tv_sec * INT64_C(1000000000) + st.st_atim.tv_nsec, 1), lst);
               lst = cons(onum(st.st_size, 1), lst);
               lst = cons(onum(st.st_rdev, 0), lst);
               lst = cons(onum(st.st_gid, 0), lst);
               lst = cons(onum(st.st_uid, 0), lst);
               lst = cons(onum(st.st_nlink, 0), lst);