view release on metacpan or  search on metacpan

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

            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);
               lst = cons(onum(st.st_mode, 0), lst);
               lst = cons(onum(st.st_ino, 0), lst);
               lst = cons(onum(st.st_dev, 1), lst);
               return lst;
            }
         }
         return INULL;
      case 39: /* chmod fd|path mode follow → bool */
         if ((immediatep(a) || stringp(a)) && fixnump(b)) {
            mode_t mod = immval(b);
            int flg = c != IFALSE ? 0 : AT_SYMLINK_NOFOLLOW;
            if ((allocp(a) ? fchmodat(AT_FDCWD, (char *)a + W, mod, flg) : fchmod(immval(a), mod)) == 0)
               return ITRUE;
         }
         return IFALSE;
      case 40: /* chown fd|path (uid . gid) follow → bool */
         if ((immediatep(a) || stringp(a)) && pairp(b)) {
            uid_t uid = cnum(G(b, 1));
            gid_t gid = cnum(G(b, 2));
            int flg = c != IFALSE ? 0 : AT_SYMLINK_NOFOLLOW;
            if ((allocp(a) ? fchownat(AT_FDCWD, (char *)a + W, uid, gid, flg) : fchown(immval(a), uid, gid)) == 0)
               return ITRUE;
         }
         return IFALSE;
      case 41: { /* peek mem nbytes → num */
         const word p = cnum(a);
         return onum(
            b == F(1) ? *(uint8_t *)p :
            b == F(2) ? *(uint16_t *)p :
            b == F(4) ? *(uint32_t *)p :
            b == F(8) ? *(uint64_t *)p :
            V(p), 0);
         }
      case 42: /* write fd data len | #f → nbytes | #f */
         if (is_type(a, TPORT) && allocp(b)) {
            size_t len, size = payl_len(header(b));
            len = c != IFALSE ? cnum(c) : size;
            if (len <= size) {
               len = write(immval(a), (const word *)b + 1, len);
               if (len != (size_t)-1)
                  return onum(len, 0);
            }
         }
         return IFALSE;
      case 43:
         return do_poll(a, b, c);
      case 44:  {
         char *host = (char *) (word *) a + W;
         struct addrinfo *res;
         int nth = immval(b);
         int rv = getaddrinfo(host, NULL, NULL, &res);
         if (rv == 0) {
            word rv = IFALSE;
            while (nth--) {
               if (res)
                  res = res->ai_next;
               if (!res)
                  return INULL;
            }
            if (res->ai_addr->sa_family == AF_INET6) {
               char *n = (char *) &((struct sockaddr_in6*)res->ai_addr)->sin6_addr;
               rv = mkraw(TBVEC, 6);
               memcpy((word *)rv + 1, n, 6);
            } else if (res->ai_addr->sa_family == AF_INET) {
               char *n = (char *) &((struct sockaddr_in*)res->ai_addr)->sin_addr;
               rv = mkraw(TBVEC, 4);
               memcpy((word *)rv + 1, n, 4);
            }
            freeaddrinfo(res);
            return rv;
         }
         return IFALSE; }
      case 45: { /* getpid _ _ _*/
         return(onum(getpid(), 0)); }
      case 46: { /* catch-signals (4 8 ...) _ _*/
         struct sigaction sa;
         word *lst = (word *)a;
         sa.sa_handler = catch_signal;
         sigemptyset(&sa.sa_mask);
         sa.sa_flags = SA_RESTART;
         while((word)lst != INULL) {