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; }
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; }
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; }
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); }
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); }
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)); }
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; }
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; }
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; }
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; }
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; }
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; }
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; }
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; }
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); }
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; }
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; }
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; }
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 */ }
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; }
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); }
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); }
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; } }
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; }
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); } }
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); } }
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; }
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); }
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; }
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; }