Esempio n. 1
0
static sexp sexp_readdir_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0) {
  sexp res;
  if (! (sexp_pointerp(arg0) && (sexp_pointer_tag(arg0) == sexp_unbox_fixnum(sexp_opcode_arg1_type(self)))))
    return sexp_type_exception(ctx, self, sexp_unbox_fixnum(sexp_opcode_arg1_type(self)), arg0);
  res = sexp_make_cpointer(ctx, sexp_unbox_fixnum(sexp_opcode_return_type(self)), readdir((DIR*)sexp_cpointer_value(arg0)), arg0, 0);
  return res;
}
Esempio n. 2
0
static sexp sexp_time_3e_seconds_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0) {
  sexp res;
  if (! (sexp_pointerp(arg0) && (sexp_pointer_tag(arg0) == sexp_unbox_fixnum(sexp_opcode_arg1_type(self)))))
    return sexp_type_exception(ctx, self, sexp_unbox_fixnum(sexp_opcode_arg1_type(self)), arg0);
  res = sexp_make_integer(ctx, sexp_shift_epoch(mktime((struct tm*)sexp_cpointer_value(arg0))));
  return res;
}
Esempio n. 3
0
static sexp sexp_player_delete_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0) {
  sexp res;
  if (! (sexp_pointerp(arg0) && (sexp_pointer_tag(arg0) == sexp_unbox_fixnum(sexp_opcode_arg1_type(self)))))
    return sexp_type_exception(ctx, self, sexp_unbox_fixnum(sexp_opcode_arg1_type(self)), arg0);
  res = ((player_delete((struct player**)sexp_cpointer_value(arg0))), SEXP_VOID);
  return res;
}
Esempio n. 4
0
sexp sexp_string_count (sexp ctx, sexp self, sexp ch, sexp str, sexp start, sexp end) {
  const unsigned char *s, *e;
  sexp_sint_t c, count = 0;
#if SEXP_USE_UTF8_STRINGS
  sexp_sint_t i;
#endif
  sexp_assert_type(ctx, sexp_charp, SEXP_CHAR, ch);
  sexp_assert_type(ctx, sexp_stringp, SEXP_STRING, str);
  sexp_assert_type(ctx, sexp_fixnump, SEXP_FIXNUM, start);
  if (sexp_not(end)) end = sexp_make_fixnum(sexp_string_size(str));
  else sexp_assert_type(ctx, sexp_fixnump, SEXP_FIXNUM, end);
  c = sexp_unbox_character(ch);
#if SEXP_USE_UTF8_STRINGS
  if (c < 128) {
#endif
    s = (unsigned char*)sexp_string_data(str) + sexp_unbox_fixnum(start);
    e = (unsigned char*)sexp_string_data(str) + sexp_unbox_fixnum(end);
    if (e > (unsigned char*)sexp_string_data(str) + sexp_string_size(str))
      return sexp_user_exception(ctx, self, "string-count: end index out of range", end);
    /* fast case for ASCII chars */
    while (s < e) if (*s++ == c) count++;
#if SEXP_USE_UTF8_STRINGS
  } else {
    /* decode utf8 chars */
    s = (unsigned char*)sexp_string_data(str);
    for (i = sexp_unbox_fixnum(start); i < sexp_unbox_fixnum(end);
         i += sexp_utf8_initial_byte_count(s[i]))
      if (sexp_string_utf8_ref(ctx, str, sexp_make_fixnum(i)) == ch) count++;
  }
#endif
  return sexp_make_fixnum(count);
}
Esempio n. 5
0
static sexp sexp_get_opcode_param_type (sexp ctx, sexp self, sexp_sint_t n, sexp op, sexp k) {
  sexp res;
  int p = sexp_unbox_fixnum(k);
  if (! sexp_opcodep(op))
    return sexp_type_exception(ctx, self, SEXP_OPCODE, op);
  else if (! sexp_fixnump(k))
    return sexp_type_exception(ctx, self, SEXP_FIXNUM, k);
  if (p > sexp_opcode_num_args(op) && sexp_opcode_variadic_p(op))
    p = sexp_opcode_num_args(op);
  switch (p) {
  case 0:
    res = sexp_opcode_arg1_type(op);
    break;
  case 1:
    res = sexp_opcode_arg2_type(op);
    break;
  default:
    res = sexp_opcode_arg3_type(op);
    if (res && sexp_vectorp(res)) {
      if (sexp_vector_length(res) > (sexp_unbox_fixnum(k)-2))
        res = sexp_vector_ref(res, sexp_fx_sub(k, SEXP_TWO));
      else
        res = sexp_type_by_index(ctx, SEXP_OBJECT);
    }
    break;
  }
  return sexp_translate_opcode_type(ctx, res);
}
Esempio n. 6
0
static sexp sexp_string_cursor_copy (sexp ctx, sexp self, sexp_sint_t n, sexp dst, sexp sfrom, sexp src, sexp sstart, sexp send) {
  unsigned char *pfrom, *pto, *pstart, *pend, *prev, *p;
  sexp_sint_t from = sexp_unbox_fixnum(sfrom), to = sexp_string_size(dst),
    start = sexp_unbox_fixnum(sstart), end = sexp_unbox_fixnum(send);
  sexp_assert_type(ctx, sexp_stringp, SEXP_STRING, dst);
  sexp_assert_type(ctx, sexp_stringp, SEXP_STRING, src);
  sexp_assert_type(ctx, sexp_fixnump, SEXP_FIXNUM, sfrom);
  sexp_assert_type(ctx, sexp_fixnump, SEXP_FIXNUM, sstart);
  sexp_assert_type(ctx, sexp_fixnump, SEXP_FIXNUM, send);
  if (from < 0 || from > to)
    return sexp_user_exception(ctx, self, "string-cursor-copy!: from out of range", sfrom);
  if (start < 0 || start > sexp_string_size(src))
    return sexp_user_exception(ctx, self, "string-cursor-copy!: start out of range", sstart);
  if (end < start || end > sexp_string_size(src))
    return sexp_user_exception(ctx, self, "string-cursor-copy!: end out of range", send);
  pfrom = (unsigned char*)sexp_string_data(dst) + from;
  pto = (unsigned char*)sexp_string_data(dst) + to;
  pstart = (unsigned char*)sexp_string_data(src) + start;
  pend = (unsigned char*)sexp_string_data(src) + end;
  for ( ; pfrom < pto && pstart < pend; ++pfrom, ++pstart)
    *pfrom = *pstart;
  /* adjust for incomplete trailing chars */
  prev = (unsigned char*)sexp_string_utf8_prev(pfrom);
  if (sexp_utf8_initial_byte_count(*prev) > pfrom - prev) {
    for (p = prev; p < pfrom; ++p)
      *p = '\0';
    pstart -= pfrom - prev;
  }
  return sexp_make_fixnum(pstart - (unsigned char*)sexp_string_data(src));
}
Esempio n. 7
0
static sexp sexp_get_opcode_data (sexp ctx, sexp self, sexp_sint_t n, sexp op) {
  sexp data;
  sexp_assert_type(ctx, sexp_opcodep, SEXP_OPCODE, op);
  data = sexp_opcode_data(op);
  if (!data) return SEXP_VOID;
  return sexp_opcode_class(op) == SEXP_OPC_TYPE_PREDICATE
    && 0 <= sexp_unbox_fixnum(data)
    && sexp_unbox_fixnum(data) <= sexp_context_num_types(ctx) ?
    sexp_type_by_index(ctx, sexp_unbox_fixnum(data)) : data;
}
Esempio n. 8
0
static sexp sexp_player_move_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1, sexp arg2) {
  sexp res;
  if (! (sexp_pointerp(arg0) && (sexp_pointer_tag(arg0) == sexp_unbox_fixnum(sexp_opcode_arg1_type(self)))))
    return sexp_type_exception(ctx, self, sexp_unbox_fixnum(sexp_opcode_arg1_type(self)), arg0);
  if (! sexp_exact_integerp(arg1))
    return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg1);
  if (! sexp_exact_integerp(arg2))
    return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg2);
  res = ((player_move((struct player**)sexp_cpointer_value(arg0), sexp_uint_value(arg1), sexp_uint_value(arg2))), SEXP_VOID);
  return res;
}
Esempio n. 9
0
sexp sexp_bignum_add_fixnum (sexp ctx, sexp a, sexp b) {
  sexp_gc_var1(c);
  sexp_gc_preserve1(ctx, c);
  c = sexp_copy_bignum(ctx, NULL, a, 0);
  if (sexp_bignum_sign(c) == sexp_fx_sign(b))
    c = sexp_bignum_fxadd(ctx, c, sexp_unbox_fixnum(sexp_fx_abs(b)));
  else
    c = sexp_bignum_fxsub(ctx, c, sexp_unbox_fixnum(sexp_fx_abs(b)));
  sexp_gc_release1(ctx);
  return c;
}
Esempio n. 10
0
static sexp sexp_set_time_of_day_x_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1) {
  int err;
  sexp res;
  if (! (sexp_pointerp(arg0) && (sexp_pointer_tag(arg0) == sexp_unbox_fixnum(sexp_opcode_arg1_type(self)))))
    return sexp_type_exception(ctx, self, sexp_unbox_fixnum(sexp_opcode_arg1_type(self)), arg0);
  if (! ((sexp_pointerp(arg1) && (sexp_pointer_tag(arg1) == sexp_unbox_fixnum(sexp_opcode_arg2_type(self)))) || sexp_not(arg1)))
    return sexp_type_exception(ctx, self, sexp_unbox_fixnum(sexp_opcode_arg2_type(self)), arg1);
  err = settimeofday((struct timeval*)sexp_cpointer_value(arg0), (struct timezone*)sexp_cpointer_maybe_null_value(arg1));
  if (err) {
  res = SEXP_FALSE;
  } else {
  res = SEXP_TRUE;
  }
  return res;
}
Esempio n. 11
0
static sexp sexp_integer_to_immediate (sexp ctx, sexp self, sexp_sint_t n, sexp i, sexp dflt) {
  sexp x = (sexp)sexp_unbox_fixnum(i);
  sexp_assert_type(ctx, sexp_fixnump, SEXP_FIXNUM, i);
  if (sexp_pointerp(x))
    return dflt;
  return x;
}
Esempio n. 12
0
static sexp sexp_opendir_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0) {
  sexp res;
  if (! sexp_stringp(arg0))
    return sexp_type_exception(ctx, self, SEXP_STRING, arg0);
  res = sexp_make_cpointer(ctx, sexp_unbox_fixnum(sexp_opcode_return_type(self)), opendir(sexp_string_data(arg0)), SEXP_FALSE, 1);
  return res;
}
Esempio n. 13
0
sexp sexp_postmountsrv (sexp ctx, sexp self, sexp_sint_t n, sexp ls, sexp name, sexp mtpt, sexp flags) {
  Srv s;
  struct sexp_plan9_srv p9s;
  if (! sexp_listp(ctx, ls))
    return sexp_type_exception(ctx, self, SEXP_PAIR, ls);
  if (! sexp_stringp(name))
    return sexp_type_exception(ctx, self, SEXP_STRING, name);
  if (! sexp_stringp(mtpt))
    return sexp_type_exception(ctx, self, SEXP_STRING, mtpt);
  if (! sexp_integerp(flags))
    return sexp_type_exception(ctx, self, SEXP_FIXNUM, flags);
  sexp_build_srv(ctx, &p9s, ls);
  s.aux = &p9s;
  s.auth = &sexp_9p_auth;
  s.attach = &sexp_9p_attach;
  s.walk = &sexp_9p_walk;
  s.walk1 = &sexp_9p_walk1;
  s.clone = &sexp_9p_clone;
  s.open = &sexp_9p_open;
  s.create = &sexp_9p_create;
  s.remove = &sexp_9p_remove;
  s.read = &sexp_9p_read;
  s.write = &sexp_9p_write;
  s.stat = &sexp_9p_stat;
  s.wstat = &sexp_9p_wstat;
  s.flush = &sexp_9p_flush;
  s.destroyfid = &sexp_9p_destroyfid;
  s.destroyreq = &sexp_9p_destroyreq;
  s.end = &sexp_9p_end;
  postmountsrv(&s, sexp_string_data(name), sexp_string_data(mtpt),
               sexp_unbox_fixnum(flags));
  return SEXP_UNDEF;
}
Esempio n. 14
0
static sexp sexp_rs_random_integer (sexp ctx, sexp self, sexp_sint_t n, sexp rs, sexp bound) {
  sexp res;
  int32_t m;
#if SEXP_USE_BIGNUMS
  int32_t hi, mod, len, i, *data;
#endif
  if (! sexp_random_source_p(rs))
    res = sexp_type_exception(ctx, self, rs_type_id, rs);
  if (sexp_fixnump(bound)) {
    sexp_call_random(rs, m);
    res = sexp_make_fixnum(m % sexp_unbox_fixnum(bound));
#if SEXP_USE_BIGNUMS
  } else if (sexp_bignump(bound)) {
    hi = sexp_bignum_hi(bound);
    len = hi * sizeof(sexp_uint_t) / sizeof(int32_t);
    res = sexp_make_bignum(ctx, hi);
    data = (int32_t*) sexp_bignum_data(res);
    for (i=0; i<len-1; i++) {
      sexp_call_random(rs, m);
      data[i] = m;
    }
    sexp_call_random(rs, m);
    mod = sexp_bignum_data(bound)[hi-1] * sizeof(int32_t) / sizeof(sexp_uint_t);
    if (mod)
      data[i] = m % mod;
#endif
  } else {
    res = sexp_type_exception(ctx, self, SEXP_FIXNUM, bound);
  }
  return res;
}
Esempio n. 15
0
static sexp sexp_bit_and (sexp ctx, sexp self, sexp_sint_t n, sexp x, sexp y) {
  sexp res;
#if SEXP_USE_BIGNUMS
  sexp_sint_t len, i;
#endif
  if (sexp_fixnump(x)) {
    if (sexp_fixnump(y))
      res = (sexp) ((sexp_uint_t)x & (sexp_uint_t)y);
#if SEXP_USE_BIGNUMS
    else if (sexp_bignump(y))
      res = sexp_bit_and(ctx, self, n, y, x);
#endif
    else
      res = sexp_type_exception(ctx, self, SEXP_FIXNUM, y);
#if SEXP_USE_BIGNUMS
  } else if (sexp_bignump(x)) {
    if (sexp_fixnump(y)) {
      res = sexp_make_fixnum(sexp_unbox_fixnum(y) & sexp_bignum_data(x)[0]);
    } else if (sexp_bignump(y)) {
      if (sexp_bignum_length(x) < sexp_bignum_length(y))
        res = sexp_copy_bignum(ctx, NULL, x, 0);
      else
        res = sexp_copy_bignum(ctx, NULL, y, 0);
      for (i=0, len=sexp_bignum_length(res); i<len; i++)
        sexp_bignum_data(res)[i]
          = sexp_bignum_data(x)[i] & sexp_bignum_data(y)[i];
    } else {
      res = sexp_type_exception(ctx, self, SEXP_FIXNUM, y);
    }
#endif
  } else {
    res = sexp_type_exception(ctx, self, SEXP_FIXNUM, x);
  }
  return sexp_bignum_normalize(res);
}
Esempio n. 16
0
static sexp sexp_make_pollfds (sexp ctx) {
  sexp res = sexp_alloc_tagged(ctx, sexp_sizeof_pollfds, sexp_unbox_fixnum(sexp_global(ctx, SEXP_G_THREADS_POLLFDS_ID)));
  sexp_pollfds_fds(res) = malloc(SEXP_INIT_POLLFDS_MAX_FDS * sizeof(struct pollfd));
  sexp_pollfds_num_fds(res) = 0;
  sexp_pollfds_max_fds(res) = SEXP_INIT_POLLFDS_MAX_FDS;
  return res;
}
Esempio n. 17
0
sexp sexp_postnote (sexp ctx, sexp self, sexp_sint_t n, sexp pid, sexp note) {
  if (! sexp_integerp(pid))
    return sexp_type_exception(ctx, self, SEXP_FIXNUM, pid);
  if (! sexp_stringp(note))
    return sexp_type_exception(ctx, self, SEXP_STRING, note);
  postnote(PNPROC, sexp_unbox_fixnum(pid), sexp_string_data(note));
  return SEXP_VOID;
}
Esempio n. 18
0
static sexp sexp_random_source_pseudo_randomize (sexp ctx, sexp self, sexp_sint_t n, sexp rs, sexp seed) {
  if (! sexp_random_source_p(rs))
    return sexp_type_exception(ctx, self, rs_type_id, rs);
  if (! sexp_fixnump(seed))
    return sexp_type_exception(ctx, self, rs_type_id, seed);
  sexp_seed_random(sexp_unbox_fixnum(seed), rs);
  return SEXP_VOID;
}
Esempio n. 19
0
sexp sexp_exec (sexp ctx, sexp self, sexp_sint_t n, sexp name, sexp args) {
  int i, len = sexp_unbox_fixnum(sexp_length(ctx, args));
  char **argv = malloc((len+1)*sizeof(char*));
  for (i=0; i<len; i++, args=sexp_cdr(args))
    argv[i] = sexp_string_data(sexp_car(args));
  argv[len] = NULL;
  exec(sexp_string_data(name), argv);
  return SEXP_VOID;             /* won't really return */
}
Esempio n. 20
0
static sexp sexp_time_3e_string_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0) {
  char *err;
  char tmp1[64];
  sexp res;
  sexp_gc_var1(res1);
  if (! (sexp_pointerp(arg0) && (sexp_pointer_tag(arg0) == sexp_unbox_fixnum(sexp_opcode_arg1_type(self)))))
    return sexp_type_exception(ctx, self, sexp_unbox_fixnum(sexp_opcode_arg1_type(self)), arg0);
  sexp_gc_preserve1(ctx, res1);
  err = asctime_r((struct tm*)sexp_cpointer_value(arg0), tmp1);
  if (!err) {
  res = SEXP_FALSE;
  } else {
  res1 = sexp_c_string(ctx, tmp1, -1);
  res = res1;
  }
  sexp_gc_release1(ctx);
  return res;
}
Esempio n. 21
0
static sexp sexp_error_string (sexp ctx, sexp self, sexp_sint_t n, sexp x) {
  int err;
  if (x == SEXP_FALSE) {
    err = errno;
  } else {
    sexp_assert_type(ctx, sexp_fixnump, SEXP_FIXNUM, x);
    err = sexp_unbox_fixnum(x);
  }
  return sexp_c_string(ctx, strerror(err), -1);
}
Esempio n. 22
0
sexp sexp_bignum_expt (sexp ctx, sexp a, sexp b) {
  sexp_sint_t e = sexp_unbox_fixnum(sexp_fx_abs(b));
  sexp_gc_var2(res, acc);
  sexp_gc_preserve2(ctx, res, acc);
  res = sexp_fixnum_to_bignum(ctx, SEXP_ONE);
  acc = sexp_copy_bignum(ctx, NULL, a, 0);
  for (; e; e>>=1, acc=sexp_bignum_mul(ctx, NULL, acc, acc))
    if (e & 1)
      res = sexp_bignum_mul(ctx, NULL, res, acc);
  sexp_gc_release2(ctx);
  return sexp_bignum_normalize(res);
}
Esempio n. 23
0
static ssize_t sexp_cookie_reader (void *cookie, char *buffer, size_t size)
#endif
{
  sexp vec = (sexp)cookie, ctx, res;
  if (! sexp_procedurep(sexp_cookie_read(vec))) return -1;
  sexp_gc_var2(ctx2, args);
  ctx = sexp_cookie_ctx(vec);
  ctx2 = sexp_last_context(ctx, (sexp*)&cookie);
  sexp_gc_preserve2(ctx, ctx2, args);
  if (size > sexp_string_length(sexp_cookie_buffer(vec)))
    sexp_cookie_buffer_set(vec, sexp_make_string(ctx, sexp_make_fixnum(size), SEXP_VOID));
  args = sexp_list2(ctx, sexp_cookie_buffer(vec), sexp_make_fixnum(size));
  res = sexp_apply(ctx, sexp_cookie_read(vec), args);
  sexp_gc_release2(ctx);
  if (sexp_fixnump(res)) {
    memcpy(buffer, sexp_string_data(sexp_cookie_buffer(vec)), sexp_unbox_fixnum(res));
    return sexp_unbox_fixnum(res);
  } else {
    return -1;
  }
}
Esempio n. 24
0
static sexp sexp_get_time_of_day_stub (sexp ctx, sexp self, sexp_sint_t n) {
  int err;
  struct timeval* tmp0;
  struct timezone* tmp1;
  sexp_gc_var3(res, res0, res1);
  sexp_gc_preserve3(ctx, res, res0, res1);
  tmp0 = (struct timeval*) calloc(1, 1 + sizeof(tmp0[0]));
  tmp1 = (struct timezone*) calloc(1, 1 + sizeof(tmp1[0]));
  err = gettimeofday(tmp0, tmp1);
  if (err) {
  res = SEXP_FALSE;
  } else {
  res0 = sexp_make_cpointer(ctx, sexp_unbox_fixnum(sexp_opcode_arg1_type(self)), tmp0, SEXP_FALSE, 1);
  res1 = sexp_make_cpointer(ctx, sexp_unbox_fixnum(sexp_opcode_arg2_type(self)), tmp1, SEXP_FALSE, 1);
  res = SEXP_NULL;
  sexp_push(ctx, res, res1);
  sexp_push(ctx, res, res0);
  }
  sexp_gc_release3(ctx);
  return res;
}
Esempio n. 25
0
static sexp sexp_pop_signal (sexp ctx, sexp self, sexp_sint_t n) {
  int allsigs, restsigs, signum;
  if (sexp_global(ctx, SEXP_G_THREADS_SIGNALS) == SEXP_ZERO) {
    return SEXP_FALSE;
  } else {
    allsigs = sexp_unbox_fixnum(sexp_global(ctx, SEXP_G_THREADS_SIGNALS));
    restsigs = allsigs & (allsigs-1);
    sexp_global(ctx, SEXP_G_THREADS_SIGNALS) = sexp_make_fixnum(restsigs);
    signum = sexp_log2_of_pow2(allsigs-restsigs);
    return sexp_make_fixnum(signum);
  }
}
Esempio n. 26
0
sexp sexp_mutex_state (sexp ctx, sexp self, sexp_sint_t n, sexp mutex) {
  if (!sexp_mutexp(ctx, mutex))
    return sexp_type_exception(ctx, self, sexp_unbox_fixnum(sexp_global(ctx, SEXP_G_THREADS_POLLFDS_ID)), mutex);
  if (sexp_truep(sexp_mutex_lockp(mutex))) {
    if (sexp_contextp(sexp_mutex_thread(mutex)))
      return sexp_mutex_thread(mutex);
    else
      return sexp_intern(ctx, "not-owned", -1);
  } else {
    return sexp_intern(ctx, (sexp_mutex_thread(mutex) ? "not-abandoned" : "abandoned"), -1);
  }
}
Esempio n. 27
0
static sexp sexp_close_file_descriptor_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0) {
  int err;
  sexp res;
  if (! (sexp_filenop(arg0) || sexp_fixnump(arg0)))
    return sexp_type_exception(ctx, self, SEXP_FILENO, arg0);
  err = close((sexp_filenop(arg0) ? sexp_fileno_fd(arg0) : sexp_unbox_fixnum(arg0)));
  if (err) {
  res = SEXP_FALSE;
  } else {
  res = SEXP_TRUE;
  }
  return res;
}
Esempio n. 28
0
static sexp sexp_get_opcode_ret_type (sexp ctx, sexp self, sexp_sint_t n, sexp op) {
  sexp res;
  if (!op)
    return sexp_type_by_index(ctx, SEXP_OBJECT);
  if (! sexp_opcodep(op))
    return sexp_type_exception(ctx, self, SEXP_OPCODE, op);
  if (sexp_opcode_code(op) == SEXP_OP_RAISE)
    return sexp_list1(ctx, sexp_intern(ctx, "error", -1));
  res = sexp_opcode_return_type(op);
  if (sexp_fixnump(res))
    res = sexp_type_by_index(ctx, sexp_unbox_fixnum(res));
  return sexp_translate_opcode_type(ctx, res);
}
Esempio n. 29
0
sexp sexp_write_u8 (sexp ctx, sexp self, sexp u8, sexp out) {
  sexp_assert_type(ctx, sexp_fixnump, SEXP_FIXNUM, u8);
  if (sexp_unbox_fixnum(u8) < 0 || sexp_unbox_fixnum(u8) > 255)
    return sexp_xtype_exception(ctx, self, "not a u8 value", u8);
  sexp_assert_type(ctx, sexp_oportp, SEXP_OPORT, out);
  if (!sexp_port_binaryp(out))
    return sexp_xtype_exception(ctx, self, "not a binary port", out);
#if SEXP_USE_GREEN_THREADS
  errno = 0;
#endif
  if (sexp_write_char(ctx, sexp_unbox_fixnum(u8), out) == EOF) {
    if (sexp_port_stream(out))
      clearerr(sexp_port_stream(out));
#if SEXP_USE_GREEN_THREADS
    if (errno == EAGAIN) {
      if (sexp_applicablep(sexp_global(ctx, SEXP_G_THREADS_BLOCKER)))
        sexp_apply1(ctx, sexp_global(ctx, SEXP_G_THREADS_BLOCKER), out);
      return sexp_global(ctx, SEXP_G_IO_BLOCK_ERROR);
    }
#endif
  }
  return SEXP_VOID;
}
Esempio n. 30
0
static sexp sexp_make_timeval_stub (sexp ctx, sexp self, sexp_sint_t n, sexp arg0, sexp arg1) {
  struct timeval* r;
  sexp_gc_var1(res);
  sexp_gc_preserve1(ctx, res);
  res = sexp_alloc_tagged(ctx, sexp_sizeof(cpointer), sexp_unbox_fixnum(sexp_opcode_return_type(self)));
  sexp_cpointer_value(res) = calloc(1, sizeof(struct timeval));
  r = (struct timeval*) sexp_cpointer_value(res);
  memset(r, 0, sizeof(struct timeval));
  sexp_freep(res) = 1;
  r->tv_sec = sexp_unshift_epoch(sexp_uint_value(arg0));
  r->tv_usec = sexp_sint_value(arg1);
  sexp_gc_release1(ctx);
  return res;
}